1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
\ @(#) see.fth 98/01/26 1.4
\ SEE ( <name> -- , disassemble pForth word )
\
\ Copyright 1996 Phil Burk
' file? >code rfence a!
anew task-see.fth
: .XT ( xt -- , print execution tokens name )
>name
dup c@ flag_immediate and
IF
." POSTPONE "
THEN
id. space
;
\ dictionary may be defined as byte code or cell code
0 constant BYTE_CODE
BYTE_CODE [IF]
: CODE@ ( addr -- xt , fetch from code space ) C@ ;
1 constant CODE_CELL
.( BYTE_CODE not implemented) abort
[ELSE]
: CODE@ ( addr -- xt , fetch from code space ) @ ;
CELL constant CODE_CELL
[THEN]
private{
0 value see_level \ level of conditional imdentation
0 value see_addr \ address of next token
0 value see_out
: SEE.INDENT.BY ( -- n )
see_level 1+ 1 max 4 *
;
: SEE.CR
>newline
see_addr ." ( ".hex ." )"
see.indent.by spaces
0 -> see_out
;
: SEE.NEWLINE
see_out 0>
IF see.cr
THEN
;
: SEE.CR?
see_out 6 >
IF
see.newline
THEN
;
: SEE.OUT+
1 +-> see_out
;
: SEE.ADVANCE
code_cell +-> see_addr
;
: SEE.GET.INLINE ( -- n )
see_addr @
;
: SEE.GET.TARGET ( -- branch-target-addr )
see_addr @ see_addr +
;
: SEE.SHOW.LIT ( -- )
see.get.inline .
see.advance
see.out+
;
exists? F* [IF]
: SEE.SHOW.FLIT ( -- )
see_addr f@ f.
1 floats +-> see_addr
see.out+
;
[THEN]
: SEE.SHOW.ALIT ( -- )
see.get.inline >name id. space
see.advance
see.out+
;
: SEE.SHOW.STRING ( -- )
see_addr count 2dup + aligned -> see_addr type
see.out+
;
: SEE.SHOW.TARGET ( -- )
see.get.target .hex see.advance
;
: SEE.BRANCH ( -- addr | , handle branch )
-1 +-> see_level
see.newline
see.get.inline 0>
IF \ forward branch
." ELSE "
see.get.target \ calculate address of target
1 +-> see_level
nip \ remove old address for THEN
ELSE
." REPEAT " see.get.target .hex
drop \ remove old address for THEN
THEN
see.advance
see.cr
;
: SEE.0BRANCH ( -- addr | , handle 0branch )
see.newline
see.get.inline 0>
IF \ forward branch
." IF or WHILE "
see.get.target \ calculate adress of target
1 +-> see_level
ELSE
." UNTIL=>" see.get.target .hex
THEN
see.advance
see.cr
;
: SEE.XT { xt -- }
xt
CASE
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
[ [THEN] ]
['] 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
see.cr? xt .xt see.out+
ENDCASE
;
: (SEE) { cfa | xt -- }
0 -> see_level
cfa -> see_addr
see.cr
0 \ fake address for THEN handler
BEGIN
see_addr code@ -> xt
BEGIN
dup see_addr ( >newline .s ) =
WHILE
-1 +-> see_level see.newline
." THEN " see.cr
drop
REPEAT
CODE_CELL +-> see_addr
xt see.xt
see_addr 0=
UNTIL
cr
0= not abort" SEE conditional analyser nesting failed!"
;
}PRIVATE
: SEE ( <name> -- , disassemble )
'
dup ['] FIRST_COLON >
IF
>code (see)
ELSE
>name id.
." is primitive defined in 'C' kernel." cr
THEN
;
PRIVATIZE
0 [IF]
: SEE.JOKE
dup swap drop
;
: SEE.IF
IF
." hello" cr
ELSE
." bye" cr
THEN
see.joke
;
: SEE.DO
4 0
DO
i . cr
LOOP
;
: SEE."
." Here are some strings." cr
c" Forth string." count type cr
s" Addr/Cnt string" type cr
;
[THEN]
|
