80 lines
2.0 KiB
Perl
Executable File
80 lines
2.0 KiB
Perl
Executable File
#!/usr/bin/perl -s
|
|
#
|
|
# This file is part of Cygwin.
|
|
#
|
|
# This software is a copyrighted work licensed under the terms of the
|
|
# Cygwin license. Please consult the file "CYGWIN_LICENSE" for
|
|
# details.
|
|
|
|
# This will do a crude test to see if the (NO)?SIGFE stuff is used properly
|
|
# in cygwin.din. It is not perfect so do not use it to do a wholesale replacement.
|
|
#
|
|
# Input is the output of 'objdump --disassemble --demangle new-cygwin1.dll'.
|
|
#
|
|
use strict;
|
|
use vars qw'$v';
|
|
sub star($);
|
|
|
|
my %funcs;
|
|
my $func = '';
|
|
|
|
$| = 1;
|
|
while (<>) {
|
|
/^610.....\s+<([^\(>]+).*?:/o and do {
|
|
$func = $1;
|
|
$funcs{$func} = {} unless defined $funcs{$func};
|
|
next;
|
|
};
|
|
$func and /call\s+\S+\s+<([^\(>]+)/o and do {
|
|
my $called = $1;
|
|
$funcs{$func}{$called} = 1;
|
|
if ($called =~ /^[A-Z].*@/o || ($called = $funcs{$called}{-uses_kernel})) {
|
|
$funcs{$func}{-uses_kernel} ||= $called;
|
|
my @a = ($func);
|
|
while (my $f = shift @a) {
|
|
for my $k (keys %funcs) {
|
|
if ($funcs{$k}{$f} && !$funcs{$k}{-uses_kernel}) {
|
|
$funcs{$k}{-uses_kernel} = $called;
|
|
push(@a, $k);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
next;
|
|
};
|
|
}
|
|
|
|
if ($v) {
|
|
for my $k (sort keys %funcs) {
|
|
print star($funcs{$k}), $k, $funcs{$k}{-uses_kernel} ? " ($funcs{$k}{-uses_kernel})\n" : "\n";
|
|
my $indent = ' ';
|
|
for (sort keys %{$funcs{$k}}) {
|
|
next if /^-/o;
|
|
print $indent, $_, star($funcs{$k});
|
|
$indent = ' ';
|
|
}
|
|
print "\n";
|
|
}
|
|
}
|
|
|
|
open(DIN, '<', 'cygwin.din') or die "$0: couldn't open cygwin.din - $!\n";
|
|
while (<DIN>) {
|
|
my $line = $_;
|
|
/^LIBRARY\s+/o and next;
|
|
/^\s*$/ and next;
|
|
/^EXPORTS/o and next;
|
|
/ DATA$/o and next;
|
|
my $sigfe = (/\s+((?:NO)?SIGFE)\s*$/o)[0] !~ /^NO/o;
|
|
s/\s+((?:NO)?SIGFE)\s*$//o;
|
|
my $func = (/\s+=\s+(\S+)/o)[0] || (/^\s*(\S+)/o)[0];
|
|
if (!defined($funcs{$func})) {
|
|
warn "hmm. couldn't find $func in disassembled output\n";
|
|
} elsif (!!$funcs{$func}{-uses_kernel} != $sigfe) {
|
|
warn "mismatch detected: $line";
|
|
}
|
|
}
|
|
|
|
sub star($) {
|
|
return $_[0]->{-uses_kernel} ? '*' : '';
|
|
}
|