blob: 6977d29ebab517588fb3cdd4a5d2b3854accac36 (
plain)
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
|
\ tag: Forth Decompiler
\
\ this code implements IEEE 1275-1994 ch. 7.5.3.2
\
\ Copyright (C) 2003 Stefan Reinauer
\
\ See the file "COPYING" for further information about
\ the copyright and warranty status of this work.
\
1 value (see-indent)
: (see-cr)
cr (see-indent) spaces
;
: indent+
(see-indent) 2+ to (see-indent)
;
: indent-
(see-indent) 2- to (see-indent)
;
: (see-colon)
dup ." : " cell - lfa2name type (see-cr)
begin
cell+ dup @ dup ['] (semis) <>
while
space
dup
case
['] do?branch of
." if" (see-cr) indent+
drop cell+
endof
['] dobranch of
." then" indent- (see-cr)
drop cell+
endof
['] (begin) of
." begin" indent+ (see-cr)
drop
endof
['] (again) of
." again" (see-cr)
drop
endof
['] (until) of
." until" (see-cr)
drop
endof
['] (while) of
indent- (see-cr)
." while"
indent+ (see-cr)
drop 2 cells +
endof
['] (repeat) of
indent- (see-cr)
." repeat"
(see-cr)
drop 2 cells +
endof
['] (lit) of
." ( lit ) h# "
drop 1 cells +
dup @ u.
endof
['] (") of
22 emit space drop dup cell+ @
2dup swap 2 cells + swap type
22 emit
+ aligned cell+
endof
cell - lfa2name type
endcase
repeat
cr ." ;"
2drop
;
: (see) ( xt -- )
cr
dup @ case
1 of
(see-colon)
endof
3 of
." constant " dup cell - lfa2name type ." = " execute .
endof
4 of
." variable " dup cell - lfa2name type ." = " execute @ .
endof
5 of
." defer " dup cell - lfa2name type cr
." is " cell+ @ cell - lfa2name type cr
endof
." primword " swap cell - lfa2name type
endcase
cr
;
: see ' (see) ;
|
