Commit | Line | Data |
---|---|---|
85d70fb7 JM |
1 | REM POKE 1, PEEK(1)AND248: REM enable all ROM areas as RAM |
2 | REM POKE 55,0: POKE 56,192: CLR: REM move BASIC end from $A000 to $C000 | |
3 | GOTO MAIN | |
4 | ||
5 | REM $INCLUDE: 'readline.in.bas' | |
6 | REM $INCLUDE: 'types.in.bas' | |
7 | REM $INCLUDE: 'reader.in.bas' | |
8 | REM $INCLUDE: 'printer.in.bas' | |
9 | REM $INCLUDE: 'env.in.bas' | |
10 | REM $INCLUDE: 'core.in.bas' | |
11 | ||
12 | REM READ(A$) -> R% | |
13 | MAL_READ: | |
14 | GOSUB READ_STR | |
15 | RETURN | |
16 | ||
17 | REM EVAL_AST(A%, E%) -> R% | |
18 | REM called using GOTO to avoid basic return address stack usage | |
19 | REM top of stack should have return label index | |
20 | EVAL_AST: | |
21 | REM push A% and E% on the stack | |
22 | ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A% | |
23 | ||
24 | IF ER%<>0 THEN GOTO EVAL_AST_RETURN | |
25 | ||
26 | GOSUB DEREF_A | |
27 | ||
28 | T%=Z%(A%,0)AND15 | |
29 | IF T%=5 THEN EVAL_AST_SYMBOL | |
30 | IF T%=6 THEN EVAL_AST_SEQ | |
31 | IF T%=7 THEN EVAL_AST_SEQ | |
32 | IF T%=8 THEN EVAL_AST_SEQ | |
33 | ||
34 | REM scalar: deref to actual value and inc ref cnt | |
35 | R%=A%: GOSUB DEREF_R | |
36 | Z%(R%,0)=Z%(R%,0)+16 | |
37 | GOTO EVAL_AST_RETURN | |
38 | ||
39 | EVAL_AST_SYMBOL: | |
40 | K%=A%: GOSUB ENV_GET | |
41 | GOTO EVAL_AST_RETURN | |
42 | ||
43 | EVAL_AST_SEQ: | |
44 | REM allocate the first entry | |
45 | SZ%=2: GOSUB ALLOC | |
46 | ||
47 | REM make space on the stack | |
48 | ZL%=ZL%+4 | |
49 | REM push type of sequence | |
50 | ZZ%(ZL%-3)=T% | |
51 | REM push sequence index | |
52 | ZZ%(ZL%-2)=-1 | |
53 | REM push future return value (new sequence) | |
54 | ZZ%(ZL%-1)=R% | |
55 | REM push previous new sequence entry | |
56 | ZZ%(ZL%)=R% | |
57 | ||
58 | EVAL_AST_SEQ_LOOP: | |
59 | REM set new sequence entry type (with 1 ref cnt) | |
60 | Z%(R%,0)=ZZ%(ZL%-3)+16 | |
61 | Z%(R%,1)=0 | |
62 | REM create value ptr placeholder | |
63 | Z%(R%+1,0)=14 | |
64 | Z%(R%+1,1)=0 | |
65 | ||
66 | REM update index | |
67 | ZZ%(ZL%-2)=ZZ%(ZL%-2)+1 | |
68 | ||
69 | REM check if we are done evaluating the source sequence | |
70 | IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE | |
71 | ||
72 | REM if hashmap, skip eval of even entries (keys) | |
73 | IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF | |
74 | GOTO EVAL_AST_DO_EVAL | |
75 | ||
76 | EVAL_AST_DO_REF: | |
77 | R%=A%+1: GOSUB DEREF_R: REM deref to target of referred entry | |
78 | Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value | |
79 | GOTO EVAL_AST_ADD_VALUE | |
80 | ||
81 | EVAL_AST_DO_EVAL: | |
82 | REM call EVAL for each entry | |
83 | A%=A%+1: GOSUB EVAL | |
84 | A%=A%-1 | |
85 | GOSUB DEREF_R: REM deref to target of evaluated entry | |
86 | ||
87 | EVAL_AST_ADD_VALUE: | |
88 | ||
89 | REM update previous value pointer to evaluated entry | |
90 | Z%(ZZ%(ZL%)+1,1)=R% | |
91 | ||
92 | IF ER%<>0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE | |
93 | ||
94 | REM allocate the next entry | |
95 | SZ%=2: GOSUB ALLOC | |
96 | ||
97 | REM update previous sequence entry value to point to new entry | |
98 | Z%(ZZ%(ZL%),1)=R% | |
99 | REM update previous ptr to current entry | |
100 | ZZ%(ZL%)=R% | |
101 | ||
102 | REM process the next sequence entry from source list | |
103 | A%=Z%(A%,1) | |
104 | ||
105 | GOTO EVAL_AST_SEQ_LOOP | |
106 | EVAL_AST_SEQ_LOOP_DONE: | |
107 | REM get return value (new seq) | |
108 | R%=ZZ%(ZL%-1) | |
109 | ||
110 | REM pop previous, return, index and type | |
111 | ZL%=ZL%-4 | |
112 | GOTO EVAL_AST_RETURN | |
113 | ||
114 | EVAL_AST_RETURN: | |
115 | REM pop A% and E% off the stack | |
116 | E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 | |
117 | ||
118 | REM pop EVAL AST return label/address | |
119 | RN%=ZZ%(ZL%): ZL%=ZL%-1 | |
120 | IF RN%=1 GOTO EVAL_AST_RETURN_1 | |
121 | IF RN%=2 GOTO EVAL_AST_RETURN_2 | |
122 | IF RN%=3 GOTO EVAL_AST_RETURN_3 | |
123 | RETURN | |
124 | ||
125 | REM EVAL(A%, E%)) -> R% | |
126 | EVAL: | |
127 | LV%=LV%+1: REM track basic return stack level | |
128 | ||
129 | REM push A% and E% on the stack | |
130 | ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A% | |
131 | ||
132 | EVAL_TCO_RECUR: | |
133 | ||
134 | REM AZ%=A%: GOSUB PR_STR | |
135 | REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%) | |
136 | ||
137 | GOSUB DEREF_A | |
138 | ||
139 | GOSUB LIST_Q | |
140 | IF R% THEN GOTO APPLY_LIST | |
141 | REM ELSE | |
142 | REM push EVAL_AST return label/address | |
143 | ZL%=ZL%+1: ZZ%(ZL%)=1 | |
144 | GOTO EVAL_AST | |
145 | EVAL_AST_RETURN_1: | |
146 | ||
147 | GOTO EVAL_RETURN | |
148 | ||
149 | APPLY_LIST: | |
150 | GOSUB EMPTY_Q | |
151 | IF R% THEN R%=A%: Z%(R%,0)=Z%(R%,0)+16: GOTO EVAL_RETURN | |
152 | ||
153 | A0%=A%+1 | |
154 | R%=A0%: GOSUB DEREF_R: A0%=R% | |
155 | ||
156 | REM get symbol in A$ | |
157 | IF (Z%(A0%,0)AND15)<>5 THEN A$="" | |
158 | IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1)) | |
159 | ||
160 | IF A$="def!" THEN GOTO EVAL_DEF | |
161 | IF A$="let*" THEN GOTO EVAL_LET | |
162 | IF A$="do" THEN GOTO EVAL_DO | |
163 | IF A$="if" THEN GOTO EVAL_IF | |
164 | IF A$="fn*" THEN GOTO EVAL_FN | |
165 | GOTO EVAL_INVOKE | |
166 | ||
167 | EVAL_GET_A3: | |
168 | A3% = Z%(Z%(Z%(A%,1),1),1)+1 | |
169 | R%=A3%: GOSUB DEREF_R: A3%=R% | |
170 | EVAL_GET_A2: | |
171 | A2% = Z%(Z%(A%,1),1)+1 | |
172 | R%=A2%: GOSUB DEREF_R: A2%=R% | |
173 | EVAL_GET_A1: | |
174 | A1% = Z%(A%,1)+1 | |
175 | R%=A1%: GOSUB DEREF_R: A1%=R% | |
176 | RETURN | |
177 | ||
178 | EVAL_DEF: | |
179 | REM PRINT "def!" | |
180 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
181 | ||
182 | ZL%=ZL%+1: ZZ%(ZL%)=A1%: REM push A1% | |
183 | A%=A2%: GOSUB EVAL: REM eval a2 | |
184 | A1%=ZZ%(ZL%): ZL%=ZL%-1: REM pop A1% | |
185 | ||
186 | REM set a1 in env to a2 | |
187 | K%=A1%: V%=R%: GOSUB ENV_SET | |
188 | GOTO EVAL_RETURN | |
189 | ||
190 | EVAL_LET: | |
191 | REM PRINT "let*" | |
192 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
193 | ||
194 | E4%=E%: REM save the current environment for release | |
195 | ||
196 | REM create new environment with outer as current environment | |
197 | EO%=E%: GOSUB ENV_NEW | |
198 | E%=R% | |
199 | EVAL_LET_LOOP: | |
200 | IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE | |
201 | ||
202 | REM push A1% | |
203 | ZL%=ZL%+1: ZZ%(ZL%)=A1% | |
204 | REM eval current A1 odd element | |
205 | A%=Z%(A1%,1)+1: GOSUB EVAL | |
206 | REM pop A1% | |
207 | A1%=ZZ%(ZL%): ZL%=ZL%-1 | |
208 | ||
209 | REM set environment: even A1% key to odd A1% eval'd above | |
210 | K%=A1%+1: V%=R%: GOSUB ENV_SET | |
211 | AY%=R%: GOSUB RELEASE: REM release our use, ENV_SET took ownership | |
212 | ||
213 | REM skip to the next pair of A1% elements | |
214 | A1%=Z%(Z%(A1%,1),1) | |
215 | GOTO EVAL_LET_LOOP | |
216 | EVAL_LET_LOOP_DONE: | |
217 | REM release previous env (if not root repl_env) because our | |
218 | REM new env refers to it and we no longer need to track it | |
219 | REM (since we are TCO recurring) | |
220 | IF E4%<>RE% THEN AY%=E4%: GOSUB RELEASE | |
221 | ||
222 | A%=A2%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
223 | ||
224 | EVAL_DO: | |
225 | A%=Z%(A%,1): REM rest | |
226 | ||
227 | REM TODO: TCO | |
228 | ||
229 | REM push EVAL_AST return label/address | |
230 | ZL%=ZL%+1: ZZ%(ZL%)=2 | |
231 | GOTO EVAL_AST | |
232 | EVAL_AST_RETURN_2: | |
233 | ||
234 | ZL%=ZL%+1: ZZ%(ZL%)=R%: REM push eval'd list | |
235 | A%=R%: GOSUB LAST: REM return the last element | |
236 | AY%=ZZ%(ZL%): ZL%=ZL%-1: REM pop eval'd list | |
237 | GOSUB RELEASE: REM release the eval'd list | |
238 | GOTO EVAL_RETURN | |
239 | ||
240 | EVAL_IF: | |
241 | GOSUB EVAL_GET_A1: REM set a1% | |
242 | REM push A% | |
243 | ZL%=ZL%+1: ZZ%(ZL%)=A% | |
244 | A%=A1%: GOSUB EVAL | |
245 | REM pop A% | |
246 | A%=ZZ%(ZL%): ZL%=ZL%-1 | |
247 | IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE | |
248 | ||
249 | EVAL_IF_TRUE: | |
250 | AY%=R%: GOSUB RELEASE | |
251 | GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL | |
252 | A%=A2%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
253 | EVAL_IF_FALSE: | |
254 | AY%=R%: GOSUB RELEASE | |
255 | REM if no false case (A3%), return nil | |
256 | IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0: GOTO EVAL_RETURN | |
257 | GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL | |
258 | A%=A3%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
259 | ||
260 | EVAL_FN: | |
261 | GOSUB EVAL_GET_A2: REM set a1% and a2% | |
262 | A%=A2%: P%=A1%: GOSUB MAL_FUNCTION | |
263 | GOTO EVAL_RETURN | |
264 | ||
265 | EVAL_INVOKE: | |
266 | REM push EVAL_AST return label/address | |
267 | ZL%=ZL%+1: ZZ%(ZL%)=3 | |
268 | GOTO EVAL_AST | |
269 | EVAL_AST_RETURN_3: | |
270 | ||
271 | REM if error, return f/args for release by caller | |
272 | IF ER%<>0 THEN GOTO EVAL_RETURN | |
273 | ||
274 | REM push f/args for release after call | |
275 | ZL%=ZL%+1: ZZ%(ZL%)=R% | |
276 | ||
277 | F%=R%+1 | |
278 | ||
279 | AR%=Z%(R%,1): REM rest | |
280 | R%=F%: GOSUB DEREF_R: F%=R% | |
281 | ||
282 | IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION | |
283 | IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION | |
284 | ||
285 | REM if error, pop and return f/args for release by caller | |
286 | R%=ZZ%(ZL%): ZL%=ZL%-1 | |
287 | ER%=1: ER$="apply of non-function": GOTO EVAL_RETURN | |
288 | ||
289 | EVAL_DO_FUNCTION: | |
290 | GOSUB DO_FUNCTION | |
291 | ||
292 | REM pop and release f/args | |
293 | AY%=ZZ%(ZL%): ZL%=ZL%-1: GOSUB RELEASE | |
294 | GOTO EVAL_RETURN | |
295 | ||
296 | EVAL_DO_MAL_FUNCTION: | |
297 | E4%=E%: REM save the current environment for release | |
298 | ||
299 | REM create new environ using env stored with function | |
300 | EO%=Z%(F%+1,1): BI%=Z%(F%+1,0): EX%=AR%: GOSUB ENV_NEW_BINDS | |
301 | ||
302 | REM release previous env if it is not the top one on the | |
303 | REM stack (ZZ%(ZL%-2)) because our new env refers to it and | |
304 | REM we no longer need to track it (since we are TCO recurring) | |
305 | IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%: GOSUB RELEASE | |
306 | ||
307 | REM claim the AST before releasing the list containing it | |
308 | A%=Z%(F%,1): Z%(A%,0)=Z%(A%,0)+16 | |
309 | REM add AST to pending release queue to free later | |
310 | ZM%=ZM%+1: ZR%(ZM%)=A% | |
311 | ||
312 | REM pop and release f/args | |
313 | AY%=ZZ%(ZL%): ZL%=ZL%-1: GOSUB RELEASE | |
314 | ||
315 | REM A% set above | |
316 | E%=R%: GOTO EVAL_TCO_RECUR: REM TCO loop | |
317 | ||
318 | EVAL_RETURN: | |
319 | REM release environment if not the top one on the stack | |
320 | IF E%<>ZZ%(ZL%-1) THEN AY%=E%: GOSUB RELEASE | |
321 | ||
322 | REM release everything we couldn't release earlier | |
323 | GOSUB RELEASE_PEND | |
324 | ||
325 | REM AZ%=R%: PR%=1: GOSUB PR_STR | |
326 | REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%) | |
327 | ||
328 | REM trigger GC | |
329 | TA%=FRE(0) | |
330 | ||
331 | REM pop A% and E% off the stack | |
332 | E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 | |
333 | ||
334 | LV%=LV%-1: REM track basic return stack level | |
335 | ||
336 | RETURN | |
337 | ||
338 | REM PRINT(A%) -> R$ | |
339 | MAL_PRINT: | |
340 | AZ%=A%: PR%=1: GOSUB PR_STR | |
341 | RETURN | |
342 | ||
343 | REM RE(A$) -> R% | |
344 | REM Assume RE% has repl_env | |
345 | REM caller must release result | |
346 | RE: | |
347 | R1%=0 | |
348 | GOSUB MAL_READ | |
349 | R1%=R% | |
350 | IF ER%<>0 THEN GOTO REP_DONE | |
351 | ||
352 | A%=R%: E%=RE%: GOSUB EVAL | |
353 | ||
354 | REP_DONE: | |
355 | REM Release memory from MAL_READ | |
356 | IF R1%<>0 THEN AY%=R1%: GOSUB RELEASE | |
357 | RETURN: REM caller must release result of EVAL | |
358 | ||
359 | REM REP(A$) -> R$ | |
360 | REM Assume RE% has repl_env | |
361 | REP: | |
362 | R1%=0: R2%=0 | |
363 | GOSUB MAL_READ | |
364 | R1%=R% | |
365 | IF ER%<>0 THEN GOTO REP_DONE | |
366 | ||
367 | A%=R%: E%=RE%: GOSUB EVAL | |
368 | R2%=R% | |
369 | IF ER%<>0 THEN GOTO REP_DONE | |
370 | ||
371 | A%=R%: GOSUB MAL_PRINT | |
372 | RT$=R$ | |
373 | ||
374 | REP_DONE: | |
375 | REM Release memory from MAL_READ and EVAL | |
376 | IF R2%<>0 THEN AY%=R2%: GOSUB RELEASE | |
377 | IF R1%<>0 THEN AY%=R1%: GOSUB RELEASE | |
378 | R$=RT$ | |
379 | RETURN | |
380 | ||
381 | REM MAIN program | |
382 | MAIN: | |
383 | GOSUB INIT_MEMORY | |
384 | ||
385 | LV%=0 | |
386 | ||
387 | REM create repl_env | |
388 | EO%=-1: GOSUB ENV_NEW | |
389 | RE%=R% | |
390 | ||
391 | REM core.EXT: defined in Basic | |
392 | E%=RE%: GOSUB INIT_CORE_NS: REM set core functions in repl_env | |
393 | ||
394 | ZT%=ZI%: REM top of memory after base repl_env | |
395 | ||
396 | REM core.mal: defined using the language itself | |
397 | A$="(def! not (fn* (a) (if a false true)))" | |
398 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
399 | ||
400 | A$="(def! load-file (fn* (f) (eval (read-string (str " | |
401 | A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) " | |
402 | A$=A$+CHR$(34)+")"+CHR$(34)+")))))" | |
403 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
404 | ||
405 | REM load the args file | |
406 | A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))" | |
407 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
408 | ||
409 | REM set the argument list | |
410 | A$="(def! *ARGV* (rest -*ARGS*-))" | |
411 | GOSUB RE: AY%=R%: GOSUB RELEASE | |
412 | ||
413 | REM get the first argument | |
414 | A$="(first -*ARGS*-)" | |
415 | GOSUB RE | |
416 | ||
417 | REM if there is an argument, then run it as a program | |
418 | IF R%<>0 THEN AY%=R%: GOSUB RELEASE: GOTO RUN_PROG | |
419 | REM no arguments, start REPL loop | |
420 | IF R%=0 THEN GOTO REPL_LOOP | |
421 | ||
422 | RUN_PROG: | |
423 | REM run a single mal program and exit | |
424 | A$="(load-file (first -*ARGS*-))" | |
425 | GOSUB REP | |
426 | IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO QUIT | |
427 | IF ER%=0 THEN PRINT R$: GOTO QUIT | |
428 | ||
429 | REPL_LOOP: | |
430 | A$="user> " | |
431 | GOSUB READLINE: REM /* call input parser */ | |
432 | IF EOF=1 THEN GOTO QUIT | |
433 | ||
434 | A$=R$: GOSUB REP: REM /* call REP */ | |
435 | ||
436 | IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP | |
437 | PRINT R$ | |
438 | GOTO REPL_LOOP | |
439 | ||
440 | QUIT: | |
441 | REM P1%=ZT%: P2%=-1: GOSUB PR_MEMORY | |
442 | GOSUB PR_MEMORY_SUMMARY | |
443 | END | |
444 | ||
445 | PRINT_ERROR: | |
446 | PRINT "Error: " + ER$ | |
447 | ER%=0 | |
448 | ER$="" | |
449 | RETURN | |
450 |