home *** CD-ROM | disk | FTP | other *** search
/ ftp.uni-stuttgart.de/pub/systems/acorn/ / Acorn.tar / Acorn / acornet / dev / forth / forthmacs / tools1 / tools1~ / !Forthmacs.extend.arm.machdep next >
Text File  |  1995-03-01  |  2KB  |  77 lines
  1. \ ARM specific mpu-code debugger
  2.  
  3. hex
  4. only forth also  bug also  system also  hidden also definitions
  5.  
  6. headerless \ **************************************************
  7.  
  8. : .exception    why ;
  9. defer op@    ' @ is op@
  10. defer op!    ' ! is op!
  11.  
  12. ef020017 constant breakpoint-opcode  \ XOS_Breakpt
  13. : amask        ( adr -- adr1)    3fffffc and ;
  14. : pc@        ( -- adr )    rpc amask @ ;
  15. : nxtpc        ( -- adr )    rpc cell+ ;
  16.  
  17. : at-breakpoint? ( adr -- f)    op@  breakpoint-opcode =  ;
  18. : put-breakpoint ( adr -- )    breakpoint-opcode swap op! ;
  19. : adr?        ( adr --adr/0)    amask dup ['] digit < if drop false then ;
  20.  
  21. : (tobranch)    ( -- addr )    rpc dup @ ffffff and 2+ cells+ adr? ;
  22. : (to-mov)    ( -- addr )    registers pc@ 0f and cells+ @ adr? ;
  23. : (to-ldr)    ( -- addr )    registers pc@ 10 rshift 0f and cells+ @ @ adr? ;
  24.  
  25. \ Keep on improving:
  26. \ So far branch addresses are found for
  27. \ 1 branch, branch+link instructions
  28. \ 2 simple  pc r?? mov    instructions ( execute, return )
  29. \ 3 post-in/decremented  pc r??  ldr instructions
  30. \ 4 to-do    a general handling of mov and ldr instructions
  31. \        b ldm
  32. \        c pc r?? xx add   pc r?? xx sub <-- adr instruction
  33.  
  34. : next-instruction    ( following-jsrs? -- next-addr branch-target|0 )
  35.    if    ( bl )    pc@ 0f000000 and 0b000000 = if nxtpc (tobranch)    exit then
  36.    then
  37.     ( bl )    pc@ 0f000000 and 0b000000 = if nxtpc 0        exit then
  38.     ( al b)    pc@ ff000000 and ea000000 = if (tobranch) 0    exit then
  39.     ( b )    pc@ 0f000000 and 0a000000 = if nxtpc (tobranch) exit then
  40.  
  41. ( pc r?? mov )    pc@ fde0f000 and e1a0f000 = if (to-mov) 0    exit then
  42. ( pc r?? mov )    pc@ 0de0f000 and 01a0f000 = if nxtpc (to-mov)    exit then
  43.  
  44. ( pc r?? ldr )    pc@ fc50f000 and e410f000 = if (to-ldr) 0    exit then
  45. ( pc r?? ldr )    pc@ 0c50f000 and 0410f000 = if nxtpc (to-ldr)    exit then
  46.  
  47. ( others ..)    nxtpc 0 ;
  48.  
  49. code goto    ( adr -- )
  50.     r0    top    mov
  51.     top    sp    pop
  52.     pc    r0    mov end-code
  53. bug also
  54.  
  55. : bumppc    ( -- )        nxtpc to rpc ;
  56. : set-pc    ( adr -- )    amask to rpc ;
  57. : return-adr    ( -- adr )    rrp cell+ @ ;    \ Word above stored link
  58. : leaf-return-adr  ( -- adr )    rsp @ ;        \ Top of stack
  59. : loop-exit-adr  ( -- adr )
  60.     rpc >r
  61.     begin    0 next-instruction ?dup
  62.         ( next-addr branch-target|0 )
  63.         if    \ It was a branch instruction
  64.             \ If the branch was backwards, we're done
  65.             rpc <
  66.             if drop  rpc  r> to rpc exit then    ( next-adr )
  67.         then
  68.         \ Not a branch or a branch forwards.
  69.         \ Advance to next instruction.
  70.         to rpc
  71.         rpc r@ - d# 1000 >
  72.     until r> to rpc
  73.     true abort" End of loop not found within 1000 bytes."
  74.     ;
  75. headers \ ****************
  76. only forth also definitions
  77.