Commit | Line | Data |
---|---|---|
0cb556e0 JM |
1 | GOTO MAIN |
2 | ||
d7a6c2d6 | 3 | REM $INCLUDE: 'mem.in.bas' |
0cb556e0 | 4 | REM $INCLUDE: 'types.in.bas' |
93593012 | 5 | REM $INCLUDE: 'readline.in.bas' |
0cb556e0 JM |
6 | REM $INCLUDE: 'reader.in.bas' |
7 | REM $INCLUDE: 'printer.in.bas' | |
8 | REM $INCLUDE: 'env.in.bas' | |
9 | ||
9e8f5211 JM |
10 | REM $INCLUDE: 'debug.in.bas' |
11 | ||
cc9dbd92 | 12 | REM READ(A$) -> R |
0cb556e0 JM |
13 | MAL_READ: |
14 | GOSUB READ_STR | |
15 | RETURN | |
16 | ||
cc9dbd92 | 17 | REM EVAL_AST(A, E) -> R |
af621e3a | 18 | SUB EVAL_AST |
cc9dbd92 | 19 | LV=LV+1 |
4b84a23b | 20 | |
cc9dbd92 | 21 | REM push A and E on the stack |
93593012 JM |
22 | Q=E:GOSUB PUSH_Q |
23 | GOSUB PUSH_A | |
4b84a23b | 24 | |
cc9dbd92 | 25 | IF ER<>-2 THEN GOTO EVAL_AST_RETURN |
0cb556e0 | 26 | |
4202ef7b | 27 | GOSUB TYPE_A |
cc9dbd92 JM |
28 | IF T=5 THEN GOTO EVAL_AST_SYMBOL |
29 | IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ | |
4b84a23b JM |
30 | |
31 | REM scalar: deref to actual value and inc ref cnt | |
9d59cdb3 | 32 | R=A |
4202ef7b | 33 | GOSUB INC_REF_R |
0cb556e0 JM |
34 | GOTO EVAL_AST_RETURN |
35 | ||
36 | EVAL_AST_SYMBOL: | |
af621e3a JM |
37 | K=A:GOTO ENV_GET |
38 | ENV_GET_RETURN: | |
0cb556e0 | 39 | GOTO EVAL_AST_RETURN |
85d70fb7 | 40 | |
0cb556e0 | 41 | EVAL_AST_SEQ: |
9d59cdb3 JM |
42 | REM setup the stack for the loop |
43 | GOSUB MAP_LOOP_START | |
0cb556e0 JM |
44 | |
45 | EVAL_AST_SEQ_LOOP: | |
4b84a23b | 46 | REM check if we are done evaluating the source sequence |
d7a6c2d6 | 47 | IF Z%(A+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE |
0cb556e0 | 48 | |
9d59cdb3 JM |
49 | REM call EVAL for each entry |
50 | GOSUB PUSH_A | |
d7a6c2d6 JM |
51 | IF T<>8 THEN A=Z%(A+2) |
52 | IF T=8 THEN A=Z%(A+3) | |
9d59cdb3 JM |
53 | Q=T:GOSUB PUSH_Q: REM push/save type |
54 | CALL EVAL | |
55 | GOSUB POP_Q:T=Q: REM pop/restore type | |
56 | GOSUB POP_A | |
d7a6c2d6 | 57 | M=R |
4b84a23b | 58 | |
9d59cdb3 JM |
59 | REM if error, release the unattached element |
60 | REM TODO: is R=0 correct? | |
61 | IF ER<>-2 THEN AY=R:GOSUB RELEASE:R=0:GOTO EVAL_AST_SEQ_LOOP_DONE | |
0cb556e0 | 62 | |
9d59cdb3 JM |
63 | REM for hash-maps, copy the key (inc ref since we are going to |
64 | REM release it below) | |
d7a6c2d6 | 65 | IF T=8 THEN N=M:M=Z%(A+2):Z%(M)=Z%(M)+32 |
85d70fb7 | 66 | |
0cb556e0 | 67 | |
9d59cdb3 JM |
68 | REM update the return sequence structure |
69 | REM release N (and M if T=8) since seq takes full ownership | |
70 | C=1:GOSUB MAP_LOOP_UPDATE | |
0cb556e0 | 71 | |
4b84a23b | 72 | REM process the next sequence entry from source list |
d7a6c2d6 | 73 | A=Z%(A+1) |
0cb556e0 JM |
74 | |
75 | GOTO EVAL_AST_SEQ_LOOP | |
76 | EVAL_AST_SEQ_LOOP_DONE: | |
9d59cdb3 JM |
77 | REM cleanup stack and get return value |
78 | GOSUB MAP_LOOP_DONE | |
0cb556e0 JM |
79 | GOTO EVAL_AST_RETURN |
80 | ||
81 | EVAL_AST_RETURN: | |
cc9dbd92 | 82 | REM pop A and E off the stack |
93593012 JM |
83 | GOSUB POP_A |
84 | GOSUB POP_Q:E=Q | |
4b84a23b | 85 | |
cc9dbd92 | 86 | LV=LV-1 |
af621e3a | 87 | END SUB |
0cb556e0 | 88 | |
af621e3a JM |
89 | REM EVAL(A, E) -> R |
90 | SUB EVAL | |
cc9dbd92 | 91 | LV=LV+1: REM track basic return stack level |
4b84a23b | 92 | |
cc9dbd92 | 93 | REM push A and E on the stack |
93593012 JM |
94 | Q=E:GOSUB PUSH_Q |
95 | GOSUB PUSH_A | |
0cb556e0 | 96 | |
c7330b3d JM |
97 | IF ER<>-2 THEN GOTO EVAL_RETURN |
98 | ||
c756af81 | 99 | REM AZ=A:B=1:GOSUB PR_STR |
cc9dbd92 | 100 | REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" |
4b84a23b | 101 | |
0cb556e0 | 102 | GOSUB LIST_Q |
cc9dbd92 | 103 | IF R THEN GOTO APPLY_LIST |
0cb556e0 | 104 | REM ELSE |
af621e3a | 105 | CALL EVAL_AST |
0cb556e0 JM |
106 | GOTO EVAL_RETURN |
107 | ||
108 | APPLY_LIST: | |
109 | GOSUB EMPTY_Q | |
4202ef7b | 110 | IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN |
0cb556e0 | 111 | |
d7a6c2d6 | 112 | A0=Z%(A+2) |
0cb556e0 JM |
113 | |
114 | REM get symbol in A$ | |
d7a6c2d6 JM |
115 | IF (Z%(A0)AND 31)<>5 THEN A$="" |
116 | IF (Z%(A0)AND 31)=5 THEN A$=S$(Z%(A0+1)) | |
0cb556e0 JM |
117 | |
118 | IF A$="def!" THEN GOTO EVAL_DEF | |
119 | IF A$="let*" THEN GOTO EVAL_LET | |
120 | GOTO EVAL_INVOKE | |
121 | ||
122 | EVAL_GET_A3: | |
d7a6c2d6 | 123 | A3=Z%(Z%(Z%(Z%(A+1)+1)+1)+2) |
0cb556e0 | 124 | EVAL_GET_A2: |
d7a6c2d6 | 125 | A2=Z%(Z%(Z%(A+1)+1)+2) |
0cb556e0 | 126 | EVAL_GET_A1: |
d7a6c2d6 | 127 | A1=Z%(Z%(A+1)+2) |
0cb556e0 JM |
128 | RETURN |
129 | ||
130 | EVAL_DEF: | |
131 | REM PRINT "def!" | |
bbab5c5d | 132 | GOSUB EVAL_GET_A2: REM set A1 and A2 |
4b84a23b | 133 | |
93593012 | 134 | Q=A1:GOSUB PUSH_Q |
af621e3a | 135 | A=A2:CALL EVAL: REM eval a2 |
93593012 | 136 | GOSUB POP_Q:A1=Q |
4b84a23b | 137 | |
cc9dbd92 | 138 | IF ER<>-2 THEN GOTO EVAL_RETURN |
70f29a2b | 139 | |
4b84a23b | 140 | REM set a1 in env to a2 |
c756af81 | 141 | K=A1:C=R:GOSUB ENV_SET |
4b84a23b | 142 | GOTO EVAL_RETURN |
85d70fb7 | 143 | |
0cb556e0 | 144 | EVAL_LET: |
4b84a23b | 145 | REM PRINT "let*" |
bbab5c5d | 146 | GOSUB EVAL_GET_A2: REM set A1 and A2 |
70f29a2b | 147 | |
93593012 | 148 | Q=A2:GOSUB PUSH_Q: REM push/save A2 |
0cb556e0 | 149 | REM create new environment with outer as current environment |
c756af81 | 150 | C=E:GOSUB ENV_NEW |
cc9dbd92 | 151 | E=R |
0cb556e0 | 152 | EVAL_LET_LOOP: |
d7a6c2d6 | 153 | IF Z%(A1+1)=0 THEN GOTO EVAL_LET_LOOP_DONE |
85d70fb7 | 154 | |
93593012 | 155 | Q=A1:GOSUB PUSH_Q: REM push A1 |
0cb556e0 | 156 | REM eval current A1 odd element |
d7a6c2d6 | 157 | A=Z%(Z%(A1+1)+2):CALL EVAL |
93593012 | 158 | GOSUB POP_Q:A1=Q: REM pop A1 |
85d70fb7 | 159 | |
c7330b3d JM |
160 | IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE |
161 | ||
d7a6c2d6 JM |
162 | REM set key/value in the environment |
163 | K=Z%(A1+2):C=R:GOSUB ENV_SET | |
cc9dbd92 | 164 | AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership |
85d70fb7 | 165 | |
bbab5c5d | 166 | REM skip to the next pair of A1 elements |
d7a6c2d6 | 167 | A1=Z%(Z%(A1+1)+1) |
0cb556e0 | 168 | GOTO EVAL_LET_LOOP |
70f29a2b | 169 | |
0cb556e0 | 170 | EVAL_LET_LOOP_DONE: |
93593012 | 171 | GOSUB POP_Q:A2=Q: REM pop A2 |
af621e3a | 172 | A=A2:CALL EVAL: REM eval A2 using let_env |
4b84a23b | 173 | GOTO EVAL_RETURN |
0cb556e0 | 174 | EVAL_INVOKE: |
af621e3a | 175 | CALL EVAL_AST |
037815e0 | 176 | W=R |
4b84a23b | 177 | |
85d70fb7 | 178 | REM if error, return f/args for release by caller |
cc9dbd92 | 179 | IF ER<>-2 THEN GOTO EVAL_RETURN |
85d70fb7 | 180 | |
d7a6c2d6 JM |
181 | AR=Z%(R+1): REM rest |
182 | F=Z%(R+2) | |
9d59cdb3 | 183 | |
4202ef7b JM |
184 | GOSUB TYPE_F |
185 | IF T<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE | |
0cb556e0 | 186 | GOSUB DO_FUNCTION |
9d59cdb3 | 187 | EVAL_INVOKE_DONE: |
037815e0 | 188 | AY=W:GOSUB RELEASE |
0cb556e0 JM |
189 | GOTO EVAL_RETURN |
190 | ||
191 | EVAL_RETURN: | |
85d70fb7 | 192 | REM release environment if not the top one on the stack |
93593012 JM |
193 | GOSUB PEEK_Q_1 |
194 | IF E<>Q THEN AY=E:GOSUB RELEASE | |
85d70fb7 | 195 | |
cc9dbd92 | 196 | LV=LV-1: REM track basic return stack level |
9e8f5211 | 197 | |
4b84a23b | 198 | REM trigger GC |
c756af81 JM |
199 | #cbm T=FRE(0) |
200 | #qbasic T=0 | |
4b84a23b | 201 | |
cc9dbd92 | 202 | REM pop A and E off the stack |
93593012 JM |
203 | GOSUB POP_A |
204 | GOSUB POP_Q:E=Q | |
4b84a23b | 205 | |
af621e3a | 206 | END SUB |
0cb556e0 | 207 | |
cc9dbd92 | 208 | REM DO_FUNCTION(F, AR) |
0cb556e0 | 209 | DO_FUNCTION: |
0cb556e0 | 210 | REM Get the function number |
d7a6c2d6 | 211 | G=Z%(F+1) |
0cb556e0 JM |
212 | |
213 | REM Get argument values | |
d7a6c2d6 JM |
214 | A=Z%(Z%(AR+2)+1) |
215 | B=Z%(Z%(Z%(AR+1)+2)+1) | |
0cb556e0 | 216 | |
0cb556e0 | 217 | REM Switch on the function number |
c756af81 JM |
218 | IF G=1 THEN GOTO DO_ADD |
219 | IF G=2 THEN GOTO DO_SUB | |
220 | IF G=3 THEN GOTO DO_MULT | |
221 | IF G=4 THEN GOTO DO_DIV | |
222 | ER=-1:E$="unknown function"+STR$(G):RETURN | |
0cb556e0 JM |
223 | |
224 | DO_ADD: | |
037815e0 | 225 | T=2:L=A+B:GOSUB ALLOC |
0cb556e0 JM |
226 | GOTO DO_FUNCTION_DONE |
227 | DO_SUB: | |
037815e0 | 228 | T=2:L=A-B:GOSUB ALLOC |
0cb556e0 JM |
229 | GOTO DO_FUNCTION_DONE |
230 | DO_MULT: | |
037815e0 | 231 | T=2:L=A*B:GOSUB ALLOC |
0cb556e0 JM |
232 | GOTO DO_FUNCTION_DONE |
233 | DO_DIV: | |
037815e0 | 234 | T=2:L=A/B:GOSUB ALLOC |
0cb556e0 JM |
235 | GOTO DO_FUNCTION_DONE |
236 | ||
237 | DO_FUNCTION_DONE: | |
238 | RETURN | |
239 | ||
cc9dbd92 | 240 | REM PRINT(A) -> R$ |
0cb556e0 | 241 | MAL_PRINT: |
c756af81 | 242 | AZ=A:B=1:GOSUB PR_STR |
0cb556e0 JM |
243 | RETURN |
244 | ||
245 | REM REP(A$) -> R$ | |
bbab5c5d | 246 | REM Assume D has repl_env |
af621e3a | 247 | SUB REP |
9d59cdb3 | 248 | R1=-1:R2=-1 |
0cb556e0 | 249 | GOSUB MAL_READ |
cc9dbd92 JM |
250 | R1=R |
251 | IF ER<>-2 THEN GOTO REP_DONE | |
4b84a23b | 252 | |
af621e3a | 253 | A=R:E=D:CALL EVAL |
cc9dbd92 JM |
254 | R2=R |
255 | IF ER<>-2 THEN GOTO REP_DONE | |
4b84a23b | 256 | |
cc9dbd92 | 257 | A=R:GOSUB MAL_PRINT |
4b84a23b JM |
258 | |
259 | REP_DONE: | |
260 | REM Release memory from MAL_READ and EVAL | |
9d59cdb3 JM |
261 | AY=R2:GOSUB RELEASE |
262 | AY=R1:GOSUB RELEASE | |
af621e3a | 263 | END SUB |
0cb556e0 JM |
264 | |
265 | REM MAIN program | |
266 | MAIN: | |
267 | GOSUB INIT_MEMORY | |
268 | ||
cc9dbd92 | 269 | LV=0 |
4b84a23b JM |
270 | |
271 | REM create repl_env | |
9d59cdb3 | 272 | C=0:GOSUB ENV_NEW:D=R |
0cb556e0 | 273 | |
bbab5c5d | 274 | E=D |
0cb556e0 | 275 | REM + function |
4202ef7b | 276 | T=9:L=1:GOSUB ALLOC: REM native function |
037815e0 | 277 | B$="+":C=R:GOSUB ENV_SET_S |
0cb556e0 JM |
278 | |
279 | REM - function | |
4202ef7b | 280 | T=9:L=2:GOSUB ALLOC: REM native function |
037815e0 | 281 | B$="-":C=R:GOSUB ENV_SET_S |
0cb556e0 JM |
282 | |
283 | REM * function | |
4202ef7b | 284 | T=9:L=3:GOSUB ALLOC: REM native function |
037815e0 | 285 | B$="*":C=R:GOSUB ENV_SET_S |
0cb556e0 JM |
286 | |
287 | REM / function | |
4202ef7b | 288 | T=9:L=4:GOSUB ALLOC: REM native function |
037815e0 | 289 | B$="/":C=R:GOSUB ENV_SET_S |
0cb556e0 | 290 | |
bbab5c5d | 291 | ZT=ZI: REM top of memory after base repl_env |
0cb556e0 | 292 | |
85d70fb7 | 293 | REPL_LOOP: |
60ef223c | 294 | A$="user> ":GOSUB READLINE: REM call input parser |
01975886 | 295 | IF EZ=1 THEN GOTO QUIT |
9d59cdb3 | 296 | IF R$="" THEN GOTO REPL_LOOP |
4b84a23b | 297 | |
af621e3a | 298 | A$=R$:CALL REP: REM call REP |
4b84a23b | 299 | |
cc9dbd92 | 300 | IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP |
0cb556e0 | 301 | PRINT R$ |
85d70fb7 | 302 | GOTO REPL_LOOP |
0cb556e0 | 303 | |
85d70fb7 | 304 | QUIT: |
9d59cdb3 | 305 | REM GOSUB PR_MEMORY_SUMMARY_SMALL |
0cb556e0 JM |
306 | END |
307 | ||
85d70fb7 | 308 | PRINT_ERROR: |
c756af81 JM |
309 | PRINT "Error: "+E$ |
310 | ER=-2:E$="" | |
85d70fb7 JM |
311 | RETURN |
312 |