Commit | Line | Data |
---|---|---|
b7b1787f JM |
1 | GOTO MAIN |
2 | ||
3 | REM $INCLUDE: 'readline.in.bas' | |
4 | REM $INCLUDE: 'types.in.bas' | |
5 | REM $INCLUDE: 'reader.in.bas' | |
6 | REM $INCLUDE: 'printer.in.bas' | |
7 | ||
9e8f5211 JM |
8 | REM $INCLUDE: 'debug.in.bas' |
9 | ||
cc9dbd92 | 10 | REM READ(A$) -> R |
b7b1787f JM |
11 | MAL_READ: |
12 | GOSUB READ_STR | |
13 | RETURN | |
14 | ||
cc9dbd92 | 15 | REM EVAL_AST(A, E) -> R |
af621e3a | 16 | SUB EVAL_AST |
cc9dbd92 | 17 | LV=LV+1 |
4b84a23b | 18 | |
cc9dbd92 | 19 | REM push A and E on the stack |
bbab5c5d | 20 | X=X+2:X%(X-1)=E:X%(X)=A |
85d70fb7 | 21 | |
cc9dbd92 | 22 | IF ER<>-2 THEN GOTO EVAL_AST_RETURN |
b7b1787f | 23 | |
4b84a23b | 24 | GOSUB DEREF_A |
b7b1787f | 25 | |
01975886 | 26 | T=Z%(A,0)AND 31 |
cc9dbd92 JM |
27 | IF T=5 THEN GOTO EVAL_AST_SYMBOL |
28 | IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ | |
4b84a23b JM |
29 | |
30 | REM scalar: deref to actual value and inc ref cnt | |
cc9dbd92 | 31 | R=A:GOSUB DEREF_R |
bbab5c5d | 32 | Z%(R,0)=Z%(R,0)+32 |
b7b1787f JM |
33 | GOTO EVAL_AST_RETURN |
34 | ||
35 | EVAL_AST_SYMBOL: | |
cc9dbd92 | 36 | H=E:K=A:GOSUB HASHMAP_GET |
4b84a23b | 37 | GOSUB DEREF_R |
cc9dbd92 | 38 | IF T3=0 THEN ER=-1:ER$="'"+S$(Z%(A,1))+"' not found":GOTO EVAL_AST_RETURN |
bbab5c5d | 39 | Z%(R,0)=Z%(R,0)+32 |
b7b1787f | 40 | GOTO EVAL_AST_RETURN |
85d70fb7 | 41 | |
0cb556e0 | 42 | EVAL_AST_SEQ: |
a742287e JM |
43 | REM allocate the first entry (T already set above) |
44 | L=0:N=0:GOSUB ALLOC | |
4b84a23b JM |
45 | |
46 | REM make space on the stack | |
cc9dbd92 | 47 | X=X+4 |
0cb556e0 | 48 | REM push type of sequence |
bbab5c5d | 49 | X%(X-3)=T |
0cb556e0 | 50 | REM push sequence index |
bbab5c5d | 51 | X%(X-2)=-1 |
0cb556e0 | 52 | REM push future return value (new sequence) |
bbab5c5d | 53 | X%(X-1)=R |
0cb556e0 | 54 | REM push previous new sequence entry |
bbab5c5d | 55 | X%(X)=R |
b7b1787f | 56 | |
0cb556e0 | 57 | EVAL_AST_SEQ_LOOP: |
0cb556e0 | 58 | REM update index |
bbab5c5d | 59 | X%(X-2)=X%(X-2)+1 |
0cb556e0 | 60 | |
4b84a23b | 61 | REM check if we are done evaluating the source sequence |
cc9dbd92 | 62 | IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE |
b7b1787f | 63 | |
0cb556e0 | 64 | REM if hashmap, skip eval of even entries (keys) |
01975886 | 65 | IF (X%(X-3)=8) AND ((X%(X-2)AND 1)=0) THEN GOTO EVAL_AST_DO_REF |
4b84a23b | 66 | GOTO EVAL_AST_DO_EVAL |
85d70fb7 | 67 | |
4b84a23b | 68 | EVAL_AST_DO_REF: |
cc9dbd92 | 69 | R=A+1:GOSUB DEREF_R: REM deref to target of referred entry |
bbab5c5d | 70 | Z%(R,0)=Z%(R,0)+32: REM inc ref cnt of referred value |
4b84a23b JM |
71 | GOTO EVAL_AST_ADD_VALUE |
72 | ||
73 | EVAL_AST_DO_EVAL: | |
74 | REM call EVAL for each entry | |
af621e3a | 75 | A=A+1:CALL EVAL |
cc9dbd92 | 76 | A=A-1 |
4b84a23b JM |
77 | GOSUB DEREF_R: REM deref to target of evaluated entry |
78 | ||
79 | EVAL_AST_ADD_VALUE: | |
80 | ||
85d70fb7 | 81 | REM update previous value pointer to evaluated entry |
bbab5c5d | 82 | Z%(X%(X)+1,1)=R |
b7b1787f | 83 | |
cc9dbd92 | 84 | IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE |
85d70fb7 | 85 | |
4b84a23b | 86 | REM allocate the next entry |
a742287e | 87 | REM same new sequence entry type |
bbab5c5d | 88 | T=X%(X-3):L=0:N=0:GOSUB ALLOC |
0cb556e0 | 89 | |
4b84a23b | 90 | REM update previous sequence entry value to point to new entry |
bbab5c5d | 91 | Z%(X%(X),1)=R |
b7b1787f | 92 | REM update previous ptr to current entry |
bbab5c5d | 93 | X%(X)=R |
b7b1787f | 94 | |
4b84a23b | 95 | REM process the next sequence entry from source list |
cc9dbd92 | 96 | A=Z%(A,1) |
b7b1787f | 97 | |
0cb556e0 JM |
98 | GOTO EVAL_AST_SEQ_LOOP |
99 | EVAL_AST_SEQ_LOOP_DONE: | |
4b84a23b | 100 | REM get return value (new seq), index, and seq type |
bbab5c5d | 101 | R=X%(X-1) |
4b84a23b | 102 | REM pop previous, return, index and type |
cc9dbd92 | 103 | X=X-4 |
b7b1787f JM |
104 | GOTO EVAL_AST_RETURN |
105 | ||
106 | EVAL_AST_RETURN: | |
cc9dbd92 | 107 | REM pop A and E off the stack |
bbab5c5d | 108 | E=X%(X-1):A=X%(X):X=X-2 |
4b84a23b | 109 | |
cc9dbd92 | 110 | LV=LV-1 |
af621e3a | 111 | END SUB |
b7b1787f | 112 | |
af621e3a JM |
113 | REM EVAL(A, E) -> R |
114 | SUB EVAL | |
cc9dbd92 | 115 | LV=LV+1: REM track basic return stack level |
4b84a23b | 116 | |
cc9dbd92 | 117 | REM push A and E on the stack |
bbab5c5d | 118 | X=X+2:X%(X-1)=E:X%(X)=A |
b7b1787f | 119 | |
c7330b3d JM |
120 | IF ER<>-2 THEN GOTO EVAL_RETURN |
121 | ||
cc9dbd92 JM |
122 | REM AZ=A:PR=1:GOSUB PR_STR |
123 | REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]" | |
4b84a23b JM |
124 | |
125 | GOSUB DEREF_A | |
b7b1787f JM |
126 | |
127 | GOSUB LIST_Q | |
cc9dbd92 | 128 | IF R THEN GOTO APPLY_LIST |
b7b1787f | 129 | REM ELSE |
af621e3a | 130 | CALL EVAL_AST |
b7b1787f JM |
131 | GOTO EVAL_RETURN |
132 | ||
133 | APPLY_LIST: | |
134 | GOSUB EMPTY_Q | |
bbab5c5d | 135 | IF R THEN R=A:Z%(R,0)=Z%(R,0)+32:GOTO EVAL_RETURN |
b7b1787f | 136 | |
0cb556e0 | 137 | EVAL_INVOKE: |
af621e3a | 138 | CALL EVAL_AST |
cc9dbd92 | 139 | R3=R |
4b84a23b | 140 | |
85d70fb7 | 141 | REM if error, return f/args for release by caller |
cc9dbd92 JM |
142 | IF ER<>-2 THEN GOTO EVAL_RETURN |
143 | F=R+1 | |
85d70fb7 | 144 | |
cc9dbd92 JM |
145 | AR=Z%(R,1): REM rest |
146 | R=F:GOSUB DEREF_R:F=R | |
01975886 | 147 | IF (Z%(F,0)AND 31)<>9 THEN ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN |
0cb556e0 | 148 | GOSUB DO_FUNCTION |
cc9dbd92 | 149 | AY=R3:GOSUB RELEASE |
0cb556e0 | 150 | GOTO EVAL_RETURN |
b7b1787f JM |
151 | |
152 | EVAL_RETURN: | |
4b84a23b | 153 | |
cc9dbd92 | 154 | LV=LV-1: REM track basic return stack level |
9e8f5211 | 155 | |
4b84a23b | 156 | REM trigger GC |
01975886 JM |
157 | #cbm TA=FRE(0) |
158 | #qbasic TA=0 | |
4b84a23b | 159 | |
cc9dbd92 | 160 | REM pop A and E off the stack |
bbab5c5d | 161 | E=X%(X-1):A=X%(X):X=X-2 |
4b84a23b | 162 | |
af621e3a | 163 | END SUB |
b7b1787f | 164 | |
cc9dbd92 | 165 | REM DO_FUNCTION(F, AR) |
b7b1787f | 166 | DO_FUNCTION: |
cc9dbd92 | 167 | AZ=F:GOSUB PR_STR |
b7b1787f | 168 | F$=R$ |
cc9dbd92 | 169 | AZ=AR:GOSUB PR_STR |
b7b1787f JM |
170 | AR$=R$ |
171 | ||
172 | REM Get the function number | |
cc9dbd92 | 173 | FF=Z%(F,1) |
b7b1787f JM |
174 | |
175 | REM Get argument values | |
cc9dbd92 JM |
176 | R=AR+1:GOSUB DEREF_R:AA=Z%(R,1) |
177 | R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1) | |
b7b1787f | 178 | |
b7b1787f | 179 | REM Switch on the function number |
cc9dbd92 JM |
180 | IF FF=1 THEN GOTO DO_ADD |
181 | IF FF=2 THEN GOTO DO_SUB | |
182 | IF FF=3 THEN GOTO DO_MULT | |
183 | IF FF=4 THEN GOTO DO_DIV | |
184 | ER=-1:ER$="unknown function"+STR$(FF):RETURN | |
b7b1787f JM |
185 | |
186 | DO_ADD: | |
a742287e | 187 | T=2:L=AA+AB:GOSUB ALLOC |
b7b1787f JM |
188 | GOTO DO_FUNCTION_DONE |
189 | DO_SUB: | |
a742287e | 190 | T=2:L=AA-AB:GOSUB ALLOC |
b7b1787f JM |
191 | GOTO DO_FUNCTION_DONE |
192 | DO_MULT: | |
a742287e | 193 | T=2:L=AA*AB:GOSUB ALLOC |
b7b1787f JM |
194 | GOTO DO_FUNCTION_DONE |
195 | DO_DIV: | |
a742287e | 196 | T=2:L=AA/AB:GOSUB ALLOC |
b7b1787f JM |
197 | GOTO DO_FUNCTION_DONE |
198 | ||
199 | DO_FUNCTION_DONE: | |
200 | RETURN | |
201 | ||
cc9dbd92 | 202 | REM PRINT(A) -> R$ |
b7b1787f | 203 | MAL_PRINT: |
cc9dbd92 | 204 | AZ=A:PR=1:GOSUB PR_STR |
b7b1787f JM |
205 | RETURN |
206 | ||
207 | REM REP(A$) -> R$ | |
bbab5c5d | 208 | REM Assume D has repl_env |
af621e3a | 209 | SUB REP |
cc9dbd92 | 210 | R1=0:R2=0 |
b7b1787f | 211 | GOSUB MAL_READ |
cc9dbd92 JM |
212 | R1=R |
213 | IF ER<>-2 THEN GOTO REP_DONE | |
4b84a23b | 214 | |
af621e3a | 215 | A=R:E=D:CALL EVAL |
cc9dbd92 JM |
216 | R2=R |
217 | IF ER<>-2 THEN GOTO REP_DONE | |
4b84a23b | 218 | |
cc9dbd92 | 219 | A=R:GOSUB MAL_PRINT |
85d70fb7 | 220 | RT$=R$ |
4b84a23b JM |
221 | |
222 | REP_DONE: | |
223 | REM Release memory from MAL_READ and EVAL | |
cc9dbd92 JM |
224 | IF R2<>0 THEN AY=R2:GOSUB RELEASE |
225 | IF R1<>0 THEN AY=R1:GOSUB RELEASE | |
85d70fb7 | 226 | R$=RT$ |
af621e3a | 227 | END SUB |
b7b1787f JM |
228 | |
229 | REM MAIN program | |
230 | MAIN: | |
231 | GOSUB INIT_MEMORY | |
232 | ||
cc9dbd92 | 233 | LV=0 |
85d70fb7 JM |
234 | |
235 | REM create repl_env | |
bbab5c5d | 236 | GOSUB HASHMAP:D=R |
b7b1787f JM |
237 | |
238 | REM + function | |
cc9dbd92 | 239 | A=1:GOSUB NATIVE_FUNCTION |
bbab5c5d | 240 | H=D:K$="+":V=R:GOSUB ASSOC1_S:D=R |
b7b1787f JM |
241 | |
242 | REM - function | |
cc9dbd92 | 243 | A=2:GOSUB NATIVE_FUNCTION |
bbab5c5d | 244 | H=D:K$="-":V=R:GOSUB ASSOC1_S:D=R |
b7b1787f JM |
245 | |
246 | REM * function | |
cc9dbd92 | 247 | A=3:GOSUB NATIVE_FUNCTION |
bbab5c5d | 248 | H=D:K$="*":V=R:GOSUB ASSOC1_S:D=R |
b7b1787f JM |
249 | |
250 | REM / function | |
cc9dbd92 | 251 | A=4:GOSUB NATIVE_FUNCTION |
bbab5c5d | 252 | H=D:K$="/":V=R:GOSUB ASSOC1_S:D=R |
b7b1787f | 253 | |
bbab5c5d | 254 | ZT=ZI: REM top of memory after base repl_env |
4b84a23b | 255 | |
85d70fb7 | 256 | REPL_LOOP: |
60ef223c | 257 | A$="user> ":GOSUB READLINE: REM call input parser |
01975886 | 258 | IF EZ=1 THEN GOTO QUIT |
4b84a23b | 259 | |
af621e3a | 260 | A$=R$:CALL REP: REM call REP |
4b84a23b | 261 | |
cc9dbd92 | 262 | IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP |
b7b1787f | 263 | PRINT R$ |
85d70fb7 | 264 | GOTO REPL_LOOP |
b7b1787f | 265 | |
85d70fb7 | 266 | QUIT: |
4e7d8a1b | 267 | REM GOSUB PR_MEMORY_SUMMARY |
b7b1787f JM |
268 | END |
269 | ||
85d70fb7 | 270 | PRINT_ERROR: |
bf8d1f7d | 271 | PRINT "Error: "+ER$ |
cc9dbd92 | 272 | ER=-2:ER$="" |
85d70fb7 JM |
273 | RETURN |
274 |