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