| #!/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 cygwin0.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} ? '*' : ''; |
| } |