examine-relay 5.04 KB
Newer Older
Alexandre Julliard's avatar
Alexandre Julliard committed
1 2
#!/usr/bin/perl -w
# -----------------------------------------------------------------------------
Alexandre Julliard's avatar
Alexandre Julliard committed
3 4 5 6 7 8 9
#
# Relay-checker.
#
# This program will inspect a log file with relay information and tell you
# whether calls and returns match.  If not, this suggests that the parameter
# list might be incorrect.  (It could be something else also.)
#
10 11 12 13 14
# This program now accepts a second command line parameter, which will enable
# a "full" listing format; otherwise a trimmed down simplified listing is 
# generated. It does not matter what the second command line parameter is;
# anything will enable the full listing. 
#
Alexandre Julliard's avatar
Alexandre Julliard committed
15
# Copyright 1997-1998 Morten Welinder (terra@diku.dk)
16
#           2001      Eric Pouech
Alexandre Julliard's avatar
Alexandre Julliard committed
17
#
18 19 20 21 22 23 24 25 26 27 28 29
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# 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
Alexandre Julliard's avatar
Alexandre Julliard committed
31
# -----------------------------------------------------------------------------
Alexandre Julliard's avatar
Alexandre Julliard committed
32

33 34
use strict;

Alexandre Julliard's avatar
Alexandre Julliard committed
35
my $srcfile = $ARGV[0];
36
my $fullformat = $ARGV[1];
37
my %tid_callstack = ();
Alexandre Julliard's avatar
Alexandre Julliard committed
38 39
my $newlineerror = 0;
my $indentp = 1;
40
my $lasttid = 0;
Alexandre Julliard's avatar
Alexandre Julliard committed
41 42 43 44

open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
LINE:
while (<IN>) {
45

46

47
    if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\((.*\)) .*/) {
48 49
	my $tid = $1;
	my $func = $2;
50 51 52 53 54
        if (defined $fullformat) {
	    if ($lasttid ne $tid) {
	        print "******** thread change\n"
	    }
	    $lasttid = $tid;
55

56 57 58 59
	    print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
	    print "$_";
	}
#	print "have call func=$func $_";
Alexandre Julliard's avatar
Alexandre Julliard committed
60
	if (/ ret=(........)$/ ||
Eric Pouech's avatar
Eric Pouech committed
61 62
	    / ret=(....:....) (ds=....)$/ ||
	    / ret=(........) fs=....$/) {
Alexandre Julliard's avatar
Alexandre Julliard committed
63
	    my $retaddr = $1;
Alexandre Julliard's avatar
Alexandre Julliard committed
64 65 66
	    my $segreg = $2;

	    $segreg = "none" unless defined $segreg;
67 68

	    push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
Alexandre Julliard's avatar
Alexandre Julliard committed
69
	    next;
70
	} elsif (not eof IN) {
Alexandre Julliard's avatar
Alexandre Julliard committed
71 72
	    # Assume a line got cut by a line feed in a string.
	    $_ .= scalar (<IN>);
Alexandre Julliard's avatar
Alexandre Julliard committed
73
	    if (!$newlineerror) {
Eric Pouech's avatar
Eric Pouech committed
74
		print "Err[$tid] string probably cut by newline at line $. .\n";
Alexandre Julliard's avatar
Alexandre Julliard committed
75
		$newlineerror = 1;
76
	    }
Alexandre Julliard's avatar
Alexandre Julliard committed
77
	    # print "[$_]";
Alexandre Julliard's avatar
Alexandre Julliard committed
78 79 80 81
	    redo;
	}
    }

82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
    elsif (/^([0-9a-f]+):Call (window proc) ([0-9a-fx]+) .*/) {
	my $tid = $1;
	my $func = $2;
	my $retaddr = $3;
	my $segreg = "none";
        if (defined $fullformat) {
	    if ($lasttid ne $tid) {
	        print "******** thread change\n"
	    }
	    $lasttid = $tid;
	    print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
	    print "$_";
	}

	push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
    }

99 100 101 102
    elsif (/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(........)$/ ||
	/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(....:....) (ds=....)$/ ||
	/^([0-9a-f]+):Ret  ([A-Za-z0-9]+\.[A-Za-z0-9_.]+)\(.*\) .* ret=(........) fs=....$/ ||
        /^([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 105 106 107
	my $tid = $1;
	my $func = $2;
	my $retaddr = $3;
	my $segreg = $4;
Alexandre Julliard's avatar
Alexandre Julliard committed
108
	my ($topfunc,$topaddr,$topseg);
109 110 111 112 113 114
        if (defined $fullformat) {
	    if ($lasttid ne $tid) {
	        print "******** thread change\n"
	    }
	    $lasttid = $tid;
	}
Alexandre Julliard's avatar
Alexandre Julliard committed
115

116
#	print "have ret func=$func <$_>\n";
117 118 119 120 121 122
	if (!defined($tid_callstack{$tid}))
	{
	    print "Err[$tid]: unknown tid\n";
	    next;
	}

Alexandre Julliard's avatar
Alexandre Julliard committed
123
	$segreg = "none" unless defined $segreg;
Alexandre Julliard's avatar
Alexandre Julliard committed
124 125 126

      POP:
	while (1) {
127 128
	    if ($#{$tid_callstack{$tid}} == -1) {
		print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
Alexandre Julliard's avatar
Alexandre Julliard committed
129 130 131
		next LINE;
	    }

132
	    ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
Alexandre Julliard's avatar
Alexandre Julliard committed
133 134

	    if ($topfunc ne $func) {
135 136
		print "Err[$tid]: Return from $topfunc, but call from $func.\n";
		next POP;
Alexandre Julliard's avatar
Alexandre Julliard committed
137 138 139 140
	    }
	    last POP;
	}

Alexandre Julliard's avatar
Alexandre Julliard committed
141 142 143
	my $addrok = ($topaddr eq $retaddr);
	my $segok = ($topseg eq $segreg);
	if ($addrok && $segok) {
144 145 146 147 148 149 150
            if (defined $fullformat) {
	        print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
	        print "$_";
	    } else {
	        print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
	        print "$func from $retaddr with $segreg.\n";
	    }
Alexandre Julliard's avatar
Alexandre Julliard committed
151
	} else {
152
	    print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
Alexandre Julliard's avatar
Alexandre Julliard committed
153
		if !$addrok;
154
	    print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
Alexandre Julliard's avatar
Alexandre Julliard committed
155
		if !$segok;
156
	}
Alexandre Julliard's avatar
Alexandre Julliard committed
157
    }
158 159 160 161
    
    else {
	print "$_";
    }
Alexandre Julliard's avatar
Alexandre Julliard committed
162 163
}

164 165 166 167 168
foreach my $tid (keys %tid_callstack) {
    while ($#{$tid_callstack{$tid}} != -1) {
	my ($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
	print "Err[$tid]: leftover call to $topfunc from $topaddr.\n";
    }
Alexandre Julliard's avatar
Alexandre Julliard committed
169 170 171
}

close (IN);