version 1.27, 2000/06/14 20:31:47
|
version 1.28, 2000/06/15 09:01:11
|
Line 514 Defer xt-see-xt ( xt -- )
|
Line 514 Defer xt-see-xt ( xt -- )
|
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 |
Line 535 Defer discode ( addr u -- )
|
Line 535 Defer discode ( addr u -- )
|
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 |