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