#!/usr/bin/env perl
-# $Id: tracemunch,v 1.26 2019/12/21 22:33:35 tom Exp $
+# $Id: tracemunch,v 1.33 2020/12/26 23:56:50 tom Exp $
##############################################################################
-# Copyright (c) 1998-2018,2019 Free Software Foundation, Inc. #
+# Copyright 2018-2019,2020 Thomas E. Dickey #
+# Copyright 1998-2005,2017 Free Software Foundation, Inc. #
# #
# Permission is hereby granted, free of charge, to any person obtaining a #
# copy of this software and associated documentation files (the "Software"), #
use strict;
use warnings;
+$| = 1;
+
our $putattr =
'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};
my $type = $known_p1{$func};
chomp $addr;
$addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i;
- if ( $type == 1 ) {
+ if ( $addr !~ /^0x[[:xdigit:]]+$/i ) {
+ printf "OOPS - expected type #$type, skipping\n>>$addr\n";
+ }
+ elsif ( $type == 1 ) {
$scr_addr{$addr} = ++$scr_nums;
$arg = &transaddr($arg);
}
$trm_addr{$addr} = ++$trm_nums;
$arg = &transaddr($arg);
}
+ elsif ( $type == 8 ) {
+ $pan_addr{$addr} = ++$pan_nums;
+ $arg = &transaddr($arg);
+ }
}
}
CLASSIFY: {
+ next unless $_;
+
# just in case someone tries a file with cr/lf line-endings:
$_ =~ 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;