Changeset 2910


Ignore:
Timestamp:
Mar 21, 2012, 11: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.