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