| #!/usr/bin/env perl |
| # $Id: tracemunch,v 1.27 2020/02/02 23:34:34 tom Exp $ |
| ############################################################################## |
| # 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"), # |
| # to deal in the Software without restriction, including without limitation # |
| # the rights to use, copy, modify, merge, publish, distribute, distribute # |
| # with modifications, sublicense, and/or sell copies of the Software, and to # |
| # permit persons to whom the Software is furnished to do so, subject to the # |
| # following conditions: # |
| # # |
| # The above copyright notice and this permission notice shall be included in # |
| # all copies or substantial portions of the Software. # |
| # # |
| # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR # |
| # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, # |
| # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL # |
| # THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER # |
| # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING # |
| # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER # |
| # DEALINGS IN THE SOFTWARE. # |
| # # |
| # Except as contained in this notice, the name(s) of the above copyright # |
| # holders shall not be used in advertising or otherwise to promote the sale, # |
| # use or other dealings in this Software without prior written # |
| # authorization. # |
| ############################################################################## |
| # tracemunch -- compactify ncurses trace logs |
| # |
| # The error logs produced by ncurses with tracing enabled can be very tedious |
| # to wade through. This script helps by compacting runs of log lines that |
| # can be conveniently expressed as higher-level operations. |
| |
| use strict; |
| use warnings; |
| |
| our $putattr = |
| 'PutAttrChar\(\{\{ ' . "'(.)'" |
| . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)'; |
| our $waddnstr = |
| 'waddnstr\(0x([[:xdigit:]]+),"([^\"]+)",[0-9]+\) called \{A_NORMAL\}'; |
| |
| # 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 |
| # such as SCREEN* and WINDOW* parameters. In this table, the type for the |
| # first parameter is encoded, relying upon an ncurses programming convention: |
| # 1 = SCREEN* |
| # 2 = WINDOW* |
| # 4 = TERMINAL* |
| our %known_p1 = qw( |
| TransformLine 1 |
| _nc_freewin 2 |
| _nc_initscr 1 |
| _nc_makenew 1 |
| _nc_mingw_console_read 1 |
| _nc_reset_colors 1 |
| _nc_scroll_optimize 1 |
| _nc_tinfo 1 |
| _nc_tinfo_mvcur 1 |
| _nc_wgetch 2 |
| adjust_window 2 |
| assume_default_colors 1 |
| attr_get 2 |
| baudrate 1 |
| beep 1 |
| border_set 2 |
| box 2 |
| box_set 2 |
| can_change_color 1 |
| cbreak 1 |
| clearok 2 |
| color_content 1 |
| copywin 2 |
| curs_set 1 |
| decrease_size 1 |
| def_prog_mode 1 |
| def_shell_mode 1 |
| define_key 1 |
| del_curterm 1 |
| delay_output 1 |
| delscreen 1 |
| delwin 2 |
| derwin 2 |
| doupdate 1 |
| dupwin 2 |
| echo 1 |
| endwin 1 |
| erasechar 1 |
| filter 1 |
| flash 1 |
| flushinp 1 |
| getattrs 2 |
| getbegx 2 |
| getbegy 2 |
| getbkgd 2 |
| getcurx 2 |
| getcury 2 |
| getmaxx 2 |
| getmaxy 2 |
| getmouse 1 |
| getparx 2 |
| getpary 2 |
| halfdelay 1 |
| has_ic 1 |
| has_il 1 |
| has_key 1 |
| idcok 2 |
| idlok 2 |
| immedok 2 |
| increase_size 1 |
| init_color 1 |
| init_pair 1 |
| intrflush 1 |
| is_cleared 2 |
| is_idcok 2 |
| is_idlok 2 |
| is_immedok 2 |
| is_keypad 2 |
| is_leaveok 2 |
| is_linetouched 2 |
| is_nodelay 2 |
| is_notimeout 2 |
| is_pad 2 |
| is_scrollok 2 |
| is_subwin 2 |
| is_syncok 2 |
| is_term_resized 1 |
| is_wintouched 2 |
| key_defined 1 |
| keybound 1 |
| keyok 1 |
| keypad 2 |
| killchar 1 |
| leaveok 2 |
| longname 1 |
| meta 2 |
| mouseinterval 1 |
| mousemask 1 |
| mvcur 1 |
| mvderwin 2 |
| mvwadd_wch 2 |
| mvwadd_wchnstr 2 |
| mvwadd_wchstr 2 |
| mvwaddch 2 |
| mvwaddchnstr 2 |
| mvwaddchstr 2 |
| mvwaddnstr 2 |
| mvwaddnwstr 2 |
| mvwaddstr 2 |
| mvwaddwstr 2 |
| mvwchgat 2 |
| mvwdelch 2 |
| mvwget_wch 2 |
| mvwget_wstr 2 |
| mvwgetch 2 |
| mvwgetn_wstr 2 |
| mvwgetnstr 2 |
| mvwgetstr 2 |
| mvwhline 2 |
| mvwhline_set 2 |
| mvwin 2 |
| mvwin_wch 2 |
| mvwin_wchnstr 2 |
| mvwin_wchstr 2 |
| mvwinch 2 |
| mvwinchnstr 2 |
| mvwinchstr 2 |
| mvwins_nwstr 2 |
| mvwins_wch 2 |
| mvwins_wstr 2 |
| mvwinsch 2 |
| mvwinsnstr 2 |
| mvwinsstr 2 |
| mvwinstr 2 |
| mvwinwstr 2 |
| mvwvline 2 |
| mvwvline_set 2 |
| newpad 1 |
| newterm 1 |
| newwin 1 |
| nl 1 |
| nocbreak 1 |
| nodelay 2 |
| noecho 1 |
| nofilter 1 |
| nonl 1 |
| noqiflush 1 |
| noraw 1 |
| notimeout 2 |
| overlap 2 |
| overlay 2 |
| overwrite 2 |
| pair_content 1 |
| pecho_wchar 2 |
| pechochar 2 |
| pnoutrefresh 2 |
| putwin 2 |
| qiflush 1 |
| raw 1 |
| redrawwin 2 |
| reset_prog_mode 1 |
| reset_shell_mode 1 |
| resetty 1 |
| resize_term 1 |
| resizeterm 1 |
| restartterm 1 |
| ripoffline 1 |
| savetty 1 |
| scr_init 1 |
| scr_restore 1 |
| scr_set 1 |
| scroll 2 |
| scrollok 2 |
| set_curterm 4 |
| set_term 1 |
| slk_attr 1 |
| slk_attr_set 1 |
| slk_attroff 1 |
| slk_attron 1 |
| slk_attrset 1 |
| slk_clear 1 |
| slk_color 1 |
| slk_init 1 |
| slk_label 1 |
| slk_noutrefresh 1 |
| slk_refresh 1 |
| slk_restore 1 |
| slk_set 1 |
| slk_touch 1 |
| start_color 1 |
| subwin 2 |
| syncok 2 |
| termattrs 1 |
| termname 1 |
| tgetflag 1 |
| tgetnum 1 |
| tigetflag 1 |
| tigetnum 1 |
| tigetstr 1 |
| tinfo 1 |
| touchline 2 |
| touchwin 2 |
| typeahead 1 |
| unget_wch 1 |
| ungetch 1 |
| ungetmouse 1 |
| untouchwin 2 |
| use_default_colors 1 |
| use_env 1 |
| use_legacy_coding 1 |
| use_screen 1 |
| use_tioctl 1 |
| use_window 2 |
| vidattr 1 |
| vidputs 1 |
| vw_printw 2 |
| vwprintw 2 |
| wadd_wch 2 |
| wadd_wchnstr 2 |
| wadd_wchstr 2 |
| waddch 2 |
| waddchnstr 2 |
| waddchstr 2 |
| waddnstr 2 |
| waddnwstr 2 |
| waddstr 2 |
| waddwstr 2 |
| wattr_get 2 |
| wattr_off 2 |
| wattr_on 2 |
| wattr_set 2 |
| wattroff 2 |
| wattron 2 |
| wattrset 2 |
| wbkgd 2 |
| wbkgdset 2 |
| wborder 2 |
| wborder_set 2 |
| wchgat 2 |
| wclear 2 |
| wclrtobot 2 |
| wclrtoeol 2 |
| wcolor_set 2 |
| wcursyncup 2 |
| wdelch 2 |
| wdeleteln 2 |
| wechochar 2 |
| wenclose 2 |
| werase 2 |
| wget_wch 2 |
| wget_wstr 2 |
| wgetbkgrnd 2 |
| wgetch 2 |
| wgetch_events 2 |
| wgetdelay 2 |
| wgetn_wstr 2 |
| wgetnstr 2 |
| wgetparent 2 |
| wgetscrreg 2 |
| wgetstr 2 |
| whline 2 |
| whline_set 2 |
| win_wch 2 |
| win_wchnstr 2 |
| win_wchstr 2 |
| winch 2 |
| winchnstr 2 |
| winchstr 2 |
| winnstr 2 |
| winnwstr 2 |
| wins_nwstr 2 |
| wins_wch 2 |
| wins_wstr 2 |
| winsch 2 |
| winsdelln 2 |
| winsertln 2 |
| winsnstr 2 |
| winsstr 2 |
| winstr 2 |
| winwstr 2 |
| wmouse_trafo 2 |
| wmove 2 |
| wnoutrefresh 2 |
| wprintw 2 |
| wredrawln 2 |
| wrefresh 2 |
| wresize 2 |
| wscrl 2 |
| wsetscrreg 2 |
| wstandend 2 |
| wstandout 2 |
| wsyncdown 2 |
| wsyncup 2 |
| wtimeout 2 |
| wtouchln 2 |
| wvline 2 |
| ); |
| |
| our $scr_nums = 0; |
| our $thr_nums = 0; |
| our $trm_nums = 0; |
| our $try_nums = 0; |
| our $win_nums = 0; |
| our $curscr = ""; |
| our $newscr = ""; |
| our $stdscr = ""; |
| our %scr_addr; |
| our %thr_addr; |
| our %trm_addr; |
| our %try_addr; |
| our %win_addr; |
| |
| sub has_addr($) { |
| my $value = shift; |
| my $result = 0; |
| $result = 1 if ( $value =~ /\b0x[[:xdigit:]]+\b/i ); |
| return $result; |
| } |
| |
| sub transaddr($) { |
| my $arg = shift; |
| my $n; |
| |
| $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 %scr_addr ) { |
| $n = $scr_addr{$addr}; |
| $arg =~ s/\b$addr\b/screen$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %thr_addr ) { |
| $n = $thr_addr{$addr}; |
| $arg =~ s/\b$addr\b/thread$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %trm_addr ) { |
| $n = $trm_addr{$addr}; |
| $arg =~ s/\b$addr\b/terminal$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %try_addr ) { |
| $n = $try_addr{$addr}; |
| $arg =~ s/\b$addr\b/tries_$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %win_addr ) { |
| $n = $win_addr{$addr}; |
| $arg =~ s/\b$addr\b/window$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| if ( $arg =~ /add_wch\((window\d+,)?0x[[:xdigit:]]+\)/i ) { |
| $arg =~ s/(0x[[:xdigit:]]+)[)]/\&wch)/i; |
| } |
| elsif ( |
| $arg =~ /color_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){3}/i ) |
| { |
| $arg =~ s/(,0x[[:xdigit:]]+){3}[)]/,\&r,\&g,\&b)/i; |
| } |
| elsif ( $arg =~ /pair_content\((screen\d+,)?\d+(,0x[[:xdigit:]]+){2}/i ) |
| { |
| $arg =~ s/(,0x[[:xdigit:]]+){2}[)]/,\&fg,\&bg)/i; |
| } |
| } |
| if ( &has_addr($arg) and $arg =~ /called\s+\{/ ) { |
| my $func = $arg; |
| chomp $func; |
| $func =~ s/^.*called\s+\{([[:alnum:]_]+)\(.*$/$1/; |
| if ( defined $known_p1{$func} ) { |
| my $addr = $arg; |
| my $type = $known_p1{$func}; |
| chomp $addr; |
| $addr =~ s/^[^(]+\((0x[[:xdigit:]]+).*/$1/i; |
| if ( $type == 1 ) { |
| $scr_addr{$addr} = ++$scr_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == 2 ) { |
| $win_addr{$addr} = ++$win_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == 4 ) { |
| $trm_addr{$addr} = ++$trm_nums; |
| $arg = &transaddr($arg); |
| } |
| } |
| } |
| |
| return $arg; |
| } |
| |
| sub muncher($) { |
| my $STDIN = shift; |
| |
| while (<$STDIN>) { |
| my $addr; |
| my $n; |
| my $awaiting = ""; |
| |
| CLASSIFY: { |
| |
| # just in case someone tries a file with cr/lf line-endings: |
| $_ =~ s/\r\n/\n/g; |
| $_ =~ s/\r/\n/g; |
| |
| my $thread = ""; |
| if ( $_ =~ /^(0x[[:xdigit:]]+):/ ) { |
| $thr_addr{$1} = ++$thr_nums unless defined $thr_addr{$1}; |
| $thread = "thread" . $thr_addr{$1} . ":"; |
| $_ =~ s/^[^:]*://; |
| } |
| |
| # Transform window pointer addresses so it's easier to compare logs |
| $awaiting = "curscr" if ( $_ =~ /creating curscr/ ); |
| $awaiting = "newscr" if ( $_ =~ /creating newscr/ ); |
| $awaiting = "stdscr" if ( $_ =~ /creating stdscr/ ); |
| $awaiting = "screen" if ( $_ =~ /^(\+ )*called \{new_prescr\(\)/ ); |
| if ( $_ =~ /^create :window 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| if ( $awaiting eq "curscr" ) { |
| $curscr = $addr; |
| } |
| elsif ( $awaiting eq "newscr" ) { |
| $newscr = $addr; |
| } |
| elsif ( $awaiting eq "stdscr" ) { |
| $stdscr = $addr; |
| } |
| else { |
| $win_addr{$addr} = $win_nums++; |
| } |
| $awaiting = ""; |
| } |
| elsif ( $_ =~ /^(\+ )*called \{set_curterm\((0x[[:xdigit:]]+)\)/ ) { |
| $trm_addr{$2} = ++$trm_nums unless defined $trm_addr{$2}; |
| } |
| elsif ( $_ =~ /^(\+ )*called \{_nc_add_to_try\((0x[[:xdigit:]]+),/ ) |
| { |
| $try_addr{$2} = ++$try_nums unless defined $try_addr{$2}; |
| } |
| elsif ( $_ =~ /^(\+ )*_nc_alloc_screen_sp 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$2"; |
| $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} ); |
| $awaiting = ""; |
| } |
| elsif ( $_ =~ /^(\+ )*return }0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$2"; |
| if ( $awaiting eq "screen" ) { |
| $scr_addr{$addr} = ++$scr_nums unless ( $scr_addr{$addr} ); |
| } |
| } |
| elsif ( $_ =~ /^\.\.\.deleted win=0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| $_ = &transaddr($_); |
| if ( $addr eq $curscr ) { |
| $curscr = ""; |
| } |
| elsif ( $addr eq $newscr ) { |
| $newscr = ""; |
| } |
| elsif ( $addr eq $stdscr ) { |
| $stdscr = ""; |
| } |
| else { |
| undef $win_addr{$addr}; |
| } |
| } |
| |
| # Compactify runs of PutAttrChar calls (TR_CHARPUT) |
| if ( $_ =~ /$putattr/ ) { |
| my $putattr_chars = $1; |
| my $starty = $2; |
| my $startx = $3; |
| while (<$STDIN>) { |
| if ( $_ =~ /$putattr/ ) { |
| $putattr_chars .= $1; |
| } |
| else { |
| last; |
| } |
| } |
| print |
| "RUN of PutAttrChar()s: \"$putattr_chars\" from ${starty}, ${startx}\n"; |
| redo CLASSIFY; |
| } |
| |
| # Compactify runs of waddnstr calls (TR_CALLS) |
| if ( $_ =~ /$waddnstr/ ) { |
| my $waddnstr_chars = $2; |
| my $winaddr = $1; |
| while (<$STDIN>) { |
| if ( $_ =~ /$waddnstr/ && $1 eq $winaddr ) { |
| $waddnstr_chars .= $2; |
| } |
| else { |
| last; |
| } |
| } |
| my $winaddstr = &transaddr($winaddr); |
| print "RUN of waddnstr()s: $winaddr, \"$waddnstr_chars\"\n"; |
| redo CLASSIFY; |
| } |
| |
| # More transformations can go here |
| |
| # Repeated runs of anything |
| my $anyline = &transaddr($_); |
| my $repeatcount = 1; |
| while (<$STDIN>) { |
| if ( &transaddr($_) eq $anyline ) { |
| $repeatcount++; |
| } |
| else { |
| last; |
| } |
| } |
| if ( $repeatcount > 1 ) { |
| print "${repeatcount} REPEATS OF $anyline"; |
| } |
| else { |
| print $thread . $anyline; |
| } |
| redo CLASSIFY if $_; |
| |
| } # :CLASSIFY |
| } |
| } |
| |
| if ( $#ARGV >= 0 ) { |
| while ( $#ARGV >= 0 ) { |
| my $file = shift @ARGV; |
| open my $ifh, "<", $file or die $!; |
| &muncher($ifh); |
| } |
| } |
| else { |
| &muncher( \*STDIN ); |
| } |
| |
| # tracemunch ends here |