| #!/usr/bin/env perl |
| # $Id: tracemunch,v 1.41 2021/09/04 10:31:03 tom Exp $ |
| ############################################################################## |
| # Copyright 2018-2020,2021 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; |
| |
| $| = 1; |
| |
| our $putattr = |
| 'PutAttrChar\(\{\{ ' . "'(.)'" |
| . ' = 0[0-7]+ \}\}\) at \(([0-9]+), ([0-9]+)\)'; |
| our $waddnstr = |
| '^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; |
| |
| our $tSCREEN = 1; # SCREEN* |
| our $tWINDOW = 2; # WINDOW* |
| our $tTERMINAL = 3; # TERMINAL* |
| our $tPANEL = 4; # PANEL* |
| our $tFIELD = 5; # FIELD* |
| our $tFORM = 5; # FORM* |
| our $tMENU = 6; # MENU* |
| our $tITEM = 7; # ITEM* |
| |
| our %known_p1_types = ( |
| $tSCREEN => "SCREEN*", |
| $tWINDOW => "WINDOW*", |
| $tTERMINAL => "TERMINAL*", |
| $tPANEL => "PANEL*", |
| $tFORM => "FORM*", |
| $tFIELD => "FIELD*", |
| $tMENU => "MENU*", |
| $tITEM => "ITEM*", |
| ); |
| |
| # 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: |
| our %known_p1 = ( |
| TransformLine => $tSCREEN, |
| _nc_console_read => $tSCREEN, |
| _nc_freewin => $tWINDOW, |
| _nc_initscr => $tSCREEN, |
| _nc_makenew => $tSCREEN, |
| _nc_mingw_console_read => $tSCREEN, |
| _nc_reset_colors => $tSCREEN, |
| _nc_scroll_optimize => $tSCREEN, |
| _nc_tinfo => $tSCREEN, |
| _nc_tinfo_mvcur => $tSCREEN, |
| _nc_wgetch => $tWINDOW, |
| adjust_window => $tWINDOW, |
| assume_default_colors => $tSCREEN, |
| attr_get => $tWINDOW, |
| baudrate => $tSCREEN, |
| beep => $tSCREEN, |
| border_set => $tWINDOW, |
| bottom_panel => $tPANEL, |
| bottom_panel => $tPANEL, |
| box => $tWINDOW, |
| box_set => $tWINDOW, |
| can_change_color => $tSCREEN, |
| cbreak => $tSCREEN, |
| ceiling_panel => $tSCREEN, |
| clearok => $tWINDOW, |
| color_content => $tSCREEN, |
| copywin => $tWINDOW, |
| current_item => $tMENU, |
| curs_set => $tSCREEN, |
| decrease_size => $tSCREEN, |
| def_prog_mode => $tSCREEN, |
| def_shell_mode => $tSCREEN, |
| define_key => $tSCREEN, |
| del_curterm => $tSCREEN, |
| del_panel => $tPANEL, |
| del_panel => $tPANEL, |
| delay_output => $tSCREEN, |
| delscreen => $tSCREEN, |
| delwin => $tWINDOW, |
| derwin => $tWINDOW, |
| doupdate => $tSCREEN, |
| dup_field => $tFIELD, |
| dupwin => $tWINDOW, |
| echo => $tSCREEN, |
| endwin => $tSCREEN, |
| erasechar => $tSCREEN, |
| field_opts_off => $tFIELD, |
| field_opts_on => $tFIELD, |
| filter => $tSCREEN, |
| flash => $tSCREEN, |
| flushinp => $tSCREEN, |
| form_driver => $tFORM, |
| form_driver_w => $tFORM, |
| form_opts_off => $tFORM, |
| form_opts_on => $tFORM, |
| free_field => $tFIELD, |
| free_form => $tFORM, |
| free_item => $tITEM, |
| free_menu => $tMENU, |
| getattrs => $tWINDOW, |
| getbegx => $tWINDOW, |
| getbegy => $tWINDOW, |
| getbkgd => $tWINDOW, |
| getcurx => $tWINDOW, |
| getcury => $tWINDOW, |
| getmaxx => $tWINDOW, |
| getmaxy => $tWINDOW, |
| getmouse => $tSCREEN, |
| getparx => $tWINDOW, |
| getpary => $tWINDOW, |
| ground_panel => $tSCREEN, |
| halfdelay => $tSCREEN, |
| has_ic => $tSCREEN, |
| has_il => $tSCREEN, |
| has_key => $tSCREEN, |
| hide_panel => $tPANEL, |
| hide_panel => $tPANEL, |
| idcok => $tWINDOW, |
| idlok => $tWINDOW, |
| immedok => $tWINDOW, |
| increase_size => $tSCREEN, |
| init_color => $tSCREEN, |
| init_pair => $tSCREEN, |
| intrflush => $tSCREEN, |
| is_cleared => $tWINDOW, |
| is_idcok => $tWINDOW, |
| is_idlok => $tWINDOW, |
| is_immedok => $tWINDOW, |
| is_keypad => $tWINDOW, |
| is_leaveok => $tWINDOW, |
| is_linetouched => $tWINDOW, |
| is_nodelay => $tWINDOW, |
| is_notimeout => $tWINDOW, |
| is_pad => $tWINDOW, |
| is_scrollok => $tWINDOW, |
| is_subwin => $tWINDOW, |
| is_syncok => $tWINDOW, |
| is_term_resized => $tSCREEN, |
| is_wintouched => $tWINDOW, |
| item_count => $tMENU, |
| item_description => $tITEM, |
| item_index => $tITEM, |
| item_init => $tMENU, |
| item_name => $tITEM, |
| item_opts => $tITEM, |
| item_opts_off => $tITEM, |
| item_opts_on => $tITEM, |
| item_term => $tMENU, |
| item_userptr => $tITEM, |
| item_value => $tITEM, |
| item_visible => $tITEM, |
| key_defined => $tSCREEN, |
| keybound => $tSCREEN, |
| keyok => $tSCREEN, |
| keypad => $tWINDOW, |
| killchar => $tSCREEN, |
| leaveok => $tWINDOW, |
| link_field => $tFIELD, |
| longname => $tSCREEN, |
| menu_back => $tMENU, |
| menu_driver => $tMENU, |
| menu_fore => $tMENU, |
| menu_format => $tMENU, |
| menu_grey => $tMENU, |
| menu_init => $tMENU, |
| menu_items => $tMENU, |
| menu_mark => $tMENU, |
| menu_opts => $tMENU, |
| menu_opts_off => $tMENU, |
| menu_opts_on => $tMENU, |
| menu_pad => $tMENU, |
| menu_pattern => $tMENU, |
| menu_spacing => $tMENU, |
| menu_sub => $tMENU, |
| menu_term => $tMENU, |
| menu_userptr => $tMENU, |
| menu_win => $tMENU, |
| meta => $tWINDOW, |
| mouseinterval => $tSCREEN, |
| mousemask => $tSCREEN, |
| move_field => $tFIELD, |
| move_panel => $tPANEL, |
| move_panel => $tPANEL, |
| mvcur => $tSCREEN, |
| mvderwin => $tWINDOW, |
| mvwadd_wch => $tWINDOW, |
| mvwadd_wchnstr => $tWINDOW, |
| mvwadd_wchstr => $tWINDOW, |
| mvwaddch => $tWINDOW, |
| mvwaddchnstr => $tWINDOW, |
| mvwaddchstr => $tWINDOW, |
| mvwaddnstr => $tWINDOW, |
| mvwaddnwstr => $tWINDOW, |
| mvwaddstr => $tWINDOW, |
| mvwaddwstr => $tWINDOW, |
| mvwchgat => $tWINDOW, |
| mvwdelch => $tWINDOW, |
| mvwget_wch => $tWINDOW, |
| mvwget_wstr => $tWINDOW, |
| mvwgetch => $tWINDOW, |
| mvwgetn_wstr => $tWINDOW, |
| mvwgetnstr => $tWINDOW, |
| mvwgetstr => $tWINDOW, |
| mvwhline => $tWINDOW, |
| mvwhline_set => $tWINDOW, |
| mvwin => $tWINDOW, |
| mvwin_wch => $tWINDOW, |
| mvwin_wchnstr => $tWINDOW, |
| mvwin_wchstr => $tWINDOW, |
| mvwinch => $tWINDOW, |
| mvwinchnstr => $tWINDOW, |
| mvwinchstr => $tWINDOW, |
| mvwins_nwstr => $tWINDOW, |
| mvwins_wch => $tWINDOW, |
| mvwins_wstr => $tWINDOW, |
| mvwinsch => $tWINDOW, |
| mvwinsnstr => $tWINDOW, |
| mvwinsstr => $tWINDOW, |
| mvwinstr => $tWINDOW, |
| mvwinwstr => $tWINDOW, |
| mvwvline => $tWINDOW, |
| mvwvline_set => $tWINDOW, |
| new_panel => $tWINDOW, |
| new_panel => $tWINDOW, |
| newpad => $tSCREEN, |
| newterm => $tSCREEN, |
| newwin => $tSCREEN, |
| nl => $tSCREEN, |
| nocbreak => $tSCREEN, |
| nodelay => $tWINDOW, |
| noecho => $tSCREEN, |
| nofilter => $tSCREEN, |
| nonl => $tSCREEN, |
| noqiflush => $tSCREEN, |
| noraw => $tSCREEN, |
| notimeout => $tWINDOW, |
| overlap => $tWINDOW, |
| overlay => $tWINDOW, |
| overwrite => $tWINDOW, |
| pair_content => $tSCREEN, |
| panel_above => $tPANEL, |
| panel_above => $tPANEL, |
| panel_below => $tPANEL, |
| panel_below => $tPANEL, |
| panel_hidden => $tPANEL, |
| panel_hidden => $tPANEL, |
| panel_userptr => $tPANEL, |
| panel_userptr => $tPANEL, |
| panel_window => $tPANEL, |
| panel_window => $tPANEL, |
| pecho_wchar => $tWINDOW, |
| pechochar => $tWINDOW, |
| pnoutrefresh => $tWINDOW, |
| pos_form_cursor => $tFORM, |
| pos_menu_cursor => $tMENU, |
| post_form => $tFORM, |
| post_menu => $tMENU, |
| putwin => $tWINDOW, |
| qiflush => $tSCREEN, |
| raw => $tSCREEN, |
| redrawwin => $tWINDOW, |
| replace_panel => $tPANEL, |
| replace_panel => $tPANEL, |
| reset_prog_mode => $tSCREEN, |
| reset_shell_mode => $tSCREEN, |
| resetty => $tSCREEN, |
| resize_term => $tSCREEN, |
| resizeterm => $tSCREEN, |
| restartterm => $tSCREEN, |
| ripoffline => $tSCREEN, |
| savetty => $tSCREEN, |
| scale_menu => $tMENU, |
| scr_init => $tSCREEN, |
| scr_restore => $tSCREEN, |
| scr_set => $tSCREEN, |
| scroll => $tWINDOW, |
| scrollok => $tWINDOW, |
| set_current_field => $tFORM, |
| set_current_item => $tMENU, |
| set_curterm => $tTERMINAL, |
| set_field_back => $tFIELD, |
| set_field_buffer => $tFIELD, |
| set_field_fore => $tFIELD, |
| set_field_init => $tFORM, |
| set_field_just => $tFIELD, |
| set_field_opts => $tFIELD, |
| set_field_pad => $tFIELD, |
| set_field_status => $tFIELD, |
| set_field_term => $tFORM, |
| set_field_type => $tFIELD, |
| set_field_userptr => $tFIELD, |
| set_form_fields => $tFORM, |
| set_form_init => $tFORM, |
| set_form_opts => $tFORM, |
| set_form_page => $tFORM, |
| set_form_sub => $tFORM, |
| set_form_term => $tFORM, |
| set_form_userptr => $tFORM, |
| set_form_win => $tFORM, |
| set_item_init => $tMENU, |
| set_item_opts => $tITEM, |
| set_item_term => $tMENU, |
| set_item_userptr => $tITEM, |
| set_item_value => $tITEM, |
| set_menu_back => $tMENU, |
| set_menu_fore => $tMENU, |
| set_menu_format => $tMENU, |
| set_menu_grey => $tMENU, |
| set_menu_init => $tMENU, |
| set_menu_items => $tMENU, |
| set_menu_mark => $tMENU, |
| set_menu_opts => $tMENU, |
| set_menu_pad => $tMENU, |
| set_menu_pattern => $tMENU, |
| set_menu_spacing => $tMENU, |
| set_menu_sub => $tMENU, |
| set_menu_term => $tMENU, |
| set_menu_userptr => $tMENU, |
| set_menu_win => $tMENU, |
| set_new_page => $tFIELD, |
| set_panel_userptr => $tPANEL, |
| set_panel_userptr => $tPANEL, |
| set_term => $tSCREEN, |
| set_top_row => $tMENU, |
| show_panel => $tPANEL, |
| show_panel => $tPANEL, |
| slk_attr => $tSCREEN, |
| slk_attr_set => $tSCREEN, |
| slk_attroff => $tSCREEN, |
| slk_attron => $tSCREEN, |
| slk_attrset => $tSCREEN, |
| slk_clear => $tSCREEN, |
| slk_color => $tSCREEN, |
| slk_init => $tSCREEN, |
| slk_label => $tSCREEN, |
| slk_noutrefresh => $tSCREEN, |
| slk_refresh => $tSCREEN, |
| slk_restore => $tSCREEN, |
| slk_set => $tSCREEN, |
| slk_touch => $tSCREEN, |
| start_color => $tSCREEN, |
| subwin => $tWINDOW, |
| syncok => $tWINDOW, |
| termattrs => $tSCREEN, |
| termname => $tSCREEN, |
| tgetflag => $tSCREEN, |
| tgetnum => $tSCREEN, |
| tigetflag => $tSCREEN, |
| tigetnum => $tSCREEN, |
| tigetstr => $tSCREEN, |
| tinfo => $tSCREEN, |
| top_panel => $tPANEL, |
| top_panel => $tPANEL, |
| top_row => $tMENU, |
| touchline => $tWINDOW, |
| touchwin => $tWINDOW, |
| typeahead => $tSCREEN, |
| unfocus_current_field => $tFORM, |
| unget_wch => $tSCREEN, |
| ungetch => $tSCREEN, |
| ungetmouse => $tSCREEN, |
| unpost_form => $tFORM, |
| unpost_menu => $tMENU, |
| untouchwin => $tWINDOW, |
| update_panels_sp => $tSCREEN, |
| use_default_colors => $tSCREEN, |
| use_env => $tSCREEN, |
| use_legacy_coding => $tSCREEN, |
| use_screen => $tSCREEN, |
| use_tioctl => $tSCREEN, |
| use_window => $tWINDOW, |
| vidattr => $tSCREEN, |
| vidputs => $tSCREEN, |
| vw_printw => $tWINDOW, |
| vwprintw => $tWINDOW, |
| wadd_wch => $tWINDOW, |
| wadd_wchnstr => $tWINDOW, |
| wadd_wchstr => $tWINDOW, |
| waddch => $tWINDOW, |
| waddchnstr => $tWINDOW, |
| waddchstr => $tWINDOW, |
| waddnstr => $tWINDOW, |
| waddnwstr => $tWINDOW, |
| waddstr => $tWINDOW, |
| waddwstr => $tWINDOW, |
| wattr_get => $tWINDOW, |
| wattr_off => $tWINDOW, |
| wattr_on => $tWINDOW, |
| wattr_set => $tWINDOW, |
| wattroff => $tWINDOW, |
| wattron => $tWINDOW, |
| wattrset => $tWINDOW, |
| wbkgd => $tWINDOW, |
| wbkgdset => $tWINDOW, |
| wborder => $tWINDOW, |
| wborder_set => $tWINDOW, |
| wchgat => $tWINDOW, |
| wclear => $tWINDOW, |
| wclrtobot => $tWINDOW, |
| wclrtoeol => $tWINDOW, |
| wcolor_set => $tWINDOW, |
| wcursyncup => $tWINDOW, |
| wdelch => $tWINDOW, |
| wdeleteln => $tWINDOW, |
| wechochar => $tWINDOW, |
| wenclose => $tWINDOW, |
| werase => $tWINDOW, |
| wget_wch => $tWINDOW, |
| wget_wstr => $tWINDOW, |
| wgetbkgrnd => $tWINDOW, |
| wgetch => $tWINDOW, |
| wgetch_events => $tWINDOW, |
| wgetdelay => $tWINDOW, |
| wgetn_wstr => $tWINDOW, |
| wgetnstr => $tWINDOW, |
| wgetparent => $tWINDOW, |
| wgetscrreg => $tWINDOW, |
| wgetstr => $tWINDOW, |
| whline => $tWINDOW, |
| whline_set => $tWINDOW, |
| win_wch => $tWINDOW, |
| win_wchnstr => $tWINDOW, |
| win_wchstr => $tWINDOW, |
| winch => $tWINDOW, |
| winchnstr => $tWINDOW, |
| winchstr => $tWINDOW, |
| winnstr => $tWINDOW, |
| winnwstr => $tWINDOW, |
| wins_nwstr => $tWINDOW, |
| wins_wch => $tWINDOW, |
| wins_wstr => $tWINDOW, |
| winsch => $tWINDOW, |
| winsdelln => $tWINDOW, |
| winsertln => $tWINDOW, |
| winsnstr => $tWINDOW, |
| winsstr => $tWINDOW, |
| winstr => $tWINDOW, |
| winwstr => $tWINDOW, |
| wmouse_trafo => $tWINDOW, |
| wmove => $tWINDOW, |
| wnoutrefresh => $tWINDOW, |
| wprintw => $tWINDOW, |
| wredrawln => $tWINDOW, |
| wrefresh => $tWINDOW, |
| wresize => $tWINDOW, |
| wscrl => $tWINDOW, |
| wsetscrreg => $tWINDOW, |
| wstandend => $tWINDOW, |
| wstandout => $tWINDOW, |
| wsyncdown => $tWINDOW, |
| wsyncup => $tWINDOW, |
| wtimeout => $tWINDOW, |
| wtouchln => $tWINDOW, |
| wvline => $tWINDOW, |
| ); |
| |
| our $fld_nums = 0; |
| our $frm_nums = 0; |
| our $itm_nums = 0; |
| our $mnu_nums = 0; |
| 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 %fld_addr; # FIELD* |
| our %frm_addr; # FORM* |
| our %itm_addr; # ITEM* |
| our %mnu_addr; # MENU* |
| our %pan_addr; # PANEL* |
| our %scr_addr; # SCREEN* |
| our %thr_addr; # thread-id |
| our %trm_addr; # TERMINAL* |
| our %try_addr; # tries-number |
| our %usr_addr; # user-pointer |
| our %win_addr; # WINDOW* |
| |
| 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 %fld_addr ) { |
| $n = $fld_addr{$addr}; |
| $arg =~ s/\b$addr\b/field$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %frm_addr ) { |
| $n = $frm_addr{$addr}; |
| $arg =~ s/\b$addr\b/form$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %itm_addr ) { |
| $n = $itm_addr{$addr}; |
| $arg =~ s/\b$addr\b/item$n/g if ( defined $n ); |
| } |
| } |
| if ( &has_addr($arg) ) { |
| foreach my $addr ( keys %mnu_addr ) { |
| $n = $mnu_addr{$addr}; |
| $arg =~ s/\b$addr\b/menu$n/g if ( defined $n ); |
| } |
| } |
| 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/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 %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}; |
| $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 ( $addr !~ /^0x[[:xdigit:]]+$/i ) { |
| if ( $type == $tSCREEN and $addr =~ /^[^(]+\(screen\d+[,)]/ ) { |
| |
| # ignore |
| } |
| elsif ( $type == $tWINDOW |
| and $addr =~ |
| /^[^(]+\((stdscr|newscr|curscr|window\d+)[,)]/ ) |
| { |
| |
| # ignore |
| } |
| elsif ( $type == $tTERMINAL |
| and $addr =~ /^[^(]+\(terminal\d+[,)]/ ) |
| { |
| # ignore |
| } |
| elsif ( $type == $tPANEL and $addr =~ /^[^(]+\(panel\d+[,)]/ ) { |
| |
| # ignore |
| } |
| elsif ( $type == $tFIELD and $addr =~ /^[^(]+\(field\d+[,)]/ ) { |
| |
| # ignore |
| } |
| elsif ( $type == $tMENU and $addr =~ /^[^(]+\(menu\d+[,)]/ ) { |
| |
| # ignore |
| } |
| elsif ( $type == $tITEM and $addr =~ /^[^(]+\(item\d+[,)]/ ) { |
| |
| # ignore |
| } |
| else { |
| printf "OOPS - expected type \"%s\", skipping\n>>$addr\n", |
| $known_p1_types{$type}; |
| } |
| } |
| elsif ( $type == $tSCREEN ) { |
| $scr_addr{$addr} = ++$scr_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tWINDOW ) { |
| $win_addr{$addr} = ++$win_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tTERMINAL ) { |
| $trm_addr{$addr} = ++$trm_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tPANEL ) { |
| $pan_addr{$addr} = ++$pan_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tFIELD ) { |
| $fld_addr{$addr} = ++$fld_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tFORM ) { |
| $frm_addr{$addr} = ++$frm_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tMENU ) { |
| $mnu_addr{$addr} = ++$mnu_nums; |
| $arg = &transaddr($arg); |
| } |
| elsif ( $type == $tITEM ) { |
| $itm_addr{$addr} = ++$itm_nums; |
| $arg = &transaddr($arg); |
| } |
| } |
| } |
| |
| return $arg; |
| } |
| |
| sub muncher($) { |
| my $STDIN = shift; |
| |
| while (<$STDIN>) { |
| my $addr; |
| my $n; |
| my $awaiting = ""; |
| |
| 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}; |
| $thread = "thread" . $thr_addr{$1} . ":"; |
| $_ =~ s/^[^:]*://; |
| } |
| |
| # Transform window pointer addresses to make it 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 ( $_ =~ /^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 ( $_ =~ /^create :field 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| $fld_addr{$addr} = $fld_nums++; |
| $_ = &transaddr($_); |
| } |
| elsif ( $_ =~ /^create :form 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| $frm_addr{$addr} = $frm_nums++; |
| $_ = &transaddr($_); |
| } |
| elsif ( $_ =~ /^create :menu 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| $mnu_addr{$addr} = $mnu_nums++; |
| $_ = &transaddr($_); |
| } |
| elsif ( $_ =~ /^create :item 0x([[:xdigit:]]+)/ ) { |
| $addr = "0x$1"; |
| $itm_addr{$addr} = $itm_nums++; |
| $_ = &transaddr($_); |
| } |
| 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}; |
| } |
| } |
| elsif ( $_ =~ /^\.\.\.deleted pan=\"0x([[:xdigit:]]+)\"/ ) { |
| $addr = "0x$1"; |
| $_ = &transaddr($_); |
| undef $pan_addr{$addr}; |
| } |
| elsif ( $_ =~ /^([+ ])*called \{free_field\(0x([[:xdigit:]]+)\)/ ) { |
| $addr = "0x$2"; |
| $_ = &transaddr($_); |
| undef $fld_addr{$addr}; |
| } |
| elsif ( $_ =~ /^([+ ])*called \{free_form\(0x([[:xdigit:]]+)\)/ ) { |
| $addr = "0x$2"; |
| $_ = &transaddr($_); |
| undef $frm_addr{$addr}; |
| } |
| elsif ( $_ =~ /^([+ ])*called \{free_menu\(0x([[:xdigit:]]+)\)/ ) { |
| $addr = "0x$2"; |
| $_ = &transaddr($_); |
| undef $mnu_addr{$addr}; |
| } |
| elsif ( $_ =~ /^([+ ])*called \{free_item\(0x([[:xdigit:]]+)\)/ ) { |
| $addr = "0x$2"; |
| $_ = &transaddr($_); |
| undef $itm_addr{$addr}; |
| } |
| |
| # Compactify runs of PutAttrChar |
| if ( ( ( $tracelevel & $TR{CHARPUT} ) != 0 ) and $_ =~ /$putattr/ ) |
| { |
| my $putattr_chars = $1; |
| my $starty = $2; |
| my $startx = $3; |
| while (<$STDIN>) { |
| if ( $_ =~ /$putattr/ ) { |
| $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"; |
| redo CLASSIFY; |
| } |
| |
| # 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; |
| } |
| else { |
| last; |
| } |
| } |
| my $winaddstr = &transaddr($winaddr); |
| print "RUN of waddnstr()s:" |
| . " $winaddstr, \"$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 |
| } |
| } |
| |
| for my $tr ( keys %TR ) { |
| $TR{$tr} = hex $TR{$tr}; |
| } |
| |
| if ( $#ARGV >= 0 ) { |
| while ( $#ARGV >= 0 ) { |
| my $file = shift @ARGV; |
| open my $ifh, "<", $file or die $!; |
| &muncher($ifh); |
| } |
| } |
| else { |
| &muncher( \*STDIN ); |
| } |
| |
| # tracemunch ends here |
