abi-dumper.pl revision 5d886e3cb2269b158ebda6cbd4ffd49e2ac9d5ee 
1#!/usr/bin/perl
2###########################################################################
3# ABI Dumper 0.99.7
4# Dump ABI of an ELF object containing DWARF debug info
5#
6# Copyright (C) 2012-2015 Andrey Ponomarenko's ABI Laboratory
7#
8# Written by Andrey Ponomarenko
9#
10# PLATFORMS
11# =========
12#  Linux
13#
14# REQUIREMENTS
15# ============
16#  Perl 5 (5.8 or newer)
17#  Elfutils (eu-readelf)
18#  Vtable-Dumper (1.0 or newer)
19#
20# COMPATIBILITY
21# =============
22#  ABI Compliance Checker >= 1.99.8
23#
24#
25# This program is free software: you can redistribute it and/or modify
26# it under the terms of the GNU General Public License or the GNU Lesser
27# General Public License as published by the Free Software Foundation.
28#
29# This program is distributed in the hope that it will be useful,
30# but WITHOUT ANY WARRANTY; without even the implied warranty of
31# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
32# GNU General Public License for more details.
33#
34# You should have received a copy of the GNU General Public License
35# and the GNU Lesser General Public License along with this program.
36# If not, see <http://www.gnu.org/licenses/>.
37###########################################################################
38use Getopt::Long;
39Getopt::Long::Configure ("posix_default", "no_ignore_case", "permute");
40use File::Path qw(mkpath rmtree);
41use File::Temp qw(tempdir);
42use Cwd qw(abs_path cwd realpath);
43use Storable qw(dclone);
44use Data::Dumper;
45
46my $TOOL_VERSION = "0.99.7";
47my $ABI_DUMP_VERSION = "3.2";
48my $ORIG_DIR = cwd();
49my $TMP_DIR = tempdir(CLEANUP=>1);
50
51my $VTABLE_DUMPER = "vtable-dumper";
52my $VTABLE_DUMPER_VERSION = "1.0";
53
54my ($Help, $ShowVersion, $DumpVersion, $OutputDump, $SortDump, $StdOut,
55$TargetVersion, $ExtraInfo, $FullDump, $AllTypes, $AllSymbols, $BinOnly,
56$SkipCxx, $Loud, $AddrToName, $DumpStatic, $Compare, $AltDebugInfo,
57$OptMem);
58
59my $CmdName = get_filename($0);
60
61my %ERROR_CODE = (
62    "Success"=>0,
63    "Error"=>2,
64    # System command is not found
65    "Not_Found"=>3,
66    # Cannot access input files
67    "Access_Error"=>4,
68    # Cannot find a module
69    "Module_Error"=>9,
70    # No debug-info
71    "No_DWARF"=>10,
72    # Invalid debug-info
73    "Invalid_DWARF"=>11
74);
75
76my $ShortUsage = "ABI Dumper $TOOL_VERSION
77Dump ABI of an ELF object containing DWARF debug info
78Copyright (C) 2015 Andrey Ponomarenko's ABI Laboratory
79License: GNU LGPL or GNU GPL
80
81Usage: $CmdName [options] [object]
82Example:
83  $CmdName libTest.so -o ABI.dump
84  $CmdName Module.ko.debug -o ABI.dump
85
86More info: $CmdName --help\n";
87
88if($#ARGV==-1)
89{
90    printMsg("INFO", $ShortUsage);
91    exit(0);
92}
93
94GetOptions("h|help!" => \$Help,
95  "v|version!" => \$ShowVersion,
96  "dumpversion!" => \$DumpVersion,
97# general options
98  "o|output|dump-path=s" => \$OutputDump,
99  "sort!" => \$SortDump,
100  "stdout!" => \$StdOut,
101  "loud!" => \$Loud,
102  "lver|lv=s" => \$TargetVersion,
103  "extra-info=s" => \$ExtraInfo,
104  "bin-only!" => \$BinOnly,
105  "all-types!" => \$AllTypes,
106  "all-symbols!" => \$AllSymbols,
107  "skip-cxx!" => \$SkipCxx,
108  "all!" => \$FullDump,
109  "dump-static!" => \$DumpStatic,
110  "compare!" => \$Compare,
111  "alt=s" => \$AltDebugInfo,
112  "mem!" =>\$OptMem,
113# internal options
114  "addr2name!" => \$AddrToName
115) or ERR_MESSAGE();
116
117sub ERR_MESSAGE()
118{
119    printMsg("INFO", "\n".$ShortUsage);
120    exit($ERROR_CODE{"Error"});
121}
122
123my $HelpMessage="
124NAME:
125  ABI Dumper ($CmdName)
126  Dump ABI of an ELF object containing DWARF debug info
127
128DESCRIPTION:
129  ABI Dumper is a tool for dumping ABI information of an ELF object
130  containing DWARF debug info.
131
132  The tool is intended to be used with ABI Compliance Checker tool for tracking
133  ABI changes of a C/C++ library or kernel module.
134
135  This tool is free software: you can redistribute it and/or modify it
136  under the terms of the GNU LGPL or GNU GPL.
137
138USAGE:
139  $CmdName [options] [object]
140
141EXAMPLES:
142  $CmdName libTest.so -o ABI.dump
143  $CmdName Module.ko.debug -o ABI.dump
144
145INFORMATION OPTIONS:
146  -h|-help
147      Print this help.
148
149  -v|-version
150      Print version information.
151
152  -dumpversion
153      Print the tool version ($TOOL_VERSION) and don't do anything else.
154
155GENERAL OPTIONS:
156  -o|-output PATH
157      Path to the output ABI dump file.
158      Default: ./ABI.dump
159
160  -sort
161      Sort data in ABI dump.
162
163  -stdout
164      Print ABI dump to stdout.
165
166  -loud
167      Print all warnings.
168
169  -lv|-lver NUM
170      Set version of the library to NUM.
171
172  -extra-info DIR
173      Dump extra analysis info to DIR.
174
175  -bin-only
176      Do not dump information about inline functions,
177      pure virtual functions and non-exported global data.
178
179  -all-types
180      Dump unused data types.
181
182  -all-symbols
183      Dump symbols not exported by the object.
184
185  -skip-cxx
186      Do not dump stdc++ and gnu c++ symbols.
187
188  -all
189      Equal to: -all-types -all-symbols.
190
191  -dump-static
192      Dump static (local) symbols.
193
194  -compare OLD.dump NEW.dump
195      Show added/removed symbols between two ABI dumps.
196
197  -alt PATH
198      Path to the alternate debug info (Fedora). It is
199      detected automatically from gnu_debugaltlink section
200      of the input object if not specified.
201
202  -mem
203      Try to optimize system memory usage.
204";
205
206sub HELP_MESSAGE() {
207    printMsg("INFO", $HelpMessage);
208}
209
210my %Cache;
211
212# Input
213my %DWARF_Info;
214
215# Alternate
216my %ImportedUnit;
217my %ImportedDecl;
218
219# Output
220my %SymbolInfo;
221my %TypeInfo;
222
223# Reader
224my %TypeMember;
225my %ArrayCount;
226my %FuncParam;
227my %Inheritance;
228my %NameSpace;
229my %SpecElem;
230my %OrigElem;
231my %ClassMethods;
232my %TypeSpec;
233my %ClassChild;
234
235my %MergedTypes;
236my %LocalType;
237
238my %SourceFile;
239my %SourceFile_Alt;
240my %DebugLoc;
241my %TName_Tid;
242my %TName_Tids;
243my %RegName;
244
245my $STDCXX_TARGET = 0;
246my $GLOBAL_ID = 0;
247my %ANON_TYPE = ();
248
249my %Mangled_ID;
250my %Checked_Spec;
251my %SelectedSymbols;
252
253my %TypeType = (
254    "class_type"=>"Class",
255    "structure_type"=>"Struct",
256    "union_type"=>"Union",
257    "enumeration_type"=>"Enum",
258    "array_type"=>"Array",
259    "base_type"=>"Intrinsic",
260    "const_type"=>"Const",
261    "pointer_type"=>"Pointer",
262    "reference_type"=>"Ref",
263    "volatile_type"=>"Volatile",
264    "typedef"=>"Typedef",
265    "ptr_to_member_type"=>"FieldPtr"
266);
267
268my %Qual = (
269    "Pointer"=>"*",
270    "Ref"=>"&",
271    "Volatile"=>"volatile",
272    "Const"=>"const"
273);
274
275my $HEADER_EXT = "h|hh|hp|hxx|hpp|h\\+\\+|tcc";
276my $SRC_EXT = "c|cpp|cxx|c\\+\\+";
277
278# Other
279my %NestedNameSpaces;
280my $TargetName;
281my %SysInfo;
282my %HeadersInfo;
283my %SourcesInfo;
284my %SymVer;
285my %UsedType;
286
287# ELF
288my %Library_Symbol;
289my %Library_LocalSymbol;
290my %Library_UndefSymbol;
291my %Library_Needed;
292my %SymbolTable;
293my %SectionInfo;
294
295# VTables
296my %VirtualTable;
297
298# Env
299my $SYS_ARCH;
300my $SYS_WORD;
301my $SYS_GCCV;
302my $SYS_COMP;
303
304my $LIB_LANG;
305
306sub printMsg($$)
307{
308    my ($Type, $Msg) = @_;
309    if($Type!~/\AINFO/) {
310        $Msg = $Type.": ".$Msg;
311    }
312    if($Type!~/_C\Z/) {
313        $Msg .= "\n";
314    }
315    if($Type eq "ERROR") {
316        print STDERR $Msg;
317    }
318    else {
319        print $Msg;
320    }
321}
322
323sub exitStatus($$)
324{
325    my ($Code, $Msg) = @_;
326    printMsg("ERROR", $Msg);
327    exit($ERROR_CODE{$Code});
328}
329
330sub cmpVersions($$)
331{ # compare two versions in dotted-numeric format
332    my ($V1, $V2) = @_;
333    return 0 if($V1 eq $V2);
334    return undef if($V1!~/\A\d+[\.\d+]*\Z/);
335    return undef if($V2!~/\A\d+[\.\d+]*\Z/);
336    my @V1Parts = split(/\./, $V1);
337    my @V2Parts = split(/\./, $V2);
338    for (my $i = 0; $i <= $#V1Parts && $i <= $#V2Parts; $i++) {
339        return -1 if(int($V1Parts[$i]) < int($V2Parts[$i]));
340        return 1 if(int($V1Parts[$i]) > int($V2Parts[$i]));
341    }
342    return -1 if($#V1Parts < $#V2Parts);
343    return 1 if($#V1Parts > $#V2Parts);
344    return 0;
345}
346
347sub writeFile($$)
348{
349    my ($Path, $Content) = @_;
350    return if(not $Path);
351    if(my $Dir = get_dirname($Path)) {
352        mkpath($Dir);
353    }
354    open(FILE, ">", $Path) || die ("can't open file \'$Path\': $!\n");
355    print FILE $Content;
356    close(FILE);
357}
358
359sub readFile($)
360{
361    my $Path = $_[0];
362    return "" if(not $Path or not -f $Path);
363    open(FILE, $Path);
364    local $/ = undef;
365    my $Content = <FILE>;
366    close(FILE);
367    return $Content;
368}
369
370sub get_filename($)
371{ # much faster than basename() from File::Basename module
372    if($_[0] and $_[0]=~/([^\/\\]+)[\/\\]*\Z/) {
373        return $1;
374    }
375    return "";
376}
377
378sub get_dirname($)
379{ # much faster than dirname() from File::Basename module
380    if($_[0] and $_[0]=~/\A(.*?)[\/\\]+[^\/\\]*[\/\\]*\Z/) {
381        return $1;
382    }
383    return "";
384}
385
386sub check_Cmd($)
387{
388    my $Cmd = $_[0];
389    return "" if(not $Cmd);
390    if(defined $Cache{"check_Cmd"}{$Cmd}) {
391        return $Cache{"check_Cmd"}{$Cmd};
392    }
393    foreach my $Path (sort {length($a)<=>length($b)} split(/:/, $ENV{"PATH"}))
394    {
395        if(-x $Path."/".$Cmd) {
396            return ($Cache{"check_Cmd"}{$Cmd} = 1);
397        }
398    }
399    return ($Cache{"check_Cmd"}{$Cmd} = 0);
400}
401
402my %ELF_BIND = map {$_=>1} (
403    "WEAK",
404    "GLOBAL",
405    "LOCAL"
406);
407
408my %ELF_TYPE = map {$_=>1} (
409    "FUNC",
410    "IFUNC",
411    "OBJECT",
412    "COMMON"
413);
414
415my %ELF_VIS = map {$_=>1} (
416    "DEFAULT",
417    "PROTECTED"
418);
419
420sub readline_ELF($)
421{ # read the line of 'eu-readelf' output corresponding to the symbol
422    my @Info = split(/\s+/, $_[0]);
423    #  Num:   Value      Size Type   Bind   Vis       Ndx  Name
424    #  3629:  000b09c0   32   FUNC   GLOBAL DEFAULT   13   _ZNSt12__basic_fileIcED1Ev@@GLIBCXX_3.4
425    #  135:   00000000    0   FUNC   GLOBAL DEFAULT   UNDEF  av_image_fill_pointers@LIBAVUTIL_52 (3)
426    shift(@Info) if($Info[0] eq ""); # spaces
427    shift(@Info); # num
428
429    if($#Info==7)
430    { # UNDEF SYMBOL (N)
431        if($Info[7]=~/\(\d+\)/) {
432            pop(@Info);
433        }
434    }
435
436    if($#Info!=6)
437    { # other lines
438        return ();
439    }
440    return () if(not defined $ELF_TYPE{$Info[2]} and $Info[5] ne "UNDEF");
441    return () if(not defined $ELF_BIND{$Info[3]});
442    return () if(not defined $ELF_VIS{$Info[4]});
443    if($Info[5] eq "ABS" and $Info[0]=~/\A0+\Z/)
444    { # 1272: 00000000     0 OBJECT  GLOBAL DEFAULT  ABS CXXABI_1.3
445        return ();
446    }
447    if(index($Info[2], "0x") == 0)
448    { # size == 0x3d158
449        $Info[2] = hex($Info[2]);
450    }
451    return @Info;
452}
453
454sub read_Symbols($)
455{
456    my $Lib_Path = $_[0];
457    my $Lib_Name = get_filename($Lib_Path);
458
459    my $Dynamic = ($Lib_Name=~/\.so(\.|\Z)/);
460    my $Dbg = ($Lib_Name=~/\.debug\Z/);
461
462    my $Readelf = "eu-readelf";
463    if(not check_Cmd($Readelf)) {
464        exitStatus("Not_Found", "can't find \"eu-readelf\"");
465    }
466
467    my $Cmd = $Readelf." -S \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
468    foreach (split(/\n/, `$Cmd`))
469    {
470        if(/\[\s*(\d+)\]\s+([\w\.]+)/)
471        {
472            $SectionInfo{$1} = $2;
473        }
474    }
475
476    if($Dynamic)
477    { # dynamic library specifics
478        $Cmd = $Readelf." -d \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
479        foreach (split(/\n/, `$Cmd`))
480        {
481            if(/NEEDED.+\[([^\[\]]+)\]/)
482            { # dependencies:
483              # 0x00000001 (NEEDED) Shared library: [libc.so.6]
484                $Library_Needed{$1} = 1;
485            }
486        }
487    }
488
489    my $ExtraPath = "";
490
491    if($ExtraInfo)
492    {
493        $ExtraPath = $ExtraInfo."/".$Lib_Name;
494        mkpath($ExtraPath);
495        $ExtraPath .= "/elf-info";
496    }
497
498    $Cmd = $Readelf." -s \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
499
500    if($ExtraPath)
501    { # debug mode
502        # write to file
503        system($Cmd." >\"$ExtraPath\"");
504        open(LIB, $ExtraPath);
505    }
506    else
507    { # write to pipe
508        open(LIB, $Cmd." |");
509    }
510
511    my (%Symbol_Value, %Value_Symbol) = ();
512
513    my $symtab = undef; # indicates that we are processing 'symtab' section of 'readelf' output
514    while(<LIB>)
515    {
516        if($Dynamic and not $Dbg)
517        { # dynamic library specifics
518            if(defined $symtab)
519            {
520                if(index($_, "'.dynsym'")!=-1)
521                { # dynamic table
522                    $symtab = undef;
523                }
524                if(not $AllSymbols)
525                { # do nothing with symtab
526                    next;
527                }
528            }
529            elsif(index($_, "'.symtab'")!=-1)
530            { # symbol table
531                $symtab = 1;
532            }
533        }
534        if(my ($Value, $Size, $Type, $Bind, $Vis, $Ndx, $Symbol) = readline_ELF($_))
535        { # read ELF entry
536            if(not $symtab)
537            { # dynsym
538                if(skipSymbol($Symbol)) {
539                    next;
540                }
541
542                if($Ndx eq "UNDEF")
543                { # ignore interfaces that are imported from somewhere else
544                    $Library_UndefSymbol{$TargetName}{$Symbol} = 0;
545                    next;
546                }
547
548                if($Bind eq "LOCAL") {
549                    $Library_LocalSymbol{$TargetName}{$Symbol} = ($Type eq "OBJECT")?-$Size:1;
550                }
551                else {
552                    $Library_Symbol{$TargetName}{$Symbol} = ($Type eq "OBJECT")?-$Size:1;
553                }
554
555                $Symbol_Value{$Symbol} = $Value;
556                $Value_Symbol{$Value}{$Symbol} = 1;
557            }
558
559            foreach ($SectionInfo{$Ndx}, "")
560            {
561                my $Val = $Value;
562
563                $SymbolTable{$_}{$Val}{$Symbol} = 1;
564
565                if($Val=~s/\A[0]+//)
566                {
567                    if($Val eq "") {
568                        $Val = "0";
569                    }
570                    $SymbolTable{$_}{$Val}{$Symbol} = 1;
571                }
572            }
573        }
574    }
575    close(LIB);
576
577    my %Found = ();
578    foreach my $Symbol (keys(%{$Library_Symbol{$TargetName}}))
579    {
580        next if(index($Symbol,"\@")==-1);
581        if(my $Value = $Symbol_Value{$Symbol})
582        {
583            foreach my $Symbol_SameValue (keys(%{$Value_Symbol{$Value}}))
584            {
585                if($Symbol_SameValue ne $Symbol
586                and index($Symbol_SameValue,"\@")==-1)
587                {
588                    $SymVer{$Symbol_SameValue} = $Symbol;
589                    $Found{$Symbol} = 1;
590                    last;
591                }
592            }
593        }
594    }
595
596    # default
597    foreach my $Symbol (keys(%{$Library_Symbol{$TargetName}}))
598    {
599        next if(defined $Found{$Symbol});
600        next if(index($Symbol,"\@\@")==-1);
601
602        if($Symbol=~/\A([^\@]*)\@\@/
603        and not $SymVer{$1})
604        {
605            $SymVer{$1} = $Symbol;
606            $Found{$Symbol} = 1;
607        }
608    }
609
610    # non-default
611    foreach my $Symbol (keys(%{$Library_Symbol{$TargetName}}))
612    {
613        next if(defined $Found{$Symbol});
614        next if(index($Symbol,"\@")==-1);
615
616        if($Symbol=~/\A([^\@]*)\@([^\@]*)/
617        and not $SymVer{$1})
618        {
619            $SymVer{$1} = $Symbol;
620            $Found{$Symbol} = 1;
621        }
622    }
623}
624
625sub read_Alt_Info($)
626{
627    my $Path = $_[0];
628    my $Name = get_filename($Path);
629
630    my $Readelf = "eu-readelf";
631    if(not check_Cmd($Readelf)) {
632        exitStatus("Not_Found", "can't find \"$Readelf\" command");
633    }
634
635    printMsg("INFO", "Reading alternate debug-info");
636
637    my $ExtraPath = undef;
638
639    # lines info
640
641    if($ExtraInfo)
642    {
643        $ExtraPath = $ExtraInfo."/".$Name;
644        mkpath($ExtraPath);
645        $ExtraPath .= "/debug_line";
646    }
647
648    if($ExtraPath)
649    {
650        system("$Readelf -N --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
651        open(SRC, $ExtraPath);
652    }
653    else {
654        open(SRC, "$Readelf -N --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" |");
655    }
656
657    my $Offset = undef;
658
659    while(<SRC>)
660    {
661        if(/(\d+)\s+\d+\s+\d+\s+\d+\s+([^ ]+)/)
662        {
663            my ($Num, $File) = ($1, $2);
664            chomp($File);
665
666            $SourceFile_Alt{0}{$Num} = $File;
667        }
668    }
669    close(SRC);
670
671    # debug info
672
673    if($ExtraInfo)
674    {
675        $ExtraPath = $ExtraInfo."/".$Name;
676        mkpath($ExtraPath);
677        $ExtraPath .= "/debug_info";
678    }
679
680    if($ExtraPath)
681    {
682        system("$Readelf -N --debug-dump=info \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
683        open(INFO, $ExtraPath);
684    }
685    else {
686        open(INFO, "$Readelf -N --debug-dump=info \"$Path\" 2>\"$TMP_DIR/error\" |");
687    }
688
689    my $ID = undef;
690    my $Num = 0;
691
692    while(<INFO>)
693    {
694        if(index($_, "  ")==0)
695        {
696            if(defined $ID) {
697                $ImportedUnit{$ID}{$Num++} = $_;
698            }
699        }
700        elsif(index($_, " [")==0
701        and /\A \[\s*(\w+?)\](\s+)(\w+)/)
702        {
703            if($3 eq "partial_unit")
704            {
705                $ID = $1;
706                $Num = 0;
707                $ImportedUnit{$ID}{0} = $_;
708            }
709            elsif(length($2)==2)
710            { # not a partial_unit
711                $ID = undef;
712            }
713            elsif(defined $ID)
714            {
715                $ImportedDecl{$1} = $ID;
716                $ImportedUnit{$ID}{$Num++} = $_;
717            }
718        }
719    }
720}
721
722sub read_DWARF_Info($)
723{
724    my $Path = $_[0];
725
726    my $Dir = get_dirname($Path);
727    my $Name = get_filename($Path);
728
729    my $Readelf = "eu-readelf";
730    if(not check_Cmd($Readelf)) {
731        exitStatus("Not_Found", "can't find \"$Readelf\" command");
732    }
733
734    my $AddOpt = "";
735    if(not defined $AddrToName)
736    { # disable search of symbol names
737        $AddOpt .= " -N";
738    }
739
740    my $Sect = `$Readelf -S \"$Path\" 2>\"$TMP_DIR/error\"`;
741
742    if($Sect!~/\.debug_info/)
743    { # No DWARF info
744        return 0;
745    }
746
747    printMsg("INFO", "Reading debug-info");
748
749    my $ExtraPath = "";
750
751    # ELF header
752    if($ExtraInfo)
753    {
754        $ExtraPath = $ExtraInfo."/".$Name;
755        mkpath($ExtraPath);
756        $ExtraPath .= "/elf-header";
757    }
758
759    if($ExtraPath)
760    {
761        system($Readelf." -h \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
762        open(HEADER, $ExtraPath);
763    }
764    else {
765        open(HEADER, $Readelf." -h \"$Path\" 2>\"$TMP_DIR/error\" |");
766    }
767
768    my %Header = ();
769    while(<HEADER>)
770    {
771        if(/\A\s*([\w ]+?)\:\s*(.+?)\Z/) {
772            $Header{$1} = $2;
773        }
774    }
775    close(HEADER);
776
777    $SYS_ARCH = $Header{"Machine"};
778
779    if($SYS_ARCH=~/80\d86/
780    or $SYS_ARCH=~/i\d86/)
781    { # i386, i586, etc.
782        $SYS_ARCH = "x86";
783    }
784
785    if($SYS_ARCH=~/amd64/i
786    or $SYS_ARCH=~/x86\-64/i)
787    { # amd64
788        $SYS_ARCH = "x86_64";
789    }
790
791    # source info
792    if($ExtraInfo)
793    {
794        $ExtraPath = $ExtraInfo."/".$Name;
795        mkpath($ExtraPath);
796        $ExtraPath .= "/debug_line";
797    }
798
799    if($ExtraPath)
800    {
801        system("$Readelf $AddOpt --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
802        open(SRC, $ExtraPath);
803    }
804    else {
805        open(SRC, "$Readelf $AddOpt --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" |");
806    }
807
808    my $Offset = undef;
809
810    while(<SRC>)
811    {
812        if(/Table at offset (\w+)/)
813        {
814            $Offset = $1;
815        }
816        elsif(defined $Offset
817        and /(\d+)\s+\d+\s+\d+\s+\d+\s+([^ ]+)/)
818        {
819            my ($Num, $File) = ($1, $2);
820            chomp($File);
821
822            $SourceFile{$Offset}{$Num} = $File;
823        }
824    }
825    close(SRC);
826
827    # debug_loc
828    if($ExtraInfo)
829    {
830        $ExtraPath = $ExtraInfo."/".$Name;
831        mkpath($ExtraPath);
832        $ExtraPath .= "/debug_loc";
833    }
834
835    if($ExtraPath)
836    {
837        system("$Readelf $AddOpt --debug-dump=loc \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
838        open(LOC, $ExtraPath);
839    }
840    else {
841        open(LOC, "$Readelf $AddOpt --debug-dump=loc \"$Path\" 2>\"$TMP_DIR/error\" |");
842    }
843
844    while(<LOC>)
845    {
846        if(/\[\s*(\w+)\].*\[\s*\w+\]\s*(.+)\Z/) {
847            $DebugLoc{$1} = $2;
848        }
849    }
850    close(LOC);
851
852    # dwarf
853    if($ExtraInfo)
854    {
855        $ExtraPath = $ExtraInfo."/".$Name;
856        mkpath($ExtraPath);
857        $ExtraPath .= "/debug_info";
858    }
859
860    my $INFO_fh;
861
862    if($Dir)
863    { # to find ".dwz" directory (Fedora)
864        chdir($Dir);
865    }
866    if($ExtraPath)
867    {
868        system("$Readelf $AddOpt --debug-dump=info \"$Name\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
869        open($INFO_fh, $ExtraPath);
870    }
871    else {
872        open($INFO_fh, "$Readelf $AddOpt --debug-dump=info \"$Name\" 2>\"$TMP_DIR/error\" |");
873    }
874    chdir($ORIG_DIR);
875
876    read_DWARF_Dump($INFO_fh, 1);
877
878    close($INFO_fh);
879
880    if(my $Err = readFile("$TMP_DIR/error"))
881    { # eu-readelf: cannot get next DIE: invalid DWARF
882        if($Err=~/invalid DWARF/i) {
883            exitStatus("Invalid_DWARF", "invalid DWARF info");
884        }
885    }
886
887    return 1;
888}
889
890sub getSource($)
891{
892    my $ID = $_[0];
893
894    if(defined $DWARF_Info{$ID}{"decl_file"})
895    {
896        my $File = $DWARF_Info{$ID}{"decl_file"};
897        my $Unit = $DWARF_Info{$ID}{"Unit"};
898
899        my $Name = undef;
900
901        if($ID>=0) {
902            $Name = $SourceFile{$Unit}{$File};
903        }
904        else
905        { # imported
906            $Name = $SourceFile_Alt{0}{$File};
907        }
908
909        return $Name;
910    }
911
912    return undef;
913}
914
915sub read_DWARF_Dump($$)
916{
917    my ($FH, $Primary) = @_;
918
919    my %TypeUnit = ();
920    my %Post_Change = ();
921    my $TypeUnit_Sign = undef;
922    my $TypeUnit_Offset = undef;
923    my $Type_Offset = undef;
924
925    my $Shift_Enabled = 1;
926    my $ID_Shift = undef;
927
928    my $CUnit = undef;
929    my $CUnit_F = undef;
930
931    my $ID = undef;
932    my $Kind = undef;
933    my $NS = undef;
934
935    my $MAX_ID = undef;
936
937    my %Shift = map {$_=>1} (
938        "specification",
939        "type",
940        "sibling",
941        "object_pointer",
942        "containing_type",
943        "abstract_origin",
944        "import",
945        "signature"
946    );
947
948    my $Line = undef;
949    my $Import = undef;
950    my $Import_Num = 0;
951
952    my %UsedUnit;
953    my %UsedDecl;
954
955    my $ID_Pre = undef; # mem opt
956    my %Mangled_Subs = (); # mem opt
957    my %Simple_Types = ();
958    my %Type_Base = ();
959
960    my %SkipNode = (
961        "imported_declaration" => 1,
962        "imported_module" => 1
963    );
964
965    my %SkipAttr = (
966        "high_pc" => 1,
967        "frame_base" => 1,
968        "encoding" => 1
969    );
970
971    my %MarkByUnit = (
972        "member" => 1,
973        "subprogram" => 1,
974        "variable" => 1
975    );
976
977    my %Excess_IDs;
978    my %Delete_Src;
979
980    my $Lexical_Block = undef;
981    my $Inlined_Block = undef;
982    my $Subprogram_Block = undef;
983    my $Skip_Block = undef;
984
985    while(($Import and $Line = $ImportedUnit{$Import}{$Import_Num}) or $Line = <$FH>)
986    {
987        if(not defined $ImportedUnit{$Import}{$Import_Num})
988        {
989            $Import_Num = 0;
990            delete($ImportedUnit{$Import});
991            $Import = undef;
992        }
993
994        if($Import) {
995            $Import_Num++;
996        }
997        if($ID and $Line=~/\A\s*(\w+)\s*(.+?)\s*\Z/)
998        {
999
1000            if(defined $Skip_Block) {
1001                next;
1002            }
1003
1004            my ($Attr, $Val) = ($1, $2);
1005
1006            if($Kind eq "member"
1007            or $Kind eq "formal_parameter")
1008            {
1009                if($Attr eq "decl_file" or $Attr eq "decl_line")
1010                {
1011                    $Delete_Src{$ID} = 1;
1012                }
1013            }
1014            elsif($Kind eq "imported_unit")
1015            {
1016                if($Attr eq "import")
1017                {
1018                    if($Val=~/\(GNU_ref_alt\)\s*\[\s*(\w+?)\]/)
1019                    {
1020                        if(defined $ImportedUnit{$1})
1021                        {
1022                            $Import = $1;
1023                            $Import_Num = 0;
1024                            $UsedUnit{$Import} = 1;
1025                        }
1026                    }
1027                }
1028            }
1029
1030            if($Kind eq "member")
1031            {
1032                if($Attr eq "data_member_location")
1033                {
1034                    delete($DWARF_Info{$ID}{"Unit"});
1035                }
1036            }
1037
1038            if($Kind ne "structure_type")
1039            {
1040                if($Attr eq "sibling")
1041                {
1042                    next;
1043                }
1044            }
1045
1046            if($Attr eq "Type")
1047            {
1048                if($Line=~/Type\s+signature:\s*0x(\w+)/) {
1049                    $TypeUnit_Sign = $1;
1050                }
1051                if($Line=~/Type\s+offset:\s*0x(\w+)/) {
1052                    $Type_Offset = hex($1);
1053                }
1054                if($Line=~/Type\s+unit\s+at\s+offset\s+(\d+)/) {
1055                    $TypeUnit_Offset = $1;
1056                }
1057                next;
1058            }
1059            elsif(defined $SkipAttr{$Attr})
1060            { # unused
1061                next;
1062            }
1063
1064            if($Val=~/\A\s*\(([^()]*)\)\s*\[\s*(\w+)\]\s*\Z/)
1065            { # ref4, ref_udata, ref_addr, etc.
1066                $Val = hex($2);
1067
1068                if($1 eq "GNU_ref_alt")
1069                {
1070                    $Val = -$Val;
1071                    $UsedDecl{$2} = 1;
1072                }
1073            }
1074            elsif($Attr eq "name")
1075            {
1076                $Val=~s/\A\([^()]*\)\s*\"(.*)\"\Z/$1/;
1077            }
1078            elsif(index($Attr, "linkage_name")!=-1)
1079            {
1080                $Val=~s/\A\([^()]*\)\s*\"(.*)\"\Z/$1/;
1081                $Attr = "linkage_name";
1082            }
1083            elsif(index($Attr, "location")!=-1)
1084            {
1085                if($Val=~/\)\s*\Z/)
1086                { # value on the next line
1087                    if($Import) {
1088                        $Val .= $ImportedUnit{$Import}{$Import_Num}
1089                    }
1090                    else {
1091                        $Val .= <$FH>;
1092                    }
1093                }
1094
1095                if($Val=~/\A\(\w+\)\s*(-?)(\w+)\Z/)
1096                { # (data1) 1c
1097                    $Val = hex($2);
1098                    if($1) {
1099                        $Val = -$Val;
1100                    }
1101                }
1102                else
1103                {
1104                    if($Val=~/ (-?\d+)\Z/) {
1105                        $Val = $1;
1106                    }
1107                    else
1108                    {
1109                        if($Attr eq "location"
1110                        and $Kind eq "formal_parameter")
1111                        {
1112                            if($Val=~/location list\s+\[\s*(\w+)\]\Z/)
1113                            {
1114                                $Attr = "location_list";
1115                                $Val = $1;
1116                            }
1117                            elsif($Val=~/ reg(\d+)\Z/)
1118                            {
1119                                $Attr = "register";
1120                                $Val = $1;
1121                            }
1122                        }
1123                    }
1124                }
1125            }
1126            elsif($Attr eq "accessibility")
1127            {
1128                $Val=~s/\A\(.+?\)\s*//;
1129                $Val=~s/\s*\(.+?\)\Z//;
1130                if($Val eq "public")
1131                { # public by default
1132                    next;
1133                }
1134            }
1135            else
1136            {
1137                $Val=~s/\A\(\w+\)\s*//;
1138
1139                if(substr($Val, 0, 1) eq "{"
1140                and $Val=~/{(.+)}/)
1141                { # {ID}
1142                    $Val = $1;
1143                    $Post_Change{$ID} = 1;
1144                }
1145            }
1146
1147            if($Shift_Enabled and $ID_Shift)
1148            {
1149                if(defined $Shift{$Attr}
1150                and not $Post_Change{$ID}) {
1151                    $Val += $ID_Shift;
1152                }
1153
1154                $DWARF_Info{$ID}{"rID"} = $ID-$ID_Shift;
1155            }
1156
1157            if($Import or not $Primary)
1158            {
1159                if(defined $Shift{$Attr})
1160                {
1161                    $Val = -$Val;
1162                }
1163            }
1164
1165            $DWARF_Info{$ID}{$Attr} = "$Val";
1166
1167            if($Kind eq "compile_unit")
1168            {
1169                if($Attr eq "stmt_list") {
1170                    $CUnit = $Val;
1171                }
1172
1173                if(not defined $CUnit_F) {
1174                    $CUnit_F = $ID;
1175                }
1176            }
1177
1178            if($Kind eq "type_unit")
1179            {
1180                if($Attr eq "stmt_list") {
1181                    $CUnit = $Val;
1182                }
1183            }
1184
1185            if($Kind eq "partial_unit" and not $Import)
1186            { # support for dwz
1187                if($Attr eq "stmt_list") {
1188                    $CUnit = $Val;
1189                }
1190            }
1191        }
1192        elsif($Line=~/\A \[\s*(\w+)\](\s*)(\w+)/)
1193        {
1194            $ID = hex($1);
1195            $NS = length($2);
1196            $Kind = $3;
1197
1198            $Skip_Block = undef;
1199
1200            if(defined $SkipNode{$Kind})
1201            {
1202                $Skip_Block = 1;
1203                next;
1204            }
1205
1206            if($Kind eq "lexical_block")
1207            {
1208                $Lexical_Block = $NS;
1209                $Skip_Block = 1;
1210                next;
1211            }
1212            else
1213            {
1214                if(defined $Lexical_Block)
1215                {
1216                    if($NS>$Lexical_Block)
1217                    {
1218                        $Skip_Block = 1;
1219                        next;
1220                    }
1221                    else
1222                    { # end of lexical block
1223                        $Lexical_Block = undef;
1224                    }
1225                }
1226            }
1227
1228            if($Kind eq "inlined_subroutine")
1229            {
1230                $Inlined_Block = $NS;
1231                $Skip_Block = 1;
1232                next;
1233            }
1234            else
1235            {
1236                if(defined $Inlined_Block)
1237                {
1238                    if($NS>$Inlined_Block)
1239                    {
1240                        $Skip_Block = 1;
1241                        next;
1242                    }
1243                    else
1244                    { # end of inlined subroutine
1245                        $Inlined_Block = undef;
1246                    }
1247                }
1248            }
1249
1250            if($Kind eq "subprogram")
1251            {
1252                $Subprogram_Block = $NS;
1253            }
1254            else
1255            {
1256                if(defined $Subprogram_Block)
1257                {
1258                    if($NS>$Subprogram_Block)
1259                    {
1260                        if($Kind eq "variable")
1261                        { # temp variables
1262                            $Skip_Block = 1;
1263                            next;
1264                        }
1265                    }
1266                    else
1267                    { # end of subprogram block
1268                        $Subprogram_Block = undef;
1269                    }
1270                }
1271            }
1272
1273            if($Import or not $Primary)
1274            {
1275                $ID = -$ID;
1276            }
1277
1278            if($Shift_Enabled)
1279            {
1280                if($Kind eq "type_unit")
1281                {
1282                    if(not defined $ID_Shift)
1283                    {
1284                        if($ID_Shift<=$MAX_ID) {
1285                            $ID_Shift = $MAX_ID;
1286                        }
1287                        else {
1288                            $ID_Shift = 0;
1289                        }
1290                    }
1291                }
1292
1293                if($ID_Shift) {
1294                    $ID += $ID_Shift;
1295                }
1296            }
1297
1298            if(defined $TypeUnit_Sign)
1299            {
1300                if($Kind ne "type_unit"
1301                and $Kind ne "namespace")
1302                {
1303                    if($TypeUnit_Offset+$Type_Offset+$ID_Shift==$ID)
1304                    {
1305                        $TypeUnit{$TypeUnit_Sign} = "$ID";
1306                        $TypeUnit_Sign = undef;
1307                    }
1308                }
1309            }
1310
1311            if(defined $ID_Pre)
1312            {
1313                my $Kind_Pre = $DWARF_Info{$ID_Pre}{"Kind"};
1314
1315                if(my $Sp = $DWARF_Info{$ID_Pre}{"specification"})
1316                {
1317                    if(defined $Delete_Src{$Sp})
1318                    {
1319                        delete($Delete_Src{$Sp});
1320                    }
1321                }
1322
1323                if(defined $OptMem)
1324                { # optimize memory usage
1325                    if($Kind_Pre eq "subprogram")
1326                    {
1327                        my $Mangled = get_Mangled($ID_Pre);
1328
1329                        if($Mangled)
1330                        {
1331                            if(my $OLD_ID = $Mangled_Subs{$Mangled})
1332                            {
1333                                if(keys(%{$DWARF_Info{$OLD_ID}})==keys(%{$DWARF_Info{$ID_Pre}}))
1334                                {
1335                                    if(getSource($OLD_ID) eq getSource($ID_Pre))
1336                                    {
1337                                        $Excess_IDs{$ID_Pre} = 1;
1338                                    }
1339                                }
1340                            }
1341                            else {
1342                                $Mangled_Subs{$Mangled} = $ID_Pre;
1343                            }
1344                        }
1345
1346                        if(not $Excess_IDs{$ID_Pre})
1347                        {
1348                            if(my $Sp = $DWARF_Info{$ID_Pre}{"specification"})
1349                            {
1350                                delete($Excess_IDs{$Sp});
1351                            }
1352                            elsif(my $Orig = $DWARF_Info{$ID_Pre}{"abstract_origin"})
1353                            {
1354                                delete($Excess_IDs{$Orig});
1355                            }
1356                        }
1357                    }
1358                    elsif($NS==4)
1359                    { # simple types
1360                        if($Kind_Pre=~/typedef|base_type|structure_type/)
1361                        {
1362                            my $Name = $DWARF_Info{$ID_Pre}{"name"};
1363                            if(not $Name)
1364                            {
1365                                if(my $Sp = $DWARF_Info{$ID_Pre}{"specification"})
1366                                {
1367                                    $Name = $DWARF_Info{$Sp}{"name"};
1368                                }
1369                            }
1370
1371                            if($Name)
1372                            {
1373                                if(my $OLD_ID = $Simple_Types{$Name})
1374                                {
1375                                    if(keys(%{$DWARF_Info{$OLD_ID}})==keys(%{$DWARF_Info{$ID_Pre}}))
1376                                    {
1377                                        if(getSource($OLD_ID) eq getSource($ID_Pre))
1378                                        {
1379                                            $Excess_IDs{$ID_Pre} = 1;
1380                                            $Type_Base{$ID_Pre} = $OLD_ID;
1381                                        }
1382                                    }
1383                                }
1384                                else {
1385                                    $Simple_Types{$Name} = $ID_Pre;
1386                                }
1387                            }
1388                        }
1389                    }
1390                }
1391            }
1392
1393            $DWARF_Info{$ID}{"Kind"} = $Kind;
1394            $DWARF_Info{$ID}{"NS"} = $NS;
1395
1396            $ID_Pre = $ID;
1397
1398            if(defined $CUnit)
1399            {
1400                if(defined $MarkByUnit{$Kind}
1401                or defined $TypeType{$Kind}) {
1402                    $DWARF_Info{$ID}{"Unit"} = $CUnit;
1403                }
1404            }
1405
1406            if(not defined $ID_Shift) {
1407                $MAX_ID = $ID;
1408            }
1409        }
1410        elsif(not defined $SYS_WORD
1411        and $Line=~/Address\s*size:\s*(\d+)/i)
1412        {
1413            $SYS_WORD = $1;
1414        }
1415    }
1416
1417    %Mangled_Subs = ();
1418
1419    foreach my $ID (keys(%Post_Change))
1420    {
1421        if(my $Type = $DWARF_Info{$ID}{"type"})
1422        {
1423            if(my $To = $TypeUnit{$Type}) {
1424                $DWARF_Info{$ID}{"type"} = $To;
1425            }
1426        }
1427        if(my $Signature = $DWARF_Info{$ID}{"signature"})
1428        {
1429            if(my $To = $TypeUnit{$Signature}) {
1430                $DWARF_Info{$ID}{"signature"} = $To;
1431            }
1432        }
1433    }
1434
1435    %TypeUnit = ();
1436    %Post_Change = ();
1437
1438    if($Primary)
1439    {
1440        if(defined $CUnit_F)
1441        {
1442            if(my $Compiler= $DWARF_Info{$CUnit_F}{"producer"})
1443            {
1444                $Compiler=~s/\A\"//;
1445                $Compiler=~s/\"\Z//;
1446
1447                if($Compiler=~/GNU\s+(C|C\+\+)\s+(.+)\Z/)
1448                {
1449                    $SYS_GCCV = $2;
1450                    $SYS_GCCV=~s/\d+\s+\(.+\).*//; # 4.6.1 20110627 (Mandriva)
1451                }
1452                else {
1453                    $SYS_COMP = $Compiler;
1454                }
1455            }
1456            if(my $Lang = $DWARF_Info{$CUnit_F}{"language"})
1457            {
1458                $Lang=~s/\s*\(.+?\)\Z//;
1459                if($Lang=~/C\d/i) {
1460                    $LIB_LANG = "C";
1461                }
1462                elsif($Lang=~/C\+\+/i) {
1463                    $LIB_LANG = "C++";
1464                }
1465                else {
1466                    $LIB_LANG = $Lang;
1467                }
1468            }
1469        }
1470
1471        my %AddUnits = ();
1472
1473        foreach my $ID (keys(%UsedDecl))
1474        {
1475            if(my $U_ID = $ImportedDecl{$ID})
1476            {
1477                if(not $UsedUnit{$U_ID})
1478                {
1479                    $AddUnits{$U_ID} = 1;
1480                }
1481            }
1482        }
1483
1484        if(keys(%AddUnits))
1485        {
1486            my $ADD_DUMP = "";
1487
1488            foreach my $U_ID (sort {hex($a)<=>hex($b)} keys(%AddUnits))
1489            {
1490                foreach my $N (sort {int($a)<=>int($b)} keys(%{$ImportedUnit{$U_ID}}))
1491                {
1492                    $ADD_DUMP .= $ImportedUnit{$U_ID}{$N};
1493                }
1494            }
1495
1496            my $AddUnit_F = $TMP_DIR."/add_unit.dump";
1497
1498            writeFile($AddUnit_F, $ADD_DUMP);
1499
1500            my $FH_add;
1501            open($FH_add, $AddUnit_F);
1502            read_DWARF_Dump($FH_add, 0);
1503            close($FH_add);
1504
1505            unlink($AddUnit_F);
1506        }
1507
1508    }
1509
1510    # clean memory
1511    %ImportedUnit = ();
1512    %ImportedDecl = ();
1513    %UsedUnit = ();
1514    %UsedDecl = ();
1515
1516    foreach my $ID (keys(%Delete_Src))
1517    {
1518        delete($DWARF_Info{$ID}{"decl_file"});
1519        delete($DWARF_Info{$ID}{"decl_line"});
1520    }
1521
1522    %Delete_Src = ();
1523
1524    if(defined $OptMem)
1525    { # optimize memory usage
1526        foreach my $ID (sort {int($a)<=>int($b)} keys(%DWARF_Info))
1527        {
1528            foreach my $Attr ("type", "sibling", "specification")
1529            {
1530                if(defined $DWARF_Info{$ID}{$Attr})
1531                {
1532                    my $Val = $DWARF_Info{$ID}{$Attr};
1533                    if(defined $Type_Base{$Val})
1534                    {
1535                        $DWARF_Info{$ID}{$Attr} = $Type_Base{$Val};
1536                    }
1537                }
1538            }
1539        }
1540
1541        my $NS_Del = undef;
1542
1543        foreach my $ID (sort {int($a)<=>int($b)} keys(%DWARF_Info))
1544        {
1545            if($Excess_IDs{$ID})
1546            { # node
1547                $NS_Del = $DWARF_Info{$ID}{"NS"};
1548                delete($DWARF_Info{$ID});
1549            }
1550            else
1551            { # sub-node
1552                if(defined $NS_Del)
1553                {
1554                    if($DWARF_Info{$ID}{"NS"}<=$NS_Del)
1555                    { # other node
1556                        $NS_Del = undef;
1557                    }
1558                    else
1559                    { # subprogram/types internals
1560                        if($DWARF_Info{$ID}{"Kind"}!~/(typedef|_type)\Z/)
1561                        {
1562                            delete($DWARF_Info{$ID});
1563                        }
1564                        else {
1565                            $DWARF_Info{$ID}{"NS"} = $NS_Del;
1566                        }
1567                    }
1568                }
1569            }
1570        }
1571
1572        %Excess_IDs = ();
1573    }
1574}
1575
1576sub read_Vtables($)
1577{
1578    my $Path = $_[0];
1579
1580    my $Name = get_filename($Path);
1581    $Path = abs_path($Path);
1582
1583
1584    if(index($LIB_LANG, "C++")!=-1)
1585    {
1586        if(check_Cmd($VTABLE_DUMPER))
1587        {
1588            if(my $Version = `$VTABLE_DUMPER -dumpversion`)
1589            {
1590                if(cmpVersions($Version, $VTABLE_DUMPER_VERSION)<0)
1591                {
1592                    printMsg("ERROR", "the version of Vtable-Dumper should be $VTABLE_DUMPER_VERSION or newer");
1593                    return;
1594                }
1595            }
1596        }
1597        else
1598        {
1599            printMsg("ERROR", "cannot find \'$VTABLE_DUMPER\'");
1600            return;
1601        }
1602
1603        my $ExtraPath = $TMP_DIR."/v-tables";
1604
1605        if($ExtraInfo)
1606        {
1607            $ExtraPath = $ExtraInfo."/".$Name;
1608            mkpath($ExtraPath);
1609            $ExtraPath .= "/v-tables";
1610        }
1611
1612        system("$VTABLE_DUMPER \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
1613
1614        my $Content = readFile($ExtraPath);
1615        foreach my $ClassInfo (split(/\n\n\n/, $Content))
1616        {
1617            if($ClassInfo=~/\AVtable\s+for\s+(.+)\n((.|\n)+)\Z/i)
1618            {
1619                my ($CName, $VTable) = ($1, $2);
1620                my @Entries = split(/\n/, $VTable);
1621                foreach (1 .. $#Entries)
1622                {
1623                    my $Entry = $Entries[$_];
1624                    if($Entry=~/\A(\d+)\s+(.+)\Z/) {
1625                        $VirtualTable{$CName}{$1} = $2;
1626                    }
1627                }
1628            }
1629        }
1630    }
1631}
1632
1633sub dump_ABI()
1634{
1635    printMsg("INFO", "Creating ABI dump");
1636
1637    my %ABI = (
1638        "TypeInfo" => \%TypeInfo,
1639        "SymbolInfo" => \%SymbolInfo,
1640        "Symbols" => \%Library_Symbol,
1641        "LocalSymbols" => \%Library_LocalSymbol,
1642        "UndefinedSymbols" => \%Library_UndefSymbol,
1643        "Needed" => \%Library_Needed,
1644        "SymbolVersion" => \%SymVer,
1645        "LibraryVersion" => $TargetVersion,
1646        "LibraryName" => $TargetName,
1647        "Language" => $LIB_LANG,
1648        "Headers" => \%HeadersInfo,
1649        "Sources" => \%SourcesInfo,
1650        "NameSpaces" => \%NestedNameSpaces,
1651        "Target" => "unix",
1652        "Arch" => $SYS_ARCH,
1653        "WordSize" => $SYS_WORD,
1654        "ABI_DUMP_VERSION" => $ABI_DUMP_VERSION,
1655        "ABI_DUMPER_VERSION" => $TOOL_VERSION,
1656    );
1657
1658    if($SYS_GCCV) {
1659        $ABI{"GccVersion"} = $SYS_GCCV;
1660    }
1661    else {
1662        $ABI{"Compiler"} = $SYS_COMP;
1663    }
1664
1665    my $ABI_DUMP = Dumper(\%ABI);
1666
1667    if($StdOut)
1668    { # --stdout option
1669        print STDOUT $ABI_DUMP;
1670    }
1671    else
1672    {
1673        mkpath(get_dirname($OutputDump));
1674
1675        open(DUMP, ">", $OutputDump) || die ("can't open file \'$OutputDump\': $!\n");
1676        print DUMP $ABI_DUMP;
1677        close(DUMP);
1678
1679        printMsg("INFO", "\nThe object ABI has been dumped to:\n  $OutputDump");
1680    }
1681}
1682
1683sub unmangleString($)
1684{
1685    my $Str = $_[0];
1686
1687    $Str=~s/\AN(.+)E\Z/$1/;
1688    while($Str=~s/\A(\d+)//)
1689    {
1690        if(length($Str)==$1) {
1691            last;
1692        }
1693
1694        $Str = substr($Str, $1, length($Str) - $1);
1695    }
1696
1697    return $Str;
1698}
1699
1700sub read_ABI()
1701{
1702    printMsg("INFO", "Extracting ABI information");
1703
1704    my %CurID = ();
1705
1706    my @IDs = sort {int($a) <=> int($b)} keys(%DWARF_Info);
1707
1708    if($AltDebugInfo) {
1709        @IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
1710    }
1711
1712    foreach my $ID (@IDs)
1713    {
1714        $ID = "$ID";
1715
1716        my $Kind = $DWARF_Info{$ID}{"Kind"};
1717        my $NS = $DWARF_Info{$ID}{"NS"};
1718        my $Scope = $CurID{$NS-2};
1719
1720        if($Kind eq "typedef")
1721        {
1722            if($DWARF_Info{$Scope}{"Kind"} eq "subprogram")
1723            {
1724                $NS = $DWARF_Info{$Scope}{"NS"};
1725                $Scope = $CurID{$NS-2};
1726            }
1727        }
1728
1729        if($Kind ne "subprogram") {
1730            delete($DWARF_Info{$ID}{"NS"});
1731        }
1732
1733        my $IsType = ($Kind=~/(struct|structure|class|union|enumeration|subroutine|array)_type/);
1734
1735        if($IsType
1736        or $Kind eq "typedef"
1737        or $Kind eq "subprogram"
1738        or $Kind eq "variable"
1739        or $Kind eq "namespace")
1740        {
1741            if($Kind ne "variable"
1742            and $Kind ne "typedef")
1743            {
1744                $CurID{$NS} = $ID;
1745            }
1746
1747            if($Scope)
1748            {
1749                $NameSpace{$ID} = $Scope;
1750                if($Kind eq "subprogram"
1751                or $Kind eq "variable")
1752                {
1753                    if($DWARF_Info{$Scope}{"Kind"}=~/class|struct/)
1754                    {
1755                        $ClassMethods{$Scope}{$ID} = 1;
1756                        if(my $Sp = $DWARF_Info{$Scope}{"specification"}) {
1757                            $ClassMethods{$Sp}{$ID} = 1;
1758                        }
1759                    }
1760                }
1761            }
1762
1763            if(my $Spec = $DWARF_Info{$ID}{"specification"}) {
1764                $SpecElem{$Spec} = $ID;
1765            }
1766
1767            if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"}) {
1768                $OrigElem{$Orig} = $ID;
1769            }
1770
1771            if($IsType)
1772            {
1773                if(not $DWARF_Info{$ID}{"name"}
1774                and $DWARF_Info{$ID}{"linkage_name"})
1775                {
1776                    $DWARF_Info{$ID}{"name"} = unmangleString($DWARF_Info{$ID}{"linkage_name"});
1777
1778                    # free memory
1779                    delete($DWARF_Info{$ID}{"linkage_name"});
1780                }
1781            }
1782        }
1783        elsif($Kind eq "member")
1784        {
1785            if($Scope)
1786            {
1787                $NameSpace{$ID} = $Scope;
1788
1789                if($DWARF_Info{$Scope}{"Kind"}=~/class|struct/
1790                and not defined $DWARF_Info{$ID}{"data_member_location"})
1791                { # variable (global data)
1792                    next;
1793                }
1794            }
1795
1796            $TypeMember{$Scope}{keys(%{$TypeMember{$Scope}})} = $ID;
1797        }
1798        elsif($Kind eq "enumerator")
1799        {
1800            $TypeMember{$Scope}{keys(%{$TypeMember{$Scope}})} = $ID;
1801        }
1802        elsif($Kind eq "inheritance")
1803        {
1804            my %In = (
1805                "id" => $DWARF_Info{$ID}{"type"},
1806                "access" => $DWARF_Info{$ID}{"accessibility"}
1807            );
1808            if(defined $DWARF_Info{$ID}{"virtuality"}) {
1809                $In{"virtual"} = 1;
1810            }
1811            $Inheritance{$Scope}{keys(%{$Inheritance{$Scope}})} = \%In;
1812
1813            # free memory
1814            delete($DWARF_Info{$ID});
1815        }
1816        elsif($Kind eq "formal_parameter")
1817        {
1818            $FuncParam{$Scope}{keys(%{$FuncParam{$Scope}})} = $ID;
1819        }
1820        elsif($Kind eq "unspecified_parameters")
1821        {
1822            $FuncParam{$Scope}{keys(%{$FuncParam{$Scope}})} = $ID;
1823            $DWARF_Info{$ID}{"type"} = "-1"; # "..."
1824        }
1825        elsif($Kind eq "subrange_type")
1826        {
1827            if((my $Bound = $DWARF_Info{$ID}{"upper_bound"}) ne "") {
1828                $ArrayCount{$Scope} = $Bound + 1;
1829            }
1830
1831            # free memory
1832            delete($DWARF_Info{$ID});
1833        }
1834    }
1835
1836    # register "void" type
1837    %{$TypeInfo{"1"}} = (
1838        "Name"=>"void",
1839        "Type"=>"Intrinsic"
1840    );
1841    $TName_Tid{"Intrinsic"}{"void"} = "1";
1842    $TName_Tids{"Intrinsic"}{"void"}{"1"} = 1;
1843    $Cache{"getTypeInfo"}{"1"} = 1;
1844
1845    # register "..." type
1846    %{$TypeInfo{"-1"}} = (
1847        "Name"=>"...",
1848        "Type"=>"Intrinsic"
1849    );
1850    $TName_Tid{"Intrinsic"}{"..."} = "-1";
1851    $TName_Tids{"Intrinsic"}{"..."}{"-1"} = 1;
1852    $Cache{"getTypeInfo"}{"-1"} = 1;
1853
1854    my @IDs = sort {int($a) <=> int($b)} keys(%DWARF_Info);
1855
1856    if($AltDebugInfo) {
1857        @IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
1858    }
1859
1860    foreach my $ID (@IDs)
1861    {
1862        if(my $Kind = $DWARF_Info{$ID}{"Kind"})
1863        {
1864            if(defined $TypeType{$Kind}) {
1865                getTypeInfo($ID);
1866            }
1867        }
1868    }
1869
1870    foreach my $Tid (sort {int($a) <=> int($b)} keys(%TypeInfo))
1871    {
1872        my $Type = $TypeInfo{$Tid}{"Type"};
1873
1874        if(not defined $TypeInfo{$Tid}{"Memb"})
1875        {
1876            if($Type=~/Struct|Class|Union|Enum/)
1877            {
1878                if(my $Signature = $DWARF_Info{$Tid}{"signature"})
1879                {
1880                    if(defined $TypeInfo{$Signature})
1881                    {
1882                        foreach my $Attr (keys(%{$TypeInfo{$Signature}}))
1883                        {
1884                            if(not defined $TypeInfo{$Tid}{$Attr}) {
1885                                $TypeInfo{$Tid}{$Attr} = $TypeInfo{$Signature}{$Attr};
1886                            }
1887                        }
1888                    }
1889                }
1890            }
1891        }
1892    }
1893
1894    my %Incomplete = ();
1895    my %Incomplete_TN = ();
1896
1897    my @IDs = sort {int($a) <=> int($b)} keys(%TypeInfo);
1898
1899    if($AltDebugInfo) {
1900        @IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
1901    }
1902
1903    foreach my $Tid (@IDs)
1904    {
1905        my $Name = $TypeInfo{$Tid}{"Name"};
1906        my $Type = $TypeInfo{$Tid}{"Type"};
1907
1908        if(not defined $SpecElem{$Tid}
1909        and not defined $Incomplete_TN{$Type}{$Name})
1910        {
1911            if(not defined $TypeInfo{$Tid}{"Size"})
1912            {
1913                if($Type=~/Struct|Class|Union|Enum/)
1914                {
1915                    $Incomplete{$Tid} = 1;
1916                }
1917            }
1918        }
1919
1920        $Incomplete_TN{$Type}{$Name} = 1;
1921    }
1922
1923    # free memory
1924    %Incomplete_TN = ();
1925
1926    foreach my $Tid (sort {int($a) <=> int($b)} keys(%Incomplete))
1927    {
1928        my $Name = $TypeInfo{$Tid}{"Name"};
1929        my $Type = $TypeInfo{$Tid}{"Type"};
1930
1931        my @Adv_IDs = sort {int($a) <=> int($b)} keys(%{$TName_Tids{$Type}{$Name}});
1932
1933        if($AltDebugInfo) {
1934            @Adv_IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @Adv_IDs;
1935        }
1936
1937        foreach my $Tid_Adv (@Adv_IDs)
1938        {
1939            if($Tid_Adv!=$Tid)
1940            {
1941                if(defined $SpecElem{$Tid_Adv}
1942                or defined $TypeInfo{$Tid_Adv}{"Size"})
1943                {
1944                    foreach my $Attr (keys(%{$TypeInfo{$Tid_Adv}}))
1945                    {
1946                        if(not defined $TypeInfo{$Tid}{$Attr})
1947                        {
1948                            if(ref($TypeInfo{$Tid_Adv}{$Attr}) eq "HASH") {
1949                                $TypeInfo{$Tid}{$Attr} = dclone($TypeInfo{$Tid_Adv}{$Attr});
1950                            }
1951                            else {
1952                                $TypeInfo{$Tid}{$Attr} = $TypeInfo{$Tid_Adv}{$Attr};
1953                            }
1954
1955                        }
1956                    }
1957                    last;
1958                }
1959            }
1960        }
1961    }
1962
1963    # free memory
1964    %Incomplete = ();
1965
1966    my %Delete = ();
1967
1968    foreach my $Tid (sort {int($a) <=> int($b)} keys(%TypeInfo))
1969    {
1970        if(defined $TypeInfo{$Tid}
1971        and $TypeInfo{$Tid}{"Type"} eq "Typedef")
1972        {
1973            my $TN = $TypeInfo{$Tid}{"Name"};
1974            my $TL = $TypeInfo{$Tid}{"Line"};
1975            my $NS = $TypeInfo{$Tid}{"NameSpace"};
1976
1977            if(my $BTid = $TypeInfo{$Tid}{"BaseType"})
1978            {
1979                if(defined $TypeInfo{$BTid}
1980                and $TypeInfo{$BTid}{"Name"}=~/\Aanon\-(\w+)\-/)
1981                {
1982                    %{$TypeInfo{$Tid}} = %{$TypeInfo{$BTid}};
1983                    $TypeInfo{$Tid}{"Name"} = $1." ".$TN;
1984                    $TypeInfo{$Tid}{"Line"} = $TL;
1985
1986                    my $Name = $TypeInfo{$Tid}{"Name"};
1987                    my $Type = $TypeInfo{$Tid}{"Type"};
1988
1989                    if(not defined $TName_Tid{$Type}{$Name}
1990                    or ($Tid>0 and $Tid<$TName_Tid{$Type}{$Name})
1991                    or ($Tid>0 and $TName_Tid{$Type}{$Name}<0)) {
1992                        $TName_Tid{$Type}{$Name} = $Tid;
1993                    }
1994                    $TName_Tids{$Type}{$Name}{$Tid} = 1;
1995
1996                    if($NS) {
1997                        $TypeInfo{$Tid}{"NameSpace"} = $NS;
1998                    }
1999                    $Delete{$BTid} = 1;
2000                }
2001            }
2002        }
2003    }
2004
2005    foreach my $Tid (keys(%Delete))
2006    {
2007        my $TN = $TypeInfo{$Tid}{"Name"};
2008        my $TT = $TypeInfo{$Tid}{"Type"};
2009
2010        delete($TName_Tid{$TT}{$TN});
2011        delete($TName_Tids{$TT}{$TN}{$Tid});
2012        if(my @IDs = sort {int($a) <=> int($b)} keys(%{$TName_Tids{$TT}{$TN}}))
2013        { # minimal ID
2014            $TName_Tid{$TT}{$TN} = $IDs[0];
2015        }
2016
2017        delete($TypeInfo{$Tid});
2018    }
2019
2020    # free memory
2021    # delete types info
2022    %Delete = ();
2023    foreach (keys(%DWARF_Info))
2024    {
2025        if(my $Kind = $DWARF_Info{$_}{"Kind"})
2026        {
2027            if(defined $TypeType{$Kind}) {
2028                delete($DWARF_Info{$_});
2029            }
2030        }
2031    }
2032
2033    foreach my $ID (sort {int($a) <=> int($b)} keys(%DWARF_Info))
2034    {
2035        if($ID<0)
2036        { # imported
2037            next;
2038        }
2039
2040        if($DWARF_Info{$ID}{"Kind"} eq "subprogram"
2041        or $DWARF_Info{$ID}{"Kind"} eq "variable")
2042        {
2043            getSymbolInfo($ID);
2044        }
2045    }
2046
2047    foreach my $ID (sort {int($a) <=> int($b)} keys(%SymbolInfo))
2048    {
2049        # add missed c-tors
2050        if($SymbolInfo{$ID}{"Constructor"})
2051        {
2052            if($SymbolInfo{$ID}{"MnglName"}=~/(C[1-2])([EI]).+/)
2053            {
2054                my ($K1, $K2) = ($1, $2);
2055                foreach ("C1", "C2")
2056                {
2057                    if($K1 ne $_)
2058                    {
2059                        my $Name = $SymbolInfo{$ID}{"MnglName"};
2060                        $Name=~s/$K1$K2/$_$K2/;
2061
2062                        if(not defined $Mangled_ID{$Name}) {
2063                            cloneSymbol($ID, $Name);
2064                        }
2065                    }
2066                }
2067            }
2068        }
2069
2070        # add missed d-tors
2071        if($SymbolInfo{$ID}{"Destructor"})
2072        {
2073            if($SymbolInfo{$ID}{"MnglName"}=~/(D[0-2])([EI]).+/)
2074            {
2075                my ($K1, $K2) = ($1, $2);
2076                foreach ("D0", "D1", "D2")
2077                {
2078                    if($K1 ne $_)
2079                    {
2080                        my $Name = $SymbolInfo{$ID}{"MnglName"};
2081                        $Name=~s/$K1$K2/$_$K2/;
2082
2083                        if(not defined $Mangled_ID{$Name}) {
2084                            cloneSymbol($ID, $Name);
2085                        }
2086                    }
2087                }
2088            }
2089        }
2090    }
2091
2092    foreach my $ID (sort {int($a) <=> int($b)} keys(%SymbolInfo))
2093    {
2094        if($LIB_LANG eq "C++")
2095        {
2096            if(not $SymbolInfo{$ID}{"MnglName"})
2097            {
2098                if($SymbolInfo{$ID}{"Artificial"}
2099                or index($SymbolInfo{$ID}{"ShortName"}, "~")==0)
2100                {
2101                    delete($SymbolInfo{$ID});
2102                    next;
2103                }
2104            }
2105        }
2106
2107        if($SymbolInfo{$ID}{"Class"}
2108        and not $SymbolInfo{$ID}{"Data"}
2109        and not $SymbolInfo{$ID}{"Constructor"}
2110        and not $SymbolInfo{$ID}{"Destructor"}
2111        and not $SymbolInfo{$ID}{"Virt"}
2112        and not $SymbolInfo{$ID}{"PureVirt"})
2113        {
2114            if(not defined $SymbolInfo{$ID}{"Param"}
2115            or $SymbolInfo{$ID}{"Param"}{0}{"name"} ne "this")
2116            {
2117                $SymbolInfo{$ID}{"Static"} = 1;
2118            }
2119        }
2120
2121        if(not $SymbolInfo{$ID}{"Return"})
2122        { # void
2123            if(not $SymbolInfo{$ID}{"Constructor"}
2124            and not $SymbolInfo{$ID}{"Destructor"})
2125            {
2126                $SymbolInfo{$ID}{"Return"} = "1";
2127            }
2128        }
2129
2130        if(defined $SymbolInfo{$ID}{"Source"})
2131        {
2132            if(not defined $SymbolInfo{$ID}{"Header"})
2133            {
2134                $SymbolInfo{$ID}{"Line"} = $SymbolInfo{$ID}{"SourceLine"};
2135                delete($SymbolInfo{$ID}{"SourceLine"});
2136            }
2137        }
2138
2139        my $S = selectSymbol($ID);
2140
2141        if($S==0)
2142        {
2143            if(defined $AllSymbols)
2144            {
2145                if($SymbolInfo{$ID}{"External"})
2146                {
2147                    $S = 1;
2148                }
2149                else
2150                { # local
2151                    if(defined $DumpStatic) {
2152                        $S = 1;
2153                    }
2154                }
2155            }
2156        }
2157
2158        if($S==0)
2159        {
2160            delete($SymbolInfo{$ID});
2161            next;
2162        }
2163        $SelectedSymbols{$ID} = $S;
2164
2165        delete($SymbolInfo{$ID}{"External"});
2166    }
2167}
2168
2169sub cloneSymbol($$)
2170{
2171    my ($ID, $Symbol) = @_;
2172
2173    my $nID = undef;
2174    if(not defined $SymbolInfo{$ID + 1}) {
2175        $nID = $ID + 1;
2176    }
2177    else {
2178        $nID = ++$GLOBAL_ID;
2179    }
2180    foreach my $Attr (keys(%{$SymbolInfo{$ID}}))
2181    {
2182        if(ref($SymbolInfo{$ID}{$Attr}) eq "HASH") {
2183            $SymbolInfo{$nID}{$Attr} = dclone($SymbolInfo{$ID}{$Attr});
2184        }
2185        else {
2186            $SymbolInfo{$nID}{$Attr} = $SymbolInfo{$ID}{$Attr};
2187        }
2188    }
2189    $SymbolInfo{$nID}{"MnglName"} = $Symbol;
2190}
2191
2192sub selectSymbol($)
2193{
2194    my $ID = $_[0];
2195
2196    my $MnglName = $SymbolInfo{$ID}{"MnglName"};
2197
2198    if(not $MnglName) {
2199        $MnglName = $SymbolInfo{$ID}{"ShortName"};
2200    }
2201
2202    my $Exp = 0;
2203
2204    if($Library_Symbol{$TargetName}{$MnglName}
2205    or $Library_Symbol{$TargetName}{$SymVer{$MnglName}})
2206    {
2207        $Exp = 1;
2208    }
2209
2210    if(my $Alias = $SymbolInfo{$ID}{"Alias"})
2211    {
2212        if($Library_Symbol{$TargetName}{$Alias}
2213        or $Library_Symbol{$TargetName}{$SymVer{$Alias}})
2214        {
2215            $Exp = 1;
2216        }
2217    }
2218
2219    if(not $Exp)
2220    {
2221        if(defined $Library_UndefSymbol{$TargetName}{$MnglName}
2222        or defined $Library_UndefSymbol{$TargetName}{$SymVer{$MnglName}})
2223        {
2224            return 0;
2225        }
2226
2227        if($SymbolInfo{$ID}{"Data"}
2228        or $SymbolInfo{$ID}{"InLine"}
2229        or $SymbolInfo{$ID}{"PureVirt"})
2230        {
2231            if(not $SymbolInfo{$ID}{"External"})
2232            { # skip static
2233                return 0;
2234            }
2235
2236            if(defined $BinOnly)
2237            { # data, inline, pure
2238                return 0;
2239            }
2240            elsif(not defined $SymbolInfo{$ID}{"Header"})
2241            { # defined in source files
2242                return 0;
2243            }
2244            else
2245            {
2246                return 2;
2247            }
2248        }
2249        else
2250        {
2251            return 0;
2252        }
2253    }
2254
2255    return 1;
2256}
2257
2258sub formatName($$)
2259{ # type name correction
2260    if(defined $Cache{"formatName"}{$_[1]}{$_[0]}) {
2261        return $Cache{"formatName"}{$_[1]}{$_[0]};
2262    }
2263
2264    my $N = $_[0];
2265
2266    if($_[1] ne "S")
2267    {
2268        $N=~s/\A[ ]+//g;
2269        $N=~s/[ ]+\Z//g;
2270        $N=~s/[ ]{2,}/ /g;
2271    }
2272
2273    $N=~s/[ ]*(\W)[ ]*/$1/g; # std::basic_string<char> const
2274
2275    $N=~s/\b(const|volatile) ([\w\:]+)([\*&,>]|\Z)/$2 $1$3/g; # "const void" to "void const"
2276
2277    $N=~s/\bvolatile const\b/const volatile/g;
2278
2279    $N=~s/\b(long long|short|long) unsigned\b/unsigned $1/g;
2280    $N=~s/\b(short|long) int\b/$1/g;
2281
2282    $N=~s/([\)\]])(const|volatile)\b/$1 $2/g;
2283
2284    while($N=~s/>>/> >/g) {};
2285
2286    if($_[1] eq "S")
2287    {
2288        if(index($N, "operator")!=-1) {
2289            $N=~s/\b(operator[ ]*)> >/$1>>/;
2290        }
2291    }
2292
2293    $N=~s/,/, /g;
2294
2295    return ($Cache{"formatName"}{$_[1]}{$_[0]} = $N);
2296}
2297
2298sub separate_Params($)
2299{
2300    my $Str = $_[0];
2301    my @Parts = ();
2302    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
2303    my $Part = 0;
2304    foreach my $Pos (0 .. length($Str) - 1)
2305    {
2306        my $S = substr($Str, $Pos, 1);
2307        if(defined $B{$S}) {
2308            $B{$S} += 1;
2309        }
2310        if($S eq "," and
2311        $B{"("}==$B{")"} and $B{"<"}==$B{">"}) {
2312            $Part += 1;
2313        }
2314        else {
2315            $Parts[$Part] .= $S;
2316        }
2317    }
2318    # remove spaces
2319    foreach (@Parts)
2320    {
2321        s/\A //g;
2322        s/ \Z//g;
2323    }
2324    return @Parts;
2325}
2326
2327sub init_FuncType($$$)
2328{
2329    my ($TInfo, $FTid, $Type) = @_;
2330
2331    $TInfo->{"Type"} = $Type;
2332
2333    if($TInfo->{"Return"} = $DWARF_Info{$FTid}{"type"}) {
2334        getTypeInfo($TInfo->{"Return"});
2335    }
2336    else
2337    { # void
2338        $TInfo->{"Return"} = "1";
2339    }
2340    delete($TInfo->{"BaseType"});
2341
2342    my @Prms = ();
2343    my $PPos = 0;
2344    foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$FuncParam{$FTid}}))
2345    {
2346        my $ParamId = $FuncParam{$FTid}{$Pos};
2347        my %PInfo = %{$DWARF_Info{$ParamId}};
2348
2349        if(defined $PInfo{"artificial"})
2350        { # this
2351            next;
2352        }
2353
2354        if(my $PTypeId = $PInfo{"type"})
2355        {
2356            $TInfo->{"Param"}{$PPos}{"type"} = $PTypeId;
2357            getTypeInfo($PTypeId);
2358            push(@Prms, $TypeInfo{$PTypeId}{"Name"});
2359        }
2360
2361        $PPos += 1;
2362    }
2363
2364    $TInfo->{"Name"} = $TypeInfo{$TInfo->{"Return"}}{"Name"};
2365    if($Type eq "FuncPtr") {
2366        $TInfo->{"Name"} .= "(*)";
2367    }
2368    else {
2369        $TInfo->{"Name"} .= "()";
2370    }
2371    $TInfo->{"Name"} .= "(".join(",", @Prms).")";
2372}
2373
2374sub get_TParams($)
2375{
2376    my $Name = $_[0];
2377    if(my $Cent = find_center($Name, "<"))
2378    {
2379        my $TParams = substr($Name, $Cent);
2380        $TParams=~s/\A<|>\Z//g;
2381
2382        $TParams = simpleName($TParams);
2383
2384        my $Short = substr($Name, 0, $Cent);
2385
2386        my @Params = separate_Params($TParams);
2387        foreach my $Pos (0 .. $#Params)
2388        {
2389            my $Param = $Params[$Pos];
2390            if($Param=~/\A(.+>)(.*?)\Z/)
2391            {
2392                my ($Tm, $Suf) = ($1, $2);
2393                my ($Sh, @Prm) = get_TParams($Tm);
2394                $Param = $Sh."<".join(", ", @Prm).">".$Suf;
2395            }
2396            $Params[$Pos] = formatName($Param, "T");
2397        }
2398
2399        # default arguments
2400        if($Short eq "std::vector")
2401        {
2402            if($#Params==1)
2403            {
2404                if($Params[1] eq "std::allocator<".$Params[0].">")
2405                { # std::vector<T, std::allocator<T> >
2406                    splice(@Params, 1, 1);
2407                }
2408            }
2409        }
2410        elsif($Short eq "std::set")
2411        {
2412            if($#Params==2)
2413            {
2414                if($Params[1] eq "std::less<".$Params[0].">"
2415                and $Params[2] eq "std::allocator<".$Params[0].">")
2416                { # std::set<T, std::less<T>, std::allocator<T> >
2417                    splice(@Params, 1, 2);
2418                }
2419            }
2420        }
2421        elsif($Short eq "std::basic_string")
2422        {
2423            if($#Params==2)
2424            {
2425                if($Params[1] eq "std::char_traits<".$Params[0].">"
2426                and $Params[2] eq "std::allocator<".$Params[0].">")
2427                { # std::basic_string<T, std::char_traits<T>, std::allocator<T> >
2428                    splice(@Params, 1, 2);
2429                }
2430            }
2431        }
2432
2433        return ($Short, @Params);
2434    }
2435
2436    return $Name; # error
2437}
2438
2439sub getTypeInfo($)
2440{
2441    my $ID = $_[0];
2442    my $Kind = $DWARF_Info{$ID}{"Kind"};
2443
2444    if(defined $Cache{"getTypeInfo"}{$ID}) {
2445        return;
2446    }
2447
2448    if(my $N = $NameSpace{$ID})
2449    {
2450        if($DWARF_Info{$N}{"Kind"} eq "subprogram")
2451        { # local code
2452          # template instances are declared in the subprogram (constructor)
2453            my $Tmpl = 0;
2454            if(my $ObjP = $DWARF_Info{$N}{"object_pointer"})
2455            {
2456                while($DWARF_Info{$ObjP}{"type"}) {
2457                    $ObjP = $DWARF_Info{$ObjP}{"type"};
2458                }
2459                my $CName = $DWARF_Info{$ObjP}{"name"};
2460                $CName=~s/<.*//g;
2461                if($CName eq $DWARF_Info{$N}{"name"}) {
2462                    $Tmpl = 1;
2463                }
2464            }
2465            if(not $Tmpl)
2466            { # local types
2467                $LocalType{$ID} = 1;
2468            }
2469        }
2470        elsif($DWARF_Info{$N}{"Kind"} eq "lexical_block")
2471        { # local code
2472            return;
2473        }
2474    }
2475
2476    $Cache{"getTypeInfo"}{$ID} = 1;
2477
2478    my %TInfo = ();
2479
2480    $TInfo{"Type"} = $TypeType{$Kind};
2481
2482    if(not $TInfo{"Type"})
2483    {
2484        if($DWARF_Info{$ID}{"Kind"} eq "subroutine_type") {
2485            $TInfo{"Type"} = "Func";
2486        }
2487    }
2488
2489    if(defined $ClassMethods{$ID})
2490    {
2491        if($TInfo{"Type"} eq "Struct") {
2492            $TInfo{"Type"} = "Class";
2493        }
2494    }
2495
2496    if(my $BaseType = $DWARF_Info{$ID}{"type"})
2497    {
2498        $TInfo{"BaseType"} = "$BaseType";
2499
2500        if(defined $TypeType{$DWARF_Info{$BaseType}{"Kind"}})
2501        {
2502            getTypeInfo($TInfo{"BaseType"});
2503
2504            if(not defined $TypeInfo{$TInfo{"BaseType"}}
2505            or not $TypeInfo{$TInfo{"BaseType"}}{"Name"})
2506            { # local code
2507                delete($TypeInfo{$ID});
2508                return;
2509            }
2510        }
2511    }
2512    if($TInfo{"Type"} eq "Class") {
2513        $TInfo{"Copied"} = 1; # will be changed in getSymbolInfo()
2514    }
2515
2516    if(defined $TypeMember{$ID})
2517    {
2518        my $Unnamed = 0;
2519        foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$TypeMember{$ID}}))
2520        {
2521            my $MemId = $TypeMember{$ID}{$Pos};
2522            my %MInfo = %{$DWARF_Info{$MemId}};
2523
2524            if(my $Name = $MInfo{"name"})
2525            {
2526                if(index($Name, "_vptr.")==0)
2527                { # v-table pointer
2528                    $Name="_vptr";
2529                }
2530                $TInfo{"Memb"}{$Pos}{"name"} = $Name;
2531            }
2532            else
2533            {
2534                $TInfo{"Memb"}{$Pos}{"name"} = "unnamed".$Unnamed;
2535                $Unnamed += 1;
2536            }
2537            if($TInfo{"Type"} eq "Enum") {
2538                $TInfo{"Memb"}{$Pos}{"value"} = $MInfo{"const_value"};
2539            }
2540            else
2541            {
2542                $TInfo{"Memb"}{$Pos}{"type"} = $MInfo{"type"};
2543                if(my $Access = $MInfo{"accessibility"}) {
2544                    $TInfo{"Memb"}{$Pos}{"access"} = $Access;
2545                }
2546                if($TInfo{"Type"} eq "Union") {
2547                    $TInfo{"Memb"}{$Pos}{"offset"} = "0";
2548                }
2549                elsif(defined $MInfo{"data_member_location"}) {
2550                    $TInfo{"Memb"}{$Pos}{"offset"} = $MInfo{"data_member_location"};
2551                }
2552            }
2553
2554            if((my $BitSize = $MInfo{"bit_size"}) ne "") {
2555                $TInfo{"Memb"}{$Pos}{"bitfield"} = $BitSize;
2556            }
2557        }
2558    }
2559
2560    if(my $Access = $DWARF_Info{$ID}{"accessibility"}) {
2561        $TInfo{ucfirst($Access)} = 1;
2562    }
2563
2564    if(my $Size = $DWARF_Info{$ID}{"byte_size"}) {
2565        $TInfo{"Size"} = $Size;
2566    }
2567
2568    setSource(\%TInfo, $ID);
2569
2570    if(not $DWARF_Info{$ID}{"name"}
2571    and my $Spec = $DWARF_Info{$ID}{"specification"}) {
2572        $DWARF_Info{$ID}{"name"} = $DWARF_Info{$Spec}{"name"};
2573    }
2574
2575    my $NS = $NameSpace{$ID};
2576    if(not $NS)
2577    {
2578        if(my $Sp = $DWARF_Info{$ID}{"specification"}) {
2579            $NS = $NameSpace{$Sp};
2580        }
2581    }
2582
2583    if($NS)
2584    {
2585        if($DWARF_Info{$NS}{"Kind"} eq "namespace")
2586        {
2587            if(my $NS_F = completeNS($ID))
2588            {
2589                $TInfo{"NameSpace"} = $NS_F;
2590            }
2591        }
2592        elsif($DWARF_Info{$NS}{"Kind"} eq "class_type"
2593        or $DWARF_Info{$NS}{"Kind"} eq "structure_type")
2594        { # class
2595            getTypeInfo($NS);
2596
2597            if(my $Sp = $SpecElem{$NS}) {
2598                getTypeInfo($Sp);
2599            }
2600
2601            if($TypeInfo{$NS}{"Name"})
2602            {
2603                $TInfo{"NameSpace"} = $TypeInfo{$NS}{"Name"};
2604                $TInfo{"NameSpace"}=~s/\Astruct //;
2605            }
2606        }
2607    }
2608
2609    if(my $Name = $DWARF_Info{$ID}{"name"})
2610    {
2611        $TInfo{"Name"} = $Name;
2612
2613        if($TInfo{"NameSpace"}) {
2614            $TInfo{"Name"} = $TInfo{"NameSpace"}."::".$TInfo{"Name"};
2615        }
2616
2617        if($TInfo{"Type"}=~/\A(Struct|Class)\Z/)
2618        {
2619            if(defined $VirtualTable{$TInfo{"Name"}}) {
2620                %{$TInfo{"VTable"}} = %{$VirtualTable{$TInfo{"Name"}}};
2621            }
2622        }
2623
2624        if($TInfo{"Type"}=~/\A(Struct|Enum|Union)\Z/) {
2625            $TInfo{"Name"} = lc($TInfo{"Type"})." ".$TInfo{"Name"};
2626        }
2627    }
2628
2629    if($TInfo{"Type"} eq "Pointer")
2630    {
2631        if($DWARF_Info{$TInfo{"BaseType"}}{"Kind"} eq "subroutine_type")
2632        {
2633            init_FuncType(\%TInfo, $TInfo{"BaseType"}, "FuncPtr");
2634        }
2635    }
2636    elsif($TInfo{"Type"}=~/Typedef|Const|Volatile/)
2637    {
2638        if($DWARF_Info{$TInfo{"BaseType"}}{"Kind"} eq "subroutine_type")
2639        {
2640            getTypeInfo($TInfo{"BaseType"});
2641        }
2642    }
2643    elsif($TInfo{"Type"} eq "Func")
2644    {
2645        init_FuncType(\%TInfo, $ID, "Func");
2646    }
2647    elsif($TInfo{"Type"} eq "Struct")
2648    {
2649        if(not $TInfo{"Name"}
2650        and my $Sb = $DWARF_Info{$ID}{"sibling"})
2651        {
2652            if($DWARF_Info{$Sb}{"Kind"} eq "subroutine_type"
2653            and defined $TInfo{"Memb"}
2654            and $TInfo{"Memb"}{0}{"name"} eq "__pfn")
2655            { # __pfn and __delta
2656                $TInfo{"Type"} = "MethodPtr";
2657
2658                my @Prms = ();
2659                my $PPos = 0;
2660                foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$FuncParam{$Sb}}))
2661                {
2662                    my $ParamId = $FuncParam{$Sb}{$Pos};
2663                    my %PInfo = %{$DWARF_Info{$ParamId}};
2664
2665                    if(defined $PInfo{"artificial"})
2666                    { # this
2667                        next;
2668                    }
2669
2670                    if(my $PTypeId = $PInfo{"type"})
2671                    {
2672                        $TInfo{"Param"}{$PPos}{"type"} = $PTypeId;
2673                        getTypeInfo($PTypeId);
2674                        push(@Prms, $TypeInfo{$PTypeId}{"Name"});
2675                    }
2676
2677                    $PPos += 1;
2678                }
2679
2680                if(my $ClassId = $DWARF_Info{$Sb}{"object_pointer"})
2681                {
2682                    while($DWARF_Info{$ClassId}{"type"}) {
2683                        $ClassId = $DWARF_Info{$ClassId}{"type"};
2684                    }
2685                    $TInfo{"Class"} = $ClassId;
2686                    getTypeInfo($TInfo{"Class"});
2687                }
2688
2689                if($TInfo{"Return"} = $DWARF_Info{$Sb}{"type"}) {
2690                    getTypeInfo($TInfo{"Return"});
2691                }
2692                else
2693                { # void
2694                    $TInfo{"Return"} = "1";
2695                }
2696
2697                $TInfo{"Name"} = $TypeInfo{$TInfo{"Return"}}{"Name"};
2698                $TInfo{"Name"} .= "(".$TypeInfo{$TInfo{"Class"}}{"Name"}."::*)";
2699                $TInfo{"Name"} .= "(".join(",", @Prms).")";
2700            }
2701        }
2702    }
2703    elsif($TInfo{"Type"} eq "FieldPtr")
2704    {
2705        $TInfo{"Return"} = $TInfo{"BaseType"};
2706        delete($TInfo{"BaseType"});
2707
2708        if(my $Class = $DWARF_Info{$ID}{"containing_type"})
2709        {
2710            $TInfo{"Class"} = $Class;
2711            getTypeInfo($TInfo{"Class"});
2712
2713            $TInfo{"Name"} = $TypeInfo{$TInfo{"Return"}}{"Name"}."(".$TypeInfo{$TInfo{"Class"}}{"Name"}."::*)";
2714        }
2715
2716        $TInfo{"Size"} = $SYS_WORD;
2717    }
2718
2719    foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$Inheritance{$ID}}))
2720    {
2721        if(my $BaseId = $Inheritance{$ID}{$Pos}{"id"})
2722        {
2723            if(my $E = $SpecElem{$BaseId}) {
2724                $BaseId = $E;
2725            }
2726
2727            $TInfo{"Base"}{$BaseId}{"pos"} = "$Pos";
2728            if(my $Access = $Inheritance{$ID}{$Pos}{"access"}) {
2729                $TInfo{"Base"}{$BaseId}{"access"} = $Access;
2730            }
2731            if($Inheritance{$ID}{$Pos}{"virtual"}) {
2732                $TInfo{"Base"}{$BaseId}{"virtual"} = 1;
2733            }
2734
2735            $ClassChild{$BaseId}{$ID} = 1;
2736        }
2737    }
2738
2739    if($TInfo{"Type"} eq "Pointer")
2740    {
2741        if(not $TInfo{"BaseType"})
2742        {
2743            $TInfo{"Name"} = "void*";
2744            $TInfo{"BaseType"} = "1";
2745        }
2746    }
2747    if($TInfo{"Type"} eq "Const")
2748    {
2749        if(not $TInfo{"BaseType"})
2750        {
2751            $TInfo{"Name"} = "const void";
2752            $TInfo{"BaseType"} = "1";
2753        }
2754    }
2755    if($TInfo{"Type"} eq "Volatile")
2756    {
2757        if(not $TInfo{"BaseType"})
2758        {
2759            $TInfo{"Name"} = "volatile void";
2760            $TInfo{"BaseType"} = "1";
2761        }
2762    }
2763
2764    if(not $TInfo{"Name"})
2765    {
2766        my $ID_ = $ID;
2767        my $BaseID = undef;
2768        my $Name = "";
2769
2770        while($BaseID = $DWARF_Info{$ID_}{"type"})
2771        {
2772            my $Kind = $DWARF_Info{$ID_}{"Kind"};
2773            if(my $Q = $Qual{$TypeType{$Kind}})
2774            {
2775                $Name = $Q.$Name;
2776                if($Q=~/\A\w/) {
2777                    $Name = " ".$Name;
2778                }
2779            }
2780            if(my $BName = $TypeInfo{$BaseID}{"Name"})
2781            {
2782                $Name = $BName.$Name;
2783                last;
2784            }
2785            elsif(my $BName2 = $DWARF_Info{$BaseID}{"name"})
2786            {
2787                $Name = $BName2.$Name;
2788            }
2789            $ID_ = $BaseID;
2790        }
2791
2792        if($Name) {
2793            $TInfo{"Name"} = $Name;
2794        }
2795
2796        if($TInfo{"Type"} eq "Array")
2797        {
2798            if(my $Count = $ArrayCount{$ID})
2799            {
2800                $TInfo{"Name"} .= "[".$Count."]";
2801                if(my $BType = $TInfo{"BaseType"})
2802                {
2803                    if(my $BSize = $TypeInfo{$BType}{"Size"})
2804                    {
2805                        if(my $Size = $Count*$BSize)
2806                        {
2807                            $TInfo{"Size"} = "$Size";
2808                        }
2809                    }
2810                }
2811            }
2812            else
2813            {
2814                $TInfo{"Name"} .= "[]";
2815                $TInfo{"Size"} = $SYS_WORD;
2816            }
2817        }
2818    }
2819
2820    if(my $Bid = $TInfo{"BaseType"})
2821    {
2822        if(not $TInfo{"Size"}
2823        and $TypeInfo{$Bid}{"Size"}) {
2824            $TInfo{"Size"} = $TypeInfo{$Bid}{"Size"};
2825        }
2826    }
2827    if($TInfo{"Name"}) {
2828        $TInfo{"Name"} = formatName($TInfo{"Name"}, "T"); # simpleName()
2829    }
2830
2831    if($TInfo{"Name"}=~/>\Z/)
2832    {
2833        my ($Short, @TParams) = get_TParams($TInfo{"Name"});
2834
2835        if(@TParams)
2836        {
2837            delete($TInfo{"TParam"});
2838            foreach my $Pos (0 .. $#TParams) {
2839                $TInfo{"TParam"}{$Pos}{"name"} = $TParams[$Pos];
2840            }
2841            $TInfo{"Name"} = formatName($Short."<".join(", ", @TParams).">", "T");
2842        }
2843    }
2844
2845    if(not $TInfo{"Name"})
2846    {
2847        if($TInfo{"Type"}=~/\A(Class|Struct|Enum|Union)\Z/)
2848        {
2849            if($TInfo{"Header"}) {
2850                $TInfo{"Name"} = "anon-".lc($TInfo{"Type"})."-".$TInfo{"Header"}."-".$TInfo{"Line"};
2851            }
2852            elsif($TInfo{"Source"}) {
2853                $TInfo{"Name"} = "anon-".lc($TInfo{"Type"})."-".$TInfo{"Source"}."-".$TInfo{"SourceLine"};
2854            }
2855            else
2856            {
2857                if(not defined $TypeMember{$ID})
2858                {
2859                    if(not defined $ANON_TYPE{$TInfo{"Type"}})
2860                    {
2861                        printMsg("WARNING", "a \"".$TInfo{"Type"}."\" type with no attributes detected in the DWARF dump ($ID)");
2862                        $ANON_TYPE{$TInfo{"Type"}} = 1;
2863                    }
2864                    $TInfo{"Name"} = "anon-".lc($TInfo{"Type"});
2865                }
2866            }
2867
2868            if($TInfo{"Name"} and $TInfo{"NameSpace"}) {
2869                $TInfo{"Name"} = $TInfo{"NameSpace"}."::".$TInfo{"Name"};
2870            }
2871        }
2872    }
2873
2874    if($TInfo{"Name"})
2875    {
2876        if(not defined $TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}}
2877        or ($ID>0 and $ID<$TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}})
2878        or ($ID>0 and $TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}}<0))
2879        {
2880            $TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}} = "$ID";
2881        }
2882        $TName_Tids{$TInfo{"Type"}}{$TInfo{"Name"}}{$ID} = 1;
2883    }
2884
2885    if(defined $TInfo{"Source"})
2886    {
2887        if(not defined $TInfo{"Header"})
2888        {
2889            $TInfo{"Line"} = $TInfo{"SourceLine"};
2890            delete($TInfo{"SourceLine"});
2891        }
2892    }
2893
2894    foreach my $Attr (keys(%TInfo)) {
2895        $TypeInfo{$ID}{$Attr} = $TInfo{$Attr};
2896    }
2897
2898    if(my $BASE_ID = $DWARF_Info{$ID}{"specification"})
2899    {
2900        foreach my $Attr (keys(%{$TypeInfo{$BASE_ID}}))
2901        {
2902            if($Attr ne "Type") {
2903                $TypeInfo{$ID}{$Attr} = $TypeInfo{$BASE_ID}{$Attr};
2904            }
2905        }
2906
2907        foreach my $Attr (keys(%{$TypeInfo{$ID}})) {
2908            $TypeInfo{$BASE_ID}{$Attr} = $TypeInfo{$ID}{$Attr};
2909        }
2910
2911        $TypeSpec{$ID} = $BASE_ID;
2912    }
2913}
2914
2915sub setSource($$)
2916{
2917    my ($R, $ID) = @_;
2918
2919    my $File = $DWARF_Info{$ID}{"decl_file"};
2920    my $Line = $DWARF_Info{$ID}{"decl_line"};
2921
2922    my $Unit = $DWARF_Info{$ID}{"Unit"};
2923
2924    if(defined $File)
2925    {
2926        my $Name = undef;
2927
2928        if($ID>=0) {
2929            $Name = $SourceFile{$Unit}{$File};
2930        }
2931        else
2932        { # imported
2933            $Name = $SourceFile_Alt{0}{$File};
2934        }
2935
2936        if($Name=~/\.($HEADER_EXT)\Z/)
2937        { # header
2938            $R->{"Header"} = $Name;
2939            if(defined $Line) {
2940                $R->{"Line"} = $Line;
2941            }
2942        }
2943        elsif($Name ne "<built-in>")
2944        { # source
2945            $R->{"Source"} = $Name;
2946            if(defined $Line) {
2947                $R->{"SourceLine"} = $Line;
2948            }
2949        }
2950    }
2951}
2952
2953sub skipSymbol($)
2954{
2955    if($SkipCxx and not $STDCXX_TARGET)
2956    {
2957        if($_[0]=~/\A(_ZS|_ZNS|_ZNKS|_ZN9__gnu_cxx|_ZNK9__gnu_cxx|_ZTIS|_ZTSS)/)
2958        { # stdc++ symbols
2959            return 1;
2960        }
2961    }
2962    return 0;
2963}
2964
2965sub find_center($$)
2966{
2967    my ($Name, $Target) = @_;
2968    my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
2969    foreach my $Pos (0 .. length($Name)-1)
2970    {
2971        my $S = substr($Name, length($Name)-1-$Pos, 1);
2972        if(defined $B{$S}) {
2973            $B{$S}+=1;
2974        }
2975        if($S eq $Target)
2976        {
2977            if($B{"("}==$B{")"}
2978            and $B{"<"}==$B{">"}) {
2979                return length($Name)-1-$Pos;
2980            }
2981        }
2982    }
2983    return 0;
2984}
2985
2986sub isExternal($)
2987{
2988    my $ID = $_[0];
2989
2990    if($DWARF_Info{$ID}{"external"}) {
2991        return 1;
2992    }
2993    elsif(my $Spec = $DWARF_Info{$ID}{"specification"})
2994    {
2995        if($DWARF_Info{$Spec}{"external"}) {
2996            return 1;
2997        }
2998    }
2999
3000    return 0;
3001}
3002
3003sub symByAddr($)
3004{
3005    my $Loc = $_[0];
3006
3007    my ($Addr, $Sect) = ("", "");
3008    if($Loc=~/\+(.+)/)
3009    {
3010        $Addr = $1;
3011        if(not $Addr=~s/\A0x//)
3012        {
3013            $Addr=~s/\A00//;
3014        }
3015    }
3016    if($Loc=~/([\w\.]+)\+/) {
3017        $Sect = $1;
3018    }
3019
3020    if($Addr ne "")
3021    {
3022        foreach ($Sect, "")
3023        {
3024            if(defined $SymbolTable{$_}{$Addr})
3025            {
3026                if(my @Symbols = sort keys(%{$SymbolTable{$_}{$Addr}})) {
3027                    return $Symbols[0];
3028                }
3029            }
3030        }
3031    }
3032
3033    return undef;
3034}
3035
3036sub get_Mangled($)
3037{
3038    my $ID = $_[0];
3039
3040    if(not defined $AddrToName)
3041    {
3042        if(my $Link = $DWARF_Info{$ID}{"linkage_name"})
3043        {
3044            return $Link;
3045        }
3046    }
3047
3048    if(my $Low_Pc = $DWARF_Info{$ID}{"low_pc"})
3049    {
3050        if($Low_Pc=~/<([\w\@\.]+)>/) {
3051            return $1;
3052        }
3053        else
3054        {
3055            if(my $Symbol = symByAddr($Low_Pc)) {
3056                return $Symbol;
3057            }
3058        }
3059    }
3060
3061    if(my $Loc = $DWARF_Info{$ID}{"location"})
3062    {
3063        if($Loc=~/<([\w\@\.]+)>/) {
3064            return $1;
3065        }
3066        else
3067        {
3068            if(my $Symbol = symByAddr($Loc)) {
3069                return $Symbol;
3070            }
3071        }
3072    }
3073
3074    if(my $Link = $DWARF_Info{$ID}{"linkage_name"})
3075    {
3076        return $Link;
3077    }
3078
3079    return undef;
3080}
3081
3082sub completeNS($)
3083{
3084    my $ID = $_[0];
3085
3086    my $NS = undef;
3087    my $ID_ = $ID;
3088    my @NSs = ();
3089
3090    while($NS = $NameSpace{$ID_}
3091    or $NS = $NameSpace{$DWARF_Info{$ID_}{"specification"}})
3092    {
3093        if(my $N = $DWARF_Info{$NS}{"name"}) {
3094            push(@NSs, $N);
3095        }
3096        $ID_ = $NS;
3097    }
3098
3099    if(@NSs)
3100    {
3101        my $N = join("::", reverse(@NSs));
3102        $NestedNameSpaces{$N} = 1;
3103        return $N;
3104    }
3105
3106    return undef;
3107}
3108
3109sub getSymbolInfo($)
3110{
3111    my $ID = $_[0];
3112
3113    if(my $N = $NameSpace{$ID})
3114    {
3115        if($DWARF_Info{$N}{"Kind"} eq "lexical_block"
3116        or $DWARF_Info{$N}{"Kind"} eq "subprogram")
3117        { # local variables
3118            return;
3119        }
3120    }
3121
3122    if(my $Loc = $DWARF_Info{$ID}{"location"})
3123    {
3124        if($Loc=~/ reg\d+\Z/)
3125        { # local variables
3126            return;
3127        }
3128    }
3129
3130    my $ShortName = $DWARF_Info{$ID}{"name"};
3131    my $MnglName = get_Mangled($ID);
3132
3133    if(not $MnglName)
3134    {
3135        if(my $Sp = $SpecElem{$ID}) {
3136            $MnglName = get_Mangled($Sp);
3137        }
3138    }
3139
3140    if(not $MnglName)
3141    {
3142        if(index($ShortName, "<")!=-1)
3143        { # template
3144            return;
3145        }
3146        $MnglName = $ShortName;
3147    }
3148
3149    if(skipSymbol($MnglName)) {
3150        return;
3151    }
3152
3153    if(index($MnglName, "\@")!=-1) {
3154        $MnglName=~s/([\@]+.*?)\Z//;
3155    }
3156
3157    if(not $MnglName) {
3158        return;
3159    }
3160
3161    if(index($MnglName, ".")!=-1)
3162    { # foo.part.14
3163      # bar.isra.15
3164        return;
3165    }
3166
3167    if($MnglName=~/\W/)
3168    { # unmangled operators, etc.
3169        return;
3170    }
3171
3172    if($MnglName)
3173    {
3174        if(my $OLD_ID = $Mangled_ID{$MnglName})
3175        { # duplicates
3176            if(not defined $SymbolInfo{$OLD_ID}{"Header"}
3177            or not defined $SymbolInfo{$OLD_ID}{"Source"})
3178            {
3179                setSource($SymbolInfo{$OLD_ID}, $ID);
3180            }
3181
3182            if(defined $Checked_Spec{$MnglName}
3183            or not $DWARF_Info{$ID}{"specification"})
3184            {
3185                if(not defined $SpecElem{$ID}
3186                and not defined $OrigElem{$ID}) {
3187                    delete($DWARF_Info{$ID});
3188                }
3189                return;
3190            }
3191        }
3192    }
3193
3194    my %SInfo = ();
3195
3196    if($ShortName) {
3197        $SInfo{"ShortName"} = $ShortName;
3198    }
3199    $SInfo{"MnglName"} = $MnglName;
3200
3201    if($MnglName eq $ShortName)
3202    {
3203        delete($SInfo{"MnglName"});
3204        $MnglName = $ShortName;
3205    }
3206    elsif(index($MnglName, "_Z")!=0)
3207    {
3208        if($SInfo{"ShortName"})
3209        {
3210            $SInfo{"Alias"} = $SInfo{"ShortName"};
3211            $SInfo{"ShortName"} = $SInfo{"MnglName"};
3212        }
3213
3214        delete($SInfo{"MnglName"});
3215        $MnglName = $ShortName;
3216    }
3217
3218    if(isExternal($ID)) {
3219        $SInfo{"External"} = 1;
3220    }
3221
3222    if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"})
3223    {
3224        if(isExternal($Orig)) {
3225            $SInfo{"External"} = 1;
3226        }
3227    }
3228
3229    if(index($MnglName, "_ZNVK")==0)
3230    {
3231        $SInfo{"Const"} = 1;
3232        $SInfo{"Volatile"} = 1;
3233    }
3234    elsif(index($MnglName, "_ZNV")==0) {
3235        $SInfo{"Volatile"} = 1;
3236    }
3237    elsif(index($MnglName, "_ZNK")==0) {
3238        $SInfo{"Const"} = 1;
3239    }
3240
3241    if($DWARF_Info{$ID}{"artificial"}) {
3242        $SInfo{"Artificial"} = 1;
3243    }
3244
3245    my ($C, $D) = ();
3246
3247    if($MnglName=~/C[1-2][EI].+/)
3248    {
3249        $C = 1;
3250        $SInfo{"Constructor"} = 1;
3251    }
3252
3253    if($MnglName=~/D[0-2][EI].+/)
3254    {
3255        $D = 1;
3256        $SInfo{"Destructor"} = 1;
3257    }
3258
3259    if($C or $D)
3260    {
3261        if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"})
3262        {
3263            if(my $InLine = $DWARF_Info{$Orig}{"inline"})
3264            {
3265                if(index($InLine, "declared_not_inlined")==0)
3266                {
3267                    $SInfo{"InLine"} = 1;
3268                    $SInfo{"Artificial"} = 1;
3269                }
3270            }
3271
3272            setSource(\%SInfo, $Orig);
3273
3274            if(my $Spec = $DWARF_Info{$Orig}{"specification"})
3275            {
3276                setSource(\%SInfo, $Spec);
3277
3278                $SInfo{"ShortName"} = $DWARF_Info{$Spec}{"name"};
3279                if($D) {
3280                    $SInfo{"ShortName"}=~s/\A\~//g;
3281                }
3282
3283                if(my $Class = $NameSpace{$Spec}) {
3284                    $SInfo{"Class"} = $Class;
3285                }
3286
3287                if(my $Virt = $DWARF_Info{$Spec}{"virtuality"})
3288                {
3289                    if(index($Virt, "virtual")!=-1) {
3290                        $SInfo{"Virt"} = 1;
3291                    }
3292                }
3293
3294                if(my $Access = $DWARF_Info{$Spec}{"accessibility"}) {
3295                    $SInfo{ucfirst($Access)} = 1;
3296                }
3297
3298                # clean origin
3299                delete($SymbolInfo{$Spec});
3300            }
3301        }
3302    }
3303    else
3304    {
3305        if(my $InLine = $DWARF_Info{$ID}{"inline"})
3306        {
3307            if(index($InLine, "declared_inlined")==0) {
3308                $SInfo{"InLine"} = 1;
3309            }
3310        }
3311    }
3312
3313    if(defined $AddrToName)
3314    {
3315        if(not $SInfo{"Alias"}
3316        and not $SInfo{"Constructor"}
3317        and not $SInfo{"Destructor"})
3318        {
3319            if(my $Linkage = $DWARF_Info{$ID}{"linkage_name"})
3320            {
3321                if($Linkage ne $MnglName) {
3322                    $SInfo{"Alias"} = $Linkage;
3323                }
3324            }
3325        }
3326    }
3327
3328    if($DWARF_Info{$ID}{"Kind"} eq "variable")
3329    { # global data
3330        $SInfo{"Data"} = 1;
3331
3332        if(my $Spec = $DWARF_Info{$ID}{"specification"})
3333        {
3334            if($DWARF_Info{$Spec}{"Kind"} eq "member")
3335            {
3336                setSource(\%SInfo, $Spec);
3337                $SInfo{"ShortName"} = $DWARF_Info{$Spec}{"name"};
3338
3339                if(my $NSp = $NameSpace{$Spec})
3340                {
3341                    if($DWARF_Info{$NSp}{"Kind"} eq "namespace") {
3342                        $SInfo{"NameSpace"} = completeNS($Spec);
3343                    }
3344                    else {
3345                        $SInfo{"Class"} = $NSp;
3346                    }
3347                }
3348            }
3349        }
3350    }
3351
3352    if(my $Access = $DWARF_Info{$ID}{"accessibility"})
3353    {
3354        $SInfo{ucfirst($Access)} = 1;
3355    }
3356
3357    if(my $Class = $DWARF_Info{$ID}{"containing_type"})
3358    {
3359        $SInfo{"Class"} = $Class;
3360    }
3361    if(my $NS = $NameSpace{$ID})
3362    {
3363        if($DWARF_Info{$NS}{"Kind"} eq "namespace") {
3364            $SInfo{"NameSpace"} = completeNS($ID);
3365        }
3366        else {
3367            $SInfo{"Class"} = $NS;
3368        }
3369    }
3370
3371    if($SInfo{"Class"} and $MnglName
3372    and index($MnglName, "_Z")!=0)
3373    {
3374        return;
3375    }
3376
3377    if(my $Return = $DWARF_Info{$ID}{"type"})
3378    {
3379        $SInfo{"Return"} = $Return;
3380    }
3381    if(my $Spec = $DWARF_Info{$ID}{"specification"})
3382    {
3383        if(not $DWARF_Info{$ID}{"type"}) {
3384            $SInfo{"Return"} = $DWARF_Info{$Spec}{"type"};
3385        }
3386        if(my $Value = $DWARF_Info{$Spec}{"const_value"})
3387        {
3388            if($Value=~/ block:\s*(.*?)\Z/) {
3389                $Value = $1;
3390            }
3391            $SInfo{"Value"} = $Value;
3392        }
3393    }
3394
3395    if($SInfo{"ShortName"}=~/>\Z/)
3396    { # foo<T1, T2, ...>
3397        my ($Short, @TParams) = get_TParams($SInfo{"ShortName"});
3398        if(@TParams)
3399        {
3400            foreach my $Pos (0 .. $#TParams) {
3401                $SInfo{"TParam"}{$Pos}{"name"} = formatName($TParams[$Pos], "T");
3402            }
3403            # simplify short name
3404            $SInfo{"ShortName"} = $Short.formatName("<".join(", ", @TParams).">", "T");
3405        }
3406    }
3407    elsif($SInfo{"ShortName"}=~/\Aoperator (\w.*)\Z/)
3408    { # operator type<T1>::name
3409        $SInfo{"ShortName"} = "operator ".simpleName($1);
3410    }
3411
3412    if(my $Virt = $DWARF_Info{$ID}{"virtuality"})
3413    {
3414        if(index($Virt, "virtual")!=-1)
3415        {
3416            if($D) {
3417                $SInfo{"Virt"} = 1;
3418            }
3419            else {
3420                $SInfo{"PureVirt"} = 1;
3421            }
3422        }
3423
3424        if((my $VirtPos = $DWARF_Info{$ID}{"vtable_elem_location"}) ne "")
3425        {
3426            $SInfo{"VirtPos"} = $VirtPos;
3427        }
3428    }
3429
3430    setSource(\%SInfo, $ID);
3431
3432    my $PPos = 0;
3433
3434    foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$FuncParam{$ID}}))
3435    {
3436        my $ParamId = $FuncParam{$ID}{$Pos};
3437        my $Offset = undef;
3438        my $Reg = undef;
3439
3440        if(my $Sp = $SpecElem{$ID})
3441        {
3442            if(defined $FuncParam{$Sp}) {
3443                $ParamId = $FuncParam{$Sp}{$Pos};
3444            }
3445        }
3446
3447        if((my $Loc = $DWARF_Info{$ParamId}{"location"}) ne "") {
3448            $Offset = $Loc;
3449        }
3450        elsif((my $R = $DWARF_Info{$ParamId}{"register"}) ne "") {
3451            $Reg = $RegName{$R};
3452        }
3453        elsif((my $LL = $DWARF_Info{$ParamId}{"location_list"}) ne "")
3454        {
3455            if(my $L = $DebugLoc{$LL})
3456            {
3457                if($L=~/reg(\d+)/) {
3458                    $Reg = $RegName{$1};
3459                }
3460                elsif($L=~/fbreg\s+(-?\w+)\Z/) {
3461                    $Offset = $1;
3462                }
3463            }
3464        }
3465
3466        if(my $Orig = $DWARF_Info{$ParamId}{"abstract_origin"}) {
3467            $ParamId = $Orig;
3468        }
3469
3470        my %PInfo = %{$DWARF_Info{$ParamId}};
3471
3472        if(defined $Offset) {
3473            $SInfo{"Param"}{$Pos}{"offset"} = $Offset;
3474        }
3475
3476        $SInfo{"Param"}{$Pos}{"type"} = $PInfo{"type"};
3477
3478        if(defined $PInfo{"name"}) {
3479            $SInfo{"Param"}{$Pos}{"name"} = $PInfo{"name"};
3480        }
3481        elsif($TypeInfo{$PInfo{"type"}}{"Name"} ne "...") {
3482            $SInfo{"Param"}{$Pos}{"name"} = "p".($PPos+1);
3483        }
3484        if(defined $Reg)
3485        { # FIXME: 0+8, 1+16, etc. (for partially distributed parameters)
3486            $SInfo{"Reg"}{$Pos} = $Reg;
3487        }
3488
3489        if($DWARF_Info{$ParamId}{"artificial"} and $Pos==0)
3490        {
3491            if($SInfo{"Param"}{$Pos}{"name"} eq "p1") {
3492                $SInfo{"Param"}{$Pos}{"name"} = "this";
3493            }
3494        }
3495
3496        if($SInfo{"Param"}{$Pos}{"name"} ne "this")
3497        { # this, p1, p2, etc.
3498            $PPos += 1;
3499        }
3500    }
3501
3502    if($SInfo{"Constructor"} and not $SInfo{"InLine"}
3503    and $SInfo{"Class"}) {
3504        delete($TypeInfo{$SInfo{"Class"}}{"Copied"});
3505    }
3506
3507    if(my $BASE_ID = $Mangled_ID{$MnglName})
3508    {
3509        $ID = $BASE_ID;
3510
3511        if(defined $SymbolInfo{$ID}{"PureVirt"})
3512        {
3513            delete($SymbolInfo{$ID}{"PureVirt"});
3514            $SymbolInfo{$ID}{"Virt"} = 1;
3515        }
3516    }
3517    $Mangled_ID{$MnglName} = $ID;
3518
3519    if($DWARF_Info{$ID}{"specification"}) {
3520        $Checked_Spec{$MnglName} = 1;
3521    }
3522
3523    foreach my $Attr (keys(%SInfo)) {
3524        $SymbolInfo{$ID}{$Attr} = $SInfo{$Attr};
3525    }
3526
3527    if($ID>$GLOBAL_ID) {
3528        $GLOBAL_ID = $ID;
3529    }
3530}
3531
3532sub getTypeIdByName($$)
3533{
3534    my ($Type, $Name) = @_;
3535    return $TName_Tid{$Type}{formatName($Name, "T")};
3536}
3537
3538sub getFirst($)
3539{
3540    my $Tid = $_[0];
3541    if(not $Tid) {
3542        return $Tid;
3543    }
3544
3545    if(defined $TypeSpec{$Tid}) {
3546        $Tid = $TypeSpec{$Tid};
3547    }
3548
3549    my $F = 0;
3550
3551    if(my $Name = $TypeInfo{$Tid}{"Name"})
3552    {
3553        my $Type = $TypeInfo{$Tid}{"Type"};
3554        if($Name=~s/\Astruct //)
3555        { # search for class or derived types (const, *, etc.)
3556            $F = 1;
3557        }
3558
3559        my $FTid = undef;
3560        if($F)
3561        {
3562            foreach my $Type ("Class", "Const", "Ref", "Pointer")
3563            {
3564                if($FTid = $TName_Tid{$Type}{$Name})
3565                {
3566                    if($FTid ne $Tid)
3567                    {
3568                        $MergedTypes{$Tid} = 1;
3569                    }
3570                    return "$FTid";
3571                }
3572            }
3573
3574            $Name = "struct ".$Name;
3575        }
3576
3577        if(not $FTid) {
3578            $FTid = $TName_Tid{$Type}{$Name};
3579        }
3580
3581        if($FTid) {
3582            return "$FTid";
3583        }
3584        printMsg("ERROR", "internal error (missed type id $Tid)");
3585    }
3586
3587    return $Tid;
3588}
3589
3590sub searchTypeID($)
3591{
3592    my $Name = $_[0];
3593
3594    my %Pr = map {$_=>1} (
3595        "Struct",
3596        "Union",
3597        "Enum"
3598    );
3599
3600    foreach my $Type ("Class", "Struct", "Union", "Enum", "Typedef", "Const",
3601    "Volatile", "Ref", "Pointer", "FuncPtr", "MethodPtr", "FieldPtr")
3602    {
3603        my $Tid = $TName_Tid{$Type}{$Name};
3604
3605        if(not $Tid)
3606        {
3607            my $P = "";
3608            if(defined $Pr{$Type})
3609            {
3610                $P = lc($Type)." ";
3611            }
3612
3613            $Tid = $TName_Tid{$Type}{$P.$Name}
3614        }
3615        if($Tid) {
3616            return $Tid;
3617        }
3618    }
3619    return undef;
3620}
3621
3622sub remove_Unused()
3623{ # remove unused data types from the ABI dump
3624    %HeadersInfo = ();
3625    %SourcesInfo = ();
3626
3627    my (%SelectedHeaders, %SelectedSources) = ();
3628
3629    foreach my $ID (sort {int($a)<=>int($b)} keys(%SymbolInfo))
3630    {
3631        if($SelectedSymbols{$ID}==2)
3632        { # data, inline, pure
3633            next;
3634        }
3635
3636        register_SymbolUsage($ID);
3637
3638        if(my $H = $SymbolInfo{$ID}{"Header"}) {
3639            $SelectedHeaders{$H} = 1;
3640        }
3641        if(my $S = $SymbolInfo{$ID}{"Source"}) {
3642            $SelectedSources{$S} = 1;
3643        }
3644    }
3645
3646    foreach my $ID (sort {int($a)<=>int($b)} keys(%SymbolInfo))
3647    {
3648        if($SelectedSymbols{$ID}==2)
3649        { # data, inline, pure
3650            my $Save = 0;
3651            if(my $Class = $SymbolInfo{$ID}{"Class"})
3652            {
3653                if(defined $UsedType{$Class}) {
3654                    $Save = 1;
3655                }
3656                else
3657                {
3658                    foreach (keys(%{$ClassChild{$Class}}))
3659                    {
3660                        if(defined $UsedType{$_})
3661                        {
3662                            $Save = 1;
3663                            last;
3664                        }
3665                    }
3666                }
3667            }
3668            if(my $Header = $SymbolInfo{$ID}{"Header"})
3669            {
3670                if(defined $SelectedHeaders{$Header}) {
3671                    $Save = 1;
3672                }
3673            }
3674            if(my $Source = $SymbolInfo{$ID}{"Source"})
3675            {
3676                if(defined $SelectedSources{$Source}) {
3677                    $Save = 1;
3678                }
3679            }
3680            if($Save) {
3681                register_SymbolUsage($ID);
3682            }
3683            else {
3684                delete($SymbolInfo{$ID});
3685            }
3686        }
3687    }
3688
3689    if(defined $AllTypes)
3690    {
3691        # register all data types (except anon structs and unions)
3692        foreach my $Tid (keys(%TypeInfo))
3693        {
3694            if(defined $LocalType{$Tid})
3695            { # except local code
3696                next;
3697            }
3698            if($TypeInfo{$Tid}{"Type"} eq "Enum"
3699            or index($TypeInfo{$Tid}{"Name"}, "anon-")!=0) {
3700                register_TypeUsage($Tid);
3701            }
3702        }
3703
3704        # remove unused anons (except enums)
3705        foreach my $Tid (keys(%TypeInfo))
3706        {
3707            if(not $UsedType{$Tid})
3708            {
3709                if($TypeInfo{$Tid}{"Type"} ne "Enum")
3710                {
3711                    if(index($TypeInfo{$Tid}{"Name"}, "anon-")==0) {
3712                        delete($TypeInfo{$Tid});
3713                    }
3714                }
3715            }
3716        }
3717
3718        # remove duplicates
3719        foreach my $Tid (keys(%TypeInfo))
3720        {
3721            my $Name = $TypeInfo{$Tid}{"Name"};
3722            my $Type = $TypeInfo{$Tid}{"Type"};
3723
3724            if($TName_Tid{$Type}{$Name} ne $Tid) {
3725                delete($TypeInfo{$Tid});
3726            }
3727        }
3728    }
3729    else
3730    {
3731        foreach my $Tid (keys(%TypeInfo))
3732        { # remove unused types
3733            if(not $UsedType{$Tid}) {
3734                delete($TypeInfo{$Tid});
3735            }
3736        }
3737    }
3738
3739    foreach my $Tid (keys(%MergedTypes)) {
3740        delete($TypeInfo{$Tid});
3741    }
3742
3743    foreach my $Tid (keys(%LocalType))
3744    {
3745        if(not $UsedType{$Tid}) {
3746            delete($TypeInfo{$Tid});
3747        }
3748    }
3749
3750    # clean memory
3751    %MergedTypes = ();
3752    %LocalType = ();
3753
3754    # completeness
3755    foreach my $Tid (keys(%TypeInfo)) {
3756        check_Completeness($TypeInfo{$Tid});
3757    }
3758
3759    foreach my $Sid (keys(%SymbolInfo)) {
3760        check_Completeness($SymbolInfo{$Sid});
3761    }
3762
3763    # clean memory
3764    %UsedType = ();
3765}
3766
3767sub simpleName($)
3768{
3769    my $N = $_[0];
3770
3771    if(index($N, "std::basic_string")!=-1)
3772    {
3773        $N=~s/std::basic_string<char, std::char_traits<char>, std::allocator<char> >/std::string /g;
3774        $N=~s/std::basic_string<char>/std::string /g;
3775    }
3776
3777    return formatName($N, "T");
3778}
3779
3780sub register_SymbolUsage($)
3781{
3782    my $InfoId = $_[0];
3783
3784    my %FuncInfo = %{$SymbolInfo{$InfoId}};
3785
3786    if(my $S = $FuncInfo{"Source"}) {
3787        $SourcesInfo{$S} = 1;
3788    }
3789    if(my $H = $FuncInfo{"Header"}) {
3790        $HeadersInfo{$H} = 1;
3791    }
3792    if(my $RTid = getFirst($FuncInfo{"Return"}))
3793    {
3794        register_TypeUsage($RTid);
3795        $SymbolInfo{$InfoId}{"Return"} = $RTid;
3796    }
3797    if(my $FCid = getFirst($FuncInfo{"Class"}))
3798    {
3799        register_TypeUsage($FCid);
3800        $SymbolInfo{$InfoId}{"Class"} = $FCid;
3801
3802        if(my $ThisId = getTypeIdByName("Const", $TypeInfo{$FCid}{"Name"}."*const"))
3803        { # register "this" pointer
3804            register_TypeUsage($ThisId);
3805        }
3806        if(my $ThisId_C = getTypeIdByName("Const", $TypeInfo{$FCid}{"Name"}." const*const"))
3807        { # register "this" pointer (const method)
3808            register_TypeUsage($ThisId_C);
3809        }
3810    }
3811    foreach my $PPos (keys(%{$FuncInfo{"Param"}}))
3812    {
3813        if(my $PTid = getFirst($FuncInfo{"Param"}{$PPos}{"type"}))
3814        {
3815            register_TypeUsage($PTid);
3816            $SymbolInfo{$InfoId}{"Param"}{$PPos}{"type"} = $PTid;
3817        }
3818    }
3819    foreach my $TPos (keys(%{$FuncInfo{"TParam"}}))
3820    {
3821        my $TPName = $FuncInfo{"TParam"}{$TPos}{"name"};
3822        if(my $TTid = searchTypeID($TPName))
3823        {
3824            if(my $FTTid = getFirst($TTid)) {
3825                register_TypeUsage($FTTid);
3826            }
3827        }
3828    }
3829}
3830
3831sub register_TypeUsage($)
3832{
3833    my $TypeId = $_[0];
3834    if(not $TypeId) {
3835        return 0;
3836    }
3837    if($UsedType{$TypeId})
3838    { # already registered
3839        return 1;
3840    }
3841    my %TInfo = %{$TypeInfo{$TypeId}};
3842
3843    if(my $S = $TInfo{"Source"}) {
3844        $SourcesInfo{$S} = 1;
3845    }
3846    if(my $H = $TInfo{"Header"}) {
3847        $HeadersInfo{$H} = 1;
3848    }
3849
3850    if($TInfo{"Type"})
3851    {
3852        if(my $NS = $TInfo{"NameSpace"})
3853        {
3854            if(my $NSTid = searchTypeID($NS))
3855            {
3856                if(my $FNSTid = getFirst($NSTid)) {
3857                    register_TypeUsage($FNSTid);
3858                }
3859            }
3860        }
3861
3862        if($TInfo{"Type"}=~/\A(Struct|Union|Class|FuncPtr|Func|MethodPtr|FieldPtr|Enum)\Z/)
3863        {
3864            $UsedType{$TypeId} = 1;
3865            if($TInfo{"Type"}=~/\A(Struct|Class)\Z/)
3866            {
3867                foreach my $BaseId (keys(%{$TInfo{"Base"}}))
3868                { # register base classes
3869                    if(my $FBaseId = getFirst($BaseId))
3870                    {
3871                        register_TypeUsage($FBaseId);
3872                        if($FBaseId ne $BaseId)
3873                        {
3874                            %{$TypeInfo{$TypeId}{"Base"}{$FBaseId}} = %{$TypeInfo{$TypeId}{"Base"}{$BaseId}};
3875                            delete($TypeInfo{$TypeId}{"Base"}{$BaseId});
3876                        }
3877                    }
3878                }
3879                foreach my $TPos (keys(%{$TInfo{"TParam"}}))
3880                {
3881                    my $TPName = $TInfo{"TParam"}{$TPos}{"name"};
3882                    if(my $TTid = searchTypeID($TPName))
3883                    {
3884                        if(my $FTTid = getFirst($TTid)) {
3885                            register_TypeUsage($FTTid);
3886                        }
3887                    }
3888                }
3889            }
3890            foreach my $Memb_Pos (keys(%{$TInfo{"Memb"}}))
3891            {
3892                if(my $MTid = getFirst($TInfo{"Memb"}{$Memb_Pos}{"type"}))
3893                {
3894                    register_TypeUsage($MTid);
3895                    $TypeInfo{$TypeId}{"Memb"}{$Memb_Pos}{"type"} = $MTid;
3896                }
3897            }
3898            if($TInfo{"Type"} eq "FuncPtr"
3899            or $TInfo{"Type"} eq "MethodPtr"
3900            or $TInfo{"Type"} eq "Func")
3901            {
3902                if(my $RTid = getFirst($TInfo{"Return"}))
3903                {
3904                    register_TypeUsage($RTid);
3905                    $TypeInfo{$TypeId}{"Return"} = $RTid;
3906                }
3907                foreach my $Memb_Pos (keys(%{$TInfo{"Param"}}))
3908                {
3909                    if(my $MTid = getFirst($TInfo{"Param"}{$Memb_Pos}{"type"}))
3910                    {
3911                        register_TypeUsage($MTid);
3912                        $TypeInfo{$TypeId}{"Param"}{$Memb_Pos}{"type"} = $MTid;
3913                    }
3914                }
3915            }
3916            if($TInfo{"Type"} eq "FieldPtr")
3917            {
3918                if(my $RTid = getFirst($TInfo{"Return"}))
3919                {
3920                    register_TypeUsage($RTid);
3921                    $TypeInfo{$TypeId}{"Return"} = $RTid;
3922                }
3923                if(my $CTid = getFirst($TInfo{"Class"}))
3924                {
3925                    register_TypeUsage($CTid);
3926                    $TypeInfo{$TypeId}{"Class"} = $CTid;
3927                }
3928            }
3929            if($TInfo{"Type"} eq "MethodPtr")
3930            {
3931                if(my $CTid = getFirst($TInfo{"Class"}))
3932                {
3933                    register_TypeUsage($CTid);
3934                    $TypeInfo{$TypeId}{"Class"} = $CTid;
3935                }
3936            }
3937            return 1;
3938        }
3939        elsif($TInfo{"Type"}=~/\A(Const|ConstVolatile|Volatile|Pointer|Ref|Restrict|Array|Typedef)\Z/)
3940        {
3941            $UsedType{$TypeId} = 1;
3942            if(my $BTid = getFirst($TInfo{"BaseType"}))
3943            {
3944                register_TypeUsage($BTid);
3945                $TypeInfo{$TypeId}{"BaseType"} = $BTid;
3946            }
3947            return 1;
3948        }
3949        elsif($TInfo{"Type"} eq "Intrinsic")
3950        {
3951            $UsedType{$TypeId} = 1;
3952            return 1;
3953        }
3954    }
3955    return 0;
3956}
3957
3958my %CheckedType = ();
3959
3960sub check_Completeness($)
3961{
3962    my $Info = $_[0];
3963
3964    # data types
3965    if(defined $Info->{"Memb"})
3966    {
3967        foreach my $Pos (keys(%{$Info->{"Memb"}}))
3968        {
3969            if(defined $Info->{"Memb"}{$Pos}{"type"}) {
3970                check_TypeInfo($Info->{"Memb"}{$Pos}{"type"});
3971            }
3972        }
3973    }
3974    if(defined $Info->{"Base"})
3975    {
3976        foreach my $Bid (keys(%{$Info->{"Base"}})) {
3977            check_TypeInfo($Bid);
3978        }
3979    }
3980    if(defined $Info->{"BaseType"}) {
3981        check_TypeInfo($Info->{"BaseType"});
3982    }
3983    if(defined $Info->{"TParam"})
3984    {
3985        foreach my $Pos (keys(%{$Info->{"TParam"}}))
3986        {
3987            my $TName = $Info->{"TParam"}{$Pos}{"name"};
3988            if($TName=~/\A(true|false|\d.*)\Z/) {
3989                next;
3990            }
3991
3992            if(my $Tid = searchTypeID($TName)) {
3993                check_TypeInfo($Tid);
3994            }
3995            else
3996            {
3997                if(defined $Loud) {
3998                    printMsg("WARNING", "missed type $TName");
3999                }
4000            }
4001        }
4002    }
4003
4004    # symbols
4005    if(defined $Info->{"Param"})
4006    {
4007        foreach my $Pos (keys(%{$Info->{"Param"}}))
4008        {
4009            if(defined $Info->{"Param"}{$Pos}{"type"}) {
4010                check_TypeInfo($Info->{"Param"}{$Pos}{"type"});
4011            }
4012        }
4013    }
4014    if(defined $Info->{"Return"}) {
4015        check_TypeInfo($Info->{"Return"});
4016    }
4017    if(defined $Info->{"Class"}) {
4018        check_TypeInfo($Info->{"Class"});
4019    }
4020}
4021
4022sub check_TypeInfo($)
4023{
4024    my $Tid = $_[0];
4025
4026    if(defined $CheckedType{$Tid}) {
4027        return;
4028    }
4029    $CheckedType{$Tid} = 1;
4030
4031    if(defined $TypeInfo{$Tid})
4032    {
4033        if(not $TypeInfo{$Tid}{"Name"}) {
4034            printMsg("ERROR", "missed type name ($Tid)");
4035        }
4036        check_Completeness($TypeInfo{$Tid});
4037    }
4038    else {
4039        printMsg("ERROR", "missed type id $Tid");
4040    }
4041}
4042
4043sub init_Registers()
4044{
4045    if($SYS_ARCH eq "x86")
4046    {
4047        %RegName = (
4048        # integer registers
4049        # 32 bits
4050            "0"=>"eax",
4051            "1"=>"ecx",
4052            "2"=>"edx",
4053            "3"=>"ebx",
4054            "4"=>"esp",
4055            "5"=>"ebp",
4056            "6"=>"esi",
4057            "7"=>"edi",
4058            "8"=>"eip",
4059            "9"=>"eflags",
4060            "10"=>"trapno",
4061        # FPU-control registers
4062        # 16 bits
4063            "37"=>"fctrl",
4064            "38"=>"fstat",
4065        # 32 bits
4066            "39"=>"mxcsr",
4067        # MMX registers
4068        # 64 bits
4069            "29"=>"mm0",
4070            "30"=>"mm1",
4071            "31"=>"mm2",
4072            "32"=>"mm3",
4073            "33"=>"mm4",
4074            "34"=>"mm5",
4075            "35"=>"mm6",
4076            "36"=>"mm7",
4077        # SSE registers
4078        # 128 bits
4079            "21"=>"xmm0",
4080            "22"=>"xmm1",
4081            "23"=>"xmm2",
4082            "24"=>"xmm3",
4083            "25"=>"xmm4",
4084            "26"=>"xmm5",
4085            "27"=>"xmm6",
4086            "28"=>"xmm7",
4087        # segment registers
4088        # 16 bits
4089            "40"=>"es",
4090            "41"=>"cs",
4091            "42"=>"ss",
4092            "43"=>"ds",
4093            "44"=>"fs",
4094            "45"=>"gs",
4095        # x87 registers
4096        # 80 bits
4097            "11"=>"st0",
4098            "12"=>"st1",
4099            "13"=>"st2",
4100            "14"=>"st3",
4101            "15"=>"st4",
4102            "16"=>"st5",
4103            "17"=>"st6",
4104            "18"=>"st7"
4105        );
4106    }
4107    elsif($SYS_ARCH eq "x86_64")
4108    {
4109        %RegName = (
4110        # integer registers
4111        # 64 bits
4112            "1"=>"rdx",
4113            "2"=>"rcx",
4114            "3"=>"rbx",
4115            "4"=>"rsi",
4116            "5"=>"rdi",
4117            "6"=>"rbp",
4118            "7"=>"rsp",
4119            "8"=>"r8",
4120            "9"=>"r9",
4121            "10"=>"r10",
4122            "11"=>"r11",
4123            "12"=>"r12",
4124            "13"=>"r13",
4125            "14"=>"r14",
4126            "15"=>"r15",
4127            "16"=>"rip",
4128            "49"=>"rflags",
4129        # MMX registers
4130        # 64 bits
4131            "41"=>"mm0",
4132            "42"=>"mm1",
4133            "43"=>"mm2",
4134            "44"=>"mm3",
4135            "45"=>"mm4",
4136            "46"=>"mm5",
4137            "47"=>"mm6",
4138            "48"=>"mm7",
4139        # SSE registers
4140        # 128 bits
4141            "17"=>"xmm0",
4142            "18"=>"xmm1",
4143            "19"=>"xmm2",
4144            "20"=>"xmm3",
4145            "21"=>"xmm4",
4146            "22"=>"xmm5",
4147            "23"=>"xmm6",
4148            "24"=>"xmm7",
4149            "25"=>"xmm8",
4150            "26"=>"xmm9",
4151            "27"=>"xmm10",
4152            "28"=>"xmm11",
4153            "29"=>"xmm12",
4154            "30"=>"xmm13",
4155            "31"=>"xmm14",
4156            "32"=>"xmm15",
4157        # control registers
4158        # 64 bits
4159            "62"=>"tr",
4160            "63"=>"ldtr",
4161            "64"=>"mxcsr",
4162        # 16 bits
4163            "65"=>"fcw",
4164            "66"=>"fsw",
4165        # segment registers
4166        # 16 bits
4167            "50"=>"es",
4168            "51"=>"cs",
4169            "52"=>"ss",
4170            "53"=>"ds",
4171            "54"=>"fs",
4172            "55"=>"gs",
4173        # 64 bits
4174            "58"=>"fs.base",
4175            "59"=>"gs.base",
4176        # x87 registers
4177        # 80 bits
4178            "33"=>"st0",
4179            "34"=>"st1",
4180            "35"=>"st2",
4181            "36"=>"st3",
4182            "37"=>"st4",
4183            "38"=>"st5",
4184            "39"=>"st6",
4185            "40"=>"st7"
4186        );
4187    }
4188    elsif($SYS_ARCH eq "arm")
4189    {
4190        %RegName = (
4191        # integer registers
4192        # 32-bit
4193            "0"=>"r0",
4194            "1"=>"r1",
4195            "2"=>"r2",
4196            "3"=>"r3",
4197            "4"=>"r4",
4198            "5"=>"r5",
4199            "6"=>"r6",
4200            "7"=>"r7",
4201            "8"=>"r8",
4202            "9"=>"r9",
4203            "10"=>"r10",
4204            "11"=>"r11",
4205            "12"=>"r12",
4206            "13"=>"r13",
4207            "14"=>"r14",
4208            "15"=>"r15"
4209        );
4210    }
4211}
4212
4213sub dump_sorting($)
4214{
4215    my $Hash = $_[0];
4216    return [] if(not $Hash);
4217    my @Keys = keys(%{$Hash});
4218    return [] if($#Keys<0);
4219    if($Keys[0]=~/\A\d+\Z/)
4220    { # numbers
4221        return [sort {int($a)<=>int($b)} @Keys];
4222    }
4223    else
4224    { # strings
4225        return [sort {$a cmp $b} @Keys];
4226    }
4227}
4228
4229sub scenario()
4230{
4231    if($Help)
4232    {
4233        HELP_MESSAGE();
4234        exit(0);
4235    }
4236    if($ShowVersion)
4237    {
4238        printMsg("INFO", "ABI Dumper $TOOL_VERSION\nCopyright (C) 2015 Andrey Ponomarenko's ABI Laboratory\nLicense: LGPL or GPL <http://www.gnu.org/licenses/>\nThis program is free software: you can redistribute it and/or modify it.\n\nWritten by Andrey Ponomarenko.");
4239        exit(0);
4240    }
4241    if($DumpVersion)
4242    {
4243        printMsg("INFO", $TOOL_VERSION);
4244        exit(0);
4245    }
4246
4247    $Data::Dumper::Sortkeys = 1;
4248
4249    if($SortDump) {
4250        $Data::Dumper::Sortkeys = \&dump_sorting;
4251    }
4252
4253    if(defined $Compare)
4254    {
4255        my $P1 = $ARGV[0];
4256        my $P2 = $ARGV[1];
4257
4258        if(not $P1) {
4259            exitStatus("Error", "arguments are not specified");
4260        }
4261        elsif(not -e $P1) {
4262            exitStatus("Access_Error", "can't access \'$P1\'");
4263        }
4264
4265        if(not $P2) {
4266            exitStatus("Error", "second argument is not specified");
4267        }
4268        elsif(not -e $P2) {
4269            exitStatus("Access_Error", "can't access \'$P2\'");
4270        }
4271
4272        my %ABI = ();
4273
4274        $ABI{1} = eval(readFile($P1));
4275        $ABI{2} = eval(readFile($P2));
4276
4277        my %SymInfo = ();
4278
4279        foreach (1, 2)
4280        {
4281            foreach my $ID (keys(%{$ABI{$_}->{"SymbolInfo"}}))
4282            {
4283                my $Info = $ABI{$_}->{"SymbolInfo"}{$ID};
4284
4285                if(my $MnglName = $Info->{"MnglName"}) {
4286                    $SymInfo{$_}{$MnglName} = $Info;
4287                }
4288                elsif(my $ShortName = $Info->{"MnglName"}) {
4289                    $SymInfo{$_}{$ShortName} = $Info;
4290                }
4291            }
4292        }
4293
4294        foreach my $Symbol (sort keys(%{$SymInfo{1}}))
4295        {
4296            if(not defined $SymInfo{2}{$Symbol}) {
4297                printMsg("INFO", "Removed $Symbol");
4298            }
4299        }
4300
4301        foreach my $Symbol (sort keys(%{$SymInfo{2}}))
4302        {
4303            if(not defined $SymInfo{1}{$Symbol}) {
4304                printMsg("INFO", "Added $Symbol");
4305            }
4306        }
4307
4308        exit(0);
4309    }
4310
4311    if(not $TargetVersion) {
4312        printMsg("WARNING", "module version is not specified (-lver NUM)");
4313    }
4314
4315    if($FullDump)
4316    {
4317        $AllTypes = 1;
4318        $AllSymbols = 1;
4319    }
4320
4321    if(not $OutputDump) {
4322        $OutputDump = "./ABI.dump";
4323    }
4324
4325    if(not @ARGV) {
4326        exitStatus("Error", "object path is not specified");
4327    }
4328
4329    foreach my $Obj (@ARGV)
4330    {
4331        if(not -e $Obj) {
4332            exitStatus("Access_Error", "can't access \'$Obj\'");
4333        }
4334    }
4335
4336    if($AltDebugInfo)
4337    {
4338        if(not -e $AltDebugInfo) {
4339            exitStatus("Access_Error", "can't access \'$AltDebugInfo\'");
4340        }
4341    }
4342    else
4343    {
4344        my $Readelf = "eu-readelf";
4345        if(not check_Cmd($Readelf)) {
4346            exitStatus("Not_Found", "can't find \"$Readelf\" command");
4347        }
4348        foreach my $Obj (@ARGV)
4349        {
4350            my $Sect = `$Readelf -S \"$Obj\" 2>\"$TMP_DIR/error\"`;
4351
4352            if($Sect=~/\.debug_info/)
4353            {
4354                if($Sect=~/\.gnu_debugaltlink/)
4355                {
4356                    my $Str = `$Readelf --strings=.gnu_debugaltlink \"$Obj\" 2>\"$TMP_DIR/error\"`;
4357
4358                    if($Str=~/0\]\s*(.+)/)
4359                    {
4360                        my $AltObj_R = get_dirname($Obj)."/".$1;
4361
4362                        my $AltObj = $AltObj_R;
4363
4364                        while($AltObj=~s/\/[^\/]+\/\.\.\//\//){};
4365
4366                        if(-e $AltObj)
4367                        {
4368                            printMsg("INFO", "Set alternate debug-info file to \'$AltObj\' (use -alt option to change it)");
4369                            $AltDebugInfo = $AltObj;
4370                        }
4371                        else
4372                        {
4373                            printMsg("WARNING", "can't access \'$AltObj_R\'");
4374                        }
4375                    }
4376                }
4377                last;
4378            }
4379        }
4380    }
4381
4382    if($AltDebugInfo) {
4383        read_Alt_Info($AltDebugInfo);
4384    }
4385
4386    if($ExtraInfo)
4387    {
4388        mkpath($ExtraInfo);
4389        $ExtraInfo = abs_path($ExtraInfo);
4390    }
4391
4392    my $Res = 0;
4393
4394    foreach my $Obj (@ARGV)
4395    {
4396        $TargetName = get_filename(realpath($Obj));
4397        $TargetName=~s/\.debug\Z//; # nouveau.ko.debug
4398
4399        if(index($TargetName, "libstdc++.so")==0) {
4400            $STDCXX_TARGET = 1;
4401        }
4402
4403        read_Symbols($Obj);
4404        $Res += read_DWARF_Info($Obj);
4405        read_Vtables($Obj);
4406    }
4407
4408    if(not $Res) {
4409        exitStatus("No_DWARF", "can't find debug info in object(s)");
4410    }
4411
4412    init_Registers();
4413    read_ABI();
4414
4415    # clean memory
4416    %DWARF_Info = ();
4417
4418    remove_Unused();
4419
4420    # clean memory
4421    %SourceFile = ();
4422    %SourceFile_Alt = ();
4423    %DebugLoc = ();
4424    %TName_Tid = ();
4425    %TName_Tids = ();
4426
4427    %TypeMember = ();
4428    %ArrayCount = ();
4429    %FuncParam = ();
4430    %Inheritance = ();
4431    %NameSpace = ();
4432    %SpecElem = ();
4433    %OrigElem = ();
4434    %ClassMethods = ();
4435    %TypeSpec = ();
4436    %ClassChild = ();
4437
4438    %VirtualTable = ();
4439    %SymbolTable = ();
4440
4441    dump_ABI();
4442
4443    exit(0);
4444}
4445
4446scenario();
4447