API files update.
[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 #           2001      Eric Pouech
12 #
13 # This library is free software; you can redistribute it and/or
14 # modify it under the terms of the GNU Lesser General Public
15 # License as published by the Free Software Foundation; either
16 # version 2.1 of the License, or (at your option) any later version.
17 #
18 # This library is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21 # Lesser General Public License for more details.
22 #
23 # You should have received a copy of the GNU Lesser General Public
24 # License along with this library; if not, write to the Free Software
25 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
26 # -----------------------------------------------------------------------------
27
28 use strict;
29
30 my $srcfile = $ARGV[0];
31 my %tid_callstack = ();
32 my $newlineerror = 0;
33 my $indentp = 1;
34
35 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
36 LINE:
37 while (<IN>) {
38
39
40     if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/  ||
41         /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
42         my $tid = $1;
43         my $func = $2;
44
45 #       print "have call func=$func <$_>\n";
46         if (/ ret=(........)$/ ||
47             / ret=(....:....) (ds=....)$/ ||
48             / ret=(........) fs=....$/) {
49             my $retaddr = $1;
50             my $segreg = $2;
51
52             $segreg = "none" unless defined $segreg;
53
54             push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
55             next;
56         } else {
57             # Assume a line got cut by a line feed in a string.
58             $_ .= scalar (<IN>);
59             if (!$newlineerror) {
60                 print "Err[$tid] string probably cut by newline at line $. .\n";
61                 $newlineerror = 1;
62             }
63             # print "[$_]";
64             redo;
65         }
66     }
67
68     if (/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
69         /^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
70          /^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........) fs=....$/ ||
71         /^([0-9a-f]+):RET  ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) {
72         my $tid = $1;
73         my $func = $2;
74         my $retaddr = $3;
75         my $segreg = $4;
76         my ($topfunc,$topaddr,$topseg);
77
78 #       print "have ret func=$func <$_>\n";
79         if (!defined($tid_callstack{$tid}))
80         {
81             print "Err[$tid]: unknown tid\n";
82             next;
83         }
84
85         $segreg = "none" unless defined $segreg;
86
87       POP:
88         while (1) {
89             if ($#{$tid_callstack{$tid}} == -1) {
90                 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
91                 next LINE;
92             }
93
94             ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
95
96             if ($topfunc ne $func) {
97                 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
98                 next POP;
99             }
100             last POP;
101         }
102
103         my $addrok = ($topaddr eq $retaddr);
104         my $segok = ($topseg eq $segreg);
105         if ($addrok && $segok) {
106             print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
107             print "$func from $retaddr with $segreg.\n";
108         } else {
109             print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
110                 if !$addrok;
111             print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
112                 if !$segok;
113         }
114     }
115 }
116
117 foreach my $tid (keys %tid_callstack) {
118     while ($#{$tid_callstack{$tid}} != -1) {
119         my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
120         print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
121     }
122 }
123
124 close (IN);