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