\ This debugger is better adapted to the risc_os environment.
\ uses text-environment debugger window

\ Debugger.  Thanks, Mike Perry, Henry Laxen, Mark Smeder.
\
\ The debugger lets you single step the execution of a high level
\ definition.  To invoke the debugger, type debug xxx where xxx is
\ the name of the word you wish to trace.  When xxx executes, you will
\ get a single step trace showing you the word within xxx that
\ is about to execute, and the contents of the parameter stack.
\ Debugging makes everything run slightly slower, even outside
\ the word being debugged.  see debug-off
\
\ debug name    Mark that word for debugging
\ step          Debug in single step mode
\ trace         Debug in trace mode
\ debug-off     Turn off the debugger (makes the system run fast again)
\ resume        Exit from a pushed interpreter (see the f keystroke)
\
\ Keystroke commands while you're single-stepping:
\   d           go down a level
\   u           go up a level
\   c           continue; trace without single stepping
\   g           go; turn off stepping and continue execution
\   f           push a Forth interpreter;  execute "resume" to get back
\   q           abort back to the top level

only forth also  hidden also  bug also definitions

: interpret-line  \ input-line ( -- ?? )
        0 0 0 0 0   prompt  2drop 2drop drop         \ Hack to make showstack work
        astring dup char+ 80 expect  span @ over c!  count eval ;
hex

variable slow-next?  slow-next? off
variable used-window   \ points to pfa of used window
create vid-par 16 allot

: set-used-window       \ ( -- )
                used-window @ 2@  used-window @ 2 cells+ 2@ (window
                used-window @ 4 cells+ 2@ at ;
: window                \ name ( x-left y-top x-right y-bot -- )
        create  >r rot , swap , , r> ,  ( cursor position ) 0 ,  0 ,
        does>   \ first save old window
                dup used-window @ = if drop exit then
                used-window @ if at? used-window @ 4 cells+ 2! then
                used-window !
                set-used-window ;

trow       lcol  swap trow 12 +   rcol 1- swap  window debugger-window
trow 14 +  lcol  swap brow        rcol 1- swap  window forth-window

: -line         ( -- )  #columns 1- #out @ - 0 max 0 ?do [char] - emit loop ;
: one-window    ( -- )  vid-par 2 cells+ 2@  vid-par 2@ (window ;

variable last-string
: .dinfo        \ ( str -- )
        dup last-string @ = if drop exit then
        dup last-string !
        at? rot one-window 13 0 at  marked ." -- " ". space -line light
        set-used-window at ;

: .dtitle       p" RiscOS Forthmacs debugger" .dinfo ;
: .dkeyinfo     p" [<space> Down Up Continue Forth Go Quit]" .dinfo ;
: .dcont        p" [ <any key> to stop ]" .dinfo ;
: .dresume      p" > resume < restarts debugger" .dinfo ;

: two-windows
        (get-window vid-par 2!  vid-par 2 cells+ 2!
        erase-screen .dtitle  forth-window ;

variable step? step? on
variable res
: (debug)       (s low-adr hi-adr -- )
        \ Silently refuse to debug the kernel; it's too dangerous
        over  low-dictionary-adr ( fence @ ) ['] alias between  if 2drop exit then
        unbug   1 cnt !   ip> !   <ip !   pnext
        slow-next? @ 0=
        if      ['] forth  low-dictionary-adr slow-next
                two-windows  slow-next? on
        then abort ;
: 'unnest       (s pfa -- pfa' )
        begin #align + dup token@ ['] unnest =  until ;

\ Enter and leave the debugger
variable save-status
variable linecounter
: (debug        ( acf -- )
        ['] status >data token@ save-status token!
        /token -   dup 'unnest  (debug) ;
: up1           ( ip -- )
        dup find-cfa swap 'unnest (debug) ;
: (trace        (s - )
        debugger-window  cr  ." ( " .s ." )"
        #out @ 4 + th fc and to-column
        r@ token@ >name  #columns 1 - over c@ -
        dup #out @ - 4 / 1- 0 max 0
        1 linecounter +! linecounter @ 2 > if ?do ."  .  " loop linecounter off else 2drop then
        to-column .id
        step? @ key? or
        if      step? on  res off .dkeyinfo key upc
                case [char] D of r@ token@ (debug                        endof
                     [char] U of rp@ cell+ @ up1                          endof
                     [char] C of step? @ not step? ! .dcont              endof
                     [char] F of .dresume forth-window
                                begin interpret-line res @ until
                                debugger-window .dtitle			endof
                     [char] G of cr <ip off  ip> off .dtitle             endof
                     [char] Q of .dtitle forth-window cr ." unbug" abort endof
                endcase
        then
        forth-window pnext ;
' (trace  'debug token!

only forth also  hidden also  bug also forth definitions

: debug         \ name (s -- )
        ' (debug ;
: resume        (s -- )         res on  pnext  ;
: step          (s -- )         step? on  ;
: trace         (s -- )         step? off ;
: debug-off     (s -- )
        unbug here  low-dictionary-adr  fast-next slow-next? off
        (pos? one-window at
        save-status token@ is status ;

only forth also definitions
decimal
