| then |
then |
| space ; |
space ; |
| |
|
| Defer discode ( addr u -- ) |
Defer discode ( addr u -- ) \ gforth |
| \ hook for the disassembler: disassemble code at addr of length u |
\G hook for the disassembler: disassemble code at addr of length u |
| ' dump IS discode |
' dump IS discode |
| |
|
| : next-head ( addr1 -- addr2 ) \ gforth |
: next-head ( addr1 -- addr2 ) \ gforth |
| then |
then |
| drop ; |
drop ; |
| |
|
| : next-prim ( addr1 -- addr2 ) |
: next-prim ( addr1 -- addr2 ) \ gforth |
| \G find the next primitive after addr1 |
\G find the next primitive after addr1 (unreliable) |
| 1+ >r -1 primstart |
1+ >r -1 primstart |
| begin ( umin head R: boundary ) |
begin ( umin head R: boundary ) |
| @ dup |
@ dup |
| while |
while |
| tuck name>int >code-address ( head1 umin c-addr ) |
tuck name>int >code-address ( head1 umin ca R: boundary ) |
| r@ - umin |
r@ - umin |
| swap |
swap |
| repeat |
repeat |
| drop r> + ; |
drop dup r@ negate u>= |
| |
\ "umin+boundary within [0,boundary)" = "umin within [-boundary,0)" |
| |
if ( umin R: boundary ) \ no primitive found behind -> use a default length |
| |
drop 31 |
| |
then |
| |
r> + ; |
| |
|
| : seecode ( xt -- ) |
: seecode ( xt -- ) |
| dup s" Code" .defname |
dup s" Code" .defname |
| dup >body ." 0 " ? ." 0 0 " |
dup >body ." 0 " ? ." 0 0 " |
| s" Field" .defname cr ; |
s" Field" .defname cr ; |
| |
|
| : xt-see ( xt -- ) |
: xt-see ( xt -- ) \ gforth |
| |
\G Decompile the definition represented by @i{xt}. |
| cr c-init |
cr c-init |
| dup >does-code |
dup >does-code |
| if |
if |
