Changeset 2910


Ignore:
Timestamp:
Mar 21, 2012, 10:15:39 PM (3 years ago)
Author:
wmb
Message:

Debugger - factored (trace so it's not so crazy long, and cleaned up a few minor glitches.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • forth/lib/debug.fth

    r2904 r2910  
    3838variable res
    3939headers
    40 false value first-time?
    41 d# 10 circular-stack: locations
     40false value redisplay?
    4241
    4342: (debug)       (s low-adr hi-adr -- )
     
    4847   then
    4948   step? on
    50    true is first-time?
     49   true is redisplay?
    5150;
    5251headerless
     
    117116   ." \       Display Forth return stack as numbers (like the data stack)" cr
    118117   ." Q       Quit: abandon execution of the debugged word" cr
     118   ." V       Visual: toggle between 2-D and scrolling" cr
    119119;
    120120d# 24 constant cmd-column
     
    142142: to-result-loc  ( -- )  result-col result-line at-xy  ;
    143143
    144 0 value rp-mark
    145 
    146144\ set-package is a hook for Open Firmware.  When Open Firmware is loaded,
    147145\ set-package should be set to a word that sets the active package to the
     
    166164: save#     ( -- )  #-buf /#buf -  #buf-save  d# 72 move    hld @  hld-save !  ;
    167165: restore#  ( -- )  #buf-save  #-buf /#buf -  d# 72 move    hld-save @  hld !  ;
     1660 value the-ip
     1670 value the-rp
    168168: (.rs  ( -- )
    169169   show-rstack @ 0=  if  exit  then
    170170   ." return-stack: "
    171171   push-hex
    172    rp0 @ rp@ - /n /
    173    6 do   \ It appears that skipping the first 6 entries on the stack skips the debug goo on the rs
    174       rp@ i /n * + @ .
    175    loop
     172   \ Skip the debugger's footprint on the return stack
     173   rp0 @  the-rp 5 na+  ?do  i @ .  /n +loop
    176174   pop-base
    177175;
    178 : (trace  ( -- )
    179    first-time?  if
     176: setup-scrolling-display  ( -- )
     177   ??cr
     178   the-ip  <ip @ =  if  ." : "  else  ." Inside "  then
     179   <ip @ find-cfa .name
     180;
     181: setup-2d-display  ( -- )
     182   page
     183   d# 78 rmargin !
     184   .debug-short-help
     185   ." Callers: "  rp0 @ the-rp na1+ rslist kill-line cr
     186   \ XXX the following is wrong when popping up
     187   the-ip  <ip @ =  if 
     188      #line @ is stack-line \ So the initial stack is displayed in the right place
     189   then
     190   d# 40 rmargin !
     191   the-ip debug-see
     192   cr
     193   \ When popping up from an interior word, display the initial stack on
     194   \ the line where the cursor will be.
     195   the-ip  <ip @ <>  if 
     196      the-ip ip>position  if   ( col row )
     197         drop  is stack-line   ( )
     198      then
     199   then
     200;
     201: setup-debug-display  ( -- )
     202   redisplay?  if
    180203      scrolling-debug?  if
    181          ??cr
    182          ip@  <ip @ =  if  ." : "  else  ." Inside "  then
    183          <ip @ find-cfa .name
     204         setup-scrolling-display
    184205      else
    185          page
    186          d# 78 rmargin !
    187          ." Callers: "  rp0 @ rp@ na1+ rslist kill-line cr
    188          \ XXX the following is wrong when popping up
    189          ip@  <ip @ =  if 
    190             #line @ is stack-line \ So the initial stack is displayed in the right place
    191          then
    192          d# 40 rmargin !
    193          ip@ debug-see
    194          cr
    195 \         ip@  <ip @ <>  if 
    196 \            ip@ ip>position  if   ( col row )
    197 \               swap
    198 \               is stack-line
    199 \            then
    200 \            #line @ is stack-line \ So the initial stack is displayed in the right place
    201  \        then
     206         setup-2d-display
    202207      then
    203208      0 show-rstack !
    204       false is first-time?
    205       rp@ is rp-mark
    206    then
    207 
     209      false is redisplay?
     210   then
     211;
     212: show-debug-stack  ( -- )
     213   scrolling-debug?  if
     214      save#
     215      cmd-column 2+ to-column
     216
     217      hex-stack @  if  push-hex  then
     218      ." ( " .s    \ Show data stack
     219      hex-stack @  if  pop-base  then
     220      show-rstack @  if  (.rs  then   \ Show return stack
     221      ." )"
     222      restore#
     223
     224      cr
     225      ['] noop is indent
     226      the-ip .token drop                  \ Show word name
     227      ['] (indent) is indent
     228      to-cmd-column
     229   else
     230      save-result-loc
     231      show-partial-stack
     232       
     233      the-ip ip-set-cursor
     234      #line @ to stack-line
     235   then
     236;
     237: debug-interact  ( -- )
     238   save#
    208239   begin
    209240      step? @  if  to-debug-window  then
    210       save#
    211       scrolling-debug?  if
    212          cmd-column 2+ to-column
    213 
    214          hex-stack @  if  push-hex  then
    215          ." ( " .s    \ Show data stack
    216          hex-stack @  if  pop-base  then
    217          show-rstack @  if  (.rs  then   \ Show return stack
    218          ." )"
    219          restore#
    220 
    221          cr
    222          ['] noop is indent
    223          ip@ .token drop                  \ Show word name
    224          ['] (indent) is indent
    225          to-cmd-column
    226       else
    227          save-result-loc
    228          show-partial-stack
    229        
    230          ip@ ip-set-cursor
    231          #line @ to stack-line
    232       then
    233 
     241      show-debug-stack
    234242      step? @  key? or  if
    235243         step? on  res off
     
    239247         scrolling-debug?  if  reset-page  then
    240248         case
    241             ascii D  of  ip@ token@ executer  ['] (debug try endof \ Down
    242             ascii U  of  rp@ ['] up1 try                     endof \ Up
    243             ascii C  of  step? @ 0= step? !           true   endof \ Continue
    244             ascii F  of
     249            ascii D  of  the-ip token@ executer  ['] (debug try endof \ Down
     250            ascii U  of  the-rp ['] up1 try                     endof \ Up
     251            ascii C  of                                               \ Continue
     252               step? @ 0= step? !             
     253               step? @ 0=  if  true to scrolling-debug?  true to redisplay?  then
     254               true
     255            endof
     256
     257            ascii F  of                                               \ Forth
    245258               cr ." Type 'resume' to return to debugger" cr
    246259               set-package  interact  unset-package   false
    247             endof                                                  \ Forth
    248             ascii G  of  debug-off  cr  exit                 endof \ Go
    249             ascii H  of  cr .debug-long-help          false  endof \ Help
    250             ascii R  of  cr rp0 @ rp@ na1+ (rstrace  false  endof \ RSTrace
    251             ascii S  of  cr <ip @ body> (see)         false  endof \ See
    252             ascii ?  of  cr .debug-short-help         false  endof \ Short Help
     260            endof
     261            ascii G  of  debug-off  cr                 true   endof \ Go
     262            ascii H  of  cr .debug-long-help           false  endof \ Help
     263            ascii R  of  cr rp0 @ the-rp na1+ (rstrace false  endof \ RSTrace
     264            ascii S  of  cr <ip @ body> (see)          false  endof \ See
     265            ascii ?  of  cr .debug-short-help          false  endof \ Short Help
    253266            ascii $  of  space 2dup type cr to-cmd-column false endof \ String
    254267            ascii Q  of  cr ." unbug" abort           true   endof \ Quit
    255             ascii (  of  ip@ set-<ip                  false  endof
    256             ascii <  of  ip@ ta1+ set-<ip  1 cnt !    false  endof
    257             ascii )  of  ip@ ip> !  1 cnt !           false  endof
    258             ascii *  of  ip@ find-cfa dup <ip !  'unnest ip> !  false  endof
    259             ascii \  of  show-rstack @ 0= show-rstack ! false endof
    260             ascii X  of  hex-stack @ 0= hex-stack !   false  endof
    261             ascii V  of  scrolling-debug? 0= to scrolling-debug?
    262                          scrolling-debug? 0=  if  true to first-time?  then  false  endof
     268            ascii (  of  the-ip set-<ip                  false  endof
     269            ascii <  of  the-ip ta1+ set-<ip  1 cnt !    false  endof
     270            ascii )  of  the-ip ip> !  1 cnt !           false  endof
     271            ascii *  of  the-ip find-cfa dup <ip !  'unnest ip> !  false  endof
     272            ascii \  of  show-rstack @ 0= show-rstack !  false  endof  \ toggle return stack display
     273            ascii X  of  hex-stack @ 0= hex-stack !      false  endof  \ toggle heX stack display
     274            ascii V  of                                         \ toggle Visual (2D) mode
     275               scrolling-debug? 0= to scrolling-debug?     
     276               scrolling-debug? 0=  if  true to redisplay?  then  false
     277            endof
    263278            ( default )  true swap
    264279         endcase
     
    268283   until
    269284   restore#
    270    scrolling-debug? 0=  if  to-result-loc  then
    271    ip@ token@  dup ['] unnest =  swap ['] exit =  or  if
    272       cr  true is first-time?
    273    then
    274    pnext
     285;
     286: (trace  ( -- )
     287   ip@ to the-ip
     288   rp@ to the-rp
     289   setup-debug-display
     290   debug-interact
     291\   scrolling-debug? 0=  if  to-result-loc  then
     292   the-ip token@  dup ['] unnest =  swap ['] exit =  or  if
     293      cr  true is redisplay?
     294   then
     295   slow-next? @  if  pnext  then
    275296;
    276297' (trace  'debug token!
Note: See TracChangeset for help on using the changeset viewer.