wine/tools/examine-relay

#!/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)
#
# -----------------------------------------------------------------------------

my $srcfile = $ARGV[0];
my @callstack = ();
my $newlineerror = 0;
my $indentp = 1;

open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
LINE:
while (<IN>) {
    if (/^Call ([A-Za-z0-9]+\.\d+): .*\)/) {
	my $func = $1;
	if (/ ret=(........)$/ ||
	    / ret=(....:....) (ds=....)$/ ||
	    / ret=(........) (fs=....)$/) {
	    my $retaddr = $1;
	    my $segreg = $2;

	    $segreg = "none" unless defined $segreg;
	    push @callstack, [$func,$retaddr, $segreg];
	    next;
	} else {
	    # Assume a line got cut by a line feed in a string.
	    $_ .= scalar (<IN>);
	    if (!$newlineerror) {
		print "Error: string probably cut by newline.\n";
		$newlineerror = 1;
	    }	    
	    # print "[$_]";
	    redo;
	}
    }


    if (/^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........)$/ ||
	/^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(....:....) (ds=....)$/ ||
	/^Ret  ([A-Za-z0-9]+\.\d+): .* ret=(........) (fs=....)$/) {
	my $func = $1;
	my $retaddr = $2;
	my $segreg = $3;
	my ($topfunc,$topaddr,$topseg);

	$segreg = "none" unless defined $segreg;

      POP:
	while (1) {
	    if ($#callstack == -1) {
		print "Error: Return from $func to $retaddr with empty stack.\n";
		next LINE;
	    }

	    ($topfunc,$topaddr,$topseg) = @{pop @callstack};

	    if ($topfunc ne $func) {
		print "Error: 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: ", ($indentp ? (' ' x (1 + $#callstack)) : '');
	    print "$func from $retaddr with $segreg.\n";
	} else {
	    print "Error: Return from $func is to $retaddr, not $topaddr.\n"
		if !$addrok;
	    print "Error: Return from $func with segreg $segreg, not $topseg.\n"
		if !$segok;
	}    
    }
}

while ($#callstack != -1) {
    my ($topfunc,$topaddr) = @{pop @callstack};
    print "Error: leftover call to $topfunc from $topaddr.\n";
}

close (IN);