winsup/cygwin/scripts/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 ($cpu, $ar, $as, $nm, $objcopy, %replace);
   9 GetOptions('cpu=s'=>\$cpu, '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
  26 my $is_x86_64 = ($cpu eq 'x86_64' ? 1 : 0);
  27 # FIXME? Do other (non-32 bit) arches on Windows still use symbol prefixes?
  28 my $sym_prefix = '';
  29
  30 while (<$nm_fd>) {
  31     chomp;
  32     my ($fn, $type, $sym) = /^$inpdll:(.*?):\S+\s+(\S)\s+(\S+)$/o;
  33     next unless $fn;
  34     $text{$fn} = $sym if $type eq 'T';
  35     $import{$fn} = $sym if $type eq 'I';
  36     $symfile{$sym} = $fn;
  37 }
  38 close $nm_fd or exit 1;
  39
  40 for my $sym (keys %replace) {
  41     my $fn;
  42     my $_sym = $sym_prefix . $sym;
  43     if (!defined($fn = $symfile{$_sym})) {
  44         $fn = "$sym.o";
  45         $text{$fn} = $_sym;
  46     }
  47     my $imp_sym = '__imp_' . $sym_prefix . $replace{$sym};
  48     $import{$fn} = $imp_sym;
  49 }
  50
  51 for my $f (keys %text) {
  52     my $imp_sym = delete $import{$f};
  53     my $glob_sym = $text{$f};
  54     if (!defined $imp_sym) {
  55         delete $text{$f};
  56     } elsif ($imp_sym eq '__imp_' . $sym_prefix) {
  57         $text{$f} = 0;
  58     } else {
  59         $text{$f} = 1;
  60         open my $as_fd, '|-', $as, '-o', "$dir/t-$f", "-";
  61         if ($is_x86_64) {
  62             print $as_fd <<EOF;
  63         .text
  64         .extern $imp_sym
  65         .global $glob_sym
  66 $glob_sym:
  67         jmp     *$imp_sym(%rip)
  68 EOF
  69         } else {
  70             print $as_fd <<EOF;
  71         .text
  72         .extern $imp_sym
  73         .global $glob_sym
  74 $glob_sym:
  75         jmp     *$imp_sym
  76 EOF
  77         }
  78         close $as_fd or exit 1;
  79     }
  80 }
  81
  82 chdir $dir or die "$0: couldn't cd to $dir - $!\n";
  83 system $ar, 'x', $inpdll;
  84 exit 1 if $?;
  85
  86 for my $f (keys %text) {
  87     if (!$text{$f}) {
  88         unlink $f;
  89     } else {
  90         system $objcopy, '-R', '.text', $f and exit 1;
  91         system $objcopy, '-R', '.bss', '-R', '.data', "t-$f" and exit 1;
  92     }
  93 }
  94
  95 # Enable deterministic archives for reproducible builds.
  96 my $opts = 'crs';
  97 $opts .= 'D' if ($ENV{'SOURCE_DATE_EPOCH'} != '');
  98
  99 unlink $libdll;
 100 system $ar, $opts, $libdll, glob('*.o'), @ARGV;
 101 unlink glob('*.o');
 102 exit 1 if $?;
 103
 104 END {
 105     chdir '/tmp';       # Allow $dir directory removal on Windows
 106 }