An adaption from examine-relay.
Changelog:
A tool for indenting calls in relay traces.
--- /dev/null Thu Apr 11 07:25:15 2002
+++ tools/indent-relay Mon Mar 3 10:26:56 2003
@@ -0,0 +1,199 @@
+#!/usr/bin/perl -w
+# -----------------------------------------------------------------------------
+#
+# indent-relay
+#
+# This program will indent the calls of a relay trace. It is a modification
+# of the program examine-relay, which has these copyrights:
+#
+# 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;
+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_]+)\((.*\)) .*/) {
+ my $tid = $1;
+ my $func = $2;
+ if ($lasttid ne $tid) {
+ print "******** thread change\n"
+ }
+ $lasttid = $tid;
+
+# print "have call func=$func $_";
+ print ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
+ print "$_";
+ 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;
+ }
+ }
+
+ elsif (/^([0-9a-f]+):Call (window proc) ([0-9a-fx]+) .*/) {
+ my $tid = $1;
+ my $func = $2;
+ my $retaddr = $3;
+ my $segreg = "none";
+ 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=(........)$/) {
+ my $tid = $1;
+ my $func = $2;
+ my $retaddr = $3;
+ my $segreg = $4;
+ my ($topfunc,$topaddr,$topseg);
+ if ($lasttid ne $tid) {
+ print "******** thread change\n"
+ }
+ $lasttid = $tid;
+
+# 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 ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
+ print "$_";
+ } 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;
+ }
+ }
+
+ elsif (/^([0-9a-f]+):Ret (window proc) ([0-9a-fx]+) .*/) {
+ my $tid = $1;
+ my $func = $2;
+ my $retaddr = $3;
+ my $segreg = "none";
+ my ($topfunc,$topaddr,$topseg);
+ if ($lasttid ne $tid) {
+ print "******** thread change\n"
+ }
+ $lasttid = $tid;
+
+ if (!defined($tid_callstack{$tid}))
+ {
+ print "Err[$tid]: unknown tid\n";
+ next;
+ }
+
+
+ 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 ($indentp ? (' ' x 2 x (1 + $#{$tid_callstack{$tid}})) : '');
+ print "$_";
+ } 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 "$_";
+ }
+}
+
+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);
