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 REM $INCLUDE: 'env.in.bas'
8 REM $INCLUDE: 'core.in.bas'
10 REM $INCLUDE: 'debug.in.bas'
17 REM EVAL_AST(A, E) -> R
19 REM push A and E on the stack
20 X
=X
+2:X
%(X
-1)=E
:X
%(X
)=A
22 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 allocate the first entry (T already set above)
44 REM make space on the stack
46 REM push type of sequence
48 REM push sequence index
50 REM push future return value (new sequence)
52 REM push previous new sequence entry
59 REM check if we are done evaluating the source sequence
60 IF Z
%(A
,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
62 REM if we are returning to DO, then skip last element
63 IF X
%(X
-6)=2 AND Z
%(Z
%(A
,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
65 REM if hashmap, skip eval of even entries (keys)
66 IF (X
%(X
-3)=8) AND ((X
%(X
-2)AND1
)=0) THEN GOTO EVAL_AST_DO_REF
70 R
=A
+1:GOSUB DEREF_R
: REM deref to target of referred entry
71 Z
%(R
,0)=Z
%(R
,0)+32: REM inc ref cnt of referred value
72 GOTO EVAL_AST_ADD_VALUE
75 REM call EVAL for each entry
78 GOSUB DEREF_R
: REM deref to target of evaluated entry
82 REM update previous value pointer to evaluated entry
85 IF ER
<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
87 REM allocate the next entry
88 REM same new sequence entry type
89 T
=X
%(X
-3):L
=0:N
=0:GOSUB ALLOC
91 REM update previous sequence entry value to point to new entry
93 REM update previous ptr to current entry
96 REM process the next sequence entry from source list
99 GOTO EVAL_AST_SEQ_LOOP
100 EVAL_AST_SEQ_LOOP_DONE:
101 REM if no error, get return value (new seq)
102 IF ER
=-2 THEN R
=X
%(X
-1)
103 REM otherwise, free the return value and return nil
104 IF ER
<>-2 THEN R
=0:AY
=X
%(X
-1):GOSUB RELEASE
106 REM pop previous, return, index and type
111 REM pop A and E off the stack
112 E
=X
%(X
-1):A
=X
%(X
):X
=X
-2
117 LV
=LV
+1: REM track basic return stack level
119 REM push A and E on the stack
120 X
=X
+2:X
%(X
-1)=E
:X
%(X
)=A
122 REM PRINT "EVAL A:"+STR$(A)+",X:"+STR$(X)+",LV:"+STR$(LV)+",FRE:"+STR$(FRE(0))
126 IF ER
<>-2 THEN GOTO EVAL_RETURN
128 REM AZ=A:PR=1:GOSUB PR_STR
129 REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
134 IF R
THEN GOTO APPLY_LIST
141 IF R
THEN R
=A
:Z
%(R
,0)=Z
%(R
,0)+32:GOTO EVAL_RETURN
144 R
=A0
:GOSUB DEREF_R
:A0
=R
147 IF (Z
%(A0
,0)AND31
)<>5 THEN A
$=""
148 IF (Z
%(A0
,0)AND31
)=5 THEN A
$=S$(Z%(A0,1))
150 IF A
$="def!" THEN GOTO EVAL_DEF
151 IF A
$="let*" THEN GOTO EVAL_LET
152 IF A
$="do" THEN GOTO EVAL_DO
153 IF A
$="if" THEN GOTO EVAL_IF
154 IF A
$="fn*" THEN GOTO EVAL_FN
158 A3
=Z
%(Z
%(Z
%(A
,1),1),1)+1
159 R
=A3
:GOSUB DEREF_R
:A3
=R
162 R
=A2
:GOSUB DEREF_R
:A2
=R
165 R
=A1
:GOSUB DEREF_R
:A1
=R
170 GOSUB EVAL_GET_A2
: REM set A1 and A2
172 X
=X
+1:X
%(X
)=A1
: REM push A1
173 A
=A2
:CALL EVAL
: REM eval a2
174 A1
=X
%(X
):X
=X
-1: REM pop A1
176 IF ER
<>-2 THEN GOTO EVAL_RETURN
178 REM set a1 in env to a2
179 K
=A1
:V
=R
:GOSUB ENV_SET
184 GOSUB EVAL_GET_A2
: REM set A1 and A2
186 X
=X
+1:X
%(X
)=A2
: REM push/save A2
187 X
=X
+1:X
%(X
)=E
: REM push env for for later release
189 REM create new environment with outer as current environment
193 IF Z
%(A1
,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
195 X
=X
+1:X
%(X
)=A1
: REM push A1
196 REM eval current A1 odd element
197 A
=Z
%(A1
,1)+1:CALL EVAL
198 A1
=X
%(X
):X
=X
-1: REM pop A1
200 IF ER
<>-2 THEN GOTO EVAL_LET_LOOP_DONE
202 REM set environment: even A1 key to odd A1 eval'd above
203 K
=A1
+1:V
=R
:GOSUB ENV_SET
204 AY
=R
:GOSUB RELEASE
: REM release our use, ENV_SET took ownership
206 REM skip to the next pair of A1 elements
211 E4
=X
%(X
):X
=X
-1: REM pop previous env
213 REM release previous environment if not the current EVAL env
214 IF E4
<>X
%(X
-2) THEN AY
=E4
:GOSUB RELEASE
216 A2
=X
%(X
):X
=X
-1: REM pop A2
217 A
=A2
:GOTO EVAL_TCO_RECUR
: REM TCO loop
221 X
=X
+1:X
%(X
)=A
: REM push/save A
226 AY
=R
: REM get eval'd list for release
228 A
=X
%(X
):X
=X
-1: REM pop/restore original A for LAST
229 GOSUB LAST
: REM get last element for return
230 A
=R
: REM new recur AST
233 GOSUB RELEASE
: REM release eval'd list
234 AY
=A
:GOSUB RELEASE
: REM release LAST value (not sure why)
236 GOTO EVAL_TCO_RECUR
: REM TCO loop
239 GOSUB EVAL_GET_A1
: REM set A1
245 IF (R
=0) OR (R
=1) THEN GOTO EVAL_IF_FALSE
249 GOSUB EVAL_GET_A2
: REM set A1 and A2 after EVAL
250 A
=A2
:GOTO EVAL_TCO_RECUR
: REM TCO loop
253 REM if no false case (A3), return nil
255 IF R
<4 THEN R
=0:GOTO EVAL_RETURN
256 GOSUB EVAL_GET_A3
: REM set A1 - A3 after EVAL
257 A
=A3
:GOTO EVAL_TCO_RECUR
: REM TCO loop
260 GOSUB EVAL_GET_A2
: REM set A1 and A2
261 A
=A2
:P
=A1
:GOSUB MAL_FUNCTION
267 REM if error, return f/args for release by caller
268 IF ER
<>-2 THEN GOTO EVAL_RETURN
270 REM push f/args for release after call
276 R
=F
:GOSUB DEREF_R
:F
=R
278 REM if metadata, get the actual object
279 IF (Z
%(F
,0)AND31
)>=16 THEN F
=Z
%(F
,1)
281 IF (Z
%(F
,0)AND31
)=9 THEN GOTO EVAL_DO_FUNCTION
282 IF (Z
%(F
,0)AND31
)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
284 REM if error, pop and return f/args for release by caller
286 ER
=-1:ER
$="apply of non
-function":GOTO EVAL_RETURN
290 IF Z%(F,1)<60 THEN GOSUB DO_FUNCTION:GOTO EVAL_DO_FUNCTION_SKIP
291 REM for recur functions (apply, map, swap!), use GOTO
292 IF Z%(F,1)>60 THEN CALL DO_TCO_FUNCTION
293 EVAL_DO_FUNCTION_SKIP:
295 REM pop and release f/args
296 AY=X%(X):X=X-1:GOSUB RELEASE
299 EVAL_DO_MAL_FUNCTION:
300 E4=E: REM save the current environment for release
302 REM create new environ using env stored with function
303 O=Z%(F+1,1):BI=Z%(F+1,0):EX=AR:GOSUB ENV_NEW_BINDS
305 REM release previous env if it is not the top one on the
306 REM stack (X%(X-2)) because our new env refers to it and
307 REM we no longer need to track it (since we are TCO recurring)
308 IF E4<>X%(X-2) THEN AY=E4:GOSUB RELEASE
310 REM claim the AST before releasing the list containing it
311 A=Z%(F,1):Z%(A,0)=Z%(A,0)+32
312 REM add AST to pending release queue to free as soon as EVAL
313 REM actually returns (LV+1)
314 Y=Y+1:Y%(Y,0)=A:Y%(Y,1)=LV+1
316 REM pop and release f/args
317 AY=X%(X):X=X-1:GOSUB RELEASE
320 E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
323 REM AZ=R: PR=1: GOSUB PR_STR
324 REM PRINT "EVAL_RETURN R
: ["+R$+"] ("+STR
$(R)+"), LV
:"+STR$(LV)+",ER:"+STR$(ER)
326 REM release environment if not the top one on the stack
327 IF E<>X%(X-1) THEN AY=E:GOSUB RELEASE
329 LV=LV-1: REM track basic return stack level
331 REM release everything we couldn't release earlier
337 REM pop A and E off the stack
338 E=X%(X-1):A=X%(X):X=X-2
344 AZ=A:PR=1:GOSUB PR_STR
348 REM Assume D has repl_env
349 REM caller must release result
354 IF ER<>-2 THEN GOTO RE_DONE
359 REM Release memory from MAL_READ
360 IF R1<>0 THEN AY=R1:GOSUB RELEASE
361 RETURN: REM caller must release result of EVAL
364 REM Assume D has repl_env
369 IF ER<>-2 THEN GOTO REP_DONE
373 IF ER<>-2 THEN GOTO REP_DONE
379 REM Release memory from MAL_READ and EVAL
380 IF R2<>0 THEN AY=R2:GOSUB RELEASE
381 IF R1<>0 THEN AY=R1:GOSUB RELEASE
392 O=-1:GOSUB ENV_NEW:D=R
394 REM core.EXT: defined in Basic
395 E=D:GOSUB INIT_CORE_NS: REM set core functions in repl_env
397 ZT=ZI: REM top of memory after base repl_env
399 REM core.mal: defined using the language itself
400 A$="(def! not (fn* (a) (if a false true)))"
401 GOSUB RE
:AY
=R
:GOSUB RELEASE
403 A
$="(def! load-file (fn
* (f
) (eval (read
-file f
))))"
404 GOSUB RE:AY=R:GOSUB RELEASE
406 REM load the args file
407 A$="(def! -*ARGS*- (load-file "+CHR
$(34)+".args.mal"+CHR$(34)+"))"
408 GOSUB RE
:AY
=R
:GOSUB RELEASE
410 REM set the argument list
411 A
$="(def! *ARGV
* (rest
-*ARGS
*-))"
412 GOSUB RE:AY=R:GOSUB RELEASE
414 REM get the first argument
415 A$="(first -*ARGS*-)"
418 REM if there is an argument, then run it as a program
419 IF R
<>0 THEN AY
=R
:GOSUB RELEASE
:GOTO RUN_PROG
420 REM no arguments, start REPL loop
421 IF R
=0 THEN GOTO REPL_LOOP
424 REM run a single mal program and exit
425 A
$="(load-file (first
-*ARGS
*-))"
427 IF ER<>-2 THEN GOSUB PRINT_ERROR
431 A$="user> ":GOSUB READLINE
: REM call input parser
432 IF EOF
=1 THEN GOTO QUIT
434 A
$=R$:CALL REP
: REM call REP
436 IF ER
<>-2 THEN GOSUB PRINT_ERROR
:GOTO REPL_LOOP
441 REM GOSUB PR_MEMORY_SUMMARY