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