version 1.26, 2000/05/27 18:55:55
|
version 1.27, 2000/06/14 20:31:47
|
Line 514 Defer xt-see-xt ( xt -- )
|
Line 514 Defer xt-see-xt ( xt -- )
|
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 |
Line 527 IS discode
|
Line 553 IS discode
|
if |
if |
>code-address |
>code-address |
then |
then |
discode |
dup in-dictionary? \ user-defined code word? |
." end-code" cr ; |
if |
|
dup next-head |
|
else |
|
dup next-prim |
|
then |
|
over - discode |
|
." end-code" cr ; |
: seevar ( xt -- ) |
: seevar ( xt -- ) |
s" Variable" .defname cr ; |
s" Variable" .defname cr ; |
: seeuser ( xt -- ) |
: seeuser ( xt -- ) |
Line 590 IS discode
|
Line 622 IS discode
|
[ [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 ; |
|
|