#!/usr/bin/env perl
-# $Id: tracemunch,v 1.28 2020/03/08 12:22:49 tom Exp $
+# $Id: tracemunch,v 1.29 2020/04/18 23:52:24 tom Exp $
##############################################################################
# Copyright 2018-2019,2020 Thomas E. Dickey #
# Copyright 1998-2005,2017 Free Software Foundation, Inc. #
'PutAttrChar\(\{\{ ' . "'(.)'"
. ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)';
our $waddnstr =
- 'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}';
+'^called \{waddnstr\((0x[[:xdigit:]]+|window\d+),"((\\.|[^\"]*))",[-]?[0-9]+\)';
+
+our %TR = qw(
+ DISABLE 0x0000
+ TIMES 0x0001
+ TPUTS 0x0002
+ UPDATE 0x0004
+ MOVE 0x0008
+ CHARPUT 0x0010
+ ORDINARY 0x001F
+ CALLS 0x0020
+ VIRTPUT 0x0040
+ IEVENT 0x0080
+ BITS 0x0100
+ ICALLS 0x0200
+ CCALLS 0x0400
+ DATABASE 0x0800
+ ATTRS 0x1000
+);
+
+our $tracelevel = 0;
# If the trace is complete, we can infer addresses using the return value from
# newwin, etc. But if it is incomplete, we can still check for special cases
$_ =~ s/\r\n/\n/g;
$_ =~ s/\r/\n/g;
+ if ( $_ =~
+ /^TRACING NCURSES version.*\(tracelevel=(0x[[:xdigit:]]+)\)/ )
+ {
+ $tracelevel = hex $1;
+ print;
+ next;
+ }
+
my $thread = "";
if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) {
$thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1};
}
}
- # Compactify runs of PutAttrChar calls (TR_CHARPUT)
- if ( $_ =~ /$putattr/ ) {
+ # Compactify runs of PutAttrChar
+ if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ )
+ {
my $putattr_chars = $1;
my $starty = $2;
my $startx = $3;
$putattr_chars .= $1;
}
else {
+ next if ( $_ =~ /^PUTC 0x[[:xdigit:]]+.*/ );
+ next if ( $_ =~ /^\.\.\.skip.*/ );
+ next if ( $_ =~ /^forced to blank.*/ );
last;
}
}
- print
-"RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n";
+ print "RUN of PutAttrChar()s:"
+ . " \"$putattr_chars\" from ${starty}, ${startx}\n";
redo CLASSIFY;
}
- # Compactify runs of waddnstr calls (TR_CALLS)
- if ( $_ =~ /$waddnstr/ ) {
+ # Compactify runs of waddnstr calls
+ if ( ( ( $tracelevel & $TR{CALLS} ) != 0 ) and $_ =~ /$waddnstr/ ) {
my $waddnstr_chars = $2;
my $winaddr = $1;
while (<$STDIN>) {
+ next if ( $_ =~ /^return \}0/ );
if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) {
$waddnstr_chars .= $2;
}
}
}
my $winaddstr = &transaddr($winaddr);
- print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n";
+ print "RUN of waddnstr()s:"
+ . " $winaddstr, \"$waddnstr_chars\"\n";
redo CLASSIFY;
}
}
}
+for my $tr ( keys %TR ) {
+ $TR{$tr} = hex $TR{$tr};
+}
+
if ( $#ARGV >= 0 ) {
while ( $#ARGV >= 0 ) {
my $file = shift @ARGV;