hex
only forth also definitions
: low-dictionary-adr  ( -- adr ) main-task user-size +  ;

\needs bug vocabulary bug
bug also definitions
\needs assembler  fload extend.arm.assemble  fload extend.arm.ass_tool

variable 'debug \ code field for high level trace
variable <ip    \ lower limit of ip
variable ip>    \ upper limit of ip
variable cnt    \ how many times thru debug next
nuser    dnxt   \ points to the debuggers next

align   ' (lit) token,  \ this marks *op as a 'next' literal
here assembler 
        pc      ip )+           ldr  ( normal next )
        pc      'user dnxt      ldr  ( debuggers next, condition field is cleared )
        forth
constant *op

\ Change all the next routines in the indicated range to perform the
\ debuggers next routine
: slow-next     ( high low -- )
        ?do     [ forth ] i @  *op @ =
                i /cell - @ ['] (lit) <>  and
                if *op 1 cells+ @  i ! then
        /cell +loop ;

\ Change all the next routines in the indicated range to perform the
\ in-line next routine
: fast-next     ( high low -- )
        ?do     [ forth ] i @  *op 1 cells+ @ =  i /cell - @ ['] (lit) <> and
                if *op @  i ! then
        /cell +loop ;

code dofnext    \ debugger installed, fast
        pc 1    ip ia!          ldm end-code

label debnext
        r0      'body <ip pcr   ldr
        r0      ip              s cmp
 le if  r0      'body ip> pcr   ldr
        r0      ip              s cmp
 gt if  r0      'body cnt pcr   ldr
        r0      1               s incr
        r0      'body cnt pcr   str
        r0      2 #             s cmp
 eq if  r0      0 #             mov
        r0      'body cnt pcr   str
        r0      'body dofnext   adr
        r0      'user dnxt      str
        pc     'body 'debug pcr ldr
 then then then
        \ This is slightly different from the normal next
        \ so that it won't be clobbered by slow-next
        pc 1    ip ia!          ldm end-code

code pnext         (s -- ) \ Fix the next routine to use the debug version
        r0 'body debnext adr
        r0 'user dnxt       str
        pc 1    ip ia!      ldm end-code

code unbug         (s -- ) \ Turn off debugging
        r0 'body dofnext    adr
        r0 'user dnxt       str
        pc 1    ip ia!      ldm end-code
forth definitions
unbug
