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 >
Wrap
Text File
|
1995-03-01
|
2KB
|
77 lines
\ ARM specific mpu-code debugger
hex
only forth also bug also system also hidden also definitions
headerless \ **************************************************
: .exception why ;
defer op@ ' @ is op@
defer op! ' ! is op!
ef020017 constant breakpoint-opcode \ XOS_Breakpt
: amask ( adr -- adr1) 3fffffc and ;
: pc@ ( -- adr ) rpc amask @ ;
: nxtpc ( -- adr ) rpc cell+ ;
: at-breakpoint? ( adr -- f) op@ breakpoint-opcode = ;
: put-breakpoint ( adr -- ) breakpoint-opcode swap op! ;
: adr? ( adr --adr/0) amask dup ['] digit < if drop false then ;
: (tobranch) ( -- addr ) rpc dup @ ffffff and 2+ cells+ adr? ;
: (to-mov) ( -- addr ) registers pc@ 0f and cells+ @ adr? ;
: (to-ldr) ( -- addr ) registers pc@ 10 rshift 0f and cells+ @ @ adr? ;
\ Keep on improving:
\ So far branch addresses are found for
\ 1 branch, branch+link instructions
\ 2 simple pc r?? mov instructions ( execute, return )
\ 3 post-in/decremented pc r?? ldr instructions
\ 4 to-do a general handling of mov and ldr instructions
\ b ldm
\ c pc r?? xx add pc r?? xx sub <-- adr instruction
: next-instruction ( following-jsrs? -- next-addr branch-target|0 )
if ( bl ) pc@ 0f000000 and 0b000000 = if nxtpc (tobranch) exit then
then
( bl ) pc@ 0f000000 and 0b000000 = if nxtpc 0 exit then
( al b) pc@ ff000000 and ea000000 = if (tobranch) 0 exit then
( b ) pc@ 0f000000 and 0a000000 = if nxtpc (tobranch) exit then
( pc r?? mov ) pc@ fde0f000 and e1a0f000 = if (to-mov) 0 exit then
( pc r?? mov ) pc@ 0de0f000 and 01a0f000 = if nxtpc (to-mov) exit then
( pc r?? ldr ) pc@ fc50f000 and e410f000 = if (to-ldr) 0 exit then
( pc r?? ldr ) pc@ 0c50f000 and 0410f000 = if nxtpc (to-ldr) exit then
( others ..) nxtpc 0 ;
code goto ( adr -- )
r0 top mov
top sp pop
pc r0 mov end-code
bug also
: bumppc ( -- ) nxtpc to rpc ;
: set-pc ( adr -- ) amask to rpc ;
: return-adr ( -- adr ) rrp cell+ @ ; \ Word above stored link
: leaf-return-adr ( -- adr ) rsp @ ; \ Top of stack
: loop-exit-adr ( -- adr )
rpc >r
begin 0 next-instruction ?dup
( next-addr branch-target|0 )
if \ It was a branch instruction
\ If the branch was backwards, we're done
rpc <
if drop rpc r> to rpc exit then ( next-adr )
then
\ Not a branch or a branch forwards.
\ Advance to next instruction.
to rpc
rpc r@ - d# 1000 >
until r> to rpc
true abort" End of loop not found within 1000 bytes."
;
headers \ ****************
only forth also definitions