winsup/cygwin/scripts/speclib

   1 #!/usr/bin/perl
   2 use Getopt::Long;
   3 use File::Temp qw'tempdir';
   4 use File::Basename;
   5 use File::Spec;
   6 use strict;
   7
   8 sub dllname($;$);
   9
  10 my $static;
  11 my $inverse;
  12 my @exclude;
  13
  14 my ($cpu, $ar, $as, $nm, $objcopy);
  15 GetOptions('exclude=s'=>\@exclude, 'static!'=>\$static, 'v!'=>\$inverse,
  16            'cpu=s'=>\$cpu, 'ar=s'=>\$ar, 'as=s'=>\$as,'nm=s'=>\$nm, 'objcopy=s'=>\$objcopy);
  17
  18 $_ = File::Spec->rel2abs($_) for @ARGV;
  19
  20 my $libdll = shift;
  21 my $lib =  pop;
  22 # FIXME? Do other (non-32 bit) arches on Windows still use symbol prefixes?
  23 my $sym_prefix = '';
  24 (my $iname = basename $lib) =~ s/\.a$//o;
  25 $iname = $sym_prefix . $iname . '_dll_iname';
  26
  27 open my $nm_fd, '-|', $nm, '-Apg', '--defined-only', @ARGV, $libdll or
  28   die "$0: execution of $nm for object files failed - $!\n";
  29
  30 my %match_syms = ();
  31 my $symfiles = ();
  32 my $lastfn;
  33 my %extract = ();
  34 my $exclude_regex = @exclude ? join('|', @exclude) : '\\UnLiKeLy//';
  35 $exclude_regex = qr/$exclude_regex/;
  36 my $dllname;
  37 while (<$nm_fd>) {
  38     study;
  39     if (/ I _?(.*)_dll_iname/o) {
  40         $dllname = $1;
  41     } else {
  42         my ($file, $member, $symbol) = m%^([^:]*):([^:]*(?=:))?.* T (.*)%o;
  43         next if !defined($symbol) || $symbol =~ $exclude_regex;
  44         if ($file ne $libdll) {
  45              $match_syms{$symbol} = 1;
  46          } elsif ($match_syms{$symbol} ? !$inverse : $inverse) {
  47              $extract{$member} = 1;
  48          }
  49     }
  50 }
  51 close $nm_fd;
  52
  53
  54 %extract or die "$0: couldn't find symbols for $lib\n";
  55
  56 my $dir = tempdir(CLEANUP => 1);
  57
  58 chdir $dir;
  59 # print join(' ', '+', $ar, 'x', sort keys %extract), "\n";
  60 my $res = system $ar, 'x', $libdll, sort keys %extract;
  61 die "$0: $ar extraction exited with non-zero status\n" if $res;
  62 unlink $lib;
  63
  64 # Add a dummy .idata object for libtool so that it will think
  65 # this library is an import library.
  66 my $iname_o = 'd000000.o';
  67 $extract{$iname_o} = 1;
  68 open my $as_fd, '|-', $as, '-R', '-o', $iname_o, "-";
  69 print $as_fd <<EOF;
  70         .section .idata\$7
  71 .global $iname
  72 $iname: .asciz "$dllname.dll"
  73 EOF
  74 close $as_fd or exit 1;
  75 system $objcopy, '-j', '.idata$7', $iname_o;
  76
  77 # Enable deterministic archives for reproducible builds.
  78 my $opts = 'crs';
  79 $opts .= 'D' if ($ENV{'SOURCE_DATE_EPOCH'} != '');
  80
  81 $res = system $ar, $opts, $lib, sort keys %extract;
  82 unlink keys %extract;
  83 die "$0: ar creation of $lib exited with non-zero status\n" if $res;
  84 exit 0;
  85
  86 END {
  87     chdir '/tmp';       # Allow $dir directory removal on Windows
  88 }