Cygwin: signal: Increase chance of handling signal in main thread
[newlib-cygwin.git] / winsup / cygwin / scripts / analyze_sigfe
blobf6bda2355a304bafc116565ce122a2c58513e131
1 #!/usr/bin/perl -s
3 # This file is part of Cygwin.
5 # This software is a copyrighted work licensed under the terms of the
6 # Cygwin license. Please consult the file "CYGWIN_LICENSE" for
7 # details.
9 # This will do a crude test to see if the (NO)?SIGFE stuff is used properly
10 # in cygwin.din. It is not perfect so do not use it to do a wholesale replacement.
12 # Input is the output of 'objdump --disassemble --demangle new-cygwin1.dll'.
14 use strict;
15 use vars qw'$v';
16 sub star($);
18 my %funcs;
19 my $func = '';
21 $| = 1;
22 while (<>) {
23 /^610.....\s+<([^\(>]+).*?:/o and do {
24 $func = $1;
25 $funcs{$func} = {} unless defined $funcs{$func};
26 next;
28 $func and /call\s+\S+\s+<([^\(>]+)/o and do {
29 my $called = $1;
30 $funcs{$func}{$called} = 1;
31 if ($called =~ /^[A-Z].*@/o || ($called = $funcs{$called}{-uses_kernel})) {
32 $funcs{$func}{-uses_kernel} ||= $called;
33 my @a = ($func);
34 while (my $f = shift @a) {
35 for my $k (keys %funcs) {
36 if ($funcs{$k}{$f} && !$funcs{$k}{-uses_kernel}) {
37 $funcs{$k}{-uses_kernel} = $called;
38 push(@a, $k);
43 next;
47 if ($v) {
48 for my $k (sort keys %funcs) {
49 print star($funcs{$k}), $k, $funcs{$k}{-uses_kernel} ? " ($funcs{$k}{-uses_kernel})\n" : "\n";
50 my $indent = ' ';
51 for (sort keys %{$funcs{$k}}) {
52 next if /^-/o;
53 print $indent, $_, star($funcs{$k});
54 $indent = ' ';
56 print "\n";
60 open(DIN, '<', 'cygwin.din') or die "$0: couldn't open cygwin.din - $!\n";
61 while (<DIN>) {
62 my $line = $_;
63 /^LIBRARY\s+/o and next;
64 /^\s*$/ and next;
65 /^EXPORTS/o and next;
66 / DATA$/o and next;
67 my $sigfe = (/\s+((?:NO)?SIGFE)\s*$/o)[0] !~ /^NO/o;
68 s/\s+((?:NO)?SIGFE)\s*$//o;
69 my $func = (/\s+=\s+(\S+)/o)[0] || (/^\s*(\S+)/o)[0];
70 if (!defined($funcs{$func})) {
71 warn "hmm. couldn't find $func in disassembled output\n";
72 } elsif (!!$funcs{$func}{-uses_kernel} != $sigfe) {
73 warn "mismatch detected: $line";
77 sub star($) {
78 return $_[0]->{-uses_kernel} ? '*' : '';