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