3 REM $INCLUDE: 'mem.in.bas'
4 REM $INCLUDE: 'types.in.bas'
5 REM $INCLUDE: 'readline.in.bas'
6 REM $INCLUDE: 'reader.in.bas'
7 REM $INCLUDE: 'printer.in.bas'
8 REM $INCLUDE: 'env.in.bas'
9 REM $INCLUDE: 'core.in.bas'
11 REM $INCLUDE: 'debug.in.bas'
18 REM EVAL_AST(A, E) -> R
20 REM push A and E on the stack
24 IF ER
<>-2 THEN GOTO EVAL_AST_RETURN
27 IF T
=5 THEN GOTO EVAL_AST_SYMBOL
28 IF T
>=6 AND T
<=8 THEN GOTO EVAL_AST_SEQ
30 REM scalar: deref to actual value and inc ref cnt
41 REM setup the stack for the loop
45 REM check if we are done evaluating the source sequence
46 IF Z
%(A
+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
48 REM if we are returning to DO, then skip last element
49 REM The EVAL_DO call to EVAL_AST must be call #2 for EVAL_AST to
50 REM return early and for TCO to work
52 IF Q
=2 AND Z
%(Z
%(A
+1)+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
54 REM call EVAL for each entry
56 IF T
<>8 THEN A
=Z
%(A
+2)
58 Q
=T
:GOSUB PUSH_Q
: REM push/save type
60 GOSUB POP_Q
:T
=Q
: REM pop/restore type
64 REM if error, release the unattached element
65 REM TODO: is R=0 correct?
66 IF ER
<>-2 THEN AY
=R
:GOSUB RELEASE
:R
=0:GOTO EVAL_AST_SEQ_LOOP_DONE
68 REM for hash-maps, copy the key (inc ref since we are going to
70 IF T
=8 THEN N
=M
:M
=Z
%(A
+2):Z
%(M
)=Z
%(M
)+32
73 REM update the return sequence structure
74 REM release N (and M if T=8) since seq takes full ownership
75 C
=1:GOSUB MAP_LOOP_UPDATE
77 REM process the next sequence entry from source list
80 GOTO EVAL_AST_SEQ_LOOP
81 EVAL_AST_SEQ_LOOP_DONE:
82 REM cleanup stack and get return value
87 REM pop A and E off the stack
94 LV
=LV
+1: REM track basic return stack level
96 REM push A and E on the stack
100 REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0))
104 IF ER
<>-2 THEN GOTO EVAL_RETURN
106 REM AZ=A:B=1:GOSUB PR_STR
107 REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
110 IF R
THEN GOTO APPLY_LIST
117 IF R
THEN R
=A
:GOSUB INC_REF_R
:GOTO EVAL_RETURN
122 IF (Z
%(A0
)AND 31)<>5 THEN A
$=""
123 IF (Z
%(A0
)AND 31)=5 THEN A
$=S$(Z%(A0+1))
125 IF A
$="def!" THEN GOTO EVAL_DEF
126 IF A
$="let*" THEN GOTO EVAL_LET
127 IF A
$="do" THEN GOTO EVAL_DO
128 IF A
$="if" THEN GOTO EVAL_IF
129 IF A
$="fn*" THEN GOTO EVAL_FN
133 A3
=Z
%(Z
%(Z
%(Z
%(A
+1)+1)+1)+2)
135 A2
=Z
%(Z
%(Z
%(A
+1)+1)+2)
142 GOSUB EVAL_GET_A2
: REM set A1 and A2
145 A
=A2
:CALL EVAL
: REM eval a2
148 IF ER
<>-2 THEN GOTO EVAL_RETURN
150 REM set a1 in env to a2
151 K
=A1
:C
=R
:GOSUB ENV_SET
156 GOSUB EVAL_GET_A2
: REM set A1 and A2
158 Q
=A2
:GOSUB PUSH_Q
: REM push/save A2
159 Q
=E
:GOSUB PUSH_Q
: REM push env for for later release
161 REM create new environment with outer as current environment
165 IF Z
%(A1
+1)=0 THEN GOTO EVAL_LET_LOOP_DONE
167 Q
=A1
:GOSUB PUSH_Q
: REM push A1
168 REM eval current A1 odd element
169 A
=Z
%(Z
%(A1
+1)+2):CALL EVAL
170 GOSUB POP_Q
:A1
=Q
: REM pop A1
172 IF ER
<>-2 THEN GOTO EVAL_LET_LOOP_DONE
174 REM set key/value in the environment
175 K
=Z
%(A1
+2):C
=R
:GOSUB ENV_SET
176 AY
=R
:GOSUB RELEASE
: REM release our use, ENV_SET took ownership
178 REM skip to the next pair of A1 elements
183 GOSUB POP_Q
:AY
=Q
: REM pop previous env
185 REM release previous environment if not the current EVAL env
187 IF AY
<>Q
THEN GOSUB RELEASE
189 GOSUB POP_Q
:A2
=Q
: REM pop A2
190 A
=A2
:GOTO EVAL_TCO_RECUR
: REM TCO loop
194 GOSUB PUSH_A
: REM push/save A
196 REM this must be EVAL_AST call #2 for EVAL_AST to return early
197 REM and for TCO to work
201 AY
=R
: REM get eval'd list for release
203 GOSUB POP_A
: REM pop/restore original A for LAST
204 GOSUB LAST
: REM get last element for return
205 A
=R
: REM new recur AST
208 GOSUB RELEASE
: REM release eval'd list
209 AY
=A
:GOSUB RELEASE
: REM release LAST value (not sure why)
211 GOTO EVAL_TCO_RECUR
: REM TCO loop
214 GOSUB EVAL_GET_A1
: REM set A1
215 GOSUB PUSH_A
: REM push/save A
217 GOSUB POP_A
: REM pop/restore A
218 IF (R
=0) OR (R
=2) THEN GOTO EVAL_IF_FALSE
222 GOSUB EVAL_GET_A2
: REM set A1 and A2 after EVAL
223 A
=A2
:GOTO EVAL_TCO_RECUR
: REM TCO loop
226 REM if no false case (A3), return nil
228 IF R
<4 THEN R
=0:GOSUB INC_REF_R
:GOTO EVAL_RETURN
229 GOSUB EVAL_GET_A3
: REM set A1 - A3 after EVAL
230 A
=A3
:GOTO EVAL_TCO_RECUR
: REM TCO loop
233 GOSUB EVAL_GET_A2
: REM set A1 and A2
234 T
=10:L
=A2
:M
=A1
:N
=E
:GOSUB ALLOC
: REM mal function
240 REM if error, return f/args for release by caller
241 IF ER
<>-2 THEN GOTO EVAL_RETURN
243 REM push f/args for release after call
249 REM if metadata, get the actual object
251 IF T
=14 THEN F
=Z
%(F
+1):GOSUB TYPE_F
253 ON T
-8 GOTO EVAL_DO_FUNCTION
,EVAL_DO_MAL_FUNCTION
,EVAL_DO_MAL_FUNCTION
255 REM if error, pop and return f/args for release by caller
257 ER
=-1:E
$="apply of non
-function":GOTO EVAL_RETURN
261 IF Z%(F+1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
262 REM for recur functions (apply, map, swap!), use GOTO
263 IF Z%(F+1)>60 THEN CALL DO_TCO_FUNCTION
264 EVAL_DO_FUNCTION_SKIP:
266 REM pop and release f/args
271 EVAL_DO_MAL_FUNCTION:
272 Q=E:GOSUB PUSH_Q: REM save the current environment for release
274 REM create new environ using env and params stored in function
275 C=Z%(F+3):A=Z%(F+2):B=AR:GOSUB ENV_NEW_BINDS
277 REM release previous env if it is not the top one on the
278 REM stack (X%(X-2)) because our new env refers to it and
279 REM we no longer need to track it (since we are TCO recurring)
282 IF AY<>Q THEN GOSUB RELEASE
284 REM claim the AST before releasing the list containing it
285 A=Z%(F+1):Z%(A)=Z%(A)+32
286 REM add AST to pending release queue to free as soon as EVAL
287 REM actually returns (LV+1)
288 LV=LV+1:GOSUB PEND_A_LV:LV=LV-1
290 REM pop and release f/args
295 E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
298 REM AZ=R: B=1: GOSUB PR_STR
299 REM PRINT "EVAL_RETURN R
: ["+R$+"] ("+STR
$(R)+"), LV
:"+STR$(LV)+",ER:"+STR$(ER)
301 REM release environment if not the top one on the stack
303 IF E<>Q THEN AY=E:GOSUB RELEASE
305 LV=LV-1: REM track basic return stack level
307 REM release everything we couldn't release earlier
314 REM pop A and E off the stack
322 AZ=A:B=1:GOSUB PR_STR
326 REM Assume D has repl_env
327 REM caller must release result
332 IF ER<>-2 THEN GOTO RE_DONE
337 REM Release memory from MAL_READ
339 RETURN: REM caller must release result of EVAL
342 REM Assume D has repl_env
348 IF ER<>-2 THEN GOTO REP_DONE
353 REM Release memory from MAL_READ and EVAL
364 C=0:GOSUB ENV_NEW:D=R
366 REM core.EXT: defined in Basic
367 E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env
369 ZT=ZI: REM top of memory after base repl_env
371 REM core.mal: defined using the language itself
372 A$="(def! not (fn* (a) (if a false true)))"
373 GOSUB RE
:AY
=R
:GOSUB RELEASE
375 A
$="(def! load-file (fn
* (f
) (eval (read
-file f
))))"
376 GOSUB RE:AY=R:GOSUB RELEASE
378 REM load the args file
379 A$="(def! -*ARGS*- (load-file "+CHR
$(34)+".args.mal"+CHR$(34)+"))"
380 GOSUB RE
:AY
=R
:GOSUB RELEASE
382 REM set the argument list
383 A
$="(def! *ARGV
* (rest
-*ARGS
*-))"
384 GOSUB RE:AY=R:GOSUB RELEASE
386 REM get the first argument
387 A$="(first -*ARGS*-)"
390 REM if there is an argument, then run it as a program
391 IF R
<>0 THEN AY
=R
:GOSUB RELEASE
:GOTO RUN_PROG
392 REM no arguments, start REPL loop
393 IF R
=0 THEN GOTO REPL_LOOP
396 REM run a single mal program and exit
397 A
$="(load-file (first
-*ARGS
*-))"
399 IF ER<>-2 THEN GOSUB PRINT_ERROR
403 A$="user> ":GOSUB READLINE
: REM call input parser
404 IF EZ
=1 THEN GOTO QUIT
405 IF R
$="" THEN GOTO REPL_LOOP
407 A
$=R$:CALL REP
: REM call REP
409 IF ER
<>-2 THEN GOSUB PRINT_ERROR
:GOTO REPL_LOOP
414 REM GOSUB PR_MEMORY_SUMMARY_SMALL