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