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 # 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 #
15 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
16 # 2001 Eric Pouech
17 #
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
30 # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
31 # -----------------------------------------------------------------------------
32
33 use strict;
34
35 my $srcfile = $ARGV[0];
36 my $fullformat = $ARGV[1];
37 my %tid_callstack = ();
38 my $newlineerror = 0;
39 my $indentp = 1;
40 my $lasttid = 0;
41
42 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
43 LINE:
44 while (<IN>) {
45
46
47 if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\((.*\)) .*/) {
48 my $tid = $1;
49 my $func = $2;
50 if (defined $fullformat) {
51 if ($lasttid ne $tid) {
52 print "******** thread change\n"
53 }
54 $lasttid = $tid;
55
56 print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
57 print "$_";
58 }
59 # print "have call func=$func $_";
60 if (/ ret=(........)$/ ||
61 / ret=(....:....) (ds=....)$/ ||
62 / ret=(........) fs=....$/) {
63 my $retaddr = $1;
64 my $segreg = $2;
65
66 $segreg = "none" unless defined $segreg;
67
68 push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
69 next;
70 } elsif (not eof IN) {
71 # Assume a line got cut by a line feed in a string.
72 $_ .= scalar (<IN>);
73 if (!$newlineerror) {
74 print "Err[$tid] string probably cut by newline at line $. .\n";
75 $newlineerror = 1;
76 }
77 # print "[$_]";
78 redo;
79 }
80 }
81
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
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=(........)$/ ||
103 /^([0-9a-f]+):Ret (window proc) ([0-9a-fx]+) .*/) {
104 my $tid = $1;
105 my $func = $2;
106 my $retaddr = $3;
107 my $segreg = $4;
108 my ($topfunc,$topaddr,$topseg);
109 if (defined $fullformat) {
110 if ($lasttid ne $tid) {
111 print "******** thread change\n"
112 }
113 $lasttid = $tid;
114 }
115
116 # print "have ret func=$func <$_>\n";
117 if (!defined($tid_callstack{$tid}))
118 {
119 print "Err[$tid]: unknown tid\n";
120 next;
121 }
122
123 $segreg = "none" unless defined $segreg;
124
125 POP:
126 while (1) {
127 if ($#{$tid_callstack{$tid}} == -1) {
128 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
129 next LINE;
130 }
131
132 ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
133
134 if ($topfunc ne $func) {
135 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
136 next POP;
137 }
138 last POP;
139 }
140
141 my $addrok = ($topaddr eq $retaddr);
142 my $segok = ($topseg eq $segreg);
143 if ($addrok && $segok) {
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 }
151 } else {
152 print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
153 if !$addrok;
154 print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
155 if !$segok;
156 }
157 }
158
159 else {
160 print "$_";
161 }
162 }
163
164 foreach 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 }
169 }
170
171 close (IN);
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.