#!/usr/bin/perl
###########################################################################
# ABI Dumper 0.99.18
# Dump ABI of an ELF object containing DWARF debug info
#
# Copyright (C) 2013-2016 Andrey Ponomarenko's ABI Laboratory
#
# Written by Andrey Ponomarenko
#
# PLATFORMS
# =========
# Linux
#
# REQUIREMENTS
# ============
# Perl 5 (5.8 or newer)
# GNU Binutils readelf
# Vtable-Dumper (1.1 or newer)
# Binutils (objdump)
# Universal Ctags
# GCC (g++)
#
# COMPATIBILITY
# =============
# ABI Compliance Checker >= 1.99.24
#
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License or the GNU Lesser
# General Public License as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# and the GNU Lesser General Public License along with this program.
# If not, see <http://www.gnu.org/licenses/>.
###########################################################################
use Getopt::Long;
Getopt::Long::Configure ("posix_default", "no_ignore_case", "permute");
use File::Path qw(mkpath rmtree);
use File::Temp qw(tempdir);
use Cwd qw(abs_path cwd realpath);
use Storable qw(dclone);
use Data::Dumper;
my $TOOL_VERSION = "0.99.18";
my $ABI_DUMP_VERSION = "3.3";
my $ORIG_DIR = cwd();
my $TMP_DIR = tempdir(CLEANUP=>1);
my $VTABLE_DUMPER = "vtable-dumper";
my $VTABLE_DUMPER_VERSION = "1.0";
my $LOCALE = "LANG=C.UTF-8";
my $READELF = "readelf";
my $READELF_L = $LOCALE." ".$READELF;
my $OBJDUMP = "objdump";
my $CTAGS = "ctags";
my $GPP = "g++";
my ($Help, $ShowVersion, $DumpVersion, $OutputDump, $SortDump, $StdOut,
$TargetVersion, $ExtraInfo, $FullDump, $AllTypes, $AllSymbols, $BinOnly,
$SkipCxx, $Loud, $AddrToName, $DumpStatic, $Compare, $AltDebugInfoOpt,
$AddDirs, $VTDumperPath, $SymbolsListPath, $PublicHeadersPath,
$IgnoreTagsPath, $KernelExport, $UseTU, $ReimplementStd,
$IncludePreamble, $IncludePaths, $CacheHeaders, $MixedHeaders, $Debug,
$SearchDirDebuginfo, $KeepRegsAndOffsets, $Quiet);
my $CmdName = getFilename($0);
my %ERROR_CODE = (
"Success"=>0,
"Error"=>2,
# System command is not found
"Not_Found"=>3,
# Cannot access input files
"Access_Error"=>4,
# Cannot find a module
"Module_Error"=>9,
# No debug-info
"No_DWARF"=>10,
# Invalid debug-info
"Invalid_DWARF"=>11
);
my $ShortUsage = "ABI Dumper $TOOL_VERSION
Dump ABI of an ELF object containing DWARF debug info
Copyright (C) 2016 Andrey Ponomarenko's ABI Laboratory
License: GNU LGPL or GNU GPL
Usage: $CmdName [options] [object]
Example:
$CmdName libTest.so -o ABI.dump
$CmdName Module.ko.debug -o ABI.dump
More info: $CmdName --help\n";
if($#ARGV==-1)
{
printMsg("INFO", $ShortUsage);
exit(0);
}
GetOptions("h|help!" => \$Help,
"v|version!" => \$ShowVersion,
"dumpversion!" => \$DumpVersion,
# general options
"o|output|dump-path=s" => \$OutputDump,
"sort!" => \$SortDump,
"stdout!" => \$StdOut,
"loud!" => \$Loud,
"vnum|lver|lv=s" => \$TargetVersion,
"extra-info=s" => \$ExtraInfo,
"bin-only!" => \$BinOnly,
"all-types!" => \$AllTypes,
"all-symbols!" => \$AllSymbols,
"symbols-list=s" => \$SymbolsListPath,
"skip-cxx!" => \$SkipCxx,
"all!" => \$FullDump,
"dump-static!" => \$DumpStatic,
"compare!" => \$Compare,
"alt=s" => \$AltDebugInfoOpt,
"dir!" => \$AddDirs,
"vt-dumper=s" => \$VTDumperPath,
"public-headers=s" => \$PublicHeadersPath,
"ignore-tags=s" => \$IgnoreTagsPath,
"mixed-headers!" => \$MixedHeaders,
"kernel-export!" => \$KernelExport,
"search-debuginfo=s" => \$SearchDirDebuginfo,
"keep-registers-and-offsets!" => \$KeepRegsAndOffsets,
"quiet!" => \$Quiet,
"debug!" => \$Debug,
# extra options
"use-tu-dump!" => \$UseTU,
"include-preamble=s" => \$IncludePreamble,
"include-paths=s" => \$IncludePaths,
"cache-headers=s" => \$CacheHeaders,
# internal options
"addr2name!" => \$AddrToName,
# obsolete
"reimplement-std!" => \$ReimplementStd,
#get dependencies from the command line
"objdump=s" => \$OBJDUMP,
"gpp=s" => \$GPP,
"readelf=s" => \$READELF
) or ERR_MESSAGE();
sub ERR_MESSAGE()
{
printMsg("INFO", "\n".$ShortUsage);
exit($ERROR_CODE{"Error"});
}
my $HelpMessage="
NAME:
ABI Dumper ($CmdName)
Dump ABI of an ELF object containing DWARF debug info
DESCRIPTION:
ABI Dumper is a tool for dumping ABI information of an ELF object
containing DWARF debug info.
The tool is intended to be used with ABI Compliance Checker tool for
tracking ABI changes of a C/C++ library or kernel module.
This tool is free software: you can redistribute it and/or modify it
under the terms of the GNU LGPL or GNU GPL.
USAGE:
$CmdName [options] [object]
EXAMPLES:
$CmdName libTest.so -o ABI.dump
$CmdName Module.ko.debug -o ABI.dump
INFORMATION OPTIONS:
-h|-help
Print this help.
-v|-version
Print version information.
-dumpversion
Print the tool version ($TOOL_VERSION) and don't do anything else.
GENERAL OPTIONS:
-o|-output PATH
Path to the output ABI dump file.
Default: ./ABI.dump
-sort
Sort data in ABI dump.
-stdout
Print ABI dump to stdout.
-loud
Print all warnings.
-vnum NUM
Set version of the library to NUM.
-extra-info DIR
Dump extra analysis info to DIR.
-bin-only
Do not dump information about inline functions,
pure virtual functions and non-exported global data.
-all-types
Dump unused data types.
-all-symbols
Dump symbols not exported by the object.
-symbols-list PATH
Specify a file with a list of symbols that should be dumped.
-skip-cxx
Do not dump stdc++ and gnu c++ symbols.
-all
Equal to: -all-types -all-symbols.
-dump-static
Dump static (local) symbols.
-compare OLD.dump NEW.dump
Show added/removed symbols between two ABI dumps.
-alt PATH
Path to the alternate debug info (Fedora). It is
detected automatically from gnu_debugaltlink section
of the input object if not specified.
-dir
Show full paths of source files.
-vt-dumper PATH
Path to the vtable-dumper executable if it is installed
to non-default location (not in PATH).
-public-headers PATH
Path to directory with public header files or to file with
the list of header files. This option allows to filter out
private symbols from the ABI dump.
-ignore-tags PATH
Path to ignore.tags file to help ctags tool to read
symbols in header files.
-reimplement-std
Do nothing.
-mixed-headers
This option should be specified if you are using
-public-headers option and the names of public headers
intersect with the internal headers.
-kernel-export
Dump symbols exported by the Linux kernel and modules, i.e.
symbols declared in the ksymtab section of the object and
system calls.
-search-debuginfo DIR
Search for debug-info files referenced from gnu_debuglink
section of the object in DIR.
-keep-registers-and-offsets
Dump used registers and stack offsets even if incompatible
build options detected.
-quiet
Do not warn about incompatible build options.
-debug
Enable debug messages.
-readelf
Path to readelf.
-gpp
Path to g++.
-objdump
Path to objdump.
EXTRA OPTIONS:
-use-tu-dump
Use g++ -fdump-translation-unit instead of ctags to
list symbols in headers. This may be useful if all
functions are declared via macros in headers and
ctags can't recognize them.
-include-preamble PATHS
Specify header files (separated by semicolon) that
should be included before others to compile without
errors.
-include-paths DIRS
Specify include directories (separated by semicolon)
that should be passed to the compiler by -I option
in order to compile headers without errors. If this
option is not set then the tool will try to generate
include paths automatically.
-cache-headers DIR
Cache headers analysis results to reuse later.
";
sub HELP_MESSAGE() {
printMsg("INFO", $HelpMessage);
}
my %Cache;
# Input
my %DWARF_Info;
# Alternate
my %ImportedUnit;
my %ImportedDecl;
my $AltDebugInfo = undef;
my $TooBig = 0;
# Dump
my %TypeUnit;
my %Post_Change;
my %UsedUnit;
my %UsedDecl;
# Output
my %SymbolInfo;
my %TypeInfo;
# Reader
my %TypeMember;
my %ArrayCount;
my %FuncParam;
my %TmplParam;
my %Inheritance;
my %NameSpace;
my %SpecElem;
my %OrigElem;
my %ClassMethods;
my %TypeSpec;
my %ClassChild;
my %MergedTypes;
my %LocalType;
my %SourceFile;
my %SourceFile_Alt;
my %DebugLoc;
my %TName_Tid;
my %TName_Tids;
my %RegName;
my $STDCXX_TARGET = 0;
my $GLOBAL_ID = 0;
my %ANON_TYPE_WARN = ();
my %Mangled_ID;
my %Checked_Spec;
my %SelectedSymbols;
my %TypeType = (
"class_type"=>"Class",
"structure_type"=>"Struct",
"union_type"=>"Union",
"enumeration_type"=>"Enum",
"array_type"=>"Array",
"base_type"=>"Intrinsic",
"const_type"=>"Const",
"pointer_type"=>"Pointer",
"reference_type"=>"Ref",
"rvalue_reference_type"=>"RvalueRef",
"volatile_type"=>"Volatile",
"restrict_type"=>"Restrict",
"typedef"=>"Typedef",
"ptr_to_member_type"=>"FieldPtr",
"string_type"=>"String"
);
my %Qual = (
"Pointer"=>"*",
"Ref"=>"&",
"RvalueRef"=>"&&",
"Volatile"=>"volatile",
"Restrict"=>"restrict",
"Const"=>"const"
);
my %ConstSuffix = (
"unsigned int" => "u",
"unsigned long" => "ul",
"unsigned long long" => "ull",
"long" => "l",
"long long" => "ll"
);
my $HEADER_EXT = "h|hh|hp|hxx|hpp|h\\+\\+|tcc|x|inl|ads";
my $SRC_EXT = "c|cpp|cxx|c\\+\\+";
# Other
my %NestedNameSpaces;
my $TargetName = undef;
my %HeadersInfo;
my %SourcesInfo;
my %SymVer;
my %UsedType;
# ELF
my %Library_Symbol;
my %Library_UndefSymbol;
my %Library_Needed;
my %SymbolTable;
# VTables
my %VirtualTable;
# Env
my $SYS_ARCH;
my $SYS_WORD;
my $SYS_GCCV;
my $SYS_CLANGV = undef;
my $SYS_COMP;
my $LIB_LANG;
my $OBJ_LANG;
my $IncompatibleOpt = undef;
# Errors
my $InvalidDebugLoc;
# Public Headers
my %SymbolToHeader;
my %TypeToHeader;
my %PublicHeader;
my $PublicSymbols_Detected;
# Kernel
my %KSymTab;
# Filter
my %SymbolsList;
sub printMsg($$)
{
my ($Type, $Msg) = @_;
if($Type!~/\AINFO/) {
$Msg = $Type.": ".$Msg;
}
if($Type!~/_C\Z/) {
$Msg .= "\n";
}
if($Type eq "ERROR"
or $Type eq "WARNING") {
print STDERR $Msg;
}
else {
print $Msg;
}
}
sub exitStatus($$)
{
my ($Code, $Msg) = @_;
printMsg("ERROR", $Msg);
exit($ERROR_CODE{$Code});
}
sub cmpVersions($$)
{ # compare two versions in dotted-numeric format
my ($V1, $V2) = @_;
return 0 if($V1 eq $V2);
return undef if($V1!~/\A\d+[\.\d+]*\Z/);
return undef if($V2!~/\A\d+[\.\d+]*\Z/);
my @V1Parts = split(/\./, $V1);
my @V2Parts = split(/\./, $V2);
for (my $i = 0; $i <= $#V1Parts && $i <= $#V2Parts; $i++) {
return -1 if(int($V1Parts[$i]) < int($V2Parts[$i]));
return 1 if(int($V1Parts[$i]) > int($V2Parts[$i]));
}
return -1 if($#V1Parts < $#V2Parts);
return 1 if($#V1Parts > $#V2Parts);
return 0;
}
sub writeFile($$)
{
my ($Path, $Content) = @_;
return if(not $Path);
if(my $Dir = getDirname($Path)) {
mkpath($Dir);
}
open(FILE, ">", $Path) || die ("can't open file \'$Path\': $!\n");
print FILE $Content;
close(FILE);
}
sub readFile($)
{
my $Path = $_[0];
return "" if(not $Path or not -f $Path);
open(FILE, $Path);
local $/ = undef;
my $Content = <FILE>;
close(FILE);
return $Content;
}
sub getFilename($)
{ # much faster than basename() from File::Basename module
if($_[0] and $_[0]=~/([^\/\\]+)[\/\\]*\Z/) {
return $1;
}
return "";
}
sub getDirname($)
{ # much faster than dirname() from File::Basename module
if($_[0] and $_[0]=~/\A(.*?)[\/\\]+[^\/\\]*[\/\\]*\Z/) {
return $1;
}
return "";
}
sub check_Cmd($)
{
my $Cmd = $_[0];
return "" if(not $Cmd);
if(defined $Cache{"check_Cmd"}{$Cmd}) {
return $Cache{"check_Cmd"}{$Cmd};
}
if(-x $Cmd)
{ # relative or absolute path
return ($Cache{"check_Cmd"}{$Cmd} = 1);
}
foreach my $Path (sort {length($a)<=>length($b)} split(/:/, $ENV{"PATH"}))
{
if(-x $Path."/".$Cmd) {
return ($Cache{"check_Cmd"}{$Cmd} = 1);
}
}
return ($Cache{"check_Cmd"}{$Cmd} = 0);
}
my %ELF_BIND = map {$_=>1} (
"WEAK",
"GLOBAL",
"LOCAL"
);
my %ELF_TYPE = map {$_=>1} (
"FUNC",
"IFUNC",
"GNU_IFUNC",
"TLS",
"OBJECT",
"COMMON"
);
my %ELF_VIS = map {$_=>1} (
"DEFAULT",
"PROTECTED"
);
sub readline_ELF($)
{ # read the line of 'eu-readelf' output corresponding to the symbol
my @Info = split(/\s+/, $_[0]);
# Num: Value Size Type Bind Vis Ndx Name
# 3629: 000b09c0 32 FUNC GLOBAL DEFAULT 13 _ZNSt12__basic_fileIcED1Ev@@GLIBCXX_3.4
# 135: 00000000 0 FUNC GLOBAL DEFAULT UNDEF av_image_fill_pointers@LIBAVUTIL_52 (3)
shift(@Info) if($Info[0] eq ""); # spaces
shift(@Info); # num
if($#Info==7)
{ # UNDEF SYMBOL (N)
if($Info[7]=~/\(\d+\)/) {
pop(@Info);
}
}
if($#Info!=6)
{ # other lines
return ();
}
return () if(not defined $ELF_TYPE{$Info[2]} and $Info[5] ne "UND");
return () if(not defined $ELF_BIND{$Info[3]});
return () if(not defined $ELF_VIS{$Info[4]});
if($Info[5] eq "ABS" and $Info[0]=~/\A0+\Z/)
{ # 1272: 00000000 0 OBJECT GLOBAL DEFAULT ABS CXXABI_1.3
return ();
}
if(index($Info[2], "0x") == 0)
{ # size == 0x3d158
$Info[2] = hex($Info[2]);
}
return @Info;
}
sub read_Symbols($)
{
my $Lib_Path = $_[0];
my $Lib_Name = getFilename($Lib_Path);
my $Dynamic = ($Lib_Name=~/\.so(\.|\Z)/);
my $Dbg = ($Lib_Name=~/\.debug\Z/);
if(not check_Cmd($READELF)) {
exitStatus("Not_Found", "can't find \"eu-readelf\"");
}
my %SectionInfo;
my %KSect;
# Modified to match readelf instead of eu-readelf.
my $Cmd = $READELF_L." --wide -S \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
foreach (split(/\n/, `$Cmd`))
{
if(/\[\s*(\d+)\]\s+([\w\.]+)/)
{
my ($Num, $Name) = ($1, $2);
$SectionInfo{$Num} = $Name;
if(defined $KernelExport)
{
if($Name=~/\A(__ksymtab|__ksymtab_gpl)\Z/) {
$KSect{$1} = 1;
}
}
}
}
if(defined $KernelExport)
{
if(not keys(%KSect))
{
printMsg("ERROR", "can't find __ksymtab or __ksymtab_gpl sections in the object");
exit(1);
}
foreach my $Name (sort keys(%KSect))
{
$Cmd = $OBJDUMP." --section=$Name -d \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
foreach my $Line (split(/\n/, qx/$Cmd/))
{
if($Line=~/<__ksymtab_(.+?)>/)
{
$KSymTab{$1} = 1;
}
}
}
}
if($Dynamic)
{ # dynamic library specifics
# Modified to match readelf instead of eu-readelf.
$Cmd = $READELF_L." --wide -d \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
foreach (split(/\n/, `$Cmd`))
{
if(/NEEDED.+\[([^\[\]]+)\]/)
{ # dependencies:
# 0x00000001 (NEEDED) Shared library: [libc.so.6]
$Library_Needed{$1} = 1;
}
}
}
my $ExtraPath = undef;
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/elf-info";
}
# Modified to match readelf instead of eu-readelf.
$Cmd = $READELF_L." --wide -s \"$Lib_Path\" 2>\"$TMP_DIR/error\"";
if($ExtraPath)
{ # debug mode
# write to file
system($Cmd." >\"$ExtraPath\"");
open(LIB, $ExtraPath);
}
else
{ # write to pipe
open(LIB, $Cmd." |");
}
my (%Symbol_Value, %Value_Symbol) = ();
my $symtab = undef; # indicates that we are processing 'symtab' section of 'readelf' output
while(<LIB>)
{
if($Dynamic and not $Dbg)
{ # dynamic library specifics
if(defined $symtab)
{
if(index($_, "'.dynsym'")!=-1)
{ # dynamic table
$symtab = undef;
}
if(not $AllSymbols)
{ # do nothing with symtab
#next;
}
}
elsif(index($_, "'.symtab'")!=-1)
{ # symbol table
$symtab = 1;
}
}
if(my ($Value, $Size, $Type, $Bind, $Vis, $Ndx, $Symbol) = readline_ELF($_))
{ # read ELF entry
if(not $symtab)
{ # dynsym
if(skipSymbol($Symbol)) {
next;
}
# Modified to match readelf instead of eu-readelf.
if($Ndx eq "UND")
{ # ignore interfaces that are imported from somewhere else
$Library_UndefSymbol{$TargetName}{$Symbol} = 0;
next;
}
if(defined $KernelExport)
{
if($Bind ne "LOCAL")
{
if(index($Symbol, "sys_")==0
or index($Symbol, "SyS_")==0) {
$KSymTab{$Symbol} = 1;
}
}
if(not defined $KSymTab{$Symbol}) {
next;
}
}
if($Bind ne "LOCAL") {
$Library_Symbol{$TargetName}{$Symbol} = ($Type eq "OBJECT")?-$Size:1;
}
$Symbol_Value{$Symbol} = $Value;
$Value_Symbol{$Value}{$Symbol} = 1;
if(not defined $OBJ_LANG)
{
if(index($Symbol, "_Z")==0)
{
$OBJ_LANG = "C++";
}
}
}
else
{
$Symbol_Value{$Symbol} = $Value;
$Value_Symbol{$Value}{$Symbol} = 1;
}
if(not $symtab)
{
foreach ($SectionInfo{$Ndx}, "")
{
my $Val = $Value;
$SymbolTable{$_}{$Val}{$Symbol} = 1;
if($Val=~s/\A[0]+//)
{
if($Val eq "") {
$Val = "0";
}
$SymbolTable{$_}{$Val}{$Symbol} = 1;
}
}
}
}
}
close(LIB);
if(not defined $Library_Symbol{$TargetName}) {
return;
}
my %Found = ();
foreach my $Symbol (sort keys(%Symbol_Value))
{
next if(index($Symbol,"\@")==-1);
if(my $Value = $Symbol_Value{$Symbol})
{
foreach my $Symbol_SameValue (sort keys(%{$Value_Symbol{$Value}}))
{
if($Symbol_SameValue ne $Symbol
and index($Symbol_SameValue,"\@")==-1)
{
$SymVer{$Symbol_SameValue} = $Symbol;
$Found{$Symbol} = 1;
#last;
}
}
}
}
# default
foreach my $Symbol (sort keys(%Symbol_Value))
{
next if(defined $Found{$Symbol});
next if(index($Symbol,"\@\@")==-1);
if($Symbol=~/\A([^\@]*)\@\@/
and not $SymVer{$1})
{
$SymVer{$1} = $Symbol;
$Found{$Symbol} = 1;
}
}
# non-default
foreach my $Symbol (sort keys(%Symbol_Value))
{
next if(defined $Found{$Symbol});
next if(index($Symbol,"\@")==-1);
if($Symbol=~/\A([^\@]*)\@([^\@]*)/
and not $SymVer{$1})
{
$SymVer{$1} = $Symbol;
$Found{$Symbol} = 1;
}
}
if(not defined $OBJ_LANG)
{
$OBJ_LANG = "C";
}
}
sub read_Alt_Info($)
{
my $Path = $_[0];
my $Name = getFilename($Path);
if(not check_Cmd($READELF)) {
exitStatus("Not_Found", "can't find \"$READELF\" command");
}
printMsg("INFO", "Reading alternate debug-info");
my $ExtraPath = undef;
# lines info
if($ExtraInfo)
{
$ExtraPath = $ExtraInfo."/alt";
mkpath($ExtraPath);
$ExtraPath .= "/debug_line";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide -N --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(SRC, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open(SRC, $READELF_L." --wide -N --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" |");
}
my $DirTable_Def = undef;
my %DirTable = ();
while(<SRC>)
{
if(defined $AddDirs)
{ #Modified to match readelf instead of eu-readelf.
if(/Directory Table/i)
{
$DirTable_Def = 1;
next;
}
elsif(/File name table/i)
{
$DirTable_Def = undef;
next;
}
if(defined $DirTable_Def)
{
if(/\A\s*(.+?)\Z/) {
$DirTable{keys(%DirTable)+1} = $1;
}
}
}
if(/(\d+)\s+(\d+)\s+\d+\s+\d+\s+([^ ]+)/)
{
my ($Num, $Dir, $File) = ($1, $2, $3);
chomp($File);
if(defined $AddDirs)
{
if(my $DName = $DirTable{$Dir})
{
$File = $DName."/".$File;
}
}
$SourceFile_Alt{0}{$Num} = $File;
}
}
close(SRC);
# debug info
if($ExtraInfo)
{
$ExtraPath = $ExtraInfo."/alt";
mkpath($ExtraPath);
$ExtraPath .= "/debug_info";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide -N --debug-dump=info \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(INFO, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open(INFO, $READELF_L." --wide -N --debug-dump=info \"$Path\" 2>\"$TMP_DIR/error\" |");
}
my $ID = undef;
my $Num = 0;
while(<INFO>)
{
if(index($_, " ")==0)
{
if(defined $ID) {
$ImportedUnit{$ID}{$Num++} = $_;
}
}
elsif(index($_, " [")==0
and /\A \[\s*(\w+?)\](\s+)(\w+)/)
{
if($3 eq "partial_unit")
{
$ID = $1;
$Num = 0;
$ImportedUnit{$ID}{0} = $_;
}
elsif(length($2)==2)
{ # not a partial_unit
$ID = undef;
}
elsif(defined $ID)
{
$ImportedDecl{$1} = $ID;
$ImportedUnit{$ID}{$Num++} = $_;
}
}
}
}
sub read_DWARF_Info($)
{
my $Path = $_[0];
my $Dir = getDirname($Path);
my $Name = getFilename($Path);
if(not check_Cmd($READELF)) {
exitStatus("Not_Found", "can't find \"$READELF\" command");
}
if(-s $Path > 1024*1024*100) {
$TooBig = 1;
}
my $AddOpt = "";
if(not defined $AddrToName)
{ # disable search of symbol names
$AddOpt .= " -N";
}
# Modified to match readelf instead of eu-readelf.
my $Sect = `$READELF_L --wide -S \"$Path\" 2>\"$TMP_DIR/error\"`;
if($Sect!~/\.z?debug_info/)
{ # No DWARF info
if(my $DebugFile = getDebugFile($Path, "gnu_debuglink"))
{
my $DPath = $DebugFile;
my $DName = getFilename($DPath);
printMsg("INFO", "Found link to $DName (gnu_debuglink)");
if(my $DDir = getDirname($Path))
{
$DPath = $DDir."/".$DPath;
}
my $Found = undef;
if(defined $SearchDirDebuginfo)
{
if(-f $SearchDirDebuginfo."/".$DName) {
$Found = $SearchDirDebuginfo."/".$DName;
}
else
{
my @Files = findFiles($SearchDirDebuginfo, "f");
foreach my $F (@Files)
{
if(getFilename($F) eq $DName)
{
$Found = $F;
last;
}
}
}
}
elsif(-f $DPath
and $DPath ne $Path) {
$Found = $DPath;
}
if($Found and $Found ne $Path)
{
printMsg("INFO", "Reading debug-info file $DName linked from gnu_debuglink");
return read_DWARF_Info($Found);
}
else
{
printMsg("ERROR", "missed debug-info file $DName linked from gnu_debuglink (try --search-debuginfo=DIR option)");
return 0;
}
}
return 0;
}
elsif(not defined $AltDebugInfoOpt)
{
if($Sect=~/\.gnu_debugaltlink/)
{
if(my $AltObj = getDebugAltLink($Path))
{
$AltDebugInfo = $AltObj;
read_Alt_Info($AltObj);
}
else {
exitStatus("Error", "can't read gnu_debugaltlink");
}
}
}
if($AltDebugInfo)
{
if($TooBig) {
printMsg("WARNING", "input object is too big and compressed, may require a lot of RAM memory to proceed");
}
}
printMsg("INFO", "Reading debug-info");
my $ExtraPath = undef;
# ELF header
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/elf-header";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide -h \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(HEADER, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open(HEADER, $READELF_L." --wide -h \"$Path\" 2>\"$TMP_DIR/error\" |");
}
my %Header = ();
while(<HEADER>)
{
if(/\A\s*([\w ]+?)\:\s*(.+?)\Z/) {
$Header{$1} = $2;
}
}
close(HEADER);
$SYS_ARCH = $Header{"Machine"};
if($SYS_ARCH=~/80\d86/
or $SYS_ARCH=~/i\d86/)
{ # i386, i586, etc.
$SYS_ARCH = "x86";
}
if($SYS_ARCH=~/amd64/i
or $SYS_ARCH=~/x86\-64/i)
{ # amd64
$SYS_ARCH = "x86_64";
}
init_Registers();
# ELF sections
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/elf-sections";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide -S \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(HEADER, $ExtraPath);
}
# source info
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/debug_line";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide $AddOpt --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(SRC, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open(SRC, $READELF_L." --wide $AddOpt --debug-dump=line \"$Path\" 2>\"$TMP_DIR/error\" |");
}
my $Offset = undef;
my $DirTable_Def = undef;
my %DirTable = ();
while(<SRC>)
{
if(defined $AddDirs)
{ # Modified to match readelf instead of eu-readelf.
if(/Directory Table/i)
{
$DirTable_Def = 1;
%DirTable = ();
next;
}
# Modified to match readelf instead of eu-readelf.
elsif(/File Name Table/i)
{
$DirTable_Def = undef;
next;
}
if(defined $DirTable_Def)
{
# Modified to match readelf instead of eu-readelf.
if(/\A[0-9]+\s*(.+?)\Z/) {
$DirTable{keys(%DirTable)+1} = $1;
}
}
}
# Modified to match readelf instead of eu-readelf.
if(/Offset:\s+(\w+)/) {
$Offset = $1;
}
elsif(defined $Offset
and /(\d+)\s+(\d+)\s+\d+\s+\d+\s+([^ ]+)/)
{
my ($Num, $Dir, $File) = ($1, $2, $3);
chomp($File);
if(defined $AddDirs)
{
if(my $DName = $DirTable{$Dir})
{
$File = $DName."/".$File;
}
}
$SourceFile{$Offset}{$Num} = $File;
}
}
close(SRC);
# debug_loc
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/debug_loc";
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide $AddOpt --debug-dump=loc \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open(LOC, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open(LOC, $READELF_L." --wide $AddOpt --debug-dump=loc \"$Path\" 2>\"$TMP_DIR/error\" |");
}
while(<LOC>)
{
# Modified to match readelf instead of eu-readelf.
if(/(\w+)\s+[0-9a-fA-F]+\s+[0-9a-fA-F]+\s+\(DW_OP_(\w+:?\s+-?[0-9]*)+[\(;]/) {
$DebugLoc{$1} = $2;
}
elsif(/\A \[\s*(\w+)\]/) {
$DebugLoc{$1} = "";
}
}
close(LOC);
# dwarf
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/debug_info";
}
my $INFO_fh;
if($Dir)
{ # to find ".dwz" directory (Fedora)
chdir($Dir);
}
if($ExtraPath)
{
# Modified to match readelf instead of eu-readelf.
system($READELF_L." --wide $AddOpt --debug-dump=info \"$Name\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
open($INFO_fh, $ExtraPath);
}
else {
# Modified to match readelf instead of eu-readelf.
open($INFO_fh, $READELF_L." --wide $AddOpt --debug-dump=info \"$Name\" 2>\"$TMP_DIR/error\" |");
}
chdir($ORIG_DIR);
read_DWARF_Dump($INFO_fh, 1);
close($INFO_fh);
if(my $Err = readFile("$TMP_DIR/error"))
{ # eu-readelf: cannot get next DIE: invalid DWARF
if($Err=~/invalid DWARF/i)
{
if($Loud) {
printMsg("ERROR", $Err);
}
exitStatus("Invalid_DWARF", "invalid DWARF info");
}
}
return 1;
}
sub getSource($)
{
my $ID = $_[0];
if(defined $DWARF_Info{$ID}{"decl_file"})
{
my $File = $DWARF_Info{$ID}{"decl_file"};
my $Unit = $DWARF_Info{$ID}{"Unit"};
my $Name = undef;
if($ID>=0) {
$Name = $SourceFile{$Unit}{$File};
}
else
{ # imported
$Name = $SourceFile_Alt{0}{$File};
}
return $Name;
}
return undef;
}
sub read_DWARF_Dump($$)
{
my ($FH, $Primary) = @_;
my $TypeUnit_Sign = undef;
my $TypeUnit_Offset = undef;
my $Type_Offset = undef;
my $Shift_Enabled = 1;
my $ID_Shift = undef;
my $CUnit = undef;
my $Compressed = undef;
if($AltDebugInfo) {
$Compressed = 1;
}
my $ID = undef;
my $Kind = undef;
my $NS = undef;
my $MAX_ID = undef;
my %Shift = map {$_=>1} (
"specification",
"type",
"sibling",
"object_pointer",
"containing_type",
"abstract_origin",
"import",
"signature"
);
my $Line = undef;
my $Import = undef;
my $Import_Num = 0;
my %SkipNode = (
"imported_declaration" => 1,
"imported_module" => 1
);
my %SkipAttr = (
"high_pc" => 1,
"frame_base" => 1,
"encoding" => 1
);
my %MarkByUnit = (
"member" => 1,
"subprogram" => 1,
"variable" => 1
);
my $Lexical_Block = undef;
my $Inlined_Block = undef;
my $Subprogram_Block = undef;
my $Skip_Block = undef;
while(($Import and $Line = $ImportedUnit{$Import}{$Import_Num}) or $Line = <$FH>)
{
if($Import)
{
if(not defined $ImportedUnit{$Import}{$Import_Num})
{
$Import_Num = 0;
delete($ImportedUnit{$Import});
$Import = undef;
}
$Import_Num+=1;
}
# Modified to match readelf instead of eu-readelf.
if(defined $ID and $Line=~/\s*DW_AT_(\w+)\s*:\s+(.+?)\s*\Z/)
{
if(defined $Skip_Block) {
next;
}
my $Attr = $1;
my $Val = $2;
if(index($Val, "flag_present")!=-1)
{ # Fedora
$Val = "Yes";
}
if(defined $Compressed)
{
if($Kind eq "imported_unit")
{
if($Attr eq "import")
{
if($Val=~/\(GNU_ref_alt\)\s*\[\s*(\w+?)\]/)
{
if(defined $ImportedUnit{$1})
{
$Import = $1;
$Import_Num = 0;
$UsedUnit{$Import} = 1;
}
}
}
}
}
if($Kind eq "member")
{
# Modified to match readelf instead of eu-readelf.
if($Attr eq "data_member_location")
{
#data_meber_location value is handled later in the
#attr "location" clause.
delete($DWARF_Info{$ID}{"Unit"});
}
}
if($Attr eq "sibling")
{
if($Kind ne "structure_type")
{
next;
}
}
elsif($Attr eq "Type")
{
if($Line=~/Type\s+signature:\s*0x(\w+)/) {
$TypeUnit_Sign = $1;
}
if($Line=~/Type\s+offset:\s*0x(\w+)/) {
$Type_Offset = hex($1);
}
if($Line=~/Type\s+unit\s+at\s+offset\s+(\d+)/) {
$TypeUnit_Offset = $1;
}
next;
}
elsif(defined $SkipAttr{$Attr})
{ # unused
next;
}
# Modified to match readelf instead of eu-readelf.
if($Val=~/\A\s*\(([^()]*)\)\s*\[\s*(\w+)\]\s*\Z/)
{ # ref4, ref_udata, ref_addr, etc.
$Val = hex($2);
if($1 eq "GNU_ref_alt")
{
$Val = -$Val;
$UsedDecl{$2} = 1;
}
}
# Modified to match readelf instead of eu-readelf.
# type : <0x...>, abstract_origin, specification etc
if($Val=~/\A<0x(\w+)>\Z/)
{
$Val = hex($1);
}
elsif($Attr eq "name")
{
# Modified to match readelf instead of eu-readelf.
$Val=~s/\A\([^()]*\):\s+(.*)\Z/$1/;
}
elsif(index($Attr, "linkage_name")!=-1)
{
# Modified to match readelf instead of eu-readelf.
$Val=~s/\A\([^()]*\):\s+(\w+)\Z/$1/;
$Attr = "linkage_name";
}
elsif(index($Attr, "location")!=-1)
{
# Modified to match readelf instead of eu-readelf.
if($Val=~/\A(-?)(\d+)\Z/)
{ # (data1) 1c
# Modified to match readelf instead of eu-readelf.
# Eg: data_member_location : 8
$Val = $2;
if($1) {
$Val = -$Val;
}
}
else
{
if ($Val=~/\(DW_OP_(\w+:?\s+-?[0-9]*)+[\(\)]/) {
$Val = $1;
}
if($Val=~/\A(-?\d+)\Z/) {
$Val = $1;
}
else
{
if($Attr eq "location"
and $Kind eq "formal_parameter")
{
# Modified to match readelf instead of eu-readelf.
if($Val=~/0x(\w+)\s+\(location list\)\Z/)
{
$Attr = "location_list";
$Val = $1;
}
# Modified to match readelf instead of eu-readelf.
elsif($Val=~/\(reg(\d+)\s+\(.*\)\)\Z/)
{
$Attr = "register";
$Val = $1;
}
}
# Modified to match readelf instead of eu-readelf.
elsif($Attr eq "vtable_elem_location") {
if($Val=~/const.:\s+(-)?(\d+)/)
{
$Val = $2;
if ($1) {
$Val = -$Val;
}
}
}
}
}
}
elsif($Attr eq "accessibility")
{
# Modified to match readelf instead of eu-readelf.
$Val=~s/\A(\d+)\s+\((\w+)\)\Z/$2/;
# NOTE: members: private by default
}
else
{
$Val=~s/\A\(\w+\)\s*//;
if(substr($Val, 0, 1) eq "{"
and $Val=~/{(.+)}/)
{ # {ID}
$Val = $1;
$Post_Change{$ID} = 1;
}
}
if(defined $Shift_Enabled and $ID_Shift)
{
if(defined $Shift{$Attr}
and not $Post_Change{$ID}) {
$Val += $ID_Shift;
}
# $DWARF_Info{$ID}{"rID"} = $ID-$ID_Shift;
}
if($Import or not $Primary)
{
if(defined $Shift{$Attr})
{
$Val = -$Val;
}
}
$DWARF_Info{$ID}{$Attr} = "$Val";
if($Kind eq "compile_unit")
{
if($Attr eq "stmt_list") {
$CUnit = $Val;
}
if(not defined $LIB_LANG)
{
if($Attr eq "language")
{
if(index($Val, "Assembler")==-1)
{
# Modified to match readelf instead of eu-readelf.
$Val=~s/\s*\((.+?\))\Z/$1/;
if($Val=~/C\d/i) {
$LIB_LANG = "C";
}
elsif($Val=~/C\+\+|C_plus_plus/i) {
$LIB_LANG = "C++";
}
else {
$LIB_LANG = $Val;
}
}
}
}
if(not defined $SYS_COMP and not defined $SYS_GCCV)
{
if($Attr eq "producer")
{
if(index($Val, "GNU AS")==-1)
{
$Val=~s/\A\"//;
$Val=~s/\"\Z//;
if($Val=~/GNU\s+(C\d*|C\+\+)\s+(.+)\Z/)
{
$SYS_GCCV = $2;
if($SYS_GCCV=~/\A(\d+\.\d+)(\.\d+|)/)
{ # 4.6.1 20110627 (Mandriva)
$SYS_GCCV = $1.$2;
}
}
elsif($Val=~/clang\s+version\s+([^\s\(]+)/) {
$SYS_CLANGV = $1;
}
else {
$SYS_COMP = $Val;
}
if(not defined $KeepRegsAndOffsets)
{
my %Opts = ();
while($Val=~s/(\A| )(\-O([0-3]|g))( |\Z)/ /) {
$Opts{keys(%Opts)} = $2;
}
if(keys(%Opts))
{
if($Opts{keys(%Opts)-1} ne "-Og")
{
if(not defined $Quiet) {
printMsg("WARNING", "incompatible build option detected: ".$Opts{keys(%Opts)-1}." (required -Og for better analysis)");
}
$IncompatibleOpt = 1;
}
}
else
{
if(not defined $Quiet) {
printMsg("WARNING", "the object should be compiled with -Og option for better analysis");
}
$IncompatibleOpt = 1;
}
}
}
}
}
}
elsif($Kind eq "type_unit")
{
if($Attr eq "stmt_list") {
$CUnit = $Val;
}
}
elsif($Kind eq "partial_unit" and not $Import)
{ # support for dwz
if($Attr eq "stmt_list") {
$CUnit = $Val;
}
}
}
# Modified to match readelf instead of eu-readelf.
elsif($Line=~/\A <(\w+)><(\w+)>:\s+.+\(DW_TAG_(\w+)\)/)
{
$ID = hex($2);
# NS is used to identify namespace / scope. Mentioned along with ID.
$NS = hex($1);
$Kind = $3;
if(not defined $Compressed)
{
if($Kind eq "partial_unit" or $Kind eq "type_unit")
{ # compressed debug_info
$Compressed = 1;
if($TooBig) {
printMsg("WARNING", "input object is too big and compressed, may require a lot of RAM memory to proceed");
}
}
}
if(not $Compressed)
{ # compile units can depend on each other in the compressed debug_info
# so reading them all integrally by one call of read_ABI()
if($Kind eq "compile_unit" and $CUnit)
{ # read the previous compile unit
complete_Dump($Primary);
read_ABI();
if(not defined $Compressed)
{ # normal debug_info
$Compressed = 0;
}
}
}
$Skip_Block = undef;
if(defined $SkipNode{$Kind})
{
$Skip_Block = 1;
next;
}
if($Kind eq "lexical_block")
{
$Lexical_Block = $NS;
$Skip_Block = 1;
next;
}
else
{
if(defined $Lexical_Block)
{
if($NS>$Lexical_Block)
{
$Skip_Block = 1;
next;
}
else
{ # end of lexical block
$Lexical_Block = undef;
}
}
}
if($Kind eq "inlined_subroutine")
{
$Inlined_Block = $NS;
$Skip_Block = 1;
next;
}
else
{
if(defined $Inlined_Block)
{
if($NS>$Inlined_Block)
{
$Skip_Block = 1;
next;
}
else
{ # end of inlined subroutine
$Inlined_Block = undef;
}
}
}
if($Kind eq "subprogram")
{
$Subprogram_Block = $NS;
}
else
{
if(defined $Subprogram_Block)
{
if($NS>$Subprogram_Block)
{
if($Kind eq "variable")
{ # temp variables
$Skip_Block = 1;
next;
}
}
else
{ # end of subprogram block
$Subprogram_Block = undef;
}
}
}
if($Import or not $Primary)
{
$ID = -$ID;
}
if(defined $Shift_Enabled)
{
if($Kind eq "type_unit")
{
if(not defined $ID_Shift)
{
if($ID_Shift<=$MAX_ID) {
$ID_Shift = $MAX_ID;
}
else {
$ID_Shift = 0;
}
}
}
if($ID_Shift) {
$ID += $ID_Shift;
}
}
if(defined $TypeUnit_Sign)
{
if($Kind ne "type_unit"
and $Kind ne "namespace")
{
if($TypeUnit_Offset+$Type_Offset+$ID_Shift==$ID)
{
$TypeUnit{$TypeUnit_Sign} = "$ID";
$TypeUnit_Sign = undef;
}
}
}
$DWARF_Info{$ID}{"Kind"} = $Kind;
$DWARF_Info{$ID}{"NS"} = $NS;
if(defined $CUnit)
{
if(defined $MarkByUnit{$Kind}
or defined $TypeType{$Kind}) {
$DWARF_Info{$ID}{"Unit"} = $CUnit;
}
}
if(not defined $ID_Shift) {
$MAX_ID = $ID;
}
}
# Modified to match readelf instead of eu-readelf.
elsif(not defined $SYS_WORD
and $Line=~/Pointer\s*Size:\s*(\d+)/i)
{
$SYS_WORD = $1;
}
}
if(not defined $ID) {
printMsg("ERROR", "the debuginfo looks empty or corrupted");
}
# read the last compile unit
# or all units if debug_info is compressed
complete_Dump($Primary);
read_ABI();
}
sub read_Vtables($)
{
my $Path = $_[0];
$Path = abs_path($Path);
my $Dir = getDirname($Path);
if(index($LIB_LANG, "C++")!=-1
or $OBJ_LANG eq "C++")
{
printMsg("INFO", "Reading v-tables");
if(check_Cmd($VTABLE_DUMPER))
{ # Modified to match vndk-vtable-dumper
if(my $Version = `$VTABLE_DUMPER -version`)
{
if(cmpVersions($Version, $VTABLE_DUMPER_VERSION)<0)
{
printMsg("ERROR", "the version of Vtable-Dumper should be $VTABLE_DUMPER_VERSION or newer");
return;
}
}
}
else
{
printMsg("ERROR", "cannot find \'$VTABLE_DUMPER\'");
return;
}
my $ExtraPath = $TMP_DIR."/v-tables";
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraPath = $ExtraInfo."/v-tables";
}
# Modified to match the vtable dumper using LLVM's ELF api.
system("LD_LIBRARY_PATH=\"$Dir\" $VTABLE_DUMPER \"$Path\" 2>\"$TMP_DIR/error\" >\"$ExtraPath\"");
my $Content = readFile($ExtraPath);
foreach my $ClassInfo (split(/\n\n\n/, $Content))
{
# Modified to match the vtable dumper using LLVM's ELF api.
if($ClassInfo=~/\Avtable\s+for\s+(.+)\n((.|\n)+)\Z/i)
{
my ($CName, $VTable) = ($1, $2);
my @Entries = split(/\n/, $VTable);
foreach (1 .. $#Entries)
{
my $Entry = $Entries[$_];
if($Entry=~/\A(\d+)\s+(.+)\Z/) {
$VirtualTable{$CName}{$1} = $2;
}
}
}
}
}
if(keys(%VirtualTable))
{
foreach my $Tid (sort keys(%TypeInfo))
{
if($TypeInfo{$Tid}{"Type"}=~/\A(Struct|Class)\Z/)
{
my $TName = $TypeInfo{$Tid}{"Name"};
$TName=~s/\bstruct //g;
if(defined $VirtualTable{$TName})
{
%{$TypeInfo{$Tid}{"VTable"}} = %{$VirtualTable{$TName}};
}
}
}
}
}
sub dump_ABI()
{
printMsg("INFO", "Creating ABI dump");
my %ABI = (
"TypeInfo" => \%TypeInfo,
"SymbolInfo" => \%SymbolInfo,
"Symbols" => \%Library_Symbol,
"UndefinedSymbols" => \%Library_UndefSymbol,
"Needed" => \%Library_Needed,
"SymbolVersion" => \%SymVer,
"LibraryVersion" => $TargetVersion,
"LibraryName" => $TargetName,
"Language" => $LIB_LANG,
"Headers" => \%HeadersInfo,
"Sources" => \%SourcesInfo,
"NameSpaces" => \%NestedNameSpaces,
"Target" => "unix",
"Arch" => $SYS_ARCH,
"WordSize" => $SYS_WORD,
"ABI_DUMP_VERSION" => $ABI_DUMP_VERSION,
"ABI_DUMPER_VERSION" => $TOOL_VERSION,
);
if($SYS_GCCV) {
$ABI{"GccVersion"} = $SYS_GCCV;
}
elsif($SYS_CLANGV) {
$ABI{"ClangVersion"} = $SYS_CLANGV;
}
else {
$ABI{"Compiler"} = $SYS_COMP;
}
if(defined $PublicHeadersPath) {
$ABI{"PublicABI"} = "1";
}
if(defined $IncompatibleOpt)
{
$ABI{"MissedOffsets"} = "1";
$ABI{"MissedRegs"} = "1";
}
my $ABI_DUMP = Dumper(\%ABI);
if($StdOut)
{ # --stdout option
print STDOUT $ABI_DUMP;
}
else
{
mkpath(getDirname($OutputDump));
open(DUMP, ">", $OutputDump) || die ("can't open file \'$OutputDump\': $!\n");
print DUMP $ABI_DUMP;
close(DUMP);
printMsg("INFO", "\nThe object ABI has been dumped to:\n $OutputDump");
}
}
sub unmangleString($)
{
my $Str = $_[0];
$Str=~s/\AN(.+)E\Z/$1/;
while($Str=~s/\A(\d+)//)
{
if(length($Str)==$1) {
last;
}
$Str = substr($Str, $1, length($Str) - $1);
}
return $Str;
}
sub init_ABI()
{
# register "void" type
%{$TypeInfo{"1"}} = (
"Name"=>"void",
"Type"=>"Intrinsic"
);
$TName_Tid{"Intrinsic"}{"void"} = "1";
$TName_Tids{"Intrinsic"}{"void"}{"1"} = 1;
$Cache{"getTypeInfo"}{"1"} = 1;
# register "..." type
%{$TypeInfo{"-1"}} = (
"Name"=>"...",
"Type"=>"Intrinsic"
);
$TName_Tid{"Intrinsic"}{"..."} = "-1";
$TName_Tids{"Intrinsic"}{"..."}{"-1"} = 1;
$Cache{"getTypeInfo"}{"-1"} = 1;
}
sub complete_Dump($)
{
my $Primary = $_[0];
foreach my $ID (keys(%Post_Change))
{
if(my $Type = $DWARF_Info{$ID}{"type"})
{
if(my $To = $TypeUnit{$Type}) {
$DWARF_Info{$ID}{"type"} = $To;
}
}
if(my $Signature = $DWARF_Info{$ID}{"signature"})
{
if(my $To = $TypeUnit{$Signature}) {
$DWARF_Info{$ID}{"signature"} = $To;
}
}
}
%Post_Change = ();
%TypeUnit = ();
if($Primary)
{
my %AddUnits = ();
foreach my $ID (keys(%UsedDecl))
{
if(my $U_ID = $ImportedDecl{$ID})
{
if(not $UsedUnit{$U_ID})
{
$AddUnits{$U_ID} = 1;
}
}
}
if(keys(%AddUnits))
{
my $ADD_DUMP = "";
foreach my $U_ID (sort {hex($a)<=>hex($b)} keys(%AddUnits))
{
foreach my $N (sort {int($a)<=>int($b)} keys(%{$ImportedUnit{$U_ID}}))
{
$ADD_DUMP .= $ImportedUnit{$U_ID}{$N};
}
}
my $AddUnit_F = $TMP_DIR."/add_unit.dump";
writeFile($AddUnit_F, $ADD_DUMP);
my $FH_add;
open($FH_add, $AddUnit_F);
read_DWARF_Dump($FH_add, 0);
close($FH_add);
unlink($AddUnit_F);
}
}
%UsedUnit = ();
%UsedDecl = ();
}
sub read_ABI()
{
my %CurID = ();
my @IDs = sort {int($a) <=> int($b)} keys(%DWARF_Info);
if($AltDebugInfo) {
@IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
}
my $TPack = undef;
my $PPack = undef;
foreach my $ID (@IDs)
{
$ID = "$ID";
my $Kind = $DWARF_Info{$ID}{"Kind"};
my $NS = $DWARF_Info{$ID}{"NS"};
# Modified to match readelf instead of eu-readelf. In readelf, the child's
# scope level will be the parent's scope level + 1.
my $Scope = $CurID{$NS-1};
if($Kind eq "typedef")
{
if($DWARF_Info{$Scope}{"Kind"} eq "subprogram")
{
$NS = $DWARF_Info{$Scope}{"NS"};
# Modified to match readelf instead of eu-readelf.
$Scope = $CurID{$NS-1};
}
}
if($Kind ne "subprogram") {
delete($DWARF_Info{$ID}{"NS"});
}
my $IsType = ($Kind=~/(struct|structure|class|union|enumeration|subroutine|array)_type/);
if($IsType
or $Kind eq "typedef"
or $Kind eq "subprogram"
or $Kind eq "variable"
or $Kind eq "namespace")
{
if($Kind ne "variable"
and $Kind ne "typedef")
{
$CurID{$NS} = $ID;
}
if($Scope)
{
$NameSpace{$ID} = $Scope;
if($Kind eq "subprogram"
or $Kind eq "variable")
{
if($DWARF_Info{$Scope}{"Kind"}=~/class|struct/)
{
$ClassMethods{$Scope}{$ID} = 1;
if(my $Sp = $DWARF_Info{$Scope}{"specification"}) {
$ClassMethods{$Sp}{$ID} = 1;
}
}
}
}
if(my $Spec = $DWARF_Info{$ID}{"specification"}) {
$SpecElem{$Spec} = $ID;
}
if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"}) {
$OrigElem{$Orig} = $ID;
}
if($IsType)
{
if(not $DWARF_Info{$ID}{"name"}
and $DWARF_Info{$ID}{"linkage_name"})
{
$DWARF_Info{$ID}{"name"} = unmangleString($DWARF_Info{$ID}{"linkage_name"});
# free memory
delete($DWARF_Info{$ID}{"linkage_name"});
}
}
}
elsif($Kind eq "member")
{
if($Scope)
{
$NameSpace{$ID} = $Scope;
if($DWARF_Info{$Scope}{"Kind"}=~/class|struct/
and not defined $DWARF_Info{$ID}{"data_member_location"})
{ # variable (global data)
next;
}
}
$TypeMember{$Scope}{keys(%{$TypeMember{$Scope}})} = $ID;
}
elsif($Kind eq "enumerator")
{
$TypeMember{$Scope}{keys(%{$TypeMember{$Scope}})} = $ID;
}
elsif($Kind eq "inheritance")
{
my %In = ();
$In{"id"} = $DWARF_Info{$ID}{"type"};
if(my $Access = $DWARF_Info{$ID}{"accessibility"})
{
if($Access ne "public")
{ # default inheritance access in ABI dump is "public"
$In{"access"} = $Access;
}
}
if(defined $DWARF_Info{$ID}{"virtuality"}) {
$In{"virtual"} = 1;
}
$Inheritance{$Scope}{keys(%{$Inheritance{$Scope}})} = \%In;
# free memory
delete($DWARF_Info{$ID});
}
elsif($Kind eq "formal_parameter")
{
if(defined $PPack) {
$FuncParam{$PPack}{keys(%{$FuncParam{$PPack}})} = $ID;
}
else {
$FuncParam{$Scope}{keys(%{$FuncParam{$Scope}})} = $ID;
}
}
elsif($Kind eq "unspecified_parameters")
{
$FuncParam{$Scope}{keys(%{$FuncParam{$Scope}})} = $ID;
$DWARF_Info{$ID}{"type"} = "-1"; # "..."
}
elsif($Kind eq "subrange_type")
{
if((my $Bound = $DWARF_Info{$ID}{"upper_bound"}) ne "") {
$ArrayCount{$Scope} = $Bound + 1;
}
# free memory
delete($DWARF_Info{$ID});
}
# Modified to match readelf instead of eu-readelf.
elsif($Kind eq "template_type_param"
or $Kind eq "template_value_param")
{
my %Info = ("type"=>$DWARF_Info{$ID}{"type"}, "key"=>$DWARF_Info{$ID}{"name"});
if(defined $DWARF_Info{$ID}{"const_value"}) {
$Info{"value"} = $DWARF_Info{$ID}{"const_value"};
}
if(defined $DWARF_Info{$ID}{"default_value"}) {
$Info{"default"} = 1;
}
if(defined $TPack) {
$TmplParam{$TPack}{keys(%{$TmplParam{$TPack}})} = \%Info;
}
else {
$TmplParam{$Scope}{keys(%{$TmplParam{$Scope}})} = \%Info;
}
}
elsif($Kind eq "GNU_template_parameter_pack") {
$TPack = $Scope;
}
elsif($Kind eq "GNU_formal_parameter_pack") {
$PPack = $Scope;
}
if($Kind ne "GNU_template_parameter_pack")
{
if(index($Kind, "template_")==-1) {
$TPack = undef;
}
}
if($Kind ne "GNU_formal_parameter_pack")
{
if($Kind ne "formal_parameter") {
$PPack = undef;
}
}
}
my @IDs = sort {int($a) <=> int($b)} keys(%DWARF_Info);
if($AltDebugInfo) {
@IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
}
foreach my $ID (@IDs)
{
if(my $Kind = $DWARF_Info{$ID}{"Kind"})
{
if(defined $TypeType{$Kind}) {
getTypeInfo($ID);
}
}
}
foreach my $Tid (@IDs)
{
if(defined $TypeInfo{$Tid})
{
my $Type = $TypeInfo{$Tid}{"Type"};
if(not defined $TypeInfo{$Tid}{"Memb"})
{
if($Type=~/Struct|Class|Union|Enum/)
{
if(my $Signature = $DWARF_Info{$Tid}{"signature"})
{
if(defined $TypeInfo{$Signature})
{
foreach my $Attr (keys(%{$TypeInfo{$Signature}}))
{
if(not defined $TypeInfo{$Tid}{$Attr}) {
$TypeInfo{$Tid}{$Attr} = $TypeInfo{$Signature}{$Attr};
}
}
}
}
}
}
}
}
# delete types info
foreach (keys(%DWARF_Info))
{
if(my $Kind = $DWARF_Info{$_}{"Kind"})
{
if(defined $TypeType{$Kind}) {
delete($DWARF_Info{$_});
}
}
}
foreach my $ID (sort {int($a) <=> int($b)} keys(%DWARF_Info))
{
if($ID<0)
{ # imported
next;
}
if($DWARF_Info{$ID}{"Kind"} eq "subprogram"
or $DWARF_Info{$ID}{"Kind"} eq "variable")
{
getSymbolInfo($ID);
}
}
%DWARF_Info = ();
# free memory
%TypeMember = ();
%ArrayCount = ();
%FuncParam = ();
%TmplParam = ();
%Inheritance = ();
%NameSpace = ();
%SpecElem = ();
%OrigElem = ();
%ClassMethods = ();
$Cache{"getTypeInfo"} = {"1"=>1, "-1"=>1};
}
sub complete_ABI()
{
# types
my %Incomplete = ();
my %Incomplete_TN = ();
my @IDs = sort {int($a) <=> int($b)} keys(%TypeInfo);
if($AltDebugInfo) {
@IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @IDs;
}
foreach my $Tid (@IDs)
{
my $Name = $TypeInfo{$Tid}{"Name"};
my $Type = $TypeInfo{$Tid}{"Type"};
if(not defined $SpecElem{$Tid}
and not defined $Incomplete_TN{$Type}{$Name})
{
if(not defined $TypeInfo{$Tid}{"Size"})
{
if($Type=~/Struct|Class|Union|Enum/)
{
$Incomplete{$Tid} = 1;
}
}
}
$Incomplete_TN{$Type}{$Name} = 1;
}
# free memory
%Incomplete_TN = ();
foreach my $Tid (sort {int($a) <=> int($b)} keys(%Incomplete))
{
my $Name = $TypeInfo{$Tid}{"Name"};
my $Type = $TypeInfo{$Tid}{"Type"};
my @Adv_IDs = sort {int($a) <=> int($b)} keys(%{$TName_Tids{$Type}{$Name}});
if($AltDebugInfo) {
@Adv_IDs = sort {$b>0 <=> $a>0} sort {abs(int($a)) <=> abs(int($b))} @Adv_IDs;
}
foreach my $Tid_Adv (@Adv_IDs)
{
if($Tid_Adv!=$Tid)
{
if(defined $SpecElem{$Tid_Adv}
or defined $TypeInfo{$Tid_Adv}{"Size"})
{
foreach my $Attr (keys(%{$TypeInfo{$Tid_Adv}}))
{
if(not defined $TypeInfo{$Tid}{$Attr})
{
if(ref($TypeInfo{$Tid_Adv}{$Attr}) eq "HASH") {
$TypeInfo{$Tid}{$Attr} = dclone($TypeInfo{$Tid_Adv}{$Attr});
}
else {
$TypeInfo{$Tid}{$Attr} = $TypeInfo{$Tid_Adv}{$Attr};
}
}
}
last;
}
}
}
}
# free memory
%Incomplete = ();
my %Delete = ();
foreach my $Tid (sort {int($a) <=> int($b)} keys(%TypeInfo))
{
if($TypeInfo{$Tid}{"Type"} eq "Typedef")
{
my $TN = $TypeInfo{$Tid}{"Name"};
my $TL = $TypeInfo{$Tid}{"Line"};
my $NS = $TypeInfo{$Tid}{"NameSpace"};
if(my $BTid = $TypeInfo{$Tid}{"BaseType"})
{
if(defined $TypeInfo{$BTid}
and $TypeInfo{$BTid}{"Name"}=~/\Aanon\-(\w+)\-/
and $TypeInfo{$BTid}{"Type"}=~/Enum|Struct|Union/)
{
%{$TypeInfo{$Tid}} = %{$TypeInfo{$BTid}};
$TypeInfo{$Tid}{"Name"} = lc($TypeInfo{$BTid}{"Type"})." ".$TN;
$TypeInfo{$Tid}{"Line"} = $TL;
my $Name = $TypeInfo{$Tid}{"Name"};
my $Type = $TypeInfo{$Tid}{"Type"};
if(not defined $TName_Tid{$Type}{$Name}
or ($Tid>0 and $Tid<$TName_Tid{$Type}{$Name})
or ($Tid>0 and $TName_Tid{$Type}{$Name}<0)) {
$TName_Tid{$Type}{$Name} = $Tid;
}
$TName_Tids{$Type}{$Name}{$Tid} = 1;
if($NS) {
$TypeInfo{$Tid}{"NameSpace"} = $NS;
}
$Delete{$BTid} = $Tid;
}
}
}
elsif($TypeInfo{$Tid}{"Type"} eq "Pointer")
{
if(my $BTid = $TypeInfo{$Tid}{"BaseType"})
{
if(my $To = $Delete{$BTid})
{
$TypeInfo{$Tid}{"BaseType"} = $To;
$TypeInfo{$Tid}{"Name"} = $TypeInfo{$To}{"Name"}."*";
my $Name = $TypeInfo{$Tid}{"Name"};
my $Type = $TypeInfo{$Tid}{"Type"};
$TName_Tid{$Type}{$Name} = $Tid;
$TName_Tids{$Type}{$Name}{$Tid} = 1;
}
}
}
}
foreach my $Tid (keys(%Delete))
{
my $TN = $TypeInfo{$Tid}{"Name"};
my $TT = $TypeInfo{$Tid}{"Type"};
delete($TName_Tid{$TT}{$TN});
delete($TName_Tids{$TT}{$TN}{$Tid});
if(my @IDs = sort {int($a) <=> int($b)} keys(%{$TName_Tids{$TT}{$TN}}))
{ # minimal ID
$TName_Tid{$TT}{$TN} = $IDs[0];
}
delete($TypeInfo{$Tid});
}
# free memory
%Delete = ();
# symbols
foreach my $ID (sort {int($a) <=> int($b)} keys(%SymbolInfo))
{
# add missed c-tors
if($SymbolInfo{$ID}{"Constructor"})
{
if($SymbolInfo{$ID}{"MnglName"}=~/(C[1-2])([EI]).+/)
{
my ($K1, $K2) = ($1, $2);
foreach ("C1", "C2")
{
if($K1 ne $_)
{
my $Name = $SymbolInfo{$ID}{"MnglName"};
$Name=~s/$K1$K2/$_$K2/;
if(not defined $Mangled_ID{$Name}) {
cloneSymbol($ID, $Name);
}
}
}
}
}
# add missed d-tors
if($SymbolInfo{$ID}{"Destructor"})
{
if($SymbolInfo{$ID}{"MnglName"}=~/(D[0-2])([EI]).+/)
{
my ($K1, $K2) = ($1, $2);
foreach ("D0", "D1", "D2")
{
if($K1 ne $_)
{
my $Name = $SymbolInfo{$ID}{"MnglName"};
$Name=~s/$K1$K2/$_$K2/;
if(not defined $Mangled_ID{$Name}) {
cloneSymbol($ID, $Name);
}
}
}
}
}
}
foreach my $ID (sort {int($a) <=> int($b)} keys(%SymbolInfo))
{
my $Symbol = $SymbolInfo{$ID}{"MnglName"};
if(not $Symbol) {
$Symbol = $SymbolInfo{$ID}{"ShortName"};
}
if($LIB_LANG eq "C++")
{
if(not $SymbolInfo{$ID}{"MnglName"})
{
if($SymbolInfo{$ID}{"Artificial"}
or index($SymbolInfo{$ID}{"ShortName"}, "~")==0)
{
delete($SymbolInfo{$ID});
next;
}
}
}
if($SymbolInfo{$ID}{"Class"}
and not $SymbolInfo{$ID}{"Data"}
and not $SymbolInfo{$ID}{"Constructor"}
and not $SymbolInfo{$ID}{"Destructor"}
and not $SymbolInfo{$ID}{"Virt"}
and not $SymbolInfo{$ID}{"PureVirt"})
{
if(not defined $SymbolInfo{$ID}{"Param"}
or $SymbolInfo{$ID}{"Param"}{0}{"name"} ne "this")
{
$SymbolInfo{$ID}{"Static"} = 1;
}
}
if(not $SymbolInfo{$ID}{"Return"})
{ # void
if(not $SymbolInfo{$ID}{"Constructor"}
and not $SymbolInfo{$ID}{"Destructor"})
{
$SymbolInfo{$ID}{"Return"} = "1";
}
}
if(defined $SymbolInfo{$ID}{"Source"} and defined $SymbolInfo{$ID}{"SourceLine"})
{
if(not defined $SymbolInfo{$ID}{"Header"} and not defined $SymbolInfo{$ID}{"Line"})
{
$SymbolInfo{$ID}{"Line"} = $SymbolInfo{$ID}{"SourceLine"};
delete($SymbolInfo{$ID}{"SourceLine"});
}
}
my $S = selectSymbol($ID);
if($S==0)
{
if(defined $AllSymbols)
{
if($SymbolInfo{$ID}{"External"})
{
$S = 1;
}
else
{ # local
if(defined $DumpStatic) {
$S = 1;
}
}
}
}
if($S==0)
{
delete($SymbolInfo{$ID});
next;
}
elsif(defined $PublicHeadersPath)
{
if(not selectPublic($Symbol, $ID)
and (not defined $SymbolInfo{$ID}{"Alias"} or not selectPublic($SymbolInfo{$ID}{"Alias"}, $ID)))
{
delete($SymbolInfo{$ID});
next;
}
}
elsif(defined $KernelExport)
{
if(not defined $KSymTab{$Symbol})
{
delete($SymbolInfo{$ID});
next;
}
}
$SelectedSymbols{$ID} = $S;
delete($SymbolInfo{$ID}{"External"});
}
}
sub warnPrivateType($$)
{
my ($Name, $Note) = @_;
if($Name=~/Private|Opaque/i)
{ # _GstClockPrivate
# _Eo_Opaque
return;
}
if($Name=~/(\A| )_/i)
{ # _GstBufferList
return;
}
if($Name=~/_\Z/i)
{ # FT_RasterRec_
return;
}
printMsg("WARNING", "Private data type \'".$Name."\' ($Note)");
}
sub warnPrivateSymbol($$)
{
my ($Name, $Note) = @_;
printMsg("WARNING", "Private symbol \'".$Name."\' ($Note)");
}
sub selectPublicType($)
{
my $Tid = $_[0];
if($TypeInfo{$Tid}{"Type"}!~/\A(Struct|Class|Union|Enum)\Z/) {
return 1;
}
my $TName = $TypeInfo{$Tid}{"Name"};
$TName=~s/\A(struct|class|union|enum) //g;
my $Header = getFilename($TypeInfo{$Tid}{"Header"});
if($OBJ_LANG eq "C++"
or index($TName, "anon-")==0) {
return ($Header and defined $PublicHeader{$Header});
}
if($Header)
{
if(not defined $PublicHeader{$Header})
{
if(not defined $TypeToHeader{$TName}) {
return 0;
}
}
elsif($MixedHeaders)
{
if(not defined $TypeToHeader{$TName})
{
if(defined $Debug) {
warnPrivateType($TypeInfo{$Tid}{"Name"}, "NOT_FOUND");
}
return 0;
}
}
}
else
{
if(not defined $TypeToHeader{$TName})
{
# if(defined $Debug) {
# warnPrivateType($TypeInfo{$Tid}{"Name"}, "NO_HEADER");
# }
return 0;
}
}
return 1;
}
sub selectPublic($$)
{
my ($Symbol, $ID) = @_;
my $Header = getFilename($SymbolInfo{$ID}{"Header"});
if($OBJ_LANG eq "C++") {
return ($Header and defined $PublicHeader{$Header});
}
if($Header)
{
if(not defined $PublicHeader{$Header})
{
if(not defined $SymbolToHeader{$Symbol}) {
return 0;
}
}
elsif($MixedHeaders)
{
if(not defined $SymbolToHeader{$Symbol})
{
if(defined $Debug) {
warnPrivateSymbol($Symbol, "NOT_FOUND");
}
return 0;
}
}
}
else
{
if(not defined $SymbolToHeader{$Symbol})
{
# if(defined $Debug) {
# warnPrivateSymbol($Symbol, "NO_HEADER");
# }
return 0;
}
}
return 1;
}
sub cloneSymbol($$)
{
my ($ID, $Symbol) = @_;
my $nID = undef;
if(not defined $SymbolInfo{$ID + 1}) {
$nID = $ID + 1;
}
else {
$nID = ++$GLOBAL_ID;
}
foreach my $Attr (keys(%{$SymbolInfo{$ID}}))
{
if(ref($SymbolInfo{$ID}{$Attr}) eq "HASH") {
$SymbolInfo{$nID}{$Attr} = dclone($SymbolInfo{$ID}{$Attr});
}
else {
$SymbolInfo{$nID}{$Attr} = $SymbolInfo{$ID}{$Attr};
}
}
$SymbolInfo{$nID}{"MnglName"} = $Symbol;
}
sub selectSymbol($)
{
my $ID = $_[0];
my $MnglName = $SymbolInfo{$ID}{"MnglName"};
if(not $MnglName) {
$MnglName = $SymbolInfo{$ID}{"ShortName"};
}
if($SymbolsListPath
and not $SymbolsList{$MnglName})
{
next;
}
my $Exp = 0;
if($Library_Symbol{$TargetName}{$MnglName}
or $Library_Symbol{$TargetName}{$SymVer{$MnglName}})
{
$Exp = 1;
}
if(my $Alias = $SymbolInfo{$ID}{"Alias"})
{
if($Library_Symbol{$TargetName}{$Alias}
or $Library_Symbol{$TargetName}{$SymVer{$Alias}})
{
$Exp = 1;
}
}
if(not $Exp)
{
if(defined $Library_UndefSymbol{$TargetName}{$MnglName}
or defined $Library_UndefSymbol{$TargetName}{$SymVer{$MnglName}})
{
return 0;
}
if($SymbolInfo{$ID}{"Data"}
or $SymbolInfo{$ID}{"InLine"}
or $SymbolInfo{$ID}{"PureVirt"})
{
if(not $SymbolInfo{$ID}{"External"})
{ # skip static
return 0;
}
if(defined $BinOnly)
{ # data, inline, pure
return 0;
}
elsif(not defined $SymbolInfo{$ID}{"Header"})
{ # defined in source files
return 0;
}
else
{
return 2;
}
}
else
{
return 0;
}
}
return 1;
}
sub formatName($$)
{ # type name correction
if(defined $Cache{"formatName"}{$_[1]}{$_[0]}) {
return $Cache{"formatName"}{$_[1]}{$_[0]};
}
my $N = $_[0];
if($_[1] ne "S")
{
$N=~s/\A[ ]+//g;
$N=~s/[ ]+\Z//g;
$N=~s/[ ]{2,}/ /g;
}
$N=~s/[ ]*(\W)[ ]*/$1/g; # std::basic_string<char> const
$N=~s/\b(const|volatile) ([\w\:]+)([\*&,>]|\Z)/$2 $1$3/g; # "const void" to "void const"
$N=~s/\bvolatile const\b/const volatile/g;
$N=~s/\b(long long|short|long) unsigned\b/unsigned $1/g;
$N=~s/\b(short|long) int\b/$1/g;
$N=~s/([\)\]])(const|volatile)\b/$1 $2/g;
while($N=~s/>>/> >/g) {};
if($_[1] eq "S")
{
if(index($N, "operator")!=-1) {
$N=~s/\b(operator[ ]*)> >/$1>>/;
}
}
$N=~s/,/, /g;
return ($Cache{"formatName"}{$_[1]}{$_[0]} = $N);
}
sub separate_Params($)
{
my $Str = $_[0];
my @Parts = ();
my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
my $Part = 0;
foreach my $Pos (0 .. length($Str) - 1)
{
my $S = substr($Str, $Pos, 1);
if(defined $B{$S}) {
$B{$S} += 1;
}
if($S eq "," and
$B{"("}==$B{")"} and $B{"<"}==$B{">"}) {
$Part += 1;
}
else {
$Parts[$Part] .= $S;
}
}
# remove spaces
foreach (@Parts)
{
s/\A //g;
s/ \Z//g;
}
return @Parts;
}
sub init_FuncType($$$)
{
my ($TInfo, $FTid, $Type) = @_;
$TInfo->{"Type"} = $Type;
if($TInfo->{"Return"} = $DWARF_Info{$FTid}{"type"}) {
getTypeInfo($TInfo->{"Return"});
}
else
{ # void
$TInfo->{"Return"} = "1";
}
delete($TInfo->{"BaseType"});
my @Prms = ();
my $PPos = 0;
foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$FuncParam{$FTid}}))
{
my $ParamId = $FuncParam{$FTid}{$Pos};
my %PInfo = %{$DWARF_Info{$ParamId}};
if(defined $PInfo{"artificial"})
{ # this
next;
}
if(my $PTypeId = $PInfo{"type"})
{
$TInfo->{"Param"}{$PPos}{"type"} = $PTypeId;
getTypeInfo($PTypeId);
push(@Prms, $TypeInfo{$PTypeId}{"Name"});
}
$PPos += 1;
}
$TInfo->{"Name"} = $TypeInfo{$TInfo->{"Return"}}{"Name"};
if($Type eq "FuncPtr") {
$TInfo->{"Name"} .= "(*)";
}
else {
$TInfo->{"Name"} .= "()";
}
$TInfo->{"Name"} .= "(".join(",", @Prms).")";
}
sub getShortName($)
{
my $Name = $_[0];
if(my $C = find_center($Name, "<"))
{
return substr($Name, 0, $C);
}
return $Name;
}
sub get_TParams($)
{
my $ID = $_[0];
my @TParams = ();
foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$TmplParam{$ID}}))
{
my $TTid = $TmplParam{$ID}{$Pos}{"type"};
my $Val = undef;
my $Key = undef;
if(defined $TmplParam{$ID}{$Pos}{"value"}) {
$Val = $TmplParam{$ID}{$Pos}{"value"};
}
if(defined $TmplParam{$ID}{$Pos}{"key"}) {
$Key = $TmplParam{$ID}{$Pos}{"key"};
}
if($Pos>0)
{
if(defined $TmplParam{$ID}{$Pos}{"default"})
{
if($Key=~/\A(_Alloc|_Traits|_Compare)\Z/)
{
next;
}
}
}
getTypeInfo($TTid);
my $TTName = $TypeInfo{$TTid}{"Name"};
if(defined $Val)
{
if($TTName eq "bool")
{
if($Val eq "1") {
push(@TParams, "true");
}
elsif($Val eq "0") {
push(@TParams, "false");
}
}
else
{
if($Val=~/\A\d+\Z/)
{
if(my $S = $ConstSuffix{$TTName})
{
$Val .= $S;
}
}
push(@TParams, $Val);
}
}
else
{
push(@TParams, simpleName($TTName));
}
}
return @TParams;
}
sub parse_TParams($)
{
my $Name = $_[0];
if(my $Cent = find_center($Name, "<"))
{
my $TParams = substr($Name, $Cent);
$TParams=~s/\A<|>\Z//g;
$TParams = simpleName($TParams);
my $Short = substr($Name, 0, $Cent);
my @Params = separate_Params($TParams);
foreach my $Pos (0 .. $#Params)
{
my $Param = $Params[$Pos];
if($Param=~/\A(.+>)(.*?)\Z/)
{
my ($Tm, $Suf) = ($1, $2);
my ($Sh, @Prm) = parse_TParams($Tm);
$Param = $Sh."<".join(", ", @Prm).">".$Suf;
}
$Params[$Pos] = formatName($Param, "T");
}
@Params = shortTParams($Short, @Params);
return ($Short, @Params);
}
return $Name; # error
}
sub shortTParams(@)
{
my $Short = shift(@_);
my @Params = @_;
# default arguments
if($Short eq "std::vector")
{
if($#Params==1)
{
if($Params[1] eq "std::allocator<".$Params[0].">")
{ # std::vector<T, std::allocator<T> >
splice(@Params, 1, 1);
}
}
}
elsif($Short eq "std::set")
{
if($#Params==2)
{
if($Params[1] eq "std::less<".$Params[0].">"
and $Params[2] eq "std::allocator<".$Params[0].">")
{ # std::set<T, std::less<T>, std::allocator<T> >
splice(@Params, 1, 2);
}
}
}
elsif($Short eq "std::basic_string")
{
if($#Params==2)
{
if($Params[1] eq "std::char_traits<".$Params[0].">"
and $Params[2] eq "std::allocator<".$Params[0].">")
{ # std::basic_string<T, std::char_traits<T>, std::allocator<T> >
splice(@Params, 1, 2);
}
}
}
return @Params;
}
sub getTypeInfo($)
{
my $ID = $_[0];
my $Kind = $DWARF_Info{$ID}{"Kind"};
if(defined $Cache{"getTypeInfo"}{$ID}) {
return;
}
if(my $N = $NameSpace{$ID})
{
if($DWARF_Info{$N}{"Kind"} eq "subprogram")
{ # local code
# template instances are declared in the subprogram (constructor)
my $Tmpl = 0;
if(my $ObjP = $DWARF_Info{$N}{"object_pointer"})
{
while($DWARF_Info{$ObjP}{"type"}) {
$ObjP = $DWARF_Info{$ObjP}{"type"};
}
my $CName = $DWARF_Info{$ObjP}{"name"};
$CName=~s/<.*//g;
if($CName eq $DWARF_Info{$N}{"name"}) {
$Tmpl = 1;
}
}
if(not $Tmpl)
{ # local types
$LocalType{$ID} = 1;
}
}
elsif($DWARF_Info{$N}{"Kind"} eq "lexical_block")
{ # local code
return;
}
}
$Cache{"getTypeInfo"}{$ID} = 1;
my %TInfo = ();
$TInfo{"Type"} = $TypeType{$Kind};
if(not $TInfo{"Type"})
{
if($DWARF_Info{$ID}{"Kind"} eq "subroutine_type") {
$TInfo{"Type"} = "Func";
}
}
if(defined $SYS_CLANGV
and $TInfo{"Type"} eq "FieldPtr")
{ # Support for Clang
if(my $T = $DWARF_Info{$ID}{"type"})
{
if($DWARF_Info{$T}{"Kind"} eq "subroutine_type")
{
$TInfo{"Type"} = "MethodPtr";
$DWARF_Info{$ID}{"sibling"} = $T;
$DWARF_Info{$T}{"object_pointer"} = $DWARF_Info{$ID}{"containing_type"};
}
}
}
my $RealType = $TInfo{"Type"};
if(defined $ClassMethods{$ID})
{
if($TInfo{"Type"} eq "Struct") {
$RealType = "Class";
}
}
if($TInfo{"Type"} ne "Enum"
and my $BaseType = $DWARF_Info{$ID}{"type"})
{
$TInfo{"BaseType"} = "$BaseType";
if(defined $TypeType{$DWARF_Info{$BaseType}{"Kind"}})
{
getTypeInfo($TInfo{"BaseType"});
if(not defined $TypeInfo{$TInfo{"BaseType"}}
or not $TypeInfo{$TInfo{"BaseType"}}{"Name"})
{ # local code
delete($TypeInfo{$ID});
return;
}
}
}
if($RealType eq "Class") {
$TInfo{"Copied"} = 1; # will be changed in getSymbolInfo()
}
if(defined $TypeMember{$ID})
{
my $Unnamed = 0;
foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$TypeMember{$ID}}))
{
my $MemId = $TypeMember{$ID}{$Pos};
my %MInfo = %{$DWARF_Info{$MemId}};
if(my $Name = $MInfo{"name"})
{
if(index($Name, "_vptr.")==0)
{ # v-table pointer
$Name="_vptr";
}
$TInfo{"Memb"}{$Pos}{"name"} = $Name;
}
else
{
$TInfo{"Memb"}{$Pos}{"name"} = "unnamed".$Unnamed;
$Unnamed += 1;
}
if($TInfo{"Type"} eq "Enum") {
$TInfo{"Memb"}{$Pos}{"value"} = $MInfo{"const_value"};
}
else
{
$TInfo{"Memb"}{$Pos}{"type"} = $MInfo{"type"};
if(my $Access = $MInfo{"accessibility"})
{
if($Access ne "public")
{ # NOTE: default access of members in the ABI dump is "public"
$TInfo{"Memb"}{$Pos}{"access"} = $Access;
}
}
else
{
if($DWARF_Info{$ID}{"Kind"} eq "class_type")
{ # NOTE: default access of class members in the debug info is "private"
$TInfo{"Memb"}{$Pos}{"access"} = "private";
}
else
{
# NOTE: default access of struct members in the debug info is "public"
}
}
if($TInfo{"Type"} eq "Union") {
$TInfo{"Memb"}{$Pos}{"offset"} = "0";
}
elsif(defined $MInfo{"data_member_location"}) {
$TInfo{"Memb"}{$Pos}{"offset"} = $MInfo{"data_member_location"};
}
}
if((my $BitSize = $MInfo{"bit_size"}) ne "") {
$TInfo{"Memb"}{$Pos}{"bitfield"} = $BitSize;
}
}
}
my $NS = $NameSpace{$ID};
if(not $NS)
{
if(my $Sp = $DWARF_Info{$ID}{"specification"}) {
$NS = $NameSpace{$Sp};
}
}
if($NS and $DWARF_Info{$NS}{"Kind"}=~/\A(class_type|structure_type)\Z/)
{ # member class
if(my $Access = $DWARF_Info{$ID}{"accessibility"})
{
if($Access ne "public")
{ # NOTE: default access of member classes in the ABI dump is "public"
$TInfo{ucfirst($Access)} = 1;
}
}
else
{
if($DWARF_Info{$NS}{"Kind"} eq "class_type")
{
# NOTE: default access of member classes in the debug info is "private"
$TInfo{"Private"} = 1;
}
else
{
# NOTE: default access to struct member classes in the debug info is "public"
}
}
}
else
{
if(my $Access = $DWARF_Info{$ID}{"accessibility"})
{
if($Access ne "public")
{ # NOTE: default access of classes in the ABI dump is "public"
$TInfo{ucfirst($Access)} = 1;
}
}
}
if(my $Size = $DWARF_Info{$ID}{"byte_size"}) {
$TInfo{"Size"} = $Size;
}
setSource(\%TInfo, $ID);
if(not $DWARF_Info{$ID}{"name"}
and my $Spec = $DWARF_Info{$ID}{"specification"}) {
$DWARF_Info{$ID}{"name"} = $DWARF_Info{$Spec}{"name"};
}
if($NS)
{
if($DWARF_Info{$NS}{"Kind"} eq "namespace")
{
if(my $NS_F = completeNS($ID))
{
$TInfo{"NameSpace"} = $NS_F;
}
}
elsif($DWARF_Info{$NS}{"Kind"} eq "class_type"
or $DWARF_Info{$NS}{"Kind"} eq "structure_type")
{ # class
getTypeInfo($NS);
if(my $Sp = $SpecElem{$NS}) {
getTypeInfo($Sp);
}
if($TypeInfo{$NS}{"Name"})
{
$TInfo{"NameSpace"} = $TypeInfo{$NS}{"Name"};
$TInfo{"NameSpace"}=~s/\Astruct //;
}
}
}
if(my $Name = $DWARF_Info{$ID}{"name"})
{
$TInfo{"Name"} = $Name;
if($TInfo{"NameSpace"}) {
$TInfo{"Name"} = $TInfo{"NameSpace"}."::".$TInfo{"Name"};
}
if($TInfo{"Type"}=~/\A(Struct|Enum|Union)\Z/) {
$TInfo{"Name"} = lc($TInfo{"Type"})." ".$TInfo{"Name"};
}
}
if($TInfo{"Type"} eq "Struct")
{
if(not $TInfo{"Name"}
and my $Sb = $DWARF_Info{$ID}{"sibling"})
{
if($DWARF_Info{$Sb}{"Kind"} eq "subroutine_type"
and defined $TInfo{"Memb"}
and $TInfo{"Memb"}{0}{"name"} eq "__pfn")
{ # __pfn and __delta
$TInfo{"Type"} = "MethodPtr";
}
}
}
if($TInfo{"Type"}=~/Pointer|Ptr|Ref/)
{
if(not $TInfo{"Size"}) {
$TInfo{"Size"} = $SYS_WORD;
}
}
if($TInfo{"Type"} eq "Pointer")
{
if($DWARF_Info{$TInfo{"BaseType"}}{"Kind"} eq "subroutine_type")
{
init_FuncType(\%TInfo, $TInfo{"BaseType"}, "FuncPtr");
}
}
elsif($TInfo{"Type"}=~/Typedef|Const|Volatile/)
{
if($DWARF_Info{$TInfo{"BaseType"}}{"Kind"} eq "subroutine_type")
{
getTypeInfo($TInfo{"BaseType"});
}
}
elsif($TInfo{"Type"} eq "Func")
{
init_FuncType(\%TInfo, $ID, "Func");
}
elsif($TInfo{"Type"} eq "MethodPtr")
{
if(my $Sb = $DWARF_Info{$ID}{"sibling"})
{
my @Prms = ();
my $PPos = 0;
foreach my $Pos (sort {int($a)<=>int($b)} keys(%{$FuncParam{$Sb}}))
{
my $ParamId = $FuncParam{$Sb}{$Pos};
my %PInfo = %{$DWARF_Info{$ParamId}};
if(defined $PInfo{"artificial"})
{ # this
next;
}
if(my $PTypeId = $PInfo{"type"})
{
$TInfo{"Param"}{$PPos}{"type"} = $PTypeId;
getTypeInfo($PTypeId);
push(@Prms, $TypeInfo{$PTypeId}{"Name"});
}
$PPos += 1;
}
if(my $ClassId = $DWARF_Info{$Sb}{"object_pointer"})
{
while($DWARF_Info{$ClassId}{"type"}) {
$ClassId = $DWARF_Info{$ClassId}{"type"};
}
$TInfo{"Class"} = $ClassId;
getTypeInfo($TInfo{"Class"});
}
if($TInfo{"Return"} = $DWARF_Info{$Sb}{"type"}) {
getTypeInfo($TInfo{"Return"});
}
else
{ # void
$TInfo{"Return"} = "1";
}
$TInfo{"Name"} = $TypeInfo{$TInfo{"Return"}}{"Name"};
$TInfo{"Name"} .= "(".$TypeInfo{$TInfo{"Class"}}{"Name"}."::*)";
$TInfo{"Name"} .= "(".join(",", @Prms).")";
delete($TInfo{"BaseType"});
}
}
elsif($TInfo{"Type"} eq "FieldPtr")
{
$TInfo{"Return"} = $TInfo{"BaseType"};
delete($TInfo{"BaseType"});
if(my $Class = $DWARF_Info{$ID}{"containing_type"})
{
$TInfo{"Class"} = $Class;
getTypeInfo($TInfo{"Class"});
$TInfo{"Name"} = $TypeInfo{$TInfo{"Return"}}{"Name"}."(".$TypeInfo{$TInfo{"Class"}}{"Name"}."::*)";
}
$TInfo{"Size"} = $SYS_WORD;
}
elsif($TInfo{"Type"} eq "String")
{
$TInfo{"Type"} = "Pointer";
$TInfo{"Name"} = "char*";
$TInfo{"BaseType"} = $TName_Tid{"Intrinsic"}{"char"};
}
foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$Inheritance{$ID}}))
{
if(my $BaseId = $Inheritance{$ID}{$Pos}{"id"})
{
if(my $E = $SpecElem{$BaseId}) {
$BaseId = $E;
}
$TInfo{"Base"}{$BaseId}{"pos"} = "$Pos";
if(my $Access = $Inheritance{$ID}{$Pos}{"access"}) {
$TInfo{"Base"}{$BaseId}{"access"} = $Access;
}
if($Inheritance{$ID}{$Pos}{"virtual"}) {
$TInfo{"Base"}{$BaseId}{"virtual"} = 1;
}
$ClassChild{$BaseId}{$ID} = 1;
}
}
if(not $TInfo{"BaseType"})
{
if($TInfo{"Type"} eq "Pointer")
{
$TInfo{"Name"} = "void*";
$TInfo{"BaseType"} = "1";
}
elsif($TInfo{"Type"} eq "Const")
{
$TInfo{"Name"} = "const void";
$TInfo{"BaseType"} = "1";
}
elsif($TInfo{"Type"} eq "Volatile")
{
$TInfo{"Name"} = "volatile void";
$TInfo{"BaseType"} = "1";
}
elsif($TInfo{"Type"} eq "Typedef")
{
$TInfo{"BaseType"} = "1";
}
}
if(not $TInfo{"Name"}
and $TInfo{"Type"} ne "Enum")
{
my $ID_ = $ID;
my $BaseID = undef;
my $Name = "";
while($BaseID = $DWARF_Info{$ID_}{"type"})
{
my $Kind = $DWARF_Info{$ID_}{"Kind"};
if(my $Q = $Qual{$TypeType{$Kind}})
{
$Name = $Q.$Name;
if($Q=~/\A\w/) {
$Name = " ".$Name;
}
}
if(my $BName = $TypeInfo{$BaseID}{"Name"})
{
$Name = $BName.$Name;
last;
}
elsif(my $BName2 = $DWARF_Info{$BaseID}{"name"})
{
$Name = $BName2.$Name;
}
$ID_ = $BaseID;
}
if($Name) {
$TInfo{"Name"} = $Name;
}
if($TInfo{"Type"} eq "Array")
{
if(my $Count = $ArrayCount{$ID})
{
$TInfo{"Name"} .= "[".$Count."]";
if(my $BType = $TInfo{"BaseType"})
{
if(my $BSize = $TypeInfo{$BType}{"Size"})
{
if(my $Size = $Count*$BSize)
{
$TInfo{"Size"} = "$Size";
}
}
}
}
else
{
$TInfo{"Name"} .= "[]";
$TInfo{"Size"} = $SYS_WORD;
}
}
elsif($TInfo{"Type"} eq "Pointer")
{
if(my $BType = $TInfo{"BaseType"})
{
if($TypeInfo{$BType}{"Type"}=~/MethodPtr|FuncPtr/)
{ # void(GTestSuite::**)()
# int(**)(...)
if($TInfo{"Name"}=~s/\*\Z//) {
$TInfo{"Name"}=~s/\*(\))/\*\*$1/;
}
}
}
}
}
if(my $Bid = $TInfo{"BaseType"})
{
if(not $TInfo{"Size"}
and $TypeInfo{$Bid}{"Size"}) {
$TInfo{"Size"} = $TypeInfo{$Bid}{"Size"};
}
}
if($TInfo{"Name"}) {
$TInfo{"Name"} = formatName($TInfo{"Name"}, "T"); # simpleName()
}
if($TInfo{"Name"}=~/>\Z/)
{
my ($Short, @TParams) = ();
if(defined $TmplParam{$ID})
{
$Short = getShortName($TInfo{"Name"});
@TParams = get_TParams($ID);
@TParams = shortTParams($Short, @TParams);
}
else {
($Short, @TParams) = parse_TParams($TInfo{"Name"});
}
if(@TParams)
{
delete($TInfo{"TParam"});
foreach my $Pos (0 .. $#TParams) {
$TInfo{"TParam"}{$Pos}{"name"} = $TParams[$Pos];
}
$TInfo{"Name"} = formatName($Short."<".join(", ", @TParams).">", "T");
}
}
if(not $TInfo{"Name"})
{
if($TInfo{"Type"}=~/\A(Class|Struct|Enum|Union)\Z/)
{
if($TInfo{"Header"}) {
$TInfo{"Name"} = "anon-".lc($TInfo{"Type"})."-".$TInfo{"Header"}."-".$TInfo{"Line"};
}
elsif($TInfo{"Source"}) {
$TInfo{"Name"} = "anon-".lc($TInfo{"Type"})."-".$TInfo{"Source"}."-".$TInfo{"SourceLine"};
}
else
{
if(not defined $TypeMember{$ID})
{
if(not defined $ANON_TYPE_WARN{$TInfo{"Type"}})
{
printMsg("WARNING", "a \"".$TInfo{"Type"}."\" type with no attributes detected in the DWARF dump ($ID)");
$ANON_TYPE_WARN{$TInfo{"Type"}} = 1;
}
$TInfo{"Name"} = "anon-".lc($TInfo{"Type"});
}
}
if($TInfo{"Name"} and $TInfo{"NameSpace"}) {
$TInfo{"Name"} = $TInfo{"NameSpace"}."::".$TInfo{"Name"};
}
}
}
if($TInfo{"Name"})
{
if(not defined $TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}}
or ($ID>0 and $ID<$TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}})
or ($ID>0 and $TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}}<0))
{
$TName_Tid{$TInfo{"Type"}}{$TInfo{"Name"}} = "$ID";
}
$TName_Tids{$TInfo{"Type"}}{$TInfo{"Name"}}{$ID} = 1;
}
if(defined $TInfo{"Source"})
{
if(not defined $TInfo{"Header"})
{
$TInfo{"Line"} = $TInfo{"SourceLine"};
delete($TInfo{"SourceLine"});
}
}
foreach my $Attr (keys(%TInfo)) {
$TypeInfo{$ID}{$Attr} = $TInfo{$Attr};
}
if(my $BASE_ID = $DWARF_Info{$ID}{"specification"})
{
foreach my $Attr (keys(%{$TypeInfo{$BASE_ID}}))
{
if($Attr ne "Type") {
$TypeInfo{$ID}{$Attr} = $TypeInfo{$BASE_ID}{$Attr};
}
}
foreach my $Attr (keys(%{$TypeInfo{$ID}})) {
$TypeInfo{$BASE_ID}{$Attr} = $TypeInfo{$ID}{$Attr};
}
$TypeSpec{$ID} = $BASE_ID;
}
}
sub setSource($$)
{
my ($R, $ID) = @_;
my $File = $DWARF_Info{$ID}{"decl_file"};
my $Line = $DWARF_Info{$ID}{"decl_line"};
my $Unit = $DWARF_Info{$ID}{"Unit"};
if(defined $File)
{
my $Name = undef;
if($ID>=0) {
$Name = $SourceFile{$Unit}{$File};
}
else
{ # imported
$Name = $SourceFile_Alt{0}{$File};
}
if($Name=~/\.($HEADER_EXT)\Z/i)
{ # header
$R->{"Header"} = $Name;
if(defined $Line) {
$R->{"Line"} = $Line;
}
}
elsif(index($Name, "<built-in>")==-1)
{ # source
$R->{"Source"} = $Name;
if(defined $Line) {
$R->{"SourceLine"} = $Line;
}
}
}
}
sub skipSymbol($)
{
if($SkipCxx and not $STDCXX_TARGET)
{
if($_[0]=~/\A(_ZS|_ZNS|_ZNKS|_ZN9__gnu_cxx|_ZNK9__gnu_cxx|_ZTIS|_ZTSS|_Zd|_Zn)/)
{ # stdc++ symbols
return 1;
}
}
return 0;
}
sub find_center($$)
{
my ($Name, $Target) = @_;
my %B = ( "("=>0, "<"=>0, ")"=>0, ">"=>0 );
foreach my $Pos (0 .. length($Name)-1)
{
my $S = substr($Name, length($Name)-1-$Pos, 1);
if(defined $B{$S}) {
$B{$S}+=1;
}
if($S eq $Target)
{
if($B{"("}==$B{")"}
and $B{"<"}==$B{">"}) {
return length($Name)-1-$Pos;
}
}
}
return 0;
}
sub isExternal($)
{
my $ID = $_[0];
if($DWARF_Info{$ID}{"external"}) {
return 1;
}
elsif(my $Spec = $DWARF_Info{$ID}{"specification"})
{
if($DWARF_Info{$Spec}{"external"}) {
return 1;
}
}
return 0;
}
sub symByAddr($)
{
my $Loc = $_[0];
my ($Addr, $Sect) = ("", "");
#Modified to match readelf instead of eu-readelf.
if($Loc=~/0x(.+)/)
{
$Addr = $1;
if(not $Addr=~s/\A0x//)
{
$Addr=~s/\A00//;
}
}
if($Loc=~/([\w\.]+)\+/) {
$Sect = $1;
}
if($Addr ne "")
{
foreach ($Sect, "")
{
if(defined $SymbolTable{$_}{$Addr})
{
if(my @Symbols = sort keys(%{$SymbolTable{$_}{$Addr}})) {
return $Symbols[0];
}
}
}
}
return undef;
}
sub get_Mangled($)
{
my $ID = $_[0];
if(not defined $AddrToName)
{
if(my $Link = $DWARF_Info{$ID}{"linkage_name"})
{
return $Link;
}
}
if(my $Low_Pc = $DWARF_Info{$ID}{"low_pc"})
{
if($Low_Pc=~/<([\w\@\.]+)>/) {
return $1;
}
else
{
if(my $Symbol = symByAddr($Low_Pc)) {
return $Symbol;
}
}
}
if(my $Loc = $DWARF_Info{$ID}{"location"})
{
if($Loc=~/<([\w\@\.]+)>/) {
return $1;
}
else
{
if(my $Symbol = symByAddr($Loc)) {
return $Symbol;
}
}
}
if(my $Link = $DWARF_Info{$ID}{"linkage_name"})
{
return $Link;
}
return undef;
}
sub completeNS($)
{
my $ID = $_[0];
my $NS = undef;
my $ID_ = $ID;
my @NSs = ();
while($NS = $NameSpace{$ID_}
or $NS = $NameSpace{$DWARF_Info{$ID_}{"specification"}})
{
if(my $N = $DWARF_Info{$NS}{"name"}) {
push(@NSs, $N);
}
$ID_ = $NS;
}
if(@NSs)
{
my $N = join("::", reverse(@NSs));
$NestedNameSpaces{$N} = 1;
return $N;
}
return undef;
}
sub getSymbolInfo($)
{
my $ID = $_[0];
if(my $N = $NameSpace{$ID})
{
if($DWARF_Info{$N}{"Kind"} eq "lexical_block"
or $DWARF_Info{$N}{"Kind"} eq "subprogram")
{ # local variables
return;
}
}
if(my $Loc = $DWARF_Info{$ID}{"location"})
{
if($Loc=~/ reg\d+\Z/)
{ # local variables
return;
}
}
my $ShortName = $DWARF_Info{$ID}{"name"};
my $MnglName = get_Mangled($ID);
if(not $MnglName)
{
if(my $Sp = $SpecElem{$ID})
{
$MnglName = get_Mangled($Sp);
if(not $MnglName)
{
if(my $Orig = $OrigElem{$Sp})
{
$MnglName = get_Mangled($Orig);
}
}
}
}
if(not $MnglName)
{
if(index($ShortName, "<")!=-1)
{ # template
return;
}
$MnglName = $ShortName;
}
if(skipSymbol($MnglName)) {
return;
}
if(index($MnglName, "\@")!=-1) {
$MnglName=~s/([\@]+.*?)\Z//;
}
if(not $MnglName) {
return;
}
if(index($MnglName, ".")!=-1)
{ # foo.part.14
# bar.isra.15
return;
}
if($MnglName=~/\W/)
{ # unmangled operators, etc.
return;
}
if($MnglName)
{
if(my $OLD_ID = $Mangled_ID{$MnglName})
{ # duplicates
if(not defined $SymbolInfo{$OLD_ID}{"Header"}
or not defined $SymbolInfo{$OLD_ID}{"Source"})
{
setSource($SymbolInfo{$OLD_ID}, $ID);
}
if(not defined $SymbolInfo{$OLD_ID}{"ShortName"}
and $ShortName) {
$SymbolInfo{$OLD_ID}{"ShortName"} = $ShortName;
}
if(defined $DWARF_Info{$OLD_ID}{"low_pc"}
or not defined $DWARF_Info{$ID}{"low_pc"})
{
if(defined $Checked_Spec{$MnglName}
or not $DWARF_Info{$ID}{"specification"})
{
if(not defined $SpecElem{$ID}
and not defined $OrigElem{$ID}) {
delete($DWARF_Info{$ID});
}
return;
}
}
}
}
my %SInfo = ();
if($ShortName) {
$SInfo{"ShortName"} = $ShortName;
}
$SInfo{"MnglName"} = $MnglName;
if($ShortName)
{
if($MnglName eq $ShortName)
{
delete($SInfo{"MnglName"});
$MnglName = $ShortName;
}
elsif(index($MnglName, "_Z")!=0)
{
if($SInfo{"ShortName"})
{
if(index($SInfo{"ShortName"}, ".")==-1) {
$SInfo{"Alias"} = $SInfo{"ShortName"};
}
$SInfo{"ShortName"} = $SInfo{"MnglName"};
}
delete($SInfo{"MnglName"});
$MnglName = $ShortName;
# $ShortName = $SInfo{"ShortName"};
}
}
else
{
if(index($MnglName, "_Z")!=0)
{
$SInfo{"ShortName"} = $SInfo{"MnglName"};
delete($SInfo{"MnglName"});
}
}
if(isExternal($ID)) {
$SInfo{"External"} = 1;
}
if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"})
{
if(isExternal($Orig)) {
$SInfo{"External"} = 1;
}
}
if(index($MnglName, "_ZNVK")==0)
{
$SInfo{"Const"} = 1;
$SInfo{"Volatile"} = 1;
}
elsif(index($MnglName, "_ZNV")==0) {
$SInfo{"Volatile"} = 1;
}
elsif(index($MnglName, "_ZNK")==0) {
$SInfo{"Const"} = 1;
}
if($DWARF_Info{$ID}{"artificial"}) {
$SInfo{"Artificial"} = 1;
}
my ($C, $D) = ();
if($MnglName=~/C[1-4][EI].+/)
{
$C = 1;
$SInfo{"Constructor"} = 1;
}
if($MnglName=~/D[0-4][EI].+/)
{
$D = 1;
$SInfo{"Destructor"} = 1;
}
if($C or $D)
{
if(my $Orig = $DWARF_Info{$ID}{"abstract_origin"})
{
if(my $InLine = $DWARF_Info{$Orig}{"inline"})
{
if(index($InLine, "declared_not_inlined")==0)
{
$SInfo{"InLine"} = 1;
$SInfo{"Artificial"} = 1;
}
}
setSource(\%SInfo, $Orig);
if(my $Spec = $DWARF_Info{$Orig}{"specification"})
{
setSource(\%SInfo, $Spec);
$SInfo{"ShortName"} = $DWARF_Info{$Spec}{"name"};
if($D) {
$SInfo{"ShortName"}=~s/\A\~//g;
}
if(my $Class = $NameSpace{$Spec}) {
$SInfo{"Class"} = $Class;
}
if(my $Virt = $DWARF_Info{$Spec}{"virtuality"})
{
if(index($Virt, "virtual")!=-1) {
$SInfo{"Virt"} = 1;
}
}
if(my $Access = $DWARF_Info{$Spec}{"accessibility"})
{
if($Access ne "public")
{ # default access of methods in the ABI dump is "public"
$SInfo{ucfirst($Access)} = 1;
}
}
else
{ # NOTE: default access of class methods in the debug info is "private"
if($TypeInfo{$SInfo{"Class"}}{"Type"} eq "Class")
{
$SInfo{"Private"} = 1;
}
}
# clean origin
delete($SymbolInfo{$Spec});
}
}
}
else
{
if(my $InLine = $DWARF_Info{$ID}{"inline"})
{
if(index($InLine, "declared_inlined")==0) {
$SInfo{"InLine"} = 1;
}
}
}
if(defined $AddrToName)
{
if(not $SInfo{"Alias"}
and not $SInfo{"Constructor"}
and not $SInfo{"Destructor"})
{
if(my $Linkage = $DWARF_Info{$ID}{"linkage_name"})
{
if($Linkage ne $MnglName) {
$SInfo{"Alias"} = $Linkage;
}
}
}
}
if($DWARF_Info{$ID}{"Kind"} eq "variable")
{ # global data
$SInfo{"Data"} = 1;
if(my $Spec = $DWARF_Info{$ID}{"specification"})
{
if($DWARF_Info{$Spec}{"Kind"} eq "member")
{
setSource(\%SInfo, $Spec);
$SInfo{"ShortName"} = $DWARF_Info{$Spec}{"name"};
if(my $NSp = $NameSpace{$Spec})
{
if($DWARF_Info{$NSp}{"Kind"} eq "namespace") {
$SInfo{"NameSpace"} = completeNS($Spec);
}
else {
$SInfo{"Class"} = $NSp;
}
}
}
}
}
if(my $Access = $DWARF_Info{$ID}{"accessibility"})
{
if($Access ne "public")
{ # default access of methods in the ABI dump is "public"
$SInfo{ucfirst($Access)} = 1;
}
}
elsif(not $DWARF_Info{$ID}{"specification"}
and not $DWARF_Info{$ID}{"abstract_origin"})
{
if(my $NS = $NameSpace{$ID})
{
if(defined $TypeInfo{$NS})
{ # NOTE: default access of class methods in the debug info is "private"
if($TypeInfo{$NS}{"Type"} eq "Class")
{
$SInfo{"Private"} = 1;
}
}
}
}
if(my $Class = $DWARF_Info{$ID}{"containing_type"})
{
$SInfo{"Class"} = $Class;
}
if(my $NS = $NameSpace{$ID})
{
if($DWARF_Info{$NS}{"Kind"} eq "namespace") {
$SInfo{"NameSpace"} = completeNS($ID);
}
else {
$SInfo{"Class"} = $NS;
}
}
if($SInfo{"Class"} and $MnglName
and index($MnglName, "_Z")!=0)
{
return;
}
if(my $Return = $DWARF_Info{$ID}{"type"})
{
$SInfo{"Return"} = $Return;
}
if(my $Spec = $DWARF_Info{$ID}{"specification"})
{
if(not $DWARF_Info{$ID}{"type"}) {
$SInfo{"Return"} = $DWARF_Info{$Spec}{"type"};
}
if(my $Value = $DWARF_Info{$Spec}{"const_value"})
{
if($Value=~/ block:\s*(.*?)\Z/) {
$Value = $1;
}
$SInfo{"Value"} = $Value;
}
}
if($SInfo{"ShortName"}=~/>\Z/)
{ # foo<T1, T2, ...>
my ($Short, @TParams) = ();
if(defined $TmplParam{$ID})
{
$Short = getShortName($SInfo{"ShortName"});
@TParams = get_TParams($ID);
@TParams = shortTParams($Short, @TParams);
}
else {
($Short, @TParams) = parse_TParams($SInfo{"ShortName"});
}
if(@TParams)
{
foreach my $Pos (0 .. $#TParams) {
$SInfo{"TParam"}{$Pos}{"name"} = formatName($TParams[$Pos], "T");
}
# simplify short name
$SInfo{"ShortName"} = $Short.formatName("<".join(", ", @TParams).">", "T");
}
}
elsif($SInfo{"ShortName"}=~/\Aoperator (\w.*)\Z/)
{ # operator type<T1>::name
$SInfo{"ShortName"} = "operator ".simpleName($1);
}
if(my $Virt = $DWARF_Info{$ID}{"virtuality"})
{
if(index($Virt, "virtual")!=-1)
{
if($D or defined $SpecElem{$ID}) {
$SInfo{"Virt"} = 1;
}
else {
$SInfo{"PureVirt"} = 1;
}
}
if((my $VirtPos = $DWARF_Info{$ID}{"vtable_elem_location"}) ne "")
{
$SInfo{"VirtPos"} = $VirtPos;
}
}
setSource(\%SInfo, $ID);
if(not $SInfo{"Header"})
{
if($SInfo{"Class"})
{ # detect missed header by class
if(defined $TypeInfo{$SInfo{"Class"}}{"Header"}) {
$SInfo{"Header"} = $TypeInfo{$SInfo{"Class"}}{"Header"};
}
}
}
if(not $SInfo{"Header"}
or ($SInfo{"External"} and not defined $PublicHeader{$SInfo{"Header"}}))
{
if($SInfo{"MnglName"} and defined $SymbolToHeader{$SInfo{"MnglName"}}) {
$SInfo{"Header"} = chooseHeader($SInfo{"MnglName"}, $SInfo{"Source"});
}
elsif(not $SInfo{"Class"}
and defined $SymbolToHeader{$SInfo{"ShortName"}}) {
$SInfo{"Header"} = chooseHeader($SInfo{"ShortName"}, $SInfo{"Source"});
}
}
if($SInfo{"Alias"})
{
if(defined $SymbolToHeader{$SInfo{"Alias"}}) {
$SInfo{"Header"} = chooseHeader($SInfo{"Alias"}, $SInfo{"Source"});
}
}
my $PPos = 0;
foreach my $Pos (sort {int($a) <=> int($b)} keys(%{$FuncParam{$ID}}))
{
my $ParamId = $FuncParam{$ID}{$Pos};
my $Offset = undef;
my $Reg = undef;
if(my $Sp = $SpecElem{$ID})
{
if(defined $FuncParam{$Sp}) {
$ParamId = $FuncParam{$Sp}{$Pos};
}
}
if((my $Loc = $DWARF_Info{$ParamId}{"location"}) ne "") {
$Offset = $Loc;
}
elsif((my $R = $DWARF_Info{$ParamId}{"register"}) ne "") {
$Reg = $RegName{$R};
}
elsif((my $LL = $DWARF_Info{$ParamId}{"location_list"}) ne "")
{
if(my $L = $DebugLoc{$LL})
{
if($L=~/reg(\d+)/) {
$Reg = $RegName{$1};
}
elsif($L=~/fbreg\s+(-?\w+)\Z/) {
$Offset = $1;
}
}
elsif(not defined $DebugLoc{$LL})
{ # invalid debug_loc
if(not $InvalidDebugLoc)
{
printMsg("ERROR", "invalid debug_loc section of object, please fix your elf utils");
$InvalidDebugLoc = 1;
}
}
}
if(my $Orig = $DWARF_Info{$ParamId}{"abstract_origin"}) {
$ParamId = $Orig;
}
my %PInfo = %{$DWARF_Info{$ParamId}};
if(defined $Offset
and not defined $IncompatibleOpt) {
$SInfo{"Param"}{$Pos}{"offset"} = $Offset;
}
if($TypeInfo{$PInfo{"type"}}{"Type"} eq "Const")
{
if(my $BTid = $TypeInfo{$PInfo{"type"}}{"BaseType"})
{
if($TypeInfo{$BTid}{"Type"} eq "Ref")
{ # const&const -> const&
$PInfo{"type"} = $BTid;
}
}
}
$SInfo{"Param"}{$Pos}{"type"} = $PInfo{"type"};
if(defined $PInfo{"name"}) {
$SInfo{"Param"}{$Pos}{"name"} = $PInfo{"name"};
}
elsif($TypeInfo{$PInfo{"type"}}{"Name"} ne "...") {
$SInfo{"Param"}{$Pos}{"name"} = "p".($PPos+1);
}
if(defined $Reg
and not defined $IncompatibleOpt)
{
$SInfo{"Reg"}{$Pos} = $Reg;
}
if($DWARF_Info{$ParamId}{"artificial"} and $Pos==0)
{
if($SInfo{"Param"}{$Pos}{"name"} eq "p1") {
$SInfo{"Param"}{$Pos}{"name"} = "this";
}
}
if($SInfo{"Param"}{$Pos}{"name"} ne "this")
{ # this, p1, p2, etc.
$PPos += 1;
}
}
if($SInfo{"Constructor"} and not $SInfo{"InLine"}
and $SInfo{"Class"}) {
delete($TypeInfo{$SInfo{"Class"}}{"Copied"});
}
if(my $BASE_ID = $Mangled_ID{$MnglName})
{
if(defined $SInfo{"Param"})
{
if(keys(%{$SInfo{"Param"}})!=keys(%{$SymbolInfo{$BASE_ID}{"Param"}}))
{ # different symbols with the same name
delete($SymbolInfo{$BASE_ID});
}
}
$ID = $BASE_ID;
if(defined $SymbolInfo{$ID}{"PureVirt"})
{ # if the specification of a symbol is located in other compile unit
delete($SymbolInfo{$ID}{"PureVirt"});
$SymbolInfo{$ID}{"Virt"} = 1;
}
}
$Mangled_ID{$MnglName} = $ID;
if($DWARF_Info{$ID}{"specification"}) {
$Checked_Spec{$MnglName} = 1;
}
foreach my $Attr (keys(%SInfo))
{
if(ref($SInfo{$Attr}) eq "HASH")
{
foreach my $K1 (keys(%{$SInfo{$Attr}}))
{
if(ref($SInfo{$Attr}{$K1}) eq "HASH")
{
foreach my $K2 (keys(%{$SInfo{$Attr}{$K1}}))
{
$SymbolInfo{$ID}{$Attr}{$K1}{$K2} = $SInfo{$Attr}{$K1}{$K2};
}
}
else {
$SymbolInfo{$ID}{$Attr}{$K1} = $SInfo{$Attr}{$K1};
}
}
}
else
{
$SymbolInfo{$ID}{$Attr} = $SInfo{$Attr};
}
}
if($ID>$GLOBAL_ID) {
$GLOBAL_ID = $ID;
}
}
sub chooseHeader($$)
{
my ($Symbol, $Source) = @_;
my @Headers = keys(%{$SymbolToHeader{$Symbol}});
if($#Headers==0) {
return $Headers[0];
}
$Source=~s/\.\w+\Z//g;
foreach my $Header (@Headers)
{
if($Header=~/\A\Q$Source\E(|\.[\w\+]+)\Z/) {
return $Header;
}
}
@Headers = sort {length($a)<=>length($b)} sort {lc($a) cmp lc($b)} @Headers;
return $Headers[0];
}
sub getTypeIdByName($$)
{
my ($Type, $Name) = @_;
return $TName_Tid{$Type}{formatName($Name, "T")};
}
sub getFirst($)
{
my $Tid = $_[0];
if(not $Tid) {
return $Tid;
}
if(defined $TypeSpec{$Tid}) {
$Tid = $TypeSpec{$Tid};
}
my $F = 0;
if(my $Name = $TypeInfo{$Tid}{"Name"})
{
my $Type = $TypeInfo{$Tid}{"Type"};
if($Name=~s/\Astruct //)
{ # search for class or derived types (const, *, etc.)
$F = 1;
}
my $FTid = undef;
if($F)
{
foreach my $Type ("Class", "Const", "Ref", "RvalueRef", "Pointer")
{
if($FTid = $TName_Tid{$Type}{$Name})
{
if($FTid ne $Tid)
{
$MergedTypes{$Tid} = 1;
}
return "$FTid";
}
}
$Name = "struct ".$Name;
}
if(not $FTid) {
$FTid = $TName_Tid{$Type}{$Name};
}
if($FTid) {
return "$FTid";
}
printMsg("ERROR", "internal error (missed type id $Tid)");
}
return $Tid;
}
sub searchTypeID($)
{
my $Name = $_[0];
my %Pr = map {$_=>1} (
"Struct",
"Union",
"Enum"
);
foreach my $Type ("Class", "Struct", "Union", "Enum", "Typedef", "Const",
"Volatile", "Ref", "RvalueRef", "Pointer", "FuncPtr", "MethodPtr", "FieldPtr")
{
my $Tid = $TName_Tid{$Type}{$Name};
if(not $Tid)
{
my $P = "";
if(defined $Pr{$Type})
{
$P = lc($Type)." ";
}
$Tid = $TName_Tid{$Type}{$P.$Name}
}
if($Tid) {
return $Tid;
}
}
return undef;
}
sub remove_Unused()
{ # remove unused data types from the ABI dump
%HeadersInfo = ();
%SourcesInfo = ();
my (%SelectedHeaders, %SelectedSources) = ();
foreach my $ID (sort {int($a)<=>int($b)} keys(%SymbolInfo))
{
if($SelectedSymbols{$ID}==2)
{ # data, inline, pure
next;
}
register_SymbolUsage($ID);
if(my $H = $SymbolInfo{$ID}{"Header"}) {
$SelectedHeaders{$H} = 1;
}
if(my $S = $SymbolInfo{$ID}{"Source"}) {
$SelectedSources{$S} = 1;
}
}
foreach my $ID (sort {int($a)<=>int($b)} keys(%SymbolInfo))
{
if($SelectedSymbols{$ID}==2)
{ # data, inline, pure
my $Save = 0;
if(my $Class = $SymbolInfo{$ID}{"Class"})
{
if(defined $UsedType{$Class}) {
$Save = 1;
}
else
{
foreach (keys(%{$ClassChild{$Class}}))
{
if(defined $UsedType{$_})
{
$Save = 1;
last;
}
}
}
}
if(my $Header = $SymbolInfo{$ID}{"Header"})
{
if(defined $SelectedHeaders{$Header}) {
$Save = 1;
}
}
if(my $Source = $SymbolInfo{$ID}{"Source"})
{
if(defined $SelectedSources{$Source}) {
$Save = 1;
}
}
if($Save) {
register_SymbolUsage($ID);
}
else {
delete($SymbolInfo{$ID});
}
}
}
if(defined $AllTypes)
{
# register all data types (except anon structs and unions)
foreach my $Tid (keys(%TypeInfo))
{
if(defined $LocalType{$Tid})
{ # except local code
next;
}
if($TypeInfo{$Tid}{"Type"} eq "Enum"
or index($TypeInfo{$Tid}{"Name"}, "anon-")!=0) {
register_TypeUsage($Tid);
}
}
# remove unused anons (except enums)
foreach my $Tid (keys(%TypeInfo))
{
if(not $UsedType{$Tid})
{
if($TypeInfo{$Tid}{"Type"} ne "Enum")
{
if(index($TypeInfo{$Tid}{"Name"}, "anon-")==0) {
delete($TypeInfo{$Tid});
}
}
}
}
# remove duplicates
foreach my $Tid (keys(%TypeInfo))
{
my $Name = $TypeInfo{$Tid}{"Name"};
my $Type = $TypeInfo{$Tid}{"Type"};
if($TName_Tid{$Type}{$Name} ne $Tid) {
delete($TypeInfo{$Tid});
}
}
}
else
{
foreach my $Tid (keys(%TypeInfo))
{ # remove unused types
if(not $UsedType{$Tid}) {
delete($TypeInfo{$Tid});
}
}
}
foreach my $Tid (keys(%MergedTypes)) {
delete($TypeInfo{$Tid});
}
foreach my $Tid (keys(%LocalType))
{
if(not $UsedType{$Tid}) {
delete($TypeInfo{$Tid});
}
}
# clean memory
%MergedTypes = ();
%LocalType = ();
# completeness
foreach my $Tid (sort keys(%TypeInfo)) {
check_Completeness($TypeInfo{$Tid});
}
foreach my $Sid (sort keys(%SymbolInfo)) {
check_Completeness($SymbolInfo{$Sid});
}
# clean memory
%UsedType = ();
}
sub simpleName($)
{
my $N = $_[0];
$N=~s/\A(struct|class|union|enum) //; # struct, class, union, enum
if(index($N, "std::basic_string")!=-1)
{
$N=~s/std::basic_string<char, std::char_traits<char>, std::allocator<char> >/std::string /g;
$N=~s/std::basic_string<char, std::char_traits<char> >/std::string /g;
$N=~s/std::basic_string<char>/std::string /g;
}
return formatName($N, "T");
}
sub register_SymbolUsage($)
{
my $InfoId = $_[0];
my %FuncInfo = %{$SymbolInfo{$InfoId}};
if(my $S = $FuncInfo{"Source"}) {
$SourcesInfo{$S} = 1;
}
if(my $H = $FuncInfo{"Header"}) {
$HeadersInfo{$H} = 1;
}
if(my $RTid = getFirst($FuncInfo{"Return"}))
{
register_TypeUsage($RTid);
$SymbolInfo{$InfoId}{"Return"} = $RTid;
}
if(my $FCid = getFirst($FuncInfo{"Class"}))
{
register_TypeUsage($FCid);
$SymbolInfo{$InfoId}{"Class"} = $FCid;
if(my $ThisId = getTypeIdByName("Const", $TypeInfo{$FCid}{"Name"}."*const"))
{ # register "this" pointer
register_TypeUsage($ThisId);
}
if(my $ThisId_C = getTypeIdByName("Const", $TypeInfo{$FCid}{"Name"}." const*const"))
{ # register "this" pointer (const method)
register_TypeUsage($ThisId_C);
}
}
foreach my $PPos (keys(%{$FuncInfo{"Param"}}))
{
if(my $PTid = getFirst($FuncInfo{"Param"}{$PPos}{"type"}))
{
register_TypeUsage($PTid);
$SymbolInfo{$InfoId}{"Param"}{$PPos}{"type"} = $PTid;
}
}
foreach my $TPos (keys(%{$FuncInfo{"TParam"}}))
{
my $TPName = $FuncInfo{"TParam"}{$TPos}{"name"};
if(my $TTid = searchTypeID($TPName))
{
if(my $FTTid = getFirst($TTid)) {
register_TypeUsage($FTTid);
}
}
}
}
sub register_TypeUsage($)
{
my $TypeId = $_[0];
if(not $TypeId) {
return 0;
}
if($UsedType{$TypeId})
{ # already registered
return 1;
}
my %TInfo = %{$TypeInfo{$TypeId}};
if(my $S = $TInfo{"Source"}) {
$SourcesInfo{$S} = 1;
}
if(my $H = $TInfo{"Header"}) {
$HeadersInfo{$H} = 1;
}
if($TInfo{"Type"})
{
if(my $NS = $TInfo{"NameSpace"})
{
if(my $NSTid = searchTypeID($NS))
{
if(my $FNSTid = getFirst($NSTid)) {
register_TypeUsage($FNSTid);
}
}
}
if($TInfo{"Type"}=~/\A(Struct|Union|Class|FuncPtr|Func|MethodPtr|FieldPtr|Enum)\Z/)
{
$UsedType{$TypeId} = 1;
if($TInfo{"Type"}=~/\A(Struct|Class)\Z/)
{
foreach my $BaseId (keys(%{$TInfo{"Base"}}))
{ # register base classes
if(my $FBaseId = getFirst($BaseId))
{
register_TypeUsage($FBaseId);
if($FBaseId ne $BaseId)
{
%{$TypeInfo{$TypeId}{"Base"}{$FBaseId}} = %{$TypeInfo{$TypeId}{"Base"}{$BaseId}};
delete($TypeInfo{$TypeId}{"Base"}{$BaseId});
}
}
}
foreach my $TPos (keys(%{$TInfo{"TParam"}}))
{
my $TPName = $TInfo{"TParam"}{$TPos}{"name"};
if(my $TTid = searchTypeID($TPName))
{
if(my $FTTid = getFirst($TTid)) {
register_TypeUsage($FTTid);
}
}
}
}
foreach my $Memb_Pos (keys(%{$TInfo{"Memb"}}))
{
if(my $MTid = getFirst($TInfo{"Memb"}{$Memb_Pos}{"type"}))
{
register_TypeUsage($MTid);
$TypeInfo{$TypeId}{"Memb"}{$Memb_Pos}{"type"} = $MTid;
}
}
if($TInfo{"Type"} eq "FuncPtr"
or $TInfo{"Type"} eq "MethodPtr"
or $TInfo{"Type"} eq "Func")
{
if(my $RTid = getFirst($TInfo{"Return"}))
{
register_TypeUsage($RTid);
$TypeInfo{$TypeId}{"Return"} = $RTid;
}
foreach my $Memb_Pos (keys(%{$TInfo{"Param"}}))
{
if(my $MTid = getFirst($TInfo{"Param"}{$Memb_Pos}{"type"}))
{
register_TypeUsage($MTid);
$TypeInfo{$TypeId}{"Param"}{$Memb_Pos}{"type"} = $MTid;
}
}
}
if($TInfo{"Type"} eq "FieldPtr")
{
if(my $RTid = getFirst($TInfo{"Return"}))
{
register_TypeUsage($RTid);
$TypeInfo{$TypeId}{"Return"} = $RTid;
}
if(my $CTid = getFirst($TInfo{"Class"}))
{
register_TypeUsage($CTid);
$TypeInfo{$TypeId}{"Class"} = $CTid;
}
}
if($TInfo{"Type"} eq "MethodPtr")
{
if(my $CTid = getFirst($TInfo{"Class"}))
{
register_TypeUsage($CTid);
$TypeInfo{$TypeId}{"Class"} = $CTid;
}
}
if($TInfo{"Type"} eq "Enum")
{
if(my $BTid = getFirst($TInfo{"BaseType"}))
{
register_TypeUsage($BTid);
$TypeInfo{$TypeId}{"BaseType"} = $BTid;
}
}
return 1;
}
elsif($TInfo{"Type"}=~/\A(Const|ConstVolatile|Volatile|Pointer|Ref|RvalueRef|Restrict|Array|Typedef)\Z/)
{
$UsedType{$TypeId} = 1;
if(my $BTid = getFirst($TInfo{"BaseType"}))
{
register_TypeUsage($BTid);
$TypeInfo{$TypeId}{"BaseType"} = $BTid;
}
return 1;
}
elsif($TInfo{"Type"} eq "Intrinsic")
{
$UsedType{$TypeId} = 1;
return 1;
}
}
return 0;
}
my %CheckedType = ();
sub check_Completeness($)
{
my $Info = $_[0];
# data types
if(defined $Info->{"Memb"})
{
foreach my $Pos (sort keys(%{$Info->{"Memb"}}))
{
if(defined $Info->{"Memb"}{$Pos}{"type"}) {
check_TypeInfo($Info->{"Memb"}{$Pos}{"type"});
}
}
}
if(defined $Info->{"Base"})
{
foreach my $Bid (sort keys(%{$Info->{"Base"}})) {
check_TypeInfo($Bid);
}
}
if(defined $Info->{"BaseType"}) {
check_TypeInfo($Info->{"BaseType"});
}
if(defined $Info->{"TParam"})
{
foreach my $Pos (sort keys(%{$Info->{"TParam"}}))
{
my $TName = $Info->{"TParam"}{$Pos}{"name"};
if($TName=~/\A(true|false|\d.*)\Z/) {
next;
}
if(my $Tid = searchTypeID($TName)) {
check_TypeInfo($Tid);
}
else
{
if(defined $Loud) {
printMsg("WARNING", "missed type $TName");
}
}
}
}
# symbols
if(defined $Info->{"Param"})
{
foreach my $Pos (sort keys(%{$Info->{"Param"}}))
{
if(defined $Info->{"Param"}{$Pos}{"type"}) {
check_TypeInfo($Info->{"Param"}{$Pos}{"type"});
}
}
}
if(defined $Info->{"Return"}) {
check_TypeInfo($Info->{"Return"});
}
if(defined $Info->{"Class"}) {
check_TypeInfo($Info->{"Class"});
}
}
sub check_TypeInfo($)
{
my $Tid = $_[0];
if(defined $CheckedType{$Tid}) {
return;
}
$CheckedType{$Tid} = 1;
if(defined $TypeInfo{$Tid})
{
if(not $TypeInfo{$Tid}{"Name"}) {
printMsg("ERROR", "missed type name ($Tid)");
}
check_Completeness($TypeInfo{$Tid});
}
else {
printMsg("ERROR", "missed type id $Tid");
}
}
sub init_Registers()
{
if($SYS_ARCH eq "x86")
{
%RegName = (
# integer registers
# 32 bits
"0"=>"eax",
"1"=>"ecx",
"2"=>"edx",
"3"=>"ebx",
"4"=>"esp",
"5"=>"ebp",
"6"=>"esi",
"7"=>"edi",
"8"=>"eip",
"9"=>"eflags",
"10"=>"trapno",
# FPU-control registers
# 16 bits
"37"=>"fctrl",
"38"=>"fstat",
# 32 bits
"39"=>"mxcsr",
# MMX registers
# 64 bits
"29"=>"mm0",
"30"=>"mm1",
"31"=>"mm2",
"32"=>"mm3",
"33"=>"mm4",
"34"=>"mm5",
"35"=>"mm6",
"36"=>"mm7",
# SSE registers
# 128 bits
"21"=>"xmm0",
"22"=>"xmm1",
"23"=>"xmm2",
"24"=>"xmm3",
"25"=>"xmm4",
"26"=>"xmm5",
"27"=>"xmm6",
"28"=>"xmm7",
# segment registers
# 16 bits
"40"=>"es",
"41"=>"cs",
"42"=>"ss",
"43"=>"ds",
"44"=>"fs",
"45"=>"gs",
# x87 registers
# 80 bits
"11"=>"st0",
"12"=>"st1",
"13"=>"st2",
"14"=>"st3",
"15"=>"st4",
"16"=>"st5",
"17"=>"st6",
"18"=>"st7"
);
}
elsif($SYS_ARCH eq "x86_64")
{
%RegName = (
# integer registers
# 64 bits
"0"=>"rax",
"1"=>"rdx",
"2"=>"rcx",
"3"=>"rbx",
"4"=>"rsi",
"5"=>"rdi",
"6"=>"rbp",
"7"=>"rsp",
"8"=>"r8",
"9"=>"r9",
"10"=>"r10",
"11"=>"r11",
"12"=>"r12",
"13"=>"r13",
"14"=>"r14",
"15"=>"r15",
"16"=>"rip",
"49"=>"rFLAGS",
# MMX registers
# 64 bits
"41"=>"mm0",
"42"=>"mm1",
"43"=>"mm2",
"44"=>"mm3",
"45"=>"mm4",
"46"=>"mm5",
"47"=>"mm6",
"48"=>"mm7",
# SSE registers
# 128 bits
"17"=>"xmm0",
"18"=>"xmm1",
"19"=>"xmm2",
"20"=>"xmm3",
"21"=>"xmm4",
"22"=>"xmm5",
"23"=>"xmm6",
"24"=>"xmm7",
"25"=>"xmm8",
"26"=>"xmm9",
"27"=>"xmm10",
"28"=>"xmm11",
"29"=>"xmm12",
"30"=>"xmm13",
"31"=>"xmm14",
"32"=>"xmm15",
# control registers
# 64 bits
"62"=>"tr",
"63"=>"ldtr",
"64"=>"mxcsr",
# 16 bits
"65"=>"fcw",
"66"=>"fsw",
# segment registers
# 16 bits
"50"=>"es",
"51"=>"cs",
"52"=>"ss",
"53"=>"ds",
"54"=>"fs",
"55"=>"gs",
# 64 bits
"58"=>"fs.base",
"59"=>"gs.base",
# x87 registers
# 80 bits
"33"=>"st0",
"34"=>"st1",
"35"=>"st2",
"36"=>"st3",
"37"=>"st4",
"38"=>"st5",
"39"=>"st6",
"40"=>"st7"
);
}
elsif($SYS_ARCH eq "arm")
{
%RegName = (
# integer registers
# 32-bit
"0"=>"r0",
"1"=>"r1",
"2"=>"r2",
"3"=>"r3",
"4"=>"r4",
"5"=>"r5",
"6"=>"r6",
"7"=>"r7",
"8"=>"r8",
"9"=>"r9",
"10"=>"r10",
"11"=>"r11",
"12"=>"r12",
"13"=>"r13",
"14"=>"r14",
"15"=>"r15"
);
}
}
sub dump_sorting($)
{
my $Hash = $_[0];
return [] if(not $Hash);
my @Keys = keys(%{$Hash});
return [] if($#Keys<0);
if($Keys[0]=~/\A\d+\Z/)
{ # numbers
return [sort {int($a)<=>int($b)} @Keys];
}
else
{ # strings
return [sort {$a cmp $b} @Keys];
}
}
sub getDebugFile($$)
{
my ($Obj, $Header) = @_;
my $Str = `$READELF_L --strings=.$Header \"$Obj\" 2>\"$TMP_DIR/error\"`;
if($Str=~/(\s|\[)0\]\s*(.+)/) {
return $2;
}
return undef;
}
sub findFiles(@)
{
my ($Path, $Type) = @_;
my $Cmd = "find \"$Path\"";
if($Type) {
$Cmd .= " -type ".$Type;
}
my @Res = split(/\n/, `$Cmd`);
return @Res;
}
sub isHeader($)
{
my $Path = $_[0];
return ($Path=~/\.($HEADER_EXT)\Z/i);
}
sub detectPublicSymbols($)
{
my $Path = $_[0];
if(not -e $Path) {
exitStatus("Access_Error", "can't access \'$Path\'");
}
my $Path_A = abs_path($Path);
printMsg("INFO", "Detect public symbols");
if($UseTU)
{
if(not check_Cmd($GPP))
{
printMsg("ERROR", "can't find \"$GPP\"");
return;
}
}
else
{
if(not check_Cmd($CTAGS))
{
printMsg("ERROR", "can't find \"$CTAGS\"");
return;
}
}
$PublicSymbols_Detected = 1;
my @Files = ();
my @Headers = ();
my @DefaultInc = ();
if(-f $Path)
{ # list of headers
@Headers = split(/\n/, readFile($Path));
}
elsif(-d $Path)
{ # directory
@Files = findFiles($Path, "f");
foreach my $File (@Files)
{
if(isHeader($File)) {
push(@Headers, $File);
}
}
push(@DefaultInc, $Path_A);
if(-d $Path_A."/include") {
push(@DefaultInc, $Path_A."/include");
}
}
my $PublicHeader_F = $CacheHeaders."/PublicHeader.data";
my $SymbolToHeader_F = $CacheHeaders."/SymbolToHeader.data";
my $TypeToHeader_F = $CacheHeaders."/TypeToHeader.data";
my $Path_F = $CacheHeaders."/PATH";
if($CacheHeaders
and -f $PublicHeader_F
and -f $SymbolToHeader_F
and -f $TypeToHeader_F
and -f $Path_F)
{
if(readFile($Path_F) eq $Path_A)
{
%PublicHeader = %{eval(readFile($PublicHeader_F))};
%SymbolToHeader = %{eval(readFile($SymbolToHeader_F))};
%TypeToHeader = %{eval(readFile($TypeToHeader_F))};
return;
}
}
foreach my $File (@Headers)
{
$PublicHeader{getFilename($File)} = 1;
}
my $Is_C = ($OBJ_LANG eq "C");
foreach my $File (sort {length($b)<=>length($a)} sort {lc($b) cmp lc($a)} @Headers)
{
my $HName = getFilename($File);
if($UseTU)
{
my $TmpDir = $TMP_DIR."/tu";
if(not -d $TmpDir) {
mkpath($TmpDir);
}
my $File_A = abs_path($File);
my $IncDir = getDirname($File_A);
my $IncDir_O = getDirname($IncDir);
my $TmpInc = $TmpDir."/tmp-inc.h";
my $TmpContent = "";
if($IncludePreamble)
{
foreach my $P (split(/;/, $IncludePreamble))
{
if($P=~/\A\//) {
$TmpContent = "#include \"".$P."\"\n";
}
else {
$TmpContent = "#include <".$P.">\n";
}
}
}
$TmpContent .= "#include \"$File_A\"\n";
writeFile($TmpInc, $TmpContent);
my $Cmd = $GPP." -w -fpermissive -fdump-translation-unit -fkeep-inline-functions -c \"$TmpInc\"";
if(defined $IncludePaths)
{
foreach my $P (split(/;/, $IncludePaths))
{
if($P!~/\A\//) {
$P = $Path_A."/".$P;
}
$Cmd .= " -I\"".$P."\"";
}
}
else
{ # automatic
$Cmd .= " -I\"$IncDir\" -I\"$IncDir_O\"";
}
foreach my $P (@DefaultInc) {
$Cmd .= " -I\"$P\"";
}
$Cmd .= " -o ./a.out >OUT 2>&1";
chdir($TmpDir);
system($Cmd);
chdir($ORIG_DIR);
my $TuDump = $TmpDir."/tmp-inc.h.001t.tu";
if(not -e $TuDump)
{
printMsg("ERROR", "failed to list symbols in the header \'$HName\'");
next;
}
elsif($?) {
printMsg("ERROR", "some errors occured when compiling header \'$HName\'");
}
my (%Fdecl, %Tdecl, %Tname, %Ident, %NotDecl) = ();
my $Content = readFile($TuDump);
$Content=~s/\n[ ]+/ /g;
my @Lines = split(/\n/, $Content);
foreach my $N (0 .. $#Lines)
{
my $Line = $Lines[$N];
if(index($Line, "function_decl")!=-1
or index($Line, "var_decl")!=-1)
{
if($Line=~/name: \@(\d+)/)
{
my $Id = $1;
if($Line=~/srcp: ([^:]+)\:\d/)
{
if(defined $PublicHeader{$1}) {
$Fdecl{$Id} = $1;
}
}
}
}
elsif($Line=~/\@(\d+)\s+identifier_node\s+strg:\s+(\w+)/)
{
$Ident{$1} = $2;
}
elsif($Is_C)
{
if(index($Line, "type_decl")!=-1)
{
if($Line=~/\A\@(\d+)/)
{
my $Id = $1;
if($Line=~/name: \@(\d+)/)
{
my $NId = $1;
if($Line=~/srcp: ([^:]+)\:\d/)
{
if(defined $PublicHeader{$1})
{
$Tdecl{$Id} = $1;
$Tname{$Id} = $NId;
}
}
}
}
}
elsif(index($Line, "record_type")!=-1
or index($Line, "union_type")!=-1)
{
if($Line!~/ flds:/)
{
if($Line=~/name: \@(\d+)/)
{
$NotDecl{$1} = 1;
}
}
}
elsif(index($Line, "enumeral_type")!=-1)
{
if($Line!~/ csts:/)
{
if($Line=~/name: \@(\d+)/)
{
$NotDecl{$1} = 1;
}
}
}
elsif(index($Line, "integer_type")!=-1)
{
if($Line=~/name: \@(\d+)/)
{
$NotDecl{$1} = 1;
}
}
}
}
foreach my $Id (keys(%Fdecl))
{
if(my $Name = $Ident{$Id}) {
$SymbolToHeader{$Name}{$Fdecl{$Id}} = 1;
}
}
if($Is_C)
{
foreach my $Id (keys(%Tdecl))
{
if(defined $NotDecl{$Id}) {
next;
}
if(my $Name = $Ident{$Tname{$Id}}) {
$TypeToHeader{$Name} = $Tdecl{$Id};
}
}
}
unlink($TuDump);
}
else
{ # using Ctags
my $IgnoreTags = "";
if(defined $IgnoreTagsPath) {
$IgnoreTags = "-I \@".$IgnoreTagsPath;
}
my $List_S = `$CTAGS -x --c-kinds=fpvx $IgnoreTags \"$File\"`;
foreach my $Line (split(/\n/, $List_S))
{
if($Line=~/\A(\w+)/) {
$SymbolToHeader{$1}{$HName} = 1;
}
}
if($Is_C)
{
my $List_T = `$CTAGS -x --c-kinds=gstu --language-force=c $IgnoreTags \"$File\"`;
foreach my $Line (split(/\n/, $List_T))
{
if($Line=~/\A(\w+)/)
{
my $N = $1;
if($Line!~/\b$N\s+$N\b/) {
$TypeToHeader{$N} = $HName;
}
}
}
}
}
}
if($CacheHeaders)
{
writeFile($PublicHeader_F, Dumper(\%PublicHeader));
writeFile($SymbolToHeader_F, Dumper(\%SymbolToHeader));
writeFile($TypeToHeader_F, Dumper(\%TypeToHeader));
writeFile($Path_F, $Path_A);
}
}
sub getDebugAltLink($)
{
my $Obj = $_[0];
my $AltDebugFile = getDebugFile($Obj, "gnu_debugaltlink");
if(not $AltDebugFile) {
return undef;
}
my $Dir = getDirname($Obj);
my $AltObj_R = $AltDebugFile;
if($Dir and $Dir ne ".") {
$AltObj_R = $Dir."/".$AltObj_R;
}
if(-e $AltObj_R)
{
printMsg("INFO", "Set alternate debug-info file to \'$AltObj_R\' (use -alt option to change it)");
return $AltObj_R;
}
printMsg("WARNING", "can't access \'$AltObj_R\'");
return undef;
}
sub scenario()
{
$READELF_L = $LOCALE." ".abs_path($READELF);
$GPP = abs_path($GPP);
$OBJDUMP = abs_path($OBJDUMP);
if($Help)
{
HELP_MESSAGE();
exit(0);
}
if($ShowVersion)
{
printMsg("INFO", "ABI Dumper $TOOL_VERSION");
printMsg("INFO", "Copyright (C) 2016 Andrey Ponomarenko's ABI Laboratory");
printMsg("INFO", "License: LGPL or GPL <http://www.gnu.org/licenses/>");
printMsg("INFO", "This program is free software: you can redistribute it and/or modify it.\n");
printMsg("INFO", "Written by Andrey Ponomarenko.");
exit(0);
}
if($DumpVersion)
{
printMsg("INFO", $TOOL_VERSION);
exit(0);
}
$Data::Dumper::Sortkeys = 1;
if($SortDump) {
$Data::Dumper::Sortkeys = \&dump_sorting;
}
if($SearchDirDebuginfo)
{
if(not -d $SearchDirDebuginfo) {
exitStatus("Access_Error", "can't access directory \'$SearchDirDebuginfo\'");
}
}
if($PublicHeadersPath)
{
if(not -e $PublicHeadersPath) {
exitStatus("Access_Error", "can't access \'$PublicHeadersPath\'");
}
foreach my $P (split(/;/, $IncludePaths))
{
if($P!~/\A\//) {
$P = $PublicHeadersPath."/".$P;
}
if(not -e $P) {
exitStatus("Access_Error", "can't access \'$P\'");
}
}
}
if($SymbolsListPath)
{
if(not -f $SymbolsListPath) {
exitStatus("Access_Error", "can't access file \'$SymbolsListPath\'");
}
foreach my $S (split(/\s*\n\s*/, readFile($SymbolsListPath))) {
$SymbolsList{$S} = 1;
}
}
if($VTDumperPath)
{
if(not -x $VTDumperPath) {
exitStatus("Access_Error", "can't access \'$VTDumperPath\'");
}
$VTABLE_DUMPER = $VTDumperPath;
}
if(defined $Compare)
{
my $P1 = $ARGV[0];
my $P2 = $ARGV[1];
if(not $P1) {
exitStatus("Error", "arguments are not specified");
}
elsif(not -e $P1) {
exitStatus("Access_Error", "can't access \'$P1\'");
}
if(not $P2) {
exitStatus("Error", "second argument is not specified");
}
elsif(not -e $P2) {
exitStatus("Access_Error", "can't access \'$P2\'");
}
my %ABI = ();
$ABI{1} = eval(readFile($P1));
$ABI{2} = eval(readFile($P2));
my %SymInfo = ();
foreach (1, 2)
{
foreach my $ID (keys(%{$ABI{$_}->{"SymbolInfo"}}))
{
my $Info = $ABI{$_}->{"SymbolInfo"}{$ID};
if(my $MnglName = $Info->{"MnglName"}) {
$SymInfo{$_}{$MnglName} = $Info;
}
elsif(my $ShortName = $Info->{"ShortName"}) {
$SymInfo{$_}{$ShortName} = $Info;
}
}
}
foreach my $Symbol (sort keys(%{$SymInfo{1}}))
{
if(not defined $SymInfo{2}{$Symbol}) {
printMsg("INFO", "Removed $Symbol");
}
}
foreach my $Symbol (sort keys(%{$SymInfo{2}}))
{
if(not defined $SymInfo{1}{$Symbol}) {
printMsg("INFO", "Added $Symbol");
}
}
exit(0);
}
if(not $TargetVersion) {
printMsg("WARNING", "module version is not specified (-lver NUM)");
}
if($FullDump)
{
$AllTypes = 1;
$AllSymbols = 1;
}
if(not $OutputDump) {
$OutputDump = "./ABI.dump";
}
if(not @ARGV) {
exitStatus("Error", "object path is not specified");
}
foreach my $Obj (@ARGV)
{
if(not -e $Obj) {
exitStatus("Access_Error", "can't access \'$Obj\'");
}
}
if($AltDebugInfoOpt)
{
if(not -e $AltDebugInfoOpt) {
exitStatus("Access_Error", "can't access \'$AltDebugInfoOpt\'");
}
$AltDebugInfo = $AltDebugInfoOpt;
read_Alt_Info($AltDebugInfoOpt);
}
if($ExtraInfo)
{
mkpath($ExtraInfo);
$ExtraInfo = abs_path($ExtraInfo);
}
init_ABI();
my $Res = 0;
foreach my $Obj (@ARGV)
{
if(not $TargetName)
{
$TargetName = getFilename(realpath($Obj));
$TargetName=~s/\.debug\Z//; # nouveau.ko.debug
if(index($TargetName, "libstdc++.so")==0) {
$STDCXX_TARGET = 1;
}
}
read_Symbols($Obj);
if(not defined $PublicSymbols_Detected)
{
if(defined $PublicHeadersPath) {
detectPublicSymbols($PublicHeadersPath);
}
}
$Res += read_DWARF_Info($Obj);
%DWARF_Info = ();
%ImportedUnit = ();
%ImportedDecl = ();
read_Vtables($Obj);
}
if(not defined $Library_Symbol{$TargetName}) {
exitStatus("Error", "can't find exported symbols in object(s), please add a shared object on command line");
}
if(not $Res) {
exitStatus("No_DWARF", "can't find debug info in object(s)");
}
%VirtualTable = ();
complete_ABI();
remove_Unused();
if(defined $PublicHeadersPath)
{
foreach my $Tid (sort {lc($TypeInfo{$a}{"Name"}) cmp lc($TypeInfo{$b}{"Name"})} keys(%TypeInfo))
{
if(not $TypeInfo{$Tid}{"Header"}
or not defined $PublicHeader{$TypeInfo{$Tid}{"Header"}})
{
if($TypeInfo{$Tid}{"Type"}=~/Struct|Union|Enum|Typedef/)
{
my $TName = $TypeInfo{$Tid}{"Name"};
$TName=~s/\A(struct|class|union|enum) //g;
if(defined $TypeToHeader{$TName}) {
$TypeInfo{$Tid}{"Header"} = $TypeToHeader{$TName};
}
}
}
if(not selectPublicType($Tid))
{
$TypeInfo{$Tid}{"PrivateABI"} = 1;
}
}
}
%Mangled_ID = ();
%Checked_Spec = ();
%SelectedSymbols = ();
%Cache = ();
%ClassChild = ();
%TypeSpec = ();
# clean memory
%SourceFile = ();
%SourceFile_Alt = ();
%DebugLoc = ();
%TName_Tid = ();
%TName_Tids = ();
%SymbolTable = ();
if(defined $PublicHeadersPath)
{
foreach my $H (keys(%HeadersInfo))
{
if(not defined $PublicHeader{getFilename($H)}) {
delete($HeadersInfo{$H});
}
}
}
dump_ABI();
exit(0);
}
scenario();