103 lines
2.2 KiB
Perl
Executable File
103 lines
2.2 KiB
Perl
Executable File
#!/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 $is_x86_64 = ($cpu eq 'x86_64' ? 1 : 0);
|
|
# FIXME? Do other (non-32 bit) arches on Windows still use symbol prefixes?
|
|
my $sym_prefix = '';
|
|
|
|
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 ($is_x86_64) {
|
|
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
|
|
}
|