1 \ @(#) see.fth 98/01/26 1.4
2 \ SEE ( <name> -- , disassemble pForth word )
4 \ Copyright 1996 Phil Burk
6 ' file? >code rfence a!
10 : .XT ( xt -- , print execution tokens name )
12 dup c@ flag_immediate and
19 \ dictionary may be defined as byte code or cell code
23 : CODE@ ( addr -- xt , fetch from code space ) C@ ;
25 .( BYTE_CODE not implemented) abort
27 : CODE@ ( addr -- xt , fetch from code space ) @ ;
28 CELL constant CODE_CELL
33 0 value see_level \ level of conditional imdentation
34 0 value see_addr \ address of next token
37 : SEE.INDENT.BY ( -- n )
38 see_level 1+ 1 max 4 *
43 see_addr ." ( ".hex ." )"
63 code_cell +-> see_addr
65 : SEE.GET.INLINE ( -- n )
69 : SEE.GET.TARGET ( -- branch-target-addr )
80 : SEE.SHOW.FLIT ( -- )
87 : SEE.SHOW.ALIT ( -- )
88 see.get.inline >name id. space
93 : SEE.SHOW.STRING ( -- )
94 see_addr count 2dup + aligned -> see_addr type
97 : SEE.SHOW.TARGET ( -- )
98 see.get.target .hex see.advance
101 : SEE.BRANCH ( -- addr | , handle branch )
107 see.get.target \ calculate address of target
109 nip \ remove old address for THEN
111 ." REPEAT " see.get.target .hex
112 drop \ remove old address for THEN
118 : SEE.0BRANCH ( -- addr | , handle 0branch )
123 see.get.target \ calculate adress of target
126 ." UNTIL=>" see.get.target .hex
135 0 OF see_level 0> IF ." EXIT " see.out+ ELSE ." ;" 0 -> see_addr THEN ENDOF
136 ['] (LITERAL) OF see.show.lit ENDOF
137 ['] (ALITERAL) OF see.show.alit ENDOF
138 [ exists? (FLITERAL) [IF] ]
139 ['] (FLITERAL) OF see.show.flit ENDOF
141 ['] BRANCH OF see.branch ENDOF
142 ['] 0BRANCH OF see.0branch ENDOF
143 ['] (LOOP) OF -1 +-> see_level see.newline ." LOOP " see.advance see.cr ENDOF
144 ['] (+LOOP) OF -1 +-> see_level see.newline ." +LOOP" see.advance see.cr ENDOF
145 ['] (DO) OF see.newline ." DO" 1 +-> see_level see.cr ENDOF
146 ['] (?DO) OF see.newline ." ?DO " see.advance 1 +-> see_level see.cr ENDOF
147 ['] (.") OF .' ." ' see.show.string .' " ' ENDOF
148 ['] (C") OF .' C" ' see.show.string .' " ' ENDOF
149 ['] (S") OF .' S" ' see.show.string .' " ' ENDOF
151 see.cr? xt .xt see.out+
155 : (SEE) { cfa | xt -- }
159 0 \ fake address for THEN handler
163 dup see_addr ( >newline .s ) =
165 -1 +-> see_level see.newline
169 CODE_CELL +-> see_addr
174 0= not abort" SEE conditional analyser nesting failed!"
179 : SEE ( <name> -- , disassemble )
181 dup ['] FIRST_COLON >
186 ." is primitive defined in 'C' kernel." cr
213 ." Here are some strings." cr
214 c" Forth string." count type cr
215 s" Addr/Cnt string" type cr