@ -3,7 +3,8 @@
use strict ;
use strict ;
use warnings ;
use warnings ;
use List::Util qw( max ) ;
use List::Util qw( min ) ;
use Getopt::Long ;
my @ def ;
my @ def ;
@ -112,7 +113,7 @@ sub extract_syms
sub writedef
sub writedef
{
{
my ( $ deffile , $ platform , $ def ) = @ _ ;
my ( $ deffile , $ arch , $ def ) = @ _ ;
open ( my $ fh , '>' , $ deffile ) || die "Could not write to $deffile\n" ;
open ( my $ fh , '>' , $ deffile ) || die "Could not write to $deffile\n" ;
print $ fh "EXPORTS\n" ;
print $ fh "EXPORTS\n" ;
foreach my $ f ( sort keys % { $ def } )
foreach my $ f ( sort keys % { $ def } )
@ -121,7 +122,7 @@ sub writedef
# Strip the leading underscore for win32, but not x64
# Strip the leading underscore for win32, but not x64
$ f =~ s/^_//
$ f =~ s/^_//
unless ( $ platform eq "x64" ) ;
unless ( $ arch eq "x86_ 64" ) ;
# Emit just the name if it's a function symbol, or emit the name
# Emit just the name if it's a function symbol, or emit the name
# decorated with the DATA option for variables.
# decorated with the DATA option for variables.
@ -141,40 +142,64 @@ sub writedef
sub usage
sub usage
{
{
die ( "Usage: gendef.pl <modulepath> <platform>\n"
die ( "Usage: gendef.pl --arch <arch> --deffile <deffile> --tempdir <tempdir> files-or-directories\n"
. " modulepath: path to dir with obj files, no trailing slash"
. " arch: x86 | x86_64\n"
. " platform: Win32 | x64" ) ;
. " deffile: path of the generated file\n"
. " tempdir: directory for temporary files\n"
. " files or directories: object files or directory containing object files\n"
) ;
}
}
usage ( )
my $ arch ;
unless scalar ( @ ARGV ) == 2
my $ deffile ;
&& ( ( $ ARGV [ 0 ] =~ /\\([^\\]+$)/ )
my $ tempdir = '.' ;
&& ( $ ARGV [ 1 ] eq 'Win32' || $ ARGV [ 1 ] eq 'x64' ) ) ;
my $ defname = uc $ 1 ;
GetOptions (
my $ deffile = "$ARGV[0]/$defname.def" ;
'arch:s' = > \ $ arch ,
my $ platform = $ ARGV [ 1 ] ;
'deffile:s' = > \ $ deffile ,
'tempdir:s' = > \ $ tempdir , ) or usage ( ) ;
usage ( "arch: $arch" )
unless ( $ arch eq 'x86' || $ arch eq 'x86_64' ) ;
my @ files ;
foreach my $ in ( @ ARGV )
{
if ( - d $ in )
{
push @ files , glob "$in/*.obj" ;
}
else
{
push @ files , $ in ;
}
}
# if the def file exists and is newer than all input object files, skip
# if the def file exists and is newer than all input object files, skip
# its creation
# its creation
if ( - f $ deffile
if ( - f $ deffile
&& ( - M $ deffile > max ( map { - M } <$ARGV[0]/*.obj> ) ) )
&& ( - M $ deffile < min ( map { - M } @ files ) ) )
{
{
print "Not re-generating $defname.DEF, file already exists.\n" ;
print "Not re-generating $deffile , file already exists.\n" ;
exit ( 0 ) ;
exit ( 0 ) ;
}
}
print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n" ;
print "Generating $deffile in tempdir $tempdir \n" ;
my % def = ( ) ;
my % def = ( ) ;
my $ symfile = "$ARGV[0]/all.sym" ;
my $ symfile = "$tempdir/all.sym" ;
my $ tmpfile = "$ARGV[0]/tmp.sym" ;
my $ tmpfile = "$tempdir/tmp.sym" ;
system ( "dumpbin /symbols /out:$tmpfile $ARGV[0]/*.obj >NUL" )
mkdir ( $ tempdir ) unless - d $ tempdir ;
&& die "Could not call dumpbin" ;
my $ cmd = "dumpbin /nologo /symbols /out:$tmpfile " . join ( ' ' , @ files ) ;
system ( $ cmd ) && die "Could not call dumpbin" ;
rename ( $ tmpfile , $ symfile ) ;
rename ( $ tmpfile , $ symfile ) ;
extract_syms ( $ symfile , \ % def ) ;
extract_syms ( $ symfile , \ % def ) ;
print "\n" ;
print "\n" ;
writedef ( $ deffile , $ platform , \ % def ) ;
writedef ( $ deffile , $ arch , \ % def ) ;
print "Generated " . scalar ( keys ( % def ) ) . " symbols\n" ;
print "Generated " . scalar ( keys ( % def ) ) . " symbols\n" ;