Made a new improved version of winapi-check in perl.
[wine] / tools / examine-relay
1 #!/usr/bin/perl -w
2 # -----------------------------------------------------------------------------
3 #
4 # Relay-checker.
5 #
6 # This program will inspect a log file with relay information and tell you
7 # whether calls and returns match.  If not, this suggests that the parameter
8 # list might be incorrect.  (It could be something else also.)
9 #
10 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
11 #
12 # -----------------------------------------------------------------------------
13
14 my $srcfile = $ARGV[0];
15 my @callstack = ();
16 my $newlineerror = 0;
17 my $indentp = 1;
18
19 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
20 LINE:
21 while (<IN>) {
22     if (/^Call ([A-Za-z0-9]+\.\d+): .*\)/) {
23         my $func = $1;
24         if (/ ret=(........)$/ ||
25             / ret=(....:....) (ds=....)$/ ||
26             / ret=(........) (fs=....)$/) {
27             my $retaddr = $1;
28             my $segreg = $2;
29
30             $segreg = "none" unless defined $segreg;
31             push @callstack, [$func,$retaddr, $segreg];
32             next;
33         } else {
34             # Assume a line got cut by a line feed in a string.
35             $_ .= scalar (<IN>);
36             if (!$newlineerror) {
37                 print "Error: string probably cut by newline.\n";
38                 $newlineerror = 1;
39             }       
40             # print "[$_]";
41             redo;
42         }
43     }
44
45
46     if (/^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........)$/ ||
47         /^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(....:....) (ds=....)$/ ||
48         /^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........) (fs=....)$/) {
49         my $func = $1;
50         my $retaddr = $2;
51         my $segreg = $3;
52         my ($topfunc,$topaddr,$topseg);
53
54         $segreg = "none" unless defined $segreg;
55
56       POP:
57         while (1) {
58             if ($#callstack == -1) {
59                 print "Error: Return from $func to $retaddr with empty stack.\n";
60                 next LINE;
61             }
62
63             ($topfunc,$topaddr,$topseg) = @{pop @callstack};
64
65             if ($topfunc ne $func) {
66                 print "Error: Return from $topfunc, but call from $func.\n";
67                 next POP 
68             }
69             last POP;
70         }
71
72         my $addrok = ($topaddr eq $retaddr);
73         my $segok = ($topseg eq $segreg);
74         if ($addrok && $segok) {
75             print "OK: ", ($indentp ? (' ' x (1 + $#callstack)) : '');
76             print "$func from $retaddr with $segreg.\n";
77         } else {
78             print "Error: Return from $func is to $retaddr, not $topaddr.\n"
79                 if !$addrok;
80             print "Error: Return from $func with segreg $segreg, not $topseg.\n"
81                 if !$segok;
82         }    
83     }
84 }
85
86 while ($#callstack != -1) {
87     my ($topfunc,$topaddr) = @{pop @callstack};
88     print "Error: leftover call to $topfunc from $topaddr.\n";
89 }
90
91 close (IN);