cf/w32-list-externs-from-objs.pl

   1 my $show_module_name = 1;
   2 my $use_indent = 1;
   3 my $strip_leading_underscore = 0;
   4
   5 # Dump all symbols for the given object file that are defined and have
   6 # external scope.
   7
   8 sub dump_symbols_for_file($)
   9 {
  10     $fn = shift;
  11
  12     print STDERR "Opening dump of object [$fn]\n";
  13
  14     open(SP, '-|', "dumpbin /symbols \"".$fn."\"") or die "Can't open pipe for $fn";
  15
  16   LINE:
  17     while (<SP>) {
  18         # 008 00000000 SECT3  notype ()    External     | _encode_AccessDescription
  19
  20         /^[[:xdigit:]]{3,}\s[[:xdigit:]]{8,}\s(\w+)\s+\w*\s+(\(\)|  )\s+(\w+)\s+\|\s+([0-9a-zA-Z\@\_]+)$/ && do {
  21             my ($section, $type, $visibility, $symbol) = ($1, $2, $3, $4);
  22
  23             if ($section ne "UNDEF" && $visibility eq "External") {
  24                 print $fn if $show_module_name;
  25                 print "\t" if $use_indent || $show_module_name;
  26
  27                 if ($strip_leading_underscore && $symbol =~ /_(.*)/) {
  28                     $symbol = $1;
  29                 }
  30                 if ($strip_leading_underscore && $symbol =~ /(.*)\@.*$/) {
  31                     $symbol = $1;
  32                 }
  33                 print $symbol;
  34                 if ($type ne "()") {
  35                     print "\tDATA";
  36                 }
  37                 print "\n";
  38             }
  39         };
  40     }
  41
  42     close SP;
  43 }
  44
  45 sub use_response_file($)
  46 {
  47     $fn = shift;
  48
  49     open (RF, '<', $fn) or die "Can't open response file $fn";
  50
  51     while (<RF>) {
  52         /(\S+)/ && do {
  53             dump_symbols_for_file($1);
  54         }
  55     }
  56     close RF;
  57 }
  58
  59 for (@ARGV) {
  60     ARG: {
  61         /-q/ && do {
  62             $show_module_name = 0;
  63             last ARG;
  64         };
  65
  66         /-1/ && do {
  67             $use_indent = 0;
  68             last ARG;
  69         };
  70
  71         /-u/ && do {
  72             $strip_leading_underscore = 1;
  73             last ARG;
  74         };
  75
  76         /@(.*)/ && do {
  77             use_response_file($1);
  78             last ARG;
  79         };
  80
  81         dump_symbols_for_file($_);
  82     }
  83 }