Add full format to examine-relay
Duane Clark
dclark at akamail.com
Mon Mar 3 20:27:37 CST 2003
This adds a full listing format option to examine-relay, rather than
having a separate program.
Changelog:
Add full listing format option.
Fix an infinite loop if the last line is a partial line.
-------------- next part --------------
Index: tools/examine-relay
===================================================================
RCS file: /home/wine/wine/tools/examine-relay,v
retrieving revision 1.6
diff -u -r1.6 examine-relay
--- tools/examine-relay 1 Jun 2002 02:55:52 -0000 1.6
+++ tools/examine-relay 4 Mar 2003 02:24:26 -0000
@@ -7,6 +7,11 @@
# whether calls and returns match. If not, this suggests that the parameter
# list might be incorrect. (It could be something else also.)
#
+# 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.
+#
# Copyright 1997-1998 Morten Welinder (terra at diku.dk)
# 2001 Eric Pouech
#
@@ -28,21 +33,30 @@
use strict;
my $srcfile = $ARGV[0];
+my $fullformat = $ARGV[1];
my %tid_callstack = ();
my $newlineerror = 0;
my $indentp = 1;
+my $lasttid = 0;
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]+)\((.*\)) .*/) {
+ if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/) {
my $tid = $1;
my $func = $2;
+ if (defined $fullformat) {
+ if ($lasttid ne $tid) {
+ print "******** thread change\n"
+ }
+ $lasttid = $tid;
-# print "have call func=$func <$_>\n";
+ print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
+ print "$_";
+ }
+# print "have call func=$func $_";
if (/ ret=(........)$/ ||
/ ret=(....:....) (ds=....)$/ ||
/ ret=(........) fs=....$/) {
@@ -53,7 +67,7 @@
push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
next;
- } else {
+ } elsif (not eof IN) {
# Assume a line got cut by a line feed in a string.
$_ .= scalar (<IN>);
if (!$newlineerror) {
@@ -65,15 +79,39 @@
}
}
- if (/^([0-9a-f]+):Ret ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\(.*\) .* ret=(........)$/ ||
+ 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];
+ }
+
+ 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=(........)$/) {
+ /^([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=(........)$/ ||
+ /^([0-9a-f]+):Ret (window proc) ([0-9a-fx]+) .*/) {
my $tid = $1;
my $func = $2;
my $retaddr = $3;
my $segreg = $4;
my ($topfunc,$topaddr,$topseg);
+ if (defined $fullformat) {
+ if ($lasttid ne $tid) {
+ print "******** thread change\n"
+ }
+ $lasttid = $tid;
+ }
# print "have ret func=$func <$_>\n";
if (!defined($tid_callstack{$tid}))
@@ -103,14 +141,23 @@
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";
+ 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";
+ }
} 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;
}
+ }
+
+ else {
+ print "$_";
}
}
More information about the wine-patches
mailing list