winedos: Merge the few definitions from dosvm.h into dosexe.h.
[wine] / tools / examine-relay
CommitLineData
a0b2b1d0
AJ
1#!/usr/bin/perl -w
2# -----------------------------------------------------------------------------
c7c217b3
AJ
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#
3377a9c8
DC
10# This program now accepts a second command line parameter, which will enable
11# a "full" listing format; otherwise a trimmed down simplified listing is
12# generated. It does not matter what the second command line parameter is;
13# anything will enable the full listing.
14#
c7c217b3 15# Copyright 1997-1998 Morten Welinder (terra@diku.dk)
1055481a 16# 2001 Eric Pouech
c7c217b3 17#
0799c1a7
AJ
18# This library is free software; you can redistribute it and/or
19# modify it under the terms of the GNU Lesser General Public
20# License as published by the Free Software Foundation; either
21# version 2.1 of the License, or (at your option) any later version.
22#
23# This library is distributed in the hope that it will be useful,
24# but WITHOUT ANY WARRANTY; without even the implied warranty of
25# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
26# Lesser General Public License for more details.
27#
28# You should have received a copy of the GNU Lesser General Public
29# License along with this library; if not, write to the Free Software
360a3f91 30# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
c7c217b3 31# -----------------------------------------------------------------------------
a0b2b1d0 32
1055481a
EP
33use strict;
34
a0b2b1d0 35my $srcfile = $ARGV[0];
3377a9c8 36my $fullformat = $ARGV[1];
1055481a 37my %tid_callstack = ();
c7c217b3
AJ
38my $newlineerror = 0;
39my $indentp = 1;
3377a9c8 40my $lasttid = 0;
a0b2b1d0
AJ
41
42open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
43LINE:
44while (<IN>) {
1055481a 45
2011fa2d 46
1df41285 47 if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\((.*\)) .*/) {
1055481a
EP
48 my $tid = $1;
49 my $func = $2;
3377a9c8
DC
50 if (defined $fullformat) {
51 if ($lasttid ne $tid) {
52 print "******** thread change\n"
53 }
54 $lasttid = $tid;
1055481a 55
3377a9c8
DC
56 print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
57 print "$_";
58 }
59# print "have call func=$func $_";
a0b2b1d0 60 if (/ ret=(........)$/ ||
3a0b3bbd
EP
61 / ret=(....:....) (ds=....)$/ ||
62 / ret=(........) fs=....$/) {
a0b2b1d0 63 my $retaddr = $1;
c7c217b3
AJ
64 my $segreg = $2;
65
66 $segreg = "none" unless defined $segreg;
1055481a
EP
67
68 push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
a0b2b1d0 69 next;
3377a9c8 70 } elsif (not eof IN) {
a0b2b1d0
AJ
71 # Assume a line got cut by a line feed in a string.
72 $_ .= scalar (<IN>);
c7c217b3 73 if (!$newlineerror) {
3a0b3bbd 74 print "Err[$tid] string probably cut by newline at line $. .\n";
c7c217b3 75 $newlineerror = 1;
7cae558b 76 }
c7c217b3 77 # print "[$_]";
a0b2b1d0
AJ
78 redo;
79 }
80 }
81
3377a9c8
DC
82 elsif (/^([0-9a-f]+):Call (window proc) ([0-9a-fx]+) .*/) {
83 my $tid = $1;
84 my $func = $2;
85 my $retaddr = $3;
86 my $segreg = "none";
87 if (defined $fullformat) {
88 if ($lasttid ne $tid) {
89 print "******** thread change\n"
90 }
91 $lasttid = $tid;
92 print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
93 print "$_";
94 }
95
96 push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
97 }
98
1df41285
DC
99 elsif (/^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(........)$/ ||
100 /^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
101 /^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(........) fs=....$/ ||
102 /^([0-9a-f]+):RET ([A-Za-z0-9]+\.[A-Za-z0-9_.]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/ ||
3377a9c8 103 /^([0-9a-f]+):Ret (window proc) ([0-9a-fx]+) .*/) {
1055481a
EP
104 my $tid = $1;
105 my $func = $2;
106 my $retaddr = $3;
107 my $segreg = $4;
c7c217b3 108 my ($topfunc,$topaddr,$topseg);
3377a9c8
DC
109 if (defined $fullformat) {
110 if ($lasttid ne $tid) {
111 print "******** thread change\n"
112 }
113 $lasttid = $tid;
114 }
c7c217b3 115
2011fa2d 116# print "have ret func=$func <$_>\n";
1055481a
EP
117 if (!defined($tid_callstack{$tid}))
118 {
119 print "Err[$tid]: unknown tid\n";
120 next;
121 }
122
c7c217b3 123 $segreg = "none" unless defined $segreg;
a0b2b1d0
AJ
124
125 POP:
126 while (1) {
1055481a
EP
127 if ($#{$tid_callstack{$tid}} == -1) {
128 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
a0b2b1d0
AJ
129 next LINE;
130 }
131
1055481a 132 ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
a0b2b1d0
AJ
133
134 if ($topfunc ne $func) {
1055481a
EP
135 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
136 next POP;
a0b2b1d0
AJ
137 }
138 last POP;
139 }
140
c7c217b3
AJ
141 my $addrok = ($topaddr eq $retaddr);
142 my $segok = ($topseg eq $segreg);
143 if ($addrok && $segok) {
3377a9c8
DC
144 if (defined $fullformat) {
145 print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
146 print "$_";
147 } else {
148 print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
149 print "$func from $retaddr with $segreg.\n";
150 }
a0b2b1d0 151 } else {
1055481a 152 print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
c7c217b3 153 if !$addrok;
1055481a 154 print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
c7c217b3 155 if !$segok;
7cae558b 156 }
a0b2b1d0 157 }
3377a9c8
DC
158
159 else {
160 print "$_";
161 }
a0b2b1d0
AJ
162}
163
1055481a
EP
164foreach my $tid (keys %tid_callstack) {
165 while ($#{$tid_callstack{$tid}} != -1) {
166 my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
167 print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
168 }
a0b2b1d0
AJ
169}
170
171close (IN);