\ @(#) see.fth 98/01/26 1.4
\ SEE ( <name> -- , disassemble pForth word )
\ Copyright 1996 Phil Burk
: .XT ( xt -- , print execution tokens name )
dup c@ flag_immediate and
\ dictionary may be defined as byte code or cell code
: CODE@ ( addr -- xt , fetch from code space ) C@ ;
.( BYTE_CODE not implemented) abort
: CODE@ ( addr -- xt , fetch from code space ) @ ;
0 value see_level \ level of conditional imdentation
0 value see_addr \ address of next token
see_addr ." ( ".hex ." )"
: SEE.GET.INLINE ( -- n )
: SEE.GET.TARGET ( -- branch-target-addr )
see.get.inline >name id. space
see_addr count 2dup + aligned -> see_addr type
see.get.target .hex see.advance
: SEE.BRANCH ( -- addr | , handle branch )
see.get.target \ calculate address of target
nip \ remove old address for THEN
." REPEAT " see.get.target .hex
drop \ remove old address for THEN
: SEE.0BRANCH ( -- addr | , handle 0branch )
see.get.target \ calculate adress of target
." UNTIL=>" see.get.target .hex
0 OF see_level 0> IF ." EXIT " see.out+ ELSE ." ;" 0 -> see_addr THEN ENDOF
['] (LITERAL) OF see.show.lit ENDOF
['] (ALITERAL) OF see.show.alit ENDOF
[ exists? (FLITERAL) [IF] ]
['] (FLITERAL) OF see.show.flit ENDOF
['] BRANCH OF see.branch ENDOF
['] 0BRANCH OF see.0branch ENDOF
['] (LOOP) OF -1 +-> see_level see.newline ." LOOP " see.advance see.cr ENDOF
['] (+LOOP) OF -1 +-> see_level see.newline ." +LOOP" see.advance see.cr ENDOF
['] (DO) OF see.newline ." DO" 1 +-> see_level see.cr ENDOF
['] (?DO) OF see.newline ." ?DO " see.advance 1 +-> see_level see.cr ENDOF
['] (.") OF .' ." ' see.show.string .' " ' ENDOF
['] (C") OF .' C" ' see.show.string .' " ' ENDOF
['] (S") OF .' S" ' see.show.string .' " ' ENDOF
0 \ fake address for THEN handler
dup see_addr ( >newline .s ) =
-1 +-> see_level see.newline
0= not abort" SEE conditional analyser nesting failed!"
: SEE ( <name> -- , disassemble )
." is primitive defined in 'C' kernel." cr
." Here are some strings." cr
c" Forth string." count type cr
s" Addr/Cnt string" type cr