cf/w32-def-from-dll.pl

   1 my $show_module_name = 1;
   2 my $use_indent = 1;
   3 my $strip_leading_underscore = 0;
   4 my $module_name = "";
   5 my %target_exports = ();
   6 my %local_exports = ();
   7
   8 sub build_target_exports_list($)
   9 {
  10     $fn = shift;
  11
  12     print STDERR "Processing defs from file [$fn]\n";
  13
  14     open(SP, '-|', "dumpbin /exports \"".$fn."\"") or die "Can't open pipe for $fn";
  15
  16   LINE:
  17     while (<SP>) {
  18 #        112   6F 00071CDC krb5_encrypt_size
  19
  20         /^ +([[:digit:]]+)\s+[[:xdigit:]]+\s[[:xdigit:]]{8,}\s+(\S+)(?:| = (\S*))$/ && do {
  21             my ($ordinal, $symbol, $in) = ($1, $2, $3);
  22
  23             if ($in eq "") { $in = $symbol };
  24             $target_exports{$symbol} = $in;
  25         };
  26     }
  27
  28     close SP;
  29 }
  30
  31 # Dump all symbols for the given dll file that are defined and have
  32 # external scope.
  33
  34 sub build_glue_exports_list($)
  35 {
  36     $fn = shift;
  37
  38     print STDERR "Opening dump of DLL [$fn]\n";
  39
  40     open(SP, '-|', "dumpbin /exports \"".$fn."\"") or die "Can't open pipe for $fn";
  41
  42   LINE:
  43     while (<SP>) {
  44 #        112   6F 00071CDC krb5_encrypt_size
  45
  46         /^ +([[:digit:]]+)\s+[[:xdigit:]]+\s[[:xdigit:]]{8,}\s+(\S+)(?:| = (\S*))$/ && do {
  47             my ($ordinal, $symbol, $in) = ($1, $2, $3);
  48
  49             if ($strip_leading_underscore && $symbol =~ /_(.*)/) {
  50                 $symbol = $1;
  51             }
  52             if (exists $local_exports{$symbol}) {
  53                 print "\t".$symbol;
  54                 print " = ".$local_exports{$symbol};
  55                 if ($in ne $local_exports{$symbol} and $in ne "") {
  56                     print STDERR "Incorrect calling convention for local $symbol\n";
  57                     print STDERR "  ".$in." != ".$local_exports{$symbol}."\n";
  58                 }
  59                 print "\t@".$ordinal."\n";
  60             } elsif (exists $local_exports{"SHIM_".$symbol}) {
  61                 print "\t".$symbol;
  62                 print " = ".$local_exports{"SHIM_".$symbol};
  63                 print "\t@".$ordinal."\n";
  64             } elsif (exists $target_exports{$symbol}) {
  65                 print "\t".$symbol;
  66                 print " = ".$module_name;
  67                 if ($in ne $target_exports{$symbol} and $in ne "") {
  68                     print STDERR "Incorrect calling convention for $symbol\n";
  69                     print STDERR "  ".$in." != ".$target_exports{$symbol}."\n";
  70                 }
  71                 my $texp = $target_exports{$symbol};
  72                 if ($texp =~ /^_([^@]+)$/) { $texp = $1; }
  73                 print $texp."\t@".$ordinal."\n";
  74             } else {
  75                 print STDERR "Symbol not found: $symbol\n";
  76             }
  77         };
  78     }
  79
  80     close SP;
  81 }
  82
  83 sub build_local_exports_list($)
  84 {
  85     $fn = shift;
  86
  87     print STDERR "Opening dump of object [$fn]\n";
  88
  89     open(SP, '-|', "dumpbin /symbols \"".$fn."\"") or die "Can't open pipe for $fn";
  90
  91   LINE:
  92     while (<SP>) {
  93         # 009 00000010 SECT3  notype ()    External     | _remove_error_table@4
  94         m/^[[:xdigit:]]{3,}\s[[:xdigit:]]{8,}\s(\w+)\s+\w*\s+(?:\(\)|  )\s+(\w+)\s+\|\s+(\S+)$/ && do {
  95             my ($section, $visibility, $symbol) = ($1, $2, $3);
  96
  97             if ($section ne "UNDEF" && $visibility eq "External") {
  98
  99                 my $exp_name = $symbol;
 100
 101                 if ($symbol =~ m/^_(\w+)(?:@.*|)$/) {
 102                     $exp_name = $1;
 103                 }
 104
 105                 if ($symbol =~ m/^_([^@]+)$/) {
 106                     $symbol = $1;
 107                 }
 108
 109                 $local_exports{$exp_name} = $symbol;
 110             }
 111         };
 112     }
 113
 114     close SP;
 115 }
 116
 117 sub process_file($)
 118 {
 119     $fn = shift;
 120
 121     if ($fn =~ m/\.dll$/i) {
 122         build_glue_exports_list($fn);
 123     } elsif ($fn =~ m/\.obj$/i) {
 124         build_local_exports_list($fn);
 125     } else {
 126         die "File type not recognized for $fn.";
 127     }
 128 }
 129
 130 sub use_response_file($)
 131 {
 132     $fn = shift;
 133
 134     open (RF, '<', $fn) or die "Can't open response file $fn";
 135
 136     while (<RF>) {
 137         /(\S+)/ && do {
 138             process_file($1);
 139         }
 140     }
 141     close RF;
 142 }
 143
 144 print "; This is a generated file.  Do not modify directly.\n";
 145 print "EXPORTS\n";
 146
 147 for (@ARGV) {
 148     ARG: {
 149         /-m(.*)/ && do {
 150             $module_name = $1.".";
 151             last ARG;
 152         };
 153
 154         /-e(.*)/ && do {
 155             build_target_exports_list($1);
 156             last ARG;
 157         };
 158
 159         /@(.*)/ && do {
 160             use_response_file($1);
 161             last ARG;
 162         };
 163
 164         process_file($_);
 165     }
 166 }