home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / code / forthmacs / !Forthmacs / lib / debug < prev    next >
Encoding:
Text File  |  1994-02-18  |  3.4 KB  |  108 lines

  1. \ Debugger.  Thanks, Mike Perry, Henry Laxen, Mark Smeder.
  2. \
  3. \ The debugger lets you single step the execution of a high level
  4. \ definition.  To invoke the debugger, type debug xxx where xxx is
  5. \ the name of the word you wish to trace.  When xxx executes, you will
  6. \ get a single step trace showing you the word within xxx that
  7. \ is about to execute, and the contents of the parameter stack.
  8. \ Debugging makes everything run slightly slower, even outside
  9. \ the word being debugged.  see debug-off
  10. \
  11. \ debug name    Mark that word for debugging
  12. \ step          Debug in single step mode
  13. \ trace         Debug in trace mode
  14. \ debug-off     Turn off the debugger (makes the system run fast again)
  15. \ resume        Exit from a pushed interpreter (see the f keystroke)
  16. \
  17. \ Keystroke commands while you're single-stepping:
  18. \   d           go down a level
  19. \   u           go up a level
  20. \   c           continue; trace without single stepping
  21. \   g           go; turn off stepping and continue execution
  22. \   f           push a Forth interpreter;  execute "resume" to get back
  23. \   q           abort back to the top level
  24.  
  25. only forth also definitions
  26. : interpret-line  \ input-line ( -- ?? )
  27.    0 0 0 0 0   prompt  2drop 2drop drop         \ Hack to make showstack work
  28.    tib 80 expect
  29.    tib  span @  eval
  30. ;
  31.  
  32. hex
  33. variable slow-next?  slow-next? off
  34.  
  35. only forth hidden also forth also definitions
  36. bug also definitions
  37. : l.id   (s anf len -- )
  38.    swap dup .id   ( len anf acf )
  39.    c@ th 1f and   ( len namelen )
  40.    - spaces
  41. ;
  42. variable step? step? on
  43. variable res
  44. : (debug)       (s low-adr hi-adr -- )
  45.    \ Silently refuse to debug the kernel; it's too dangerous
  46.    over  low-dictionary-adr  fence @  between  if  2drop exit  then
  47.  
  48.    unbug   1 cnt !   ip> !   <ip !   pnext
  49.    slow-next? @ 0=
  50.    if   ['] forth low-dictionary-adr  slow-next
  51.         slow-next? on
  52.    then abort
  53. ;
  54. : 'unnest   (s pfa -- pfa' )
  55.    begin   #align + dup token@ ['] unnest = until
  56. ;
  57.  
  58. \ Enter and leave the debugger
  59. variable #out-save variable #line-save variable save-status
  60. : (debug  ( acf -- )
  61.    ['] status >data token@ save-status token!
  62.    /token -   dup 'unnest  (debug)
  63. ;
  64. : up1  ( ip -- )  dup find-cfa swap 'unnest (debug)  ;
  65. : (trace   (s - )
  66.    step? @  if
  67.       \ Always interact with the debugger at a fixed location
  68.       #out @ #out-save !  #line @  #lines 1- max  #line-save !
  69.       0 0 at
  70.    else
  71.       cr
  72.    then
  73.    kill-line   ." ( " .s ." )" cr         \ Show stack
  74.    kill-line   r@ token@ >name td 10 l.id      \ Show word name
  75.    step? @  key? or
  76.    if step? on  res off
  77.       ." [<space> Down Up Continue Forth Go Quit] : "
  78.       key upc
  79.       #line-save @ #out-save @ at
  80.       case
  81.          ascii D  of  r@ token@ (debug                   endof \ Down
  82.          ascii U  of  rp@ na1+ @ up1                     endof \ Up
  83.          ascii C  of  step? @ not step? !                endof \ Continue
  84.          ascii F  of  begin interpret-line res @ until   endof \ Forth
  85.          ascii G  of  <ip off  ip> off                   endof \ Go
  86.          ascii Q  of  cr ." unbug" abort                 endof \ Quit
  87.       endcase
  88.       #line-save @ #out-save @ at
  89.    then
  90.    pnext
  91. ;
  92. ' (trace  'debug token!
  93.  
  94. only forth bug also forth definitions
  95.  
  96. : debug  \ name (s -- )
  97.    ' (debug
  98. ;
  99. : resume (s -- )  res on  pnext  ;
  100. : step   (s -- )  step? on  ;
  101. : trace  (s -- )  step? off ;
  102. : debug-off (s -- )
  103.    unbug here  low-dictionary-adr  fast-next slow-next? off
  104.    save-status token@ is status
  105. ;
  106.  
  107. only forth also definitions
  108.