| #!/usr/bin/perl |
| use strict; |
| use File::Temp qw'tempdir'; |
| use File::Spec; |
| use Getopt::Long; |
| my $dir = tempdir(CLEANUP => 1); |
| |
| my ($cpu, $ar, $as, $nm, $objcopy, %replace); |
| GetOptions('cpu=s'=>\$cpu, 'ar=s'=>\$ar, 'as=s'=>\$as,'nm=s'=>\$nm, 'objcopy=s'=>\$objcopy, 'replace=s'=>\%replace); |
| |
| # Args:: |
| # 1) import lib to create |
| # 2) input dll |
| # 3...) extra objects to add |
| |
| $_ = File::Spec->rel2abs($_) for @ARGV; |
| |
| my $libdll = shift; |
| my $inpdll = shift; |
| |
| open my $nm_fd, '-|', $nm, '-Apg', '--defined-only', $inpdll; |
| my %text = (); |
| my %import = (); |
| my %symfile = (); |
| |
| my $is64bit = ($cpu eq 'x86_64' ? 1 : 0); |
| my $sym_prefix = ($is64bit ? '' : '_'); |
| |
| while (<$nm_fd>) { |
| chomp; |
| my ($fn, $type, $sym) = /^$inpdll:(.*?):\S+\s+(\S)\s+(\S+)$/o; |
| next unless $fn; |
| $text{$fn} = $sym if $type eq 'T'; |
| $import{$fn} = $sym if $type eq 'I'; |
| $symfile{$sym} = $fn; |
| } |
| close $nm_fd or exit 1; |
| |
| for my $sym (keys %replace) { |
| my $fn; |
| my $_sym = $sym_prefix . $sym; |
| if (!defined($fn = $symfile{$_sym})) { |
| $fn = "$sym.o"; |
| $text{$fn} = $_sym; |
| } |
| my $imp_sym = '__imp_' . $sym_prefix . $replace{$sym}; |
| $import{$fn} = $imp_sym; |
| } |
| |
| for my $f (keys %text) { |
| my $imp_sym = delete $import{$f}; |
| my $glob_sym = $text{$f}; |
| if (!defined $imp_sym) { |
| delete $text{$f}; |
| } elsif ($imp_sym eq '__imp_' . $sym_prefix) { |
| $text{$f} = 0; |
| } else { |
| $text{$f} = 1; |
| open my $as_fd, '|-', $as, '-o', "$dir/t-$f", "-"; |
| if ($is64bit) { |
| print $as_fd <<EOF; |
| .text |
| .extern $imp_sym |
| .global $glob_sym |
| $glob_sym: |
| jmp *$imp_sym(%rip) |
| EOF |
| } else { |
| print $as_fd <<EOF; |
| .text |
| .extern $imp_sym |
| .global $glob_sym |
| $glob_sym: |
| jmp *$imp_sym |
| EOF |
| } |
| close $as_fd or exit 1; |
| } |
| } |
| |
| chdir $dir or die "$0: couldn't cd to $dir - $!\n"; |
| system $ar, 'x', $inpdll; |
| exit 1 if $?; |
| |
| for my $f (keys %text) { |
| if (!$text{$f}) { |
| unlink $f; |
| } else { |
| system $objcopy, '-R', '.text', $f and exit 1; |
| system $objcopy, '-R', '.bss', '-R', '.data', "t-$f" and exit 1; |
| } |
| } |
| |
| unlink $libdll; |
| system $ar, 'crus', $libdll, glob('*.o'), @ARGV; |
| unlink glob('*.o'); |
| exit 1 if $?; |
| |
| END { |
| chdir '/tmp'; # Allow $dir directory removal on Windows |
| } |