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