winsup/cygwin/mkimport

   1 #!/usr/bin/perl
   2 use strict;
   3 use File::Temp qw'tempdir';
   4 use File::Spec;
   5 use Getopt::Long;
   6 my $dir = tempdir(CLEANUP => 1);
   7
   8 my ($ar, $as, $nm, $objcopy, %replace);
   9 GetOptions('ar=s'=>\$ar, 'as=s'=>\$as,'nm=s'=>\$nm, 'objcopy=s'=>\$objcopy, 'replace=s'=>\%replace);
  10
  11 # Args::
  12 #   1) import lib to create
  13 #   2) input dll
  14 #   3...) extra objects to add
  15
  16 $_ = File::Spec->rel2abs($_) for @ARGV;
  17
  18 my $libdll = shift;
  19 my $inpdll = shift;
  20
  21 open my $nm_fd, '-|', $nm, '-Apg', '--defined-only', $inpdll;
  22 my %text = ();
  23 my %import = ();
  24 my %symfile = ();
  25 while (<$nm_fd>) {
  26     chomp;
  27     my ($fn, $type, $sym) = /^$inpdll:(.*?):\S+\s+(\S)\s+(\S+)$/o;
  28     next unless $fn;
  29     $text{$fn} = $sym if $type eq 'T';
  30     $import{$fn} = $sym if $type eq 'I';
  31     $symfile{$sym} = $fn;
  32 }
  33 close $nm_fd or exit 1;
  34
  35 for my $sym (keys %replace) {
  36     my $fn;
  37     my $_sym = '_' . $sym;
  38     if (!defined($fn = $symfile{$_sym})) {
  39         $fn = "$sym.o";
  40         $text{$fn} = $_sym;
  41     }
  42     my $imp_sym = '__imp__' . $replace{$sym};
  43     $import{$fn} = $imp_sym;
  44 }
  45
  46 for my $f (keys %text) {
  47     my $imp_sym = delete $import{$f};
  48     my $glob_sym = $text{$f};
  49     if (!defined $imp_sym) {
  50         delete $text{$f};
  51     } elsif ($imp_sym eq '__imp__') {
  52         $text{$f} = 0;
  53     } else {
  54         $text{$f} = 1;
  55         open my $as_fd, '|-', $as, '-o', "$dir/t-$f", "-";
  56         print $as_fd <<EOF;
  57         .text
  58         .extern $imp_sym
  59         .global $glob_sym
  60 $glob_sym:
  61         jmp     *$imp_sym
  62 EOF
  63         close $as_fd or exit 1;
  64     }
  65 }
  66
  67 chdir $dir or die "$0: couldn't cd to $dir - $!\n";
  68 system $ar, 'x', $inpdll;
  69 exit 1 if $?;
  70
  71 for my $f (keys %text) {
  72     if (!$text{$f}) {
  73         unlink $f;
  74     } else {
  75         system $objcopy, '-R', '.text', $f and exit 1;
  76         system $objcopy, '-R', '.bss', '-R', '.data', "t-$f" and exit 1;
  77     }
  78 }
  79
  80 unlink $libdll;
  81 system $ar, 'crus', $libdll, glob('*.o'), @ARGV;
  82 unlink glob('*.o');
  83 exit 1 if $?;
  84
  85 END {
  86     chdir '/tmp';       # Allow $dir directory removal on Windows
  87 }