#!/usr/bin/env perl
-# $Id: tracemunch,v 1.28 2020/03/08 12:22:49 tom Exp $
+# $Id: tracemunch,v 1.32 2020/09/26 19:40:55 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
# 1 = SCREEN*
# 2 = WINDOW*
# 4 = TERMINAL*
+# 8 = PANEL*
our %known_p1 = qw(
TransformLine 1
+ _nc_console_read 1
_nc_freewin 2
_nc_initscr 1
_nc_makenew 1
baudrate 1
beep 1
border_set 2
+ bottom_panel 8
box 2
box_set 2
can_change_color 1
def_shell_mode 1
define_key 1
del_curterm 1
+ del_panel 8
delay_output 1
delscreen 1
delwin 2
has_ic 1
has_il 1
has_key 1
+ hide_panel 8
idcok 2
idlok 2
immedok 2
meta 2
mouseinterval 1
mousemask 1
+ move_panel 8
mvcur 1
mvderwin 2
mvwadd_wch 2
mvwinwstr 2
mvwvline 2
mvwvline_set 2
+ new_panel 2
newpad 1
newterm 1
newwin 1
overlay 2
overwrite 2
pair_content 1
+ panel_above 8
+ panel_below 8
+ panel_hidden 8
+ panel_userptr 8
+ panel_window 8
pecho_wchar 2
pechochar 2
pnoutrefresh 2
qiflush 1
raw 1
redrawwin 2
+ replace_panel 8
reset_prog_mode 1
reset_shell_mode 1
resetty 1
scroll 2
scrollok 2
set_curterm 4
+ set_panel_userptr 8
set_term 1
+ show_panel 8
slk_attr 1
slk_attr_set 1
slk_attroff 1
tigetnum 1
tigetstr 1
tinfo 1
+ top_panel 8
touchline 2
touchwin 2
typeahead 1
wvline 2
);
+our $pan_nums = 0;
our $scr_nums = 0;
our $thr_nums = 0;
our $trm_nums = 0;
our $try_nums = 0;
+our $usr_nums = 0;
our $win_nums = 0;
-our $curscr = "";
-our $newscr = "";
-our $stdscr = "";
+
+our $curscr = "";
+our $newscr = "";
+our $stdscr = "";
+
+our %pan_addr;
our %scr_addr;
our %thr_addr;
our %trm_addr;
our %try_addr;
+our %usr_addr;
our %win_addr;
sub has_addr($) {
$arg =~ s/\b$curscr\b/curscr/g if ($curscr);
$arg =~ s/\b$newscr\b/newscr/g if ($newscr);
$arg =~ s/\b$stdscr\b/stdscr/g if ($stdscr);
+ if ( &has_addr($arg) ) {
+ foreach my $addr ( keys %pan_addr ) {
+ $n = $pan_addr{$addr};
+ $arg =~ s/\b$addr\b/panel$n/g if ( defined $n );
+ }
+ }
if ( &has_addr($arg) ) {
foreach my $addr ( keys %scr_addr ) {
$n = $scr_addr{$addr};
$arg =~ s/\b$addr\b/tries_$n/g if ( defined $n );
}
}
+ if ( &has_addr($arg) ) {
+ foreach my $addr ( keys %usr_addr ) {
+ $n = $usr_addr{$addr};
+ $arg =~ s/\b$addr\b/user_ptr$n/g if ( defined $n );
+ }
+ }
if ( &has_addr($arg) ) {
foreach my $addr ( keys %win_addr ) {
$n = $win_addr{$addr};
$trm_addr{$addr} = ++$trm_nums;
$arg = &transaddr($arg);
}
+ elsif ( $type == 8 ) {
+ $pan_addr{$addr} = ++$pan_nums;
+ $arg = &transaddr($arg);
+ }
}
}
$_ =~ 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};
}
$awaiting = "";
}
+ elsif ( $_ =~ /^create :(root|new)_panel 0x([[:xdigit:]]+)/ ) {
+ $addr = "0x$2";
+ $pan_addr{$addr} = $pan_nums++;
+ $_ = &transaddr($_);
+ }
+ elsif ( $_ =~ /^create :user_ptr 0x([[:xdigit:]]+)/ ) {
+ $addr = "0x$1";
+ $usr_addr{$addr} = $usr_nums++;
+ $_ = &transaddr($_);
+ }
elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) {
$trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2};
}
undef $win_addr{$addr};
}
}
+ elsif ( $_ =~ /^\.\.\.deleted pan=\"0x([[:xdigit:]]+)\"/ ) {
+ $addr = "0x$1";
+ $_ = &transaddr($_);
+ undef $pan_addr{$addr};
+ }
- # 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;