blob: 5942680c35a0084619054ad93035a769640e2e6c (
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
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
219
220
221
222
223
|
/usr/bin/env 3cl "$0"; exit
\
This procedure loads ASCII codes of tokens of ccl onto the stack
\
S/etup tokens / -- ascii-code ...
{
&x / for duplicating
\ '!' \ ^ +++++++++++++++++++++++++++++++++
\ '#' \ =x$x$x ++
\ '$' \ =x$x$x +
\ '%' \ =x$x$x +
\ '&' \ =x$x$x +
\ '(' \ =x$x$x ++
\ ')' \ =x$x$x +
\ '*' \ =x$x$x +
\ '+' \ =x$x$x +
\ '-' \ =x$x$x ++
\ ':' \ =x$x$x +++++++++++++
\ ';' \ =x$x$x +
\ '<' \ =x$x$x +
\ '=' \ =x$x$x +
\ '>' \ =x$x$x +
\ '?' \ =x$x$x +
\ '@' \ =x$x$x +
\ 'A' \ =x$x$x +
\ 'B' \ =x$x$x +
\ 'C' \ =x$x$x +
\ 'D' \ =x$x$x +
\ 'E' \ =x$x$x +
\ 'F' \ =x$x$x +
\ 'G' \ =x$x$x +
\ 'H' \ =x$x$x +
\ 'I' \ =x$x$x +
\ 'J' \ =x$x$x +
\ 'K' \ =x$x$x +
\ 'L' \ =x$x$x +
\ 'M' \ =x$x$x +
\ 'N' \ =x$x$x +
\ 'O' \ =x$x$x +
\ 'P' \ =x$x$x +
\ 'Q' \ =x$x$x +
\ 'R' \ =x$x$x +
\ 'S' \ =x$x$x +
\ 'T' \ =x$x$x +
\ 'U' \ =x$x$x +
\ 'V' \ =x$x$x +
\ 'W' \ =x$x$x +
\ 'X' \ =x$x$x +
\ 'Y' \ =x$x$x +
\ 'Z' \ =x$x$x +
\ '[' \ =x$x$x +
\ ']' \ =x$x$x ++
\ '^' \ =x$x$x +
\ '_' \ =x$x$x +
\ 'a' \ =x$x$x ++
\ 'b' \ =x$x$x +
\ 'c' \ =x$x$x +
\ 'd' \ =x$x$x +
\ 'e' \ =x$x$x +
\ 'f' \ =x$x$x +
\ 'g' \ =x$x$x +
\ 'h' \ =x$x$x +
\ 'i' \ =x$x$x +
\ 'j' \ =x$x$x +
\ 'k' \ =x$x$x +
\ 'l' \ =x$x$x +
\ 'm' \ =x$x$x +
\ 'n' \ =x$x$x +
\ 'o' \ =x$x$x +
\ 'p' \ =x$x$x +
\ 'q' \ =x$x$x +
\ 'r' \ =x$x$x +
\ 's' \ =x$x$x +
\ 't' \ =x$x$x +
\ 'u' \ =x$x$x +
\ 'v' \ =x$x$x +
\ 'w' \ =x$x$x +
\ 'x' \ =x$x$x +
\ 'y' \ =x$x$x +
\ 'z' \ =x$x$x +
\ '{' \ =x$x$x +
\ '}' \ =x$x$x ++
\ '~' \ =x$x$x +
}
\
This procedure reads the code from stdin, strips all unrelated
characters and returns an array of tokens on the stack, so the toppest
element is the firstest
Note that since its algorithm this function should be called with empty
stack
TODO: rewrite this function so it won't depend on empty stack
\
R/ead / -- token ...
{
&c/har
&t/oken
/ these flags are inverted
&o^+=o/neline comment flag
&m^+=m/ultiline comment flag
&a/ny comment flag
/ comment char constants
&N^++++++++++=N/ewline
&S$N$N*$N$N**$N*---=S/lash
&B$S$S*--=B/ackslash
@S
&E^-=E$E / -1 is a separator between parsed tokens and token lut
/ on the loop start top of the stack stores parsed tokens then -1 and
/ token lut
_ ( / reading until EOF
>c
^-c?=_#;=_ / exit if EOF
&e^+=e/ntered - set if not entered block below
o[m[ / if not in comment
^=e
/ check if maybe start of a comment
$Sc?$o-=o$a+=a=_#;=_
$Bc?$m-=m$a+=a=_#;=_
$E / push one more separator
%_ / now token lut is on the top
&f / flag indicating whether char is token or not
_ ( / comparing until -1
E?#; / exit on eof
c?$f+=f#; / if token then set flag
=t%_$t%_ / move entry to another end of stack
)
/ returning lut back erasing now unneeded -1 from note
%_ _ ( E?=_#; =t%_$t%_ )
f[$c] / if token then push it onto the stack
]]
e[a[ / if in comment
m[$Nc?$o+=o$a-=a;=_] / check if oneline
o[$Bc?$m+=m$a-=a;=_] / check if mutliline
]]
)
%_
_ ( E?=_#;=_ )
}
\
This function reads stack until EOP (end of parsing) with tokens and
prints compiled text to stdout
\
P/arse loop / EOP token ... EOP --
{
&t/oken
&e=e/nd
_ (
\ EOP \ e?=_#;
\ '^' \ T?@t#;
\ '+' \ I?@i#;
\ '-' \ J?@j#;
\ '*' \ H?@h#;
\ '~' \ X?@x#;
\ '#' \ B?@b#;
\ ':' \ K?@k#;
\ '%' \ D?@d#;
\ '=' \ N?@n#;
\ '!' \ A?@a#;
\ '$' \ C?@c#;
\ '&' \ E?@e#;
\ '<' \ M?@m#;
\ '>' \ O?@o#;
\ '@' \ Q?@q#;
/ Otherwise we've got a parameter for a block instruction
/ (or any of other 8 tokens which is an error b2cl doesn't
/ handle rn)
/ Maybe it's better to not consume EOP so caller can check for
/ errors that way
@B/lock
)
}
\
Main function for compiling. Takes full stack
\
C/ompile / token ... --
{
%_^-=E$E%_$E / Insert s
\ \&x / Setup instruction names
\ '!' \ ^ +++++++++++++++++++++++++++++++++ =A
\ '#' \ $A ++ =B
\ '$' \ $B + =C
\ '%' \ $C + =D
\ '&' \ $D + =E
\ '(' \ $E ++ =F
\ ')' \ $F + =G
\ '*' \ $G + =H
\ '+' \ $H + =I
\ '-' \ $I ++ =J
\ ':' \ $J +++++++++++++ =K
\ ';' \ $K + =L
\ '<' \ $L + =M
\ '=' \ $M + =N
\ '>' \ $N + =O
\ '?' \ $O + =P
\ '@' \ $P + =Q
\ '[' \ $Q +++++++++++++++++++++++++++ =R
\ ']' \ $R ++ =S
\ '^' \ $S + =T
\ '_' \ $T + =U
\ '{' \ $U ++++++++++++++++++++++++++++ =V
\ '}' \ $V ++ =W
\ '~' \ $W + =X
/ Emit boilerplate before
@P/arse loop
/ Emit boilerplate after
}
@R\ead and then\ @C\ompile\
|