2 # -----------------------------------------------------------------------------
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.)
10 # Copyright 1997-1998 Morten Welinder (terra@diku.dk)
13 # -----------------------------------------------------------------------------
17 my $srcfile = $ARGV[0];
18 my %tid_callstack = ();
22 open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
27 if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/ ||
28 /^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
32 # print "have call func=$func <$_>\n";
33 if (/ ret=(........)$/ ||
34 / ret=(....:....) (ds=....)$/) {
38 $segreg = "none" unless defined $segreg;
40 push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
43 # Assume a line got cut by a line feed in a string.
46 print "Err[$tid] string probably cut by newline.\n";
54 if (/^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
55 /^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
56 /^([0-9a-f]+):RET ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/) {
61 my ($topfunc,$topaddr,$topseg);
63 # print "have ret func=$func <$_>\n";
64 if (!defined($tid_callstack{$tid}))
66 print "Err[$tid]: unknown tid\n";
70 $segreg = "none" unless defined $segreg;
74 if ($#{$tid_callstack{$tid}} == -1) {
75 print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
79 ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
81 if ($topfunc ne $func) {
82 print "Err[$tid]: Return from $topfunc, but call from $func.\n";
88 my $addrok = ($topaddr eq $retaddr);
89 my $segok = ($topseg eq $segreg);
90 if ($addrok && $segok) {
91 print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
92 print "$func from $retaddr with $segreg.\n";
94 print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
96 print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
102 foreach my $tid (keys %tid_callstack) {
103 while ($#{$tid_callstack{$tid}} != -1) {
104 my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
105 print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";