| then |
then |
| space ; |
space ; |
| |
|
| Defer discode ( addr -- ) |
Defer discode ( addr u -- ) |
| \ hook for the disassembler: disassemble code at addr (as far as the |
\ hook for the disassembler: disassemble code at addr of length u |
| \ disassembler thinks is sensible) |
' dump IS discode |
| :noname ( addr -- ) |
|
| drop ." ..." ; |
: next-head ( addr1 -- addr2 ) \ gforth |
| IS discode |
\G find the next header starting after addr1, up to here (unreliable). |
| |
here swap u+do |
| |
i head? |
| |
if |
| |
i unloop exit |
| |
then |
| |
cell +loop |
| |
here ; |
| |
|
| |
: umin ( u1 u2 -- u ) |
| |
2dup u> |
| |
if |
| |
swap |
| |
then |
| |
drop ; |
| |
|
| |
: next-prim ( addr1 -- addr2 ) |
| |
\G find the next primitive after addr1 |
| |
1+ >r -1 primstart |
| |
begin ( umin head R: boundary ) |
| |
@ dup |
| |
while |
| |
tuck name>int >code-address ( head1 umin c-addr ) |
| |
r@ - umin |
| |
swap |
| |
repeat |
| |
drop r> + ; |
| |
|
| : seecode ( xt -- ) |
: seecode ( xt -- ) |
| dup s" Code" .defname |
dup s" Code" .defname |
| if |
if |
| >code-address |
>code-address |
| then |
then |
| discode |
dup in-dictionary? \ user-defined code word? |
| |
if |
| |
dup next-head |
| |
else |
| |
dup next-prim |
| |
then |
| |
over - discode |
| ." end-code" cr ; |
." end-code" cr ; |
| : seevar ( xt -- ) |
: seevar ( xt -- ) |
| s" Variable" .defname cr ; |
s" Variable" .defname cr ; |
| [ [IFDEF] dofield: ] |
[ [IFDEF] dofield: ] |
| dofield: of seefield endof |
dofield: of seefield endof |
| [ [THEN] ] |
[ [THEN] ] |
| over >body of seecode endof |
over of seecode endof \ direct threaded code words |
| |
over >body of seecode endof \ indirect threaded code words |
| 2drop abort" unknown word type" |
2drop abort" unknown word type" |
| ENDCASE ; |
ENDCASE ; |
| |
|
