2021-05-07 16:56:14 +02:00
|
|
|
|
2024-01-04 02:49:05 +01:00
|
|
|
# Copyright (c) 2021-2024, PostgreSQL Global Development Group
|
2021-05-07 16:56:14 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
use strict;
|
2023-12-29 18:01:53 +01:00
|
|
|
use warnings FATAL => 'all';
|
2022-09-20 00:34:50 +02:00
|
|
|
use List::Util qw(min);
|
|
|
|
use Getopt::Long;
|
2014-02-11 19:39:14 +01:00
|
|
|
|
2016-12-04 18:00:00 +01:00
|
|
|
my @def;
|
|
|
|
|
2007-03-17 15:01:01 +01:00
|
|
|
#
|
|
|
|
# Script that generates a .DEF file for all objects in a directory
|
2010-04-09 15:05:58 +02:00
|
|
|
#
|
2023-12-20 01:44:37 +01:00
|
|
|
# src/tools/msvc_gendef.pl
|
2007-03-17 15:01:01 +01:00
|
|
|
#
|
2006-10-22 19:17:09 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# 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) = @_;
|
2017-10-26 16:01:02 +02:00
|
|
|
open(my $f, '<', $symfile) || die "Could not open $symfile for $_: $!\n";
|
2017-03-27 04:24:13 +02:00
|
|
|
while (<$f>)
|
2014-02-11 19:39:14 +01:00
|
|
|
{
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2018-04-26 20:13:46 +02:00
|
|
|
# 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
|
|
|
|
#
|
2014-02-11 19:39:14 +01:00
|
|
|
s/notype \(\)/func/g;
|
|
|
|
s/notype/data/g;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
my @pieces = split;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip file and section headers and other non-symbol entries
|
|
|
|
next unless defined($pieces[0]) and $pieces[0] =~ /^[A-F0-9]{3,}$/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip blank symbol names
|
|
|
|
next unless $pieces[6];
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip externs used from another compilation unit
|
|
|
|
next if ($pieces[2] eq "UNDEF");
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip static symbols
|
|
|
|
next unless ($pieces[4] eq "External");
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip some more MSVC-generated crud
|
|
|
|
next if $pieces[6] =~ /^@/;
|
|
|
|
next if $pieces[6] =~ /^\(/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# __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/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# __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/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# More under-documented internal crud
|
|
|
|
next if $pieces[6] =~ /NULL_THUNK_DATA$/;
|
|
|
|
next if $pieces[6] =~ /^__IMPORT_DESCRIPTOR/;
|
|
|
|
next if $pieces[6] =~ /^__NULL_IMPORT/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Skip string literals
|
|
|
|
next if $pieces[6] =~ /^\?\?_C/;
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# 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];
|
|
|
|
}
|
2017-03-27 04:24:13 +02:00
|
|
|
close($f);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-02-11 19:39:14 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
sub writedef
|
|
|
|
{
|
2022-09-20 00:34:50 +02:00
|
|
|
my ($deffile, $arch, $def) = @_;
|
2017-03-27 04:24:13 +02:00
|
|
|
open(my $fh, '>', $deffile) || die "Could not write to $deffile\n";
|
|
|
|
print $fh "EXPORTS\n";
|
2014-02-11 19:39:14 +01:00
|
|
|
foreach my $f (sort keys %{$def})
|
|
|
|
{
|
|
|
|
my $isdata = $def->{$f} eq 'data';
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Strip the leading underscore for win32, but not x64
|
|
|
|
$f =~ s/^_//
|
2022-09-20 00:34:50 +02:00
|
|
|
unless ($arch eq "x86_64");
|
2014-05-06 18:12:18 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# Emit just the name if it's a function symbol, or emit the name
|
|
|
|
# decorated with the DATA option for variables.
|
|
|
|
if ($isdata)
|
|
|
|
{
|
2017-03-27 04:24:13 +02:00
|
|
|
print $fh " $f DATA\n";
|
2014-02-11 19:39:14 +01:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2017-03-27 04:24:13 +02:00
|
|
|
print $fh " $f\n";
|
2014-02-11 19:39:14 +01:00
|
|
|
}
|
|
|
|
}
|
2017-03-27 04:24:13 +02:00
|
|
|
close($fh);
|
2018-05-27 15:08:42 +02:00
|
|
|
return;
|
2014-02-11 19:39:14 +01:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
sub usage
|
|
|
|
{
|
2023-12-20 01:44:37 +01:00
|
|
|
die("Usage: msvc_gendef.pl --arch <arch> --deffile <deffile> --tempdir <tempdir> files-or-directories\n"
|
2022-09-20 00:34:50 +02:00
|
|
|
. " arch: x86 | x86_64\n"
|
|
|
|
. " deffile: path of the generated file\n"
|
|
|
|
. " tempdir: directory for temporary files\n"
|
|
|
|
. " files or directories: object files or directory containing object files\n"
|
|
|
|
);
|
2014-02-11 19:39:14 +01:00
|
|
|
}
|
|
|
|
|
2022-09-20 00:34:50 +02:00
|
|
|
my $arch;
|
|
|
|
my $deffile;
|
|
|
|
my $tempdir = '.';
|
|
|
|
|
|
|
|
GetOptions(
|
|
|
|
'arch:s' => \$arch,
|
|
|
|
'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;
|
|
|
|
}
|
|
|
|
}
|
2006-10-22 19:17:09 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
# if the def file exists and is newer than all input object files, skip
|
|
|
|
# its creation
|
|
|
|
if (-f $deffile
|
2022-09-20 00:34:50 +02:00
|
|
|
&& (-M $deffile < min(map { -M } @files)))
|
2007-03-12 20:10:50 +01:00
|
|
|
{
|
2022-09-20 00:34:50 +02:00
|
|
|
print "Not re-generating $deffile, file already exists.\n";
|
2014-02-11 19:39:14 +01:00
|
|
|
exit(0);
|
2006-10-22 19:17:09 +02:00
|
|
|
}
|
|
|
|
|
2022-09-20 00:34:50 +02:00
|
|
|
print "Generating $deffile in tempdir $tempdir\n";
|
2006-10-22 19:17:09 +02:00
|
|
|
|
2014-02-11 19:39:14 +01:00
|
|
|
my %def = ();
|
|
|
|
|
2022-09-20 00:34:50 +02:00
|
|
|
my $symfile = "$tempdir/all.sym";
|
|
|
|
my $tmpfile = "$tempdir/tmp.sym";
|
|
|
|
mkdir($tempdir) unless -d $tempdir;
|
|
|
|
|
|
|
|
my $cmd = "dumpbin /nologo /symbols /out:$tmpfile " . join(' ', @files);
|
|
|
|
|
Activate perlcritic InputOutput::RequireCheckedSyscalls and fix resulting warnings
This checks that certain I/O-related Perl functions properly check
their return value. Some parts of the PostgreSQL code had been a bit
sloppy about that. The new perlcritic warnings are fixed here. I
didn't design any beautiful error messages, mostly just used "or die
$!", which mostly matches existing code, and also this is
developer-level code, so having the system error plus source code
reference should be ok.
Initially, we only activate this check for a subset of what the
perlcritic check would warn about. The effective list is
chmod flock open read rename seek symlink system
The initial set of functions is picked because most existing code
already checked the return value of those, so any omissions are
probably unintended, or because it seems important for test
correctness.
The actual perlcritic configuration is written as an exclude list.
That seems better so that we are clear on what we are currently not
checking. Maybe future patches want to investigate checking some of
the other functions. (In principle, we might eventually want to check
all of them, but since this is test and build support code, not
production code, there are probably some reasonable compromises to be
made.)
Reviewed-by: Daniel Gustafsson <daniel@yesql.se>
Discussion: https://www.postgresql.org/message-id/flat/88b7d4f2-46d9-4cc7-b1f7-613c90f9a76a%40eisentraut.org
2024-03-19 07:01:22 +01:00
|
|
|
system($cmd) == 0 or die "Could not call dumpbin";
|
|
|
|
rename($tmpfile, $symfile) or die $!;
|
2019-05-04 06:56:47 +02:00
|
|
|
extract_syms($symfile, \%def);
|
2006-10-22 19:17:09 +02:00
|
|
|
print "\n";
|
|
|
|
|
2022-09-20 00:34:50 +02:00
|
|
|
writedef($deffile, $arch, \%def);
|
2014-02-11 19:39:14 +01:00
|
|
|
|
|
|
|
print "Generated " . scalar(keys(%def)) . " symbols\n";
|