mirror of
https://github.com/reactos/wine.git
synced 2024-11-25 20:59:54 +00:00
125 lines
3.8 KiB
Perl
Executable File
125 lines
3.8 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
# -----------------------------------------------------------------------------
|
|
#
|
|
# 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.)
|
|
#
|
|
# Copyright 1997-1998 Morten Welinder (terra@diku.dk)
|
|
# 2001 Eric Pouech
|
|
#
|
|
# 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
|
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
# -----------------------------------------------------------------------------
|
|
|
|
use strict;
|
|
|
|
my $srcfile = $ARGV[0];
|
|
my %tid_callstack = ();
|
|
my $newlineerror = 0;
|
|
my $indentp = 1;
|
|
|
|
open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
|
|
LINE:
|
|
while (<IN>) {
|
|
|
|
|
|
if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/ ||
|
|
/^([0-9a-f]+):CALL ([A-Za-z0-9]+\.[A-Za-z0-9_]+: [A-Za-z0-9]+)\((.*\)) .*/) {
|
|
my $tid = $1;
|
|
my $func = $2;
|
|
|
|
# print "have call func=$func <$_>\n";
|
|
if (/ ret=(........)$/ ||
|
|
/ ret=(....:....) (ds=....)$/ ||
|
|
/ ret=(........) fs=....$/) {
|
|
my $retaddr = $1;
|
|
my $segreg = $2;
|
|
|
|
$segreg = "none" unless defined $segreg;
|
|
|
|
push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
|
|
next;
|
|
} else {
|
|
# Assume a line got cut by a line feed in a string.
|
|
$_ .= scalar (<IN>);
|
|
if (!$newlineerror) {
|
|
print "Err[$tid] string probably cut by newline at line $. .\n";
|
|
$newlineerror = 1;
|
|
}
|
|
# print "[$_]";
|
|
redo;
|
|
}
|
|
}
|
|
|
|
if (/^([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=(........)$/) {
|
|
my $tid = $1;
|
|
my $func = $2;
|
|
my $retaddr = $3;
|
|
my $segreg = $4;
|
|
my ($topfunc,$topaddr,$topseg);
|
|
|
|
# print "have ret func=$func <$_>\n";
|
|
if (!defined($tid_callstack{$tid}))
|
|
{
|
|
print "Err[$tid]: unknown tid\n";
|
|
next;
|
|
}
|
|
|
|
$segreg = "none" unless defined $segreg;
|
|
|
|
POP:
|
|
while (1) {
|
|
if ($#{$tid_callstack{$tid}} == -1) {
|
|
print "Err[$tid]: Return from $func to $retaddr with empty stack.\n";
|
|
next LINE;
|
|
}
|
|
|
|
($topfunc,$topaddr,$topseg) = @{pop @{$tid_callstack{$tid}}};
|
|
|
|
if ($topfunc ne $func) {
|
|
print "Err[$tid]: Return from $topfunc, but call from $func.\n";
|
|
next POP;
|
|
}
|
|
last POP;
|
|
}
|
|
|
|
my $addrok = ($topaddr eq $retaddr);
|
|
my $segok = ($topseg eq $segreg);
|
|
if ($addrok && $segok) {
|
|
print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
|
|
print "$func from $retaddr with $segreg.\n";
|
|
} else {
|
|
print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
|
|
if !$addrok;
|
|
print "Err[$tid]: Return from $func with segreg $segreg, not $topseg.\n"
|
|
if !$segok;
|
|
}
|
|
}
|
|
}
|
|
|
|
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";
|
|
}
|
|
}
|
|
|
|
close (IN);
|