home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / f / forthmac / !Forthmacs / lib / arm / debugm < prev    next >
Encoding:
Text File  |  1997-02-25  |  2.0 KB  |  70 lines
  1.  
  2. only forth also definitions
  3. needs arm-assembler    extend/arm/assemble.fth
  4. needs entercode        extend/arm/ass_tool.fth
  5.  
  6. \needs bug        vocabulary bug
  7. only forth also definitions  bug also definitions
  8.  
  9. create next-instructions also arm-assembler
  10.     ' (lit) token,
  11.     pc ip )+ ldr        ( normal next )
  12.     ' (lit) token,        \ this marks *op as a 'next' literal
  13.     pc up mov
  14. previous
  15.  
  16.  
  17. : *inline-next    [ next-instructions 1 cells+ @ ] literal ;
  18. : *jmp-up-next    [ next-instructions 3 cells+ @ ] literal ;
  19.  
  20. : mask28        ( n1 -- n2 )    h# 0fffffff and ;
  21. : not-in-literal?    ( addr -- flag)    /token - token@  ['] (lit) <> ;
  22. : change-instruction    ( instruction adr -- )
  23.     swap mask28  over @  h# f0000000 and or  swap instruction! ;
  24.  
  25. : slow-next    ( high low -- )
  26.     ?do     i @ mask28  *inline-next mask28 =  i not-in-literal?  and
  27.         if *jmp-up-next i change-instruction then
  28.     /cell +loop ;
  29. : fast-next    ( high low -- )
  30.     ?do     i @ mask28  *jmp-up-next mask28 =  i not-in-literal?  and
  31.         if *inline-next i change-instruction then
  32.     /cell +loop ;
  33. hex
  34. : low-dictionary-adr origin ; \ ['] (lit) /cell - ;
  35.  
  36. nuser    debug-next    \ points to the debuggers next
  37. nuser    'debug        \ code field for high level trace
  38. nuser    <ip        \ lower limit of ip
  39. nuser    ip>        \ upper limit of ip
  40. nuser    cnt        \ how many times thru debug next
  41.  
  42. label normal-next    \ debugger installed, fast
  43.     pc 1    ip ia!          ldm end-code
  44.  
  45. label debnext
  46.         r0      'user <ip    ldr
  47.         ip    r0        cmp
  48.  gt if      r0      'user ip>    ldr
  49.         r0      ip              cmp
  50.   gt if     r0      'user cnt    ldr
  51.         r0      1               incr
  52.         r0      'user cnt    str
  53.         r0      2 #             cmp
  54.  eq if      r0      0 #             mov
  55.         r0      'user cnt    str
  56.         r0      'body normal-next   adr
  57.         r0      'user debug-next str
  58.         pc    'user 'debug    ldr
  59.  then then then
  60.     \ This is slightly different from the normal next
  61.     \ so that it won't be clobbered by slow-next
  62.     pc 1    ip ia!          ldm end-code
  63.  
  64. : pnext         (s -- ) \ Fix the next routine to use the debug version
  65.     [ also arm-assembler ]
  66.     debnext  up@ put-call [ previous ] ;
  67. : unbug        ( -- )    normal-next @  up@ instruction!  ;
  68. unbug
  69. only forth also definitions
  70.