Make gendef.pl emit DATA annotations for global variables.

This should make the MSVC build act more like builds for other platforms,
i.e. backend global variables will be automatically available to loadable
libraries without need for explicit PGDLLIMPORT marking.

Craig Ringer

src/tools/msvc/gendef.pl

 my @def;
 
+use warnings;
+use strict;
+use 5.8.0;
+use List::Util qw(max);
+
 #
 # Script that generates a .DEF file for all objects in a directory
 #
 # src/tools/msvc/gendef.pl
 #
 
-die "Usage: gendef.pl <modulepath> <platform>\n"
-  unless (($ARGV[0] =~ /\\([^\\]+$)/)
-	&& ($ARGV[1] == 'Win32' || $ARGV[1] == 'x64'));
+sub dumpsyms
+{
+    my ($objfile, $symfile) = @_;
+    system("dumpbin /symbols /out:symbols.out $_ >NUL")
+      && die "Could not call dumpbin";
+    rename("symbols.out", $symfile);
+}
+
+# Given a symbol file path, loops over its contents
+# and returns a list of symbols of interest as a dictionary
+# of 'symbolname' -> symtype, where symtype is:
+#
+#     0    a CODE symbol, left undecorated in the .DEF
+#     1    A DATA symbol, i.e. global var export
+#
+sub extract_syms
+{
+    my ($symfile, $def) = @_;
+    open(F, "<$symfile") || die "Could not open $symfile for $_\n";
+    while (<F>)
+    {
+        # Expected symbol lines look like:
+        #
+        # 0   1        2      3            4            5 6
+        # IDX SYMBOL   SECT   SYMTYPE      SYMSTATIC      SYMNAME
+        # ------------------------------------------------------------------------
+        # 02E 00000130 SECTA  notype       External     | _standbyState
+        # 02F 00000009 SECT9  notype       Static       | _LocalRecoveryInProgress
+        # 064 00000020 SECTC  notype ()    Static       | _XLogCheckBuffer
+        # 065 00000000 UNDEF  notype ()    External     | _BufferGetTag
+        #
+        # See http://msdn.microsoft.com/en-us/library/b842y285.aspx
+        #
+        # We're not interested in the symbol index or offset.
+        #
+        # SECT[ION] is only examined to see whether the symbol is defined in a
+        # COFF section of the local object file; if UNDEF, it's a symbol to be
+        # resolved at link time from another object so we can't export it.
+        #
+        # SYMTYPE is always notype for C symbols as there's no typeinfo and no
+        # way to get the symbol type from name (de)mangling. However, we care
+        # if "notype" is suffixed by "()" or not. The presence of () means the
+        # symbol is a function, the absence means it isn't.
+        #
+        # SYMSTATIC indicates whether it's a compilation-unit local "static"
+        # symbol ("Static"), or whether it's available for use from other
+        # compilation units ("External"). We export all symbols that aren't
+        # static as part of the whole program DLL interface to produce UNIX-like
+        # default linkage.
+        #
+        # SYMNAME is, obviously, the symbol name. The leading underscore
+        # indicates that the _cdecl calling convention is used. See
+        # http://www.unixwiz.net/techtips/win32-callconv.html
+        # http://www.codeproject.com/Articles/1388/Calling-Conventions-Demystified
+        #
+        s/notype \(\)/func/g;
+        s/notype/data/g;
+
+        my @pieces = split;
+        # Skip file and section headers and other non-symbol entries
+        next unless defined($pieces[0]) and $pieces[0] =~ /^[A-F0-9]{3,}$/;
+        # Skip blank symbol names
+        next unless $pieces[6];
+        # Skip externs used from another compilation unit
+        next if ($pieces[2] eq "UNDEF");
+        # Skip static symbols
+        next unless ($pieces[4] eq "External");
+        # Skip some more MSVC-generated crud
+        next if $pieces[6] =~ /^@/;
+        next if $pieces[6] =~ /^\(/;
+        # __real and __xmm are out-of-line floating point literals and
+        # (for __xmm) their SIMD equivalents. They shouldn't be part
+        # of the DLL interface.
+        next if $pieces[6] =~ /^__real/;
+        next if $pieces[6] =~ /^__xmm/;
+        # __imp entries are imports from other DLLs, eg __imp__malloc .
+        # (We should never have one of these that hasn't already been skipped
+        # by the UNDEF test above, though).
+        next if $pieces[6] =~ /^__imp/;
+        # More under-documented internal crud
+        next if $pieces[6] =~ /NULL_THUNK_DATA$/;
+        next if $pieces[6] =~ /^__IMPORT_DESCRIPTOR/;
+        next if $pieces[6] =~ /^__NULL_IMPORT/;
+        # Skip string literals
+        next if $pieces[6] =~ /^\?\?_C/;
+
+        # We assume that if a symbol is defined as data, then as a function,
+        # the linker will reject the binary anyway. So it's OK to just pick
+        # whatever came last.
+        $def->{$pieces[6]} = $pieces[3];
+    }
+    close(F);
+}
+
+sub writedef
+{
+    my ($deffile, $platform, $def) = @_;
+    open(DEF, ">$deffile") || die "Could not write to $deffile\n";
+    print DEF "EXPORTS\n";
+    foreach my $f (sort keys %{$def})
+    {
+        my $isdata = $def->{$f} eq 'data';
+        # Strip the leading underscore for win32, but not x64
+        $f =~ s/^_//
+          unless ($platform eq "x64");
+
+        # Emit just the name if it's a function symbol, or emit the name
+        # decorated with the DATA option for variables.
+        if ($isdata) {
+            print DEF "  $f DATA\n";
+        } else {
+            print DEF "  $f\n";
+        }
+    }
+    close(DEF);
+}
+
+
+sub usage {
+    die ("Usage: gendef.pl <modulepath> <platform>\n"
+       . "    modulepath: path to dir with obj files, no trailing slash"
+       . "    platform: Win32 | x64");
+}
+
+usage()
+  unless
+    scalar(@ARGV) == 2
+    && (($ARGV[0] =~ /\\([^\\]+$)/)
+    && ($ARGV[1] eq 'Win32' || $ARGV[1] eq 'x64'));
 my $defname  = uc $1;
+my $deffile = "$ARGV[0]/$defname.def";
 my $platform = $ARGV[1];
 
-if (-f "$ARGV[0]/$defname.def")
+# if the def file exists and is newer than all input object files, skip
+# its creation
+if (
+    -f $deffile
+    && (-M $deffile > max( map { -M } <$ARGV[0]/*.obj> ))
+   )
 {
-	print "Not re-generating $defname.DEF, file already exists.\n";
-	exit(0);
+    print "Not re-generating $defname.DEF, file already exists.\n";
+    exit(0);
 }
 
 print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n";
 
+my %def = ();
+
 while (<$ARGV[0]/*.obj>)
 {
-	my $symfile = $_;
-	$symfile =~ s/\.obj$/.sym/i;
-	print ".";
-	system("dumpbin /symbols /out:symbols.out $_ >NUL")
-	  && die "Could not call dumpbin";
-	open(F, "<symbols.out") || die "Could not open symbols.out for $_\n";
-	while (<F>)
-	{
-		s/\(\)//g;
-		my @pieces = split;
-		next unless $pieces[0] =~ /^[A-F0-9]{3,}$/;
-		next unless $pieces[6];
-		next if ($pieces[2] eq "UNDEF");
-		next unless ($pieces[4] eq "External");
-		next if $pieces[6] =~ /^@/;
-		next if $pieces[6] =~ /^\(/;
-		next if $pieces[6] =~ /^__real/;
-		next if $pieces[6] =~ /^__imp/;
-		next if $pieces[6] =~ /^__xmm/;
-		next if $pieces[6] =~ /NULL_THUNK_DATA$/;
-		next if $pieces[6] =~ /^__IMPORT_DESCRIPTOR/;
-		next if $pieces[6] =~ /^__NULL_IMPORT/;
-		next if $pieces[6] =~ /^\?\?_C/;
-
-		push @def, $pieces[6];
-	}
-	close(F);
-	rename("symbols.out", $symfile);
+    my $objfile = $_;
+    my $symfile = $objfile;
+    $symfile =~ s/\.obj$/.sym/i;
+    dumpsyms($objfile, $symfile);
+    print ".";
+    extract_syms($symfile, \%def);
 }
 print "\n";
 
-open(DEF, ">$ARGV[0]/$defname.def") || die "Could not write to $defname\n";
-print DEF "EXPORTS\n";
-my $i    = 0;
-my $last = "";
-foreach my $f (sort @def)
-{
-	next if ($f eq $last);
-	$last = $f;
-	$f =~ s/^_//
-	  unless ($platform eq "x64");    # win64 has new format of exports
-	$i++;
-
-	#   print DEF "  $f \@ $i\n";  # ordinaled exports?
-	print DEF "  $f\n";
-}
-close(DEF);
-print "Generated $i symbols\n";
+writedef($deffile, $platform, \%def);
+
+print "Generated " . scalar(keys(%def)) . " symbols\n";