forked from Mirrors/wine-wine
Add full listing format option.
Fix an infinite loop if the last line is a partial line.oldstable
parent
53b5a4746f
commit
3377a9c8e2
|
@ -7,6 +7,11 @@
|
||||||
# whether calls and returns match. If not, this suggests that the parameter
|
# whether calls and returns match. If not, this suggests that the parameter
|
||||||
# list might be incorrect. (It could be something else also.)
|
# 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@diku.dk)
|
# Copyright 1997-1998 Morten Welinder (terra@diku.dk)
|
||||||
# 2001 Eric Pouech
|
# 2001 Eric Pouech
|
||||||
#
|
#
|
||||||
|
@ -28,21 +33,30 @@
|
||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
my $srcfile = $ARGV[0];
|
my $srcfile = $ARGV[0];
|
||||||
|
my $fullformat = $ARGV[1];
|
||||||
my %tid_callstack = ();
|
my %tid_callstack = ();
|
||||||
my $newlineerror = 0;
|
my $newlineerror = 0;
|
||||||
my $indentp = 1;
|
my $indentp = 1;
|
||||||
|
my $lasttid = 0;
|
||||||
|
|
||||||
open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
|
open (IN, "<$srcfile") || die "Cannot open $srcfile for reading: $!\n";
|
||||||
LINE:
|
LINE:
|
||||||
while (<IN>) {
|
while (<IN>) {
|
||||||
|
|
||||||
|
|
||||||
if (/^([0-9a-f]+):Call ([A-Za-z0-9]+\.[A-Za-z0-9_]+)\((.*\)) .*/ ||
|
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 $tid = $1;
|
||||||
my $func = $2;
|
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=(........)$/ ||
|
if (/ ret=(........)$/ ||
|
||||||
/ ret=(....:....) (ds=....)$/ ||
|
/ ret=(....:....) (ds=....)$/ ||
|
||||||
/ ret=(........) fs=....$/) {
|
/ ret=(........) fs=....$/) {
|
||||||
|
@ -53,7 +67,7 @@ while (<IN>) {
|
||||||
|
|
||||||
push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
|
push @{$tid_callstack{$tid}}, [$func, $retaddr, $segreg];
|
||||||
next;
|
next;
|
||||||
} else {
|
} elsif (not eof IN) {
|
||||||
# Assume a line got cut by a line feed in a string.
|
# Assume a line got cut by a line feed in a string.
|
||||||
$_ .= scalar (<IN>);
|
$_ .= scalar (<IN>);
|
||||||
if (!$newlineerror) {
|
if (!$newlineerror) {
|
||||||
|
@ -65,15 +79,39 @@ while (<IN>) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
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=(....:....) (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_]+)\(.*\) .* 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_]+: [A-Za-z0-9]+)\(.*\) .* ret=(........)$/ ||
|
||||||
|
/^([0-9a-f]+):Ret (window proc) ([0-9a-fx]+) .*/) {
|
||||||
my $tid = $1;
|
my $tid = $1;
|
||||||
my $func = $2;
|
my $func = $2;
|
||||||
my $retaddr = $3;
|
my $retaddr = $3;
|
||||||
my $segreg = $4;
|
my $segreg = $4;
|
||||||
my ($topfunc,$topaddr,$topseg);
|
my ($topfunc,$topaddr,$topseg);
|
||||||
|
if (defined $fullformat) {
|
||||||
|
if ($lasttid ne $tid) {
|
||||||
|
print "******** thread change\n"
|
||||||
|
}
|
||||||
|
$lasttid = $tid;
|
||||||
|
}
|
||||||
|
|
||||||
# print "have ret func=$func <$_>\n";
|
# print "have ret func=$func <$_>\n";
|
||||||
if (!defined($tid_callstack{$tid}))
|
if (!defined($tid_callstack{$tid}))
|
||||||
|
@ -103,8 +141,13 @@ while (<IN>) {
|
||||||
my $addrok = ($topaddr eq $retaddr);
|
my $addrok = ($topaddr eq $retaddr);
|
||||||
my $segok = ($topseg eq $segreg);
|
my $segok = ($topseg eq $segreg);
|
||||||
if ($addrok && $segok) {
|
if ($addrok && $segok) {
|
||||||
print "Ok [$tid]: ", ($indentp ? (' ' x (1 + $#{$tid_callstack{$tid}})) : '');
|
if (defined $fullformat) {
|
||||||
print "$func from $retaddr with $segreg.\n";
|
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 {
|
} else {
|
||||||
print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
|
print "Err[$tid]: Return from $func is to $retaddr, not $topaddr.\n"
|
||||||
if !$addrok;
|
if !$addrok;
|
||||||
|
@ -112,6 +155,10 @@ while (<IN>) {
|
||||||
if !$segok;
|
if !$segok;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
else {
|
||||||
|
print "$_";
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
foreach my $tid (keys %tid_callstack) {
|
foreach my $tid (keys %tid_callstack) {
|
||||||
|
|
Loading…
Reference in New Issue