granicus.if.org Git - postgresql/blob - src/tools/msvc/gendef.pl

   1 my @def;
   2
   3 use warnings;
   4 use strict;
   5 use 5.8.0;
   6 use File::Spec::Functions qw(splitpath catpath);
   7 use List::Util qw(max);
   8
   9 #
  10 # Script that generates a .DEF file for all objects in a directory
  11 #
  12 # src/tools/msvc/gendef.pl
  13 #
  14
  15 sub dumpsyms
  16 {
  17         my ($objfile, $symfile) = @_;
  18         my ($symvol, $symdirs, $symbase) = splitpath($symfile);
  19         my $tmpfile = catpath($symvol, $symdirs, "symbols.out");
  20         system("dumpbin /symbols /out:$tmpfile $_ >NUL")
  21           && die "Could not call dumpbin";
  22         rename($tmpfile, $symfile);
  23 }
  24
  25 # Given a symbol file path, loops over its contents
  26 # and returns a list of symbols of interest as a dictionary
  27 # of 'symbolname' -> symtype, where symtype is:
  28 #
  29 #     0    a CODE symbol, left undecorated in the .DEF
  30 #     1    A DATA symbol, i.e. global var export
  31 #
  32 sub extract_syms
  33 {
  34         my ($symfile, $def) = @_;
  35         open(F, "<$symfile") || die "Could not open $symfile for $_\n";
  36         while (<F>)
  37         {
  38
  39         # Expected symbol lines look like:
  40         #
  41         # 0   1        2      3            4            5 6
  42         # IDX SYMBOL   SECT   SYMTYPE      SYMSTATIC      SYMNAME
  43         # ------------------------------------------------------------------------
  44         # 02E 00000130 SECTA  notype       External     | _standbyState
  45         # 02F 00000009 SECT9  notype       Static       | _LocalRecoveryInProgress
  46         # 064 00000020 SECTC  notype ()    Static       | _XLogCheckBuffer
  47         # 065 00000000 UNDEF  notype ()    External     | _BufferGetTag
  48         #
  49         # See http://msdn.microsoft.com/en-us/library/b842y285.aspx
  50         #
  51         # We're not interested in the symbol index or offset.
  52         #
  53         # SECT[ION] is only examined to see whether the symbol is defined in a
  54         # COFF section of the local object file; if UNDEF, it's a symbol to be
  55         # resolved at link time from another object so we can't export it.
  56         #
  57         # SYMTYPE is always notype for C symbols as there's no typeinfo and no
  58         # way to get the symbol type from name (de)mangling. However, we care
  59         # if "notype" is suffixed by "()" or not. The presence of () means the
  60         # symbol is a function, the absence means it isn't.
  61         #
  62         # SYMSTATIC indicates whether it's a compilation-unit local "static"
  63         # symbol ("Static"), or whether it's available for use from other
  64         # compilation units ("External"). We export all symbols that aren't
  65         # static as part of the whole program DLL interface to produce UNIX-like
  66         # default linkage.
  67         #
  68         # SYMNAME is, obviously, the symbol name. The leading underscore
  69         # indicates that the _cdecl calling convention is used. See
  70         # http://www.unixwiz.net/techtips/win32-callconv.html
  71         # http://www.codeproject.com/Articles/1388/Calling-Conventions-Demystified
  72         #
  73                 s/notype \(\)/func/g;
  74                 s/notype/data/g;
  75
  76                 my @pieces = split;
  77
  78                 # Skip file and section headers and other non-symbol entries
  79                 next unless defined($pieces[0]) and $pieces[0] =~ /^[A-F0-9]{3,}$/;
  80
  81                 # Skip blank symbol names
  82                 next unless $pieces[6];
  83
  84                 # Skip externs used from another compilation unit
  85                 next if ($pieces[2] eq "UNDEF");
  86
  87                 # Skip static symbols
  88                 next unless ($pieces[4] eq "External");
  89
  90                 # Skip some more MSVC-generated crud
  91                 next if $pieces[6] =~ /^@/;
  92                 next if $pieces[6] =~ /^\(/;
  93
  94                 # __real and __xmm are out-of-line floating point literals and
  95                 # (for __xmm) their SIMD equivalents. They shouldn't be part
  96                 # of the DLL interface.
  97                 next if $pieces[6] =~ /^__real/;
  98                 next if $pieces[6] =~ /^__xmm/;
  99
 100                 # __imp entries are imports from other DLLs, eg __imp__malloc .
 101                 # (We should never have one of these that hasn't already been skipped
 102                 # by the UNDEF test above, though).
 103                 next if $pieces[6] =~ /^__imp/;
 104
 105                 # More under-documented internal crud
 106                 next if $pieces[6] =~ /NULL_THUNK_DATA$/;
 107                 next if $pieces[6] =~ /^__IMPORT_DESCRIPTOR/;
 108                 next if $pieces[6] =~ /^__NULL_IMPORT/;
 109
 110                 # Skip string literals
 111                 next if $pieces[6] =~ /^\?\?_C/;
 112
 113                 # We assume that if a symbol is defined as data, then as a function,
 114                 # the linker will reject the binary anyway. So it's OK to just pick
 115                 # whatever came last.
 116                 $def->{ $pieces[6] } = $pieces[3];
 117         }
 118         close(F);
 119 }
 120
 121 sub writedef
 122 {
 123         my ($deffile, $platform, $def) = @_;
 124         open(DEF, ">$deffile") || die "Could not write to $deffile\n";
 125         print DEF "EXPORTS\n";
 126         foreach my $f (sort keys %{$def})
 127         {
 128                 my $isdata = $def->{$f} eq 'data';
 129
 130                 # Strip the leading underscore for win32, but not x64
 131                 $f =~ s/^_//
 132                   unless ($platform eq "x64");
 133
 134                 # Emit just the name if it's a function symbol, or emit the name
 135                 # decorated with the DATA option for variables.
 136                 if ($isdata)
 137                 {
 138                         print DEF "  $f DATA\n";
 139                 }
 140                 else
 141                 {
 142                         print DEF "  $f\n";
 143                 }
 144         }
 145         close(DEF);
 146 }
 147
 148
 149 sub usage
 150 {
 151         die(    "Usage: gendef.pl <modulepath> <platform>\n"
 152                   . "    modulepath: path to dir with obj files, no trailing slash"
 153                   . "    platform: Win32 | x64");
 154 }
 155
 156 usage()
 157   unless scalar(@ARGV) == 2
 158           && (   ($ARGV[0] =~ /\\([^\\]+$)/)
 159                   && ($ARGV[1] eq 'Win32' || $ARGV[1] eq 'x64'));
 160 my $defname  = uc $1;
 161 my $deffile  = "$ARGV[0]/$defname.def";
 162 my $platform = $ARGV[1];
 163
 164 # if the def file exists and is newer than all input object files, skip
 165 # its creation
 166 if (-f $deffile
 167         && (-M $deffile > max(map { -M } <$ARGV[0]/*.obj>)))
 168 {
 169         print "Not re-generating $defname.DEF, file already exists.\n";
 170         exit(0);
 171 }
 172
 173 print "Generating $defname.DEF from directory $ARGV[0], platform $platform\n";
 174
 175 my %def = ();
 176
 177 while (<$ARGV[0]/*.obj>)
 178 {
 179         my $objfile = $_;
 180         my $symfile = $objfile;
 181         $symfile =~ s/\.obj$/.sym/i;
 182         dumpsyms($objfile, $symfile);
 183         print ".";
 184         extract_syms($symfile, \%def);
 185 }
 186 print "\n";
 187
 188 writedef($deffile, $platform, \%def);
 189
 190 print "Generated " . scalar(keys(%def)) . " symbols\n";