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