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