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