home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 16 / debug.fth < prev    next >
Encoding:
Text File  |  1985-11-19  |  5.0 KB  |  161 lines
  1. \ Debugger.  Thanks, Mike Perry and Henry Laxen.
  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 tracing and continue execution
  22. \   f        push a Forth interpreter;  resume to get back
  23. \   q        abort back to the top level
  24.  
  25. only forth also definitions
  26. : label  \ name  ( -- )
  27.    create  !csp
  28.    assembler  [ assembler ] normal
  29. ;
  30. : interpret-line  \ input-line ( -- ?? )
  31.    prompt
  32.    tib 80 expect
  33.    tib  span @  string-load
  34. ;
  35.  
  36. 6 ualloc user debug-next
  37. vocabulary bug   bug also definitions
  38. variable 'debug   \ code field for high level trace
  39. variable <ip      \ lower limit of ip
  40. variable ip>      \ upper limit of ip
  41. variable cnt      \ how many times thru debug next
  42. hex
  43. variable slow-next?  slow-next? off
  44. \ Change all the next routines in the indicated range to jump through
  45. \ the user area vector
  46. code slow-next  ( high low -- )
  47.   sp )+ a0 move
  48.   sp )+ a1 move
  49.   4eeb.0000        l#  d1 lmove
  50.   'user# debug-next #  d1 wmove   \ 'user debug-next jmp  instr. is in d1
  51.   begin
  52.      a1 a0 cmpa
  53.   u< while
  54.      205d.4ed0 l#  a0 )  cmpi
  55.      0= if   \ Replace the next instruction with   'user debug-next  jmp
  56.         d1 a0 )  lmove
  57.      then
  58.      2 a0 addq
  59.   repeat
  60. c;
  61. \ Change all the next routines in the indicated range to perform the
  62. \ in-line next routine
  63. code fast-next  ( high low -- )
  64.   sp )+ a0 move
  65.   sp )+ a1 move
  66.   4eeb.0000        l#  d1 lmove
  67.   'user# debug-next #  d1 wmove   \ 'user debug-next jmp  instr. is in d1
  68.   begin
  69.      a1 a0 cmpa
  70.   u< while
  71.      a0 )  d1  cmp
  72.      0= if   \ Replace the jump instruction with the inline next routine
  73.         205d.4ed0 l#  a0 )  lmove
  74.      then
  75.      2 a0 addq
  76.   repeat
  77. c;
  78. label fnext   \ fix the >next code back to normal
  79.    205d.4ed0 l#  'user debug-next  lmove
  80.    rts
  81. end-code
  82.  
  83. label debnext
  84.    <ip l#) ip cmpa   u> if
  85.       ip> l#) ip cmpa   u<= if
  86.          cnt l#) d0 move   1 d0 addq   d0 cnt l#) move
  87.          2 # d0 word cmp normal  0= if
  88.             0 d0 moveq   d0 cnt l#) move   fnext l#) jsr
  89.             'debug l#) a0 move   a0 ) jmp
  90.    then then then
  91.    \ This is slightly different from the normal next (it has a nop)
  92.    \ so that it won't be clobbered by slow-next
  93.    ip )+ a0 move  nop  a0 ) jmp
  94. end-code
  95. code pnext   (s -- ) \ Fix the next routine to use the debug version
  96.    \ Place a "debnext l#) jmp" instruction in the next area
  97.    4ef9 #     'user debug-next  wmove
  98.    debnext l# 'user# debug-next  2+  up d)  lmove
  99. c;
  100. code unbug   (s -- ) \ Turn off debugging
  101.    fnext l#) jsr
  102. c;
  103. forth definitions
  104. unbug
  105.  
  106. only forth also definitions
  107. bug also definitions
  108. : l.id   (s anf len -- )
  109.    swap dup .id   ( len anf acf )
  110.    c@ th 1f and   ( len namelen )
  111.    - spaces
  112. ;
  113. variable step? step? on
  114. variable res
  115. : (debug)       (s low-adr hi-adr -- )
  116.    unbug   1 cnt !   ip> !   <ip !   pnext
  117.    slow-next? @ 0=
  118.    if   here  up@ user-size +  slow-next
  119.         slow-next? on
  120.    then
  121. ;
  122. : 'unnest   (s pfa -- pfa' )
  123.    begin   #align + dup token@ ['] unnest = until
  124. ;
  125.  
  126. \ Enter and leave the debugger
  127. : (debug  ( acf -- )
  128.    /token -   dup 'unnest  (debug)
  129. ;
  130. : up1  ( ip -- )  dup find-cfa swap 'unnest (debug)  ;
  131. : (trace   (s - )
  132.    ."  ( " .s ." )" cr        \ Show stack
  133.    r@ @ >name td 10 l.id      \ Show word name
  134.    step? @  key? or
  135.    if   step? on  res off   ." --> "   cursor-on key cursor-off  upc
  136.       case
  137.          ascii D  of  r@ token@ (debug                   endof \ Down
  138.          ascii U  of  rp@ na1+ @ up1                     endof \ Up
  139.          ascii C  of  step? @ not step? !                endof \ Continue
  140.          ascii F  of  begin interpret-line res @ until   endof \ Forth
  141.          ascii G  of  <ip off  ip> off                   endof \ Go
  142.          ascii Q  of  cr ." unbug" abort                 endof \ Quit
  143.       endcase
  144.    then
  145.    pnext
  146. ;
  147. ' (trace  'debug !
  148.  
  149. only forth bug also forth definitions
  150.  
  151. : debug  \ name (s -- )
  152.    ' (debug
  153. ;
  154. : resume (s -- )  res on  0  pnext  ;
  155. : step   (s -- )  step? on  ;
  156. : trace  (s -- )  step? off ;
  157. : debug-off (s -- )
  158.    unbug here  up@ user-size +  fast-next slow-next? off ;
  159.  
  160. only forth also definitions