Commit | Line | Data |
---|---|---|
9e8f5211 JM |
1 | GOTO MAIN |
2 | ||
d7a6c2d6 | 3 | REM $INCLUDE: 'mem.in.bas' |
9e8f5211 | 4 | REM $INCLUDE: 'types.in.bas' |
93593012 | 5 | REM $INCLUDE: 'readline.in.bas' |
9e8f5211 JM |
6 | REM $INCLUDE: 'reader.in.bas' |
7 | REM $INCLUDE: 'printer.in.bas' | |
8 | REM $INCLUDE: 'env.in.bas' | |
9 | REM $INCLUDE: 'core.in.bas' | |
10 | ||
11 | REM $INCLUDE: 'debug.in.bas' | |
12 | ||
cc9dbd92 | 13 | REM READ(A$) -> R |
9e8f5211 JM |
14 | MAL_READ: |
15 | GOSUB READ_STR | |
16 | RETURN | |
17 | ||
cc9dbd92 | 18 | REM QUASIQUOTE(A) -> R |
af621e3a JM |
19 | SUB QUASIQUOTE |
20 | REM pair? | |
4202ef7b JM |
21 | GOSUB TYPE_A |
22 | IF T<6 OR T>7 THEN GOTO QQ_QUOTE | |
d7a6c2d6 | 23 | IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE |
af621e3a JM |
24 | GOTO QQ_UNQUOTE |
25 | ||
26 | QQ_QUOTE: | |
9e8f5211 | 27 | REM ['quote, ast] |
c756af81 JM |
28 | B$="quote":T=5:GOSUB STRING |
29 | B=R:A=A:GOSUB LIST2 | |
30 | AY=B:GOSUB RELEASE | |
9e8f5211 | 31 | |
af621e3a | 32 | GOTO QQ_DONE |
9e8f5211 JM |
33 | |
34 | QQ_UNQUOTE: | |
d7a6c2d6 JM |
35 | R=Z%(A+2) |
36 | IF (Z%(R)AND 31)<>5 THEN GOTO QQ_SPLICE_UNQUOTE | |
37 | IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE | |
9e8f5211 | 38 | REM [ast[1]] |
d7a6c2d6 | 39 | R=Z%(Z%(A+1)+2) |
4202ef7b | 40 | GOSUB INC_REF_R |
9e8f5211 | 41 | |
af621e3a | 42 | GOTO QQ_DONE |
9e8f5211 JM |
43 | |
44 | QQ_SPLICE_UNQUOTE: | |
93593012 | 45 | GOSUB PUSH_A |
9e8f5211 | 46 | REM rest of cases call quasiquote on ast[1..] |
d7a6c2d6 | 47 | A=Z%(A+1):CALL QUASIQUOTE |
037815e0 | 48 | W=R |
93593012 | 49 | GOSUB POP_A |
cc9dbd92 JM |
50 | |
51 | REM set A to ast[0] for last two cases | |
d7a6c2d6 | 52 | A=Z%(A+2) |
cc9dbd92 | 53 | |
af621e3a | 54 | REM pair? |
4202ef7b JM |
55 | GOSUB TYPE_A |
56 | IF T<6 OR T>7 THEN GOTO QQ_DEFAULT | |
d7a6c2d6 | 57 | IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT |
af621e3a | 58 | |
d7a6c2d6 JM |
59 | B=Z%(A+2) |
60 | IF (Z%(B)AND 31)<>5 THEN GOTO QQ_DEFAULT | |
61 | IF S$(Z%(B+1))<>"splice-unquote" THEN QQ_DEFAULT | |
9e8f5211 JM |
62 | REM ['concat, ast[0][1], quasiquote(ast[1..])] |
63 | ||
d7a6c2d6 | 64 | B=Z%(Z%(A+1)+2) |
c756af81 | 65 | B$="concat":T=5:GOSUB STRING:C=R |
037815e0 | 66 | A=W:GOSUB LIST3 |
9e8f5211 | 67 | REM release inner quasiquoted since outer list takes ownership |
c756af81 JM |
68 | AY=A:GOSUB RELEASE |
69 | AY=C:GOSUB RELEASE | |
af621e3a | 70 | GOTO QQ_DONE |
9e8f5211 JM |
71 | |
72 | QQ_DEFAULT: | |
73 | REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])] | |
74 | ||
037815e0 | 75 | Q=W:GOSUB PUSH_Q |
cc9dbd92 | 76 | REM A set above to ast[0] |
af621e3a | 77 | CALL QUASIQUOTE |
c756af81 | 78 | B=R |
037815e0 | 79 | GOSUB POP_Q:W=Q |
9e8f5211 | 80 | |
c756af81 | 81 | B$="cons":T=5:GOSUB STRING:C=R |
037815e0 | 82 | A=W:GOSUB LIST3 |
9e8f5211 | 83 | REM release inner quasiquoted since outer list takes ownership |
c756af81 JM |
84 | AY=A:GOSUB RELEASE |
85 | AY=B:GOSUB RELEASE | |
86 | AY=C:GOSUB RELEASE | |
af621e3a JM |
87 | QQ_DONE: |
88 | END SUB | |
9e8f5211 JM |
89 | |
90 | ||
cc9dbd92 | 91 | REM EVAL_AST(A, E) -> R |
af621e3a | 92 | SUB EVAL_AST |
cc9dbd92 | 93 | REM push A and E on the stack |
93593012 JM |
94 | Q=E:GOSUB PUSH_Q |
95 | GOSUB PUSH_A | |
9e8f5211 | 96 | |
cc9dbd92 | 97 | IF ER<>-2 THEN GOTO EVAL_AST_RETURN |
9e8f5211 | 98 | |
4202ef7b | 99 | GOSUB TYPE_A |
cc9dbd92 JM |
100 | IF T=5 THEN GOTO EVAL_AST_SYMBOL |
101 | IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ | |
9e8f5211 JM |
102 | |
103 | REM scalar: deref to actual value and inc ref cnt | |
9d59cdb3 | 104 | R=A |
4202ef7b | 105 | GOSUB INC_REF_R |
9e8f5211 JM |
106 | GOTO EVAL_AST_RETURN |
107 | ||
108 | EVAL_AST_SYMBOL: | |
af621e3a JM |
109 | K=A:GOTO ENV_GET |
110 | ENV_GET_RETURN: | |
9e8f5211 JM |
111 | GOTO EVAL_AST_RETURN |
112 | ||
113 | EVAL_AST_SEQ: | |
9d59cdb3 JM |
114 | REM setup the stack for the loop |
115 | GOSUB MAP_LOOP_START | |
9e8f5211 JM |
116 | |
117 | EVAL_AST_SEQ_LOOP: | |
9e8f5211 | 118 | REM check if we are done evaluating the source sequence |
d7a6c2d6 | 119 | IF Z%(A+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE |
9e8f5211 | 120 | |
01e8850d | 121 | REM if we are returning to DO, then skip last element |
9d59cdb3 JM |
122 | REM The EVAL_DO call to EVAL_AST must be call #2 for EVAL_AST to |
123 | REM return early and for TCO to work | |
124 | Q=5:GOSUB PEEK_Q_Q | |
d7a6c2d6 | 125 | IF Q=2 AND Z%(Z%(A+1)+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE |
01e8850d | 126 | |
9d59cdb3 JM |
127 | REM call EVAL for each entry |
128 | GOSUB PUSH_A | |
d7a6c2d6 JM |
129 | IF T<>8 THEN A=Z%(A+2) |
130 | IF T=8 THEN A=Z%(A+3) | |
9d59cdb3 JM |
131 | Q=T:GOSUB PUSH_Q: REM push/save type |
132 | CALL EVAL | |
133 | GOSUB POP_Q:T=Q: REM pop/restore type | |
134 | GOSUB POP_A | |
d7a6c2d6 | 135 | M=R |
9e8f5211 | 136 | |
9d59cdb3 JM |
137 | REM if error, release the unattached element |
138 | REM TODO: is R=0 correct? | |
139 | IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE | |
9e8f5211 | 140 | |
9d59cdb3 JM |
141 | REM for hash-maps, copy the key (inc ref since we are going to |
142 | REM release it below) | |
d7a6c2d6 | 143 | IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 |
9e8f5211 | 144 | |
9e8f5211 | 145 | |
9d59cdb3 JM |
146 | REM update the return sequence structure |
147 | REM release N (and M if T=8) since seq takes full ownership | |
148 | C=1:GOSUB MAP_LOOP_UPDATE | |
9e8f5211 JM |
149 | |
150 | REM process the next sequence entry from source list | |
d7a6c2d6 | 151 | A=Z%(A+1) |
9e8f5211 JM |
152 | |
153 | GOTO EVAL_AST_SEQ_LOOP | |
154 | EVAL_AST_SEQ_LOOP_DONE: | |
9d59cdb3 JM |
155 | REM cleanup stack and get return value |
156 | GOSUB MAP_LOOP_DONE | |
9e8f5211 JM |
157 | GOTO EVAL_AST_RETURN |
158 | ||
159 | EVAL_AST_RETURN: | |
cc9dbd92 | 160 | REM pop A and E off the stack |
93593012 JM |
161 | GOSUB POP_A |
162 | GOSUB POP_Q:E=Q | |
af621e3a | 163 | END SUB |
9e8f5211 | 164 | |
af621e3a JM |
165 | REM EVAL(A, E) -> R |
166 | SUB EVAL | |
cc9dbd92 | 167 | LV=LV+1: REM track basic return stack level |
9e8f5211 | 168 | |
cc9dbd92 | 169 | REM push A and E on the stack |
93593012 JM |
170 | Q=E:GOSUB PUSH_Q |
171 | GOSUB PUSH_A | |
9e8f5211 | 172 | |
01e8850d JM |
173 | REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0)) |
174 | ||
9e8f5211 JM |
175 | EVAL_TCO_RECUR: |
176 | ||
c7330b3d JM |
177 | IF ER<>-2 THEN GOTO EVAL_RETURN |
178 | ||
c756af81 | 179 | REM AZ=A:B=1:GOSUB PR_STR |
cc9dbd92 | 180 | REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" |
9e8f5211 | 181 | |
9e8f5211 | 182 | GOSUB LIST_Q |
cc9dbd92 | 183 | IF R THEN GOTO APPLY_LIST |
9e8f5211 | 184 | REM ELSE |
af621e3a | 185 | CALL EVAL_AST |
9e8f5211 JM |
186 | GOTO EVAL_RETURN |
187 | ||
188 | APPLY_LIST: | |
189 | GOSUB EMPTY_Q | |
4202ef7b | 190 | IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN |
9e8f5211 | 191 | |
d7a6c2d6 | 192 | A0=Z%(A+2) |
9e8f5211 JM |
193 | |
194 | REM get symbol in A$ | |
d7a6c2d6 JM |
195 | IF (Z%(A0)AND 31)<>5 THEN A$="" |
196 | IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) | |
9e8f5211 JM |
197 | |
198 | IF A$="def!" THEN GOTO EVAL_DEF | |
199 | IF A$="let*" THEN GOTO EVAL_LET | |
200 | IF A$="quote" THEN GOTO EVAL_QUOTE | |
201 | IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE | |
202 | IF A$="do" THEN GOTO EVAL_DO | |
203 | IF A$="if" THEN GOTO EVAL_IF | |
204 | IF A$="fn*" THEN GOTO EVAL_FN | |
205 | GOTO EVAL_INVOKE | |
206 | ||
207 | EVAL_GET_A3: | |
d7a6c2d6 | 208 | A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) |
9e8f5211 | 209 | EVAL_GET_A2: |
d7a6c2d6 | 210 | A2=Z%(Z%(Z%(A+1)+1)+2) |
9e8f5211 | 211 | EVAL_GET_A1: |
d7a6c2d6 | 212 | A1=Z%(Z%(A+1)+2) |
9e8f5211 JM |
213 | RETURN |
214 | ||
215 | EVAL_DEF: | |
216 | REM PRINT "def!" | |
bbab5c5d | 217 | GOSUB EVAL_GET_A2: REM set A1 and A2 |
9e8f5211 | 218 | |
93593012 | 219 | Q=A1:GOSUB PUSH_Q |
af621e3a | 220 | A=A2:CALL EVAL: REM eval a2 |
93593012 | 221 | GOSUB POP_Q:A1=Q |
9e8f5211 | 222 | |
cc9dbd92 | 223 | IF ER<>-2 THEN GOTO EVAL_RETURN |
70f29a2b | 224 | |
9e8f5211 | 225 | REM set a1 in env to a2 |
c756af81 | 226 | K=A1:C=R:GOSUB ENV_SET |
9e8f5211 JM |
227 | GOTO EVAL_RETURN |
228 | ||
229 | EVAL_LET: | |
230 | REM PRINT "let*" | |
bbab5c5d | 231 | GOSUB EVAL_GET_A2: REM set A1 and A2 |
9e8f5211 | 232 | |
93593012 JM |
233 | Q=A2:GOSUB PUSH_Q: REM push/save A2 |
234 | Q=E:GOSUB PUSH_Q: REM push env for for later release | |
9e8f5211 JM |
235 | |
236 | REM create new environment with outer as current environment | |
c756af81 | 237 | C=E:GOSUB ENV_NEW |
cc9dbd92 | 238 | E=R |
9e8f5211 | 239 | EVAL_LET_LOOP: |
d7a6c2d6 | 240 | IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE |
9e8f5211 | 241 | |
93593012 | 242 | Q=A1:GOSUB PUSH_Q: REM push A1 |
9e8f5211 | 243 | REM eval current A1 odd element |
d7a6c2d6 | 244 | A=Z%(Z%(A1+1)+2):CALL EVAL |
93593012 | 245 | GOSUB POP_Q:A1=Q: REM pop A1 |
9e8f5211 | 246 | |
c7330b3d JM |
247 | IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE |
248 | ||
d7a6c2d6 JM |
249 | REM set key/value in the environment |
250 | K=Z%(A1+2):C=R:GOSUB ENV_SET | |
cc9dbd92 | 251 | AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership |
9e8f5211 | 252 | |
bbab5c5d | 253 | REM skip to the next pair of A1 elements |
d7a6c2d6 | 254 | A1=Z%(Z%(A1+1)+1) |
9e8f5211 | 255 | GOTO EVAL_LET_LOOP |
70f29a2b | 256 | |
9e8f5211 | 257 | EVAL_LET_LOOP_DONE: |
9d59cdb3 | 258 | GOSUB POP_Q:AY=Q: REM pop previous env |
70f29a2b JM |
259 | |
260 | REM release previous environment if not the current EVAL env | |
93593012 | 261 | GOSUB PEEK_Q_2 |
9d59cdb3 | 262 | IF AY<>Q THEN GOSUB RELEASE |
9e8f5211 | 263 | |
93593012 | 264 | GOSUB POP_Q:A2=Q: REM pop A2 |
bbab5c5d | 265 | A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop |
9e8f5211 JM |
266 | |
267 | EVAL_DO: | |
d7a6c2d6 | 268 | A=Z%(A+1): REM rest |
93593012 | 269 | GOSUB PUSH_A: REM push/save A |
9e8f5211 | 270 | |
9d59cdb3 JM |
271 | REM this must be EVAL_AST call #2 for EVAL_AST to return early |
272 | REM and for TCO to work | |
af621e3a | 273 | CALL EVAL_AST |
9e8f5211 | 274 | |
01e8850d JM |
275 | REM cleanup |
276 | AY=R: REM get eval'd list for release | |
277 | ||
93593012 | 278 | GOSUB POP_A: REM pop/restore original A for LAST |
01e8850d JM |
279 | GOSUB LAST: REM get last element for return |
280 | A=R: REM new recur AST | |
281 | ||
282 | REM cleanup | |
283 | GOSUB RELEASE: REM release eval'd list | |
284 | AY=A:GOSUB RELEASE: REM release LAST value (not sure why) | |
285 | ||
286 | GOTO EVAL_TCO_RECUR: REM TCO loop | |
9e8f5211 JM |
287 | |
288 | EVAL_QUOTE: | |
d7a6c2d6 | 289 | R=Z%(Z%(A+1)+2) |
4202ef7b | 290 | GOSUB INC_REF_R |
9e8f5211 JM |
291 | GOTO EVAL_RETURN |
292 | ||
293 | EVAL_QUASIQUOTE: | |
d7a6c2d6 | 294 | R=Z%(Z%(A+1)+2) |
af621e3a | 295 | A=R:CALL QUASIQUOTE |
93593012 | 296 | A=R |
9e8f5211 | 297 | REM add quasiquote result to pending release queue to free when |
cc9dbd92 | 298 | REM next lower EVAL level returns (LV) |
93593012 | 299 | GOSUB PEND_A_LV |
9e8f5211 | 300 | |
93593012 | 301 | GOTO EVAL_TCO_RECUR: REM TCO loop |
9e8f5211 JM |
302 | |
303 | EVAL_IF: | |
bbab5c5d | 304 | GOSUB EVAL_GET_A1: REM set A1 |
93593012 | 305 | GOSUB PUSH_A: REM push/save A |
af621e3a | 306 | A=A1:CALL EVAL |
93593012 | 307 | GOSUB POP_A: REM pop/restore A |
d7a6c2d6 | 308 | IF (R=0) OR (R=2) THEN GOTO EVAL_IF_FALSE |
9e8f5211 JM |
309 | |
310 | EVAL_IF_TRUE: | |
cc9dbd92 | 311 | AY=R:GOSUB RELEASE |
bbab5c5d JM |
312 | GOSUB EVAL_GET_A2: REM set A1 and A2 after EVAL |
313 | A=A2:GOTO EVAL_TCO_RECUR: REM TCO loop | |
9e8f5211 | 314 | EVAL_IF_FALSE: |
cc9dbd92 | 315 | AY=R:GOSUB RELEASE |
bbab5c5d | 316 | REM if no false case (A3), return nil |
037815e0 | 317 | GOSUB COUNT |
4202ef7b | 318 | IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN |
bbab5c5d JM |
319 | GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL |
320 | A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop | |
9e8f5211 JM |
321 | |
322 | EVAL_FN: | |
bbab5c5d | 323 | GOSUB EVAL_GET_A2: REM set A1 and A2 |
4202ef7b | 324 | T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function |
9e8f5211 JM |
325 | GOTO EVAL_RETURN |
326 | ||
327 | EVAL_INVOKE: | |
af621e3a | 328 | CALL EVAL_AST |
9e8f5211 JM |
329 | |
330 | REM if error, return f/args for release by caller | |
cc9dbd92 | 331 | IF ER<>-2 THEN GOTO EVAL_RETURN |
9e8f5211 JM |
332 | |
333 | REM push f/args for release after call | |
93593012 | 334 | GOSUB PUSH_R |
9e8f5211 | 335 | |
d7a6c2d6 JM |
336 | AR=Z%(R+1): REM rest |
337 | F=Z%(R+2) | |
9e8f5211 | 338 | |
bbab5c5d | 339 | REM if metadata, get the actual object |
4202ef7b JM |
340 | GOSUB TYPE_F |
341 | IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F | |
bbab5c5d | 342 | |
4202ef7b | 343 | ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION |
9e8f5211 JM |
344 | |
345 | REM if error, pop and return f/args for release by caller | |
93593012 | 346 | GOSUB POP_R |
c756af81 | 347 | ER=-1:E$="apply of non-function":GOTO EVAL_RETURN |
9e8f5211 JM |
348 | |
349 | EVAL_DO_FUNCTION: | |
01e8850d | 350 | REM regular function |
d7a6c2d6 | 351 | IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP |
01e8850d | 352 | REM for recur functions (apply, map, swap!), use GOTO |
d7a6c2d6 | 353 | IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION |
af621e3a | 354 | EVAL_DO_FUNCTION_SKIP: |
9e8f5211 JM |
355 | |
356 | REM pop and release f/args | |
93593012 JM |
357 | GOSUB POP_Q:AY=Q |
358 | GOSUB RELEASE | |
9e8f5211 JM |
359 | GOTO EVAL_RETURN |
360 | ||
361 | EVAL_DO_MAL_FUNCTION: | |
9d59cdb3 | 362 | Q=E:GOSUB PUSH_Q: REM save the current environment for release |
9e8f5211 | 363 | |
d7a6c2d6 JM |
364 | REM create new environ using env and params stored in function |
365 | C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS | |
9e8f5211 JM |
366 | |
367 | REM release previous env if it is not the top one on the | |
bbab5c5d | 368 | REM stack (X%(X-2)) because our new env refers to it and |
9e8f5211 | 369 | REM we no longer need to track it (since we are TCO recurring) |
9d59cdb3 | 370 | GOSUB POP_Q:AY=Q |
93593012 | 371 | GOSUB PEEK_Q_2 |
9d59cdb3 | 372 | IF AY<>Q THEN GOSUB RELEASE |
9e8f5211 JM |
373 | |
374 | REM claim the AST before releasing the list containing it | |
d7a6c2d6 | 375 | A=Z%(F+1):Z%(A)=Z%(A)+32 |
9e8f5211 | 376 | REM add AST to pending release queue to free as soon as EVAL |
cc9dbd92 | 377 | REM actually returns (LV+1) |
93593012 | 378 | LV=LV+1:GOSUB PEND_A_LV:LV=LV-1 |
9e8f5211 JM |
379 | |
380 | REM pop and release f/args | |
93593012 JM |
381 | GOSUB POP_Q:AY=Q |
382 | GOSUB RELEASE | |
9e8f5211 | 383 | |
cc9dbd92 JM |
384 | REM A set above |
385 | E=R:GOTO EVAL_TCO_RECUR: REM TCO loop | |
9e8f5211 JM |
386 | |
387 | EVAL_RETURN: | |
c756af81 | 388 | REM AZ=R: B=1: GOSUB PR_STR |
cc9dbd92 | 389 | REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER) |
9e8f5211 JM |
390 | |
391 | REM release environment if not the top one on the stack | |
93593012 JM |
392 | GOSUB PEEK_Q_1 |
393 | IF E<>Q THEN AY=E:GOSUB RELEASE | |
9e8f5211 | 394 | |
cc9dbd92 | 395 | LV=LV-1: REM track basic return stack level |
9e8f5211 JM |
396 | |
397 | REM release everything we couldn't release earlier | |
398 | GOSUB RELEASE_PEND | |
399 | ||
400 | REM trigger GC | |
c756af81 JM |
401 | #cbm T=FRE(0) |
402 | #qbasic T=0 | |
9e8f5211 | 403 | |
cc9dbd92 | 404 | REM pop A and E off the stack |
93593012 JM |
405 | GOSUB POP_A |
406 | GOSUB POP_Q:E=Q | |
9e8f5211 | 407 | |
af621e3a | 408 | END SUB |
9e8f5211 | 409 | |
cc9dbd92 | 410 | REM PRINT(A) -> R$ |
9e8f5211 | 411 | MAL_PRINT: |
c756af81 | 412 | AZ=A:B=1:GOSUB PR_STR |
9e8f5211 JM |
413 | RETURN |
414 | ||
cc9dbd92 | 415 | REM RE(A$) -> R |
bbab5c5d | 416 | REM Assume D has repl_env |
9e8f5211 JM |
417 | REM caller must release result |
418 | RE: | |
4202ef7b | 419 | R1=-1 |
9e8f5211 | 420 | GOSUB MAL_READ |
cc9dbd92 | 421 | R1=R |
0e508fa5 | 422 | IF ER<>-2 THEN GOTO RE_DONE |
9e8f5211 | 423 | |
af621e3a | 424 | A=R:E=D:CALL EVAL |
9e8f5211 | 425 | |
0e508fa5 | 426 | RE_DONE: |
9e8f5211 | 427 | REM Release memory from MAL_READ |
4202ef7b | 428 | AY=R1:GOSUB RELEASE |
9e8f5211 JM |
429 | RETURN: REM caller must release result of EVAL |
430 | ||
431 | REM REP(A$) -> R$ | |
bbab5c5d | 432 | REM Assume D has repl_env |
af621e3a | 433 | SUB REP |
4202ef7b | 434 | R2=-1 |
9e8f5211 | 435 | |
4202ef7b | 436 | GOSUB RE |
cc9dbd92 JM |
437 | R2=R |
438 | IF ER<>-2 THEN GOTO REP_DONE | |
9e8f5211 | 439 | |
cc9dbd92 | 440 | A=R:GOSUB MAL_PRINT |
9e8f5211 JM |
441 | |
442 | REP_DONE: | |
443 | REM Release memory from MAL_READ and EVAL | |
9d59cdb3 | 444 | AY=R2:GOSUB RELEASE |
af621e3a | 445 | END SUB |
9e8f5211 JM |
446 | |
447 | REM MAIN program | |
448 | MAIN: | |
449 | GOSUB INIT_MEMORY | |
450 | ||
cc9dbd92 | 451 | LV=0 |
9e8f5211 JM |
452 | |
453 | REM create repl_env | |
9d59cdb3 | 454 | C=0:GOSUB ENV_NEW:D=R |
9e8f5211 JM |
455 | |
456 | REM core.EXT: defined in Basic | |
bbab5c5d | 457 | E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env |
9e8f5211 | 458 | |
bbab5c5d | 459 | ZT=ZI: REM top of memory after base repl_env |
9e8f5211 JM |
460 | |
461 | REM core.mal: defined using the language itself | |
60ef223c | 462 | A$="(def! not (fn* (a) (if a false true)))" |
cc9dbd92 | 463 | GOSUB RE:AY=R:GOSUB RELEASE |
9e8f5211 | 464 | |
0e508fa5 | 465 | A$="(def! load-file (fn* (f) (eval (read-file f))))" |
cc9dbd92 | 466 | GOSUB RE:AY=R:GOSUB RELEASE |
9e8f5211 JM |
467 | |
468 | REM load the args file | |
469 | A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))" | |
cc9dbd92 | 470 | GOSUB RE:AY=R:GOSUB RELEASE |
9e8f5211 | 471 | |
e0bcd3fb JM |
472 | IF ER>-2 THEN GOSUB PRINT_ERROR:END |
473 | ||
9e8f5211 | 474 | REM set the argument list |
60ef223c | 475 | A$="(def! *ARGV* (rest -*ARGS*-))" |
cc9dbd92 | 476 | GOSUB RE:AY=R:GOSUB RELEASE |
9e8f5211 JM |
477 | |
478 | REM get the first argument | |
60ef223c JM |
479 | A$="(first -*ARGS*-)" |
480 | GOSUB RE | |
9e8f5211 | 481 | |
9e8f5211 | 482 | REM no arguments, start REPL loop |
e0bcd3fb JM |
483 | IF R<16 THEN GOTO REPL_LOOP |
484 | ||
485 | REM if there is an argument, then run it as a program | |
9e8f5211 JM |
486 | |
487 | RUN_PROG: | |
e0bcd3fb JM |
488 | REM free up first arg because we get it again |
489 | AY=R:GOSUB RELEASE | |
9e8f5211 | 490 | REM run a single mal program and exit |
60ef223c JM |
491 | A$="(load-file (first -*ARGS*-))" |
492 | GOSUB RE | |
cc9dbd92 | 493 | IF ER<>-2 THEN GOSUB PRINT_ERROR |
01e8850d | 494 | GOTO QUIT |
9e8f5211 JM |
495 | |
496 | REPL_LOOP: | |
60ef223c | 497 | A$="user> ":GOSUB READLINE: REM call input parser |
01975886 | 498 | IF EZ=1 THEN GOTO QUIT |
9d59cdb3 | 499 | IF R$="" THEN GOTO REPL_LOOP |
9e8f5211 | 500 | |
af621e3a | 501 | A$=R$:CALL REP: REM call REP |
9e8f5211 | 502 | |
cc9dbd92 | 503 | IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP |
9e8f5211 JM |
504 | PRINT R$ |
505 | GOTO REPL_LOOP | |
506 | ||
507 | QUIT: | |
9d59cdb3 | 508 | REM GOSUB PR_MEMORY_SUMMARY_SMALL |
115e430d JM |
509 | #cbm END |
510 | #qbasic SYSTEM | |
9e8f5211 JM |
511 | |
512 | PRINT_ERROR: | |
c756af81 JM |
513 | PRINT "Error: "+E$ |
514 | ER=-2:E$="" | |
9e8f5211 JM |
515 | RETURN |
516 |