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'
10 REM $INCLUDE: 'debug.in.bas'
17 REM EVAL_AST(A, E) -> R
21 REM push A and E on the stack
25 IF ER
<>-2 THEN GOTO EVAL_AST_RETURN
28 IF T
=5 THEN GOTO EVAL_AST_SYMBOL
29 IF T
>=6 AND T
<=8 THEN GOTO EVAL_AST_SEQ
31 REM scalar: deref to actual value and inc ref cnt
42 REM setup the stack for the loop
46 REM check if we are done evaluating the source sequence
47 IF Z
%(A
+1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
49 REM call EVAL for each entry
51 IF T
<>8 THEN A
=Z
%(A
+2)
53 Q
=T
:GOSUB PUSH_Q
: REM push/save type
55 GOSUB POP_Q
:T
=Q
: REM pop/restore type
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
63 REM for hash-maps, copy the key (inc ref since we are going to
65 IF T
=8 THEN N
=M
:M
=Z
%(A
+2):Z
%(M
)=Z
%(M
)+32
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
72 REM process the next sequence entry from source list
75 GOTO EVAL_AST_SEQ_LOOP
76 EVAL_AST_SEQ_LOOP_DONE:
77 REM cleanup stack and get return value
82 REM pop A and E off the stack
91 LV
=LV
+1: REM track basic return stack level
93 REM push A and E on the stack
97 IF ER
<>-2 THEN GOTO EVAL_RETURN
99 REM AZ=A:B=1:GOSUB PR_STR
100 REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
103 IF R
THEN GOTO APPLY_LIST
110 IF R
THEN R
=A
:GOSUB INC_REF_R
:GOTO EVAL_RETURN
115 IF (Z
%(A0
)AND 31)<>5 THEN A
$=""
116 IF (Z
%(A0
)AND 31)=5 THEN A
$=S$(Z%(A0+1))
118 IF A
$="def!" THEN GOTO EVAL_DEF
119 IF A
$="let*" THEN GOTO EVAL_LET
123 A3
=Z
%(Z
%(Z
%(Z
%(A
+1)+1)+1)+2)
125 A2
=Z
%(Z
%(Z
%(A
+1)+1)+2)
132 GOSUB EVAL_GET_A2
: REM set A1 and A2
135 A
=A2
:CALL EVAL
: REM eval a2
138 IF ER
<>-2 THEN GOTO EVAL_RETURN
140 REM set a1 in env to a2
141 K
=A1
:C
=R
:GOSUB ENV_SET
146 GOSUB EVAL_GET_A2
: REM set A1 and A2
148 Q
=A2
:GOSUB PUSH_Q
: REM push/save A2
149 REM create new environment with outer as current environment
153 IF Z
%(A1
+1)=0 THEN GOTO EVAL_LET_LOOP_DONE
155 Q
=A1
:GOSUB PUSH_Q
: REM push A1
156 REM eval current A1 odd element
157 A
=Z
%(Z
%(A1
+1)+2):CALL EVAL
158 GOSUB POP_Q
:A1
=Q
: REM pop A1
160 IF ER
<>-2 THEN GOTO EVAL_LET_LOOP_DONE
162 REM set key/value in the environment
163 K
=Z
%(A1
+2):C
=R
:GOSUB ENV_SET
164 AY
=R
:GOSUB RELEASE
: REM release our use, ENV_SET took ownership
166 REM skip to the next pair of A1 elements
171 GOSUB POP_Q
:A2
=Q
: REM pop A2
172 A
=A2
:CALL EVAL
: REM eval A2 using let_env
178 REM if error, return f/args for release by caller
179 IF ER
<>-2 THEN GOTO EVAL_RETURN
185 IF T
<>9 THEN R
=-1:ER
=-1:E
$="apply of non
-function":GOTO EVAL_INVOKE_DONE
192 REM release environment if not the top one on the stack
194 IF E<>Q THEN AY=E:GOSUB RELEASE
196 LV=LV-1: REM track basic return stack level
202 REM pop A and E off the stack
208 REM DO_FUNCTION(F, AR)
210 REM Get the function number
213 REM Get argument values
215 B=Z%(Z%(Z%(AR+1)+2)+1)
217 REM Switch on the function number
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
225 T
=2:L
=A
+B
:GOSUB ALLOC
226 GOTO DO_FUNCTION_DONE
228 T
=2:L
=A
-B
:GOSUB ALLOC
229 GOTO DO_FUNCTION_DONE
231 T
=2:L
=A
*B
:GOSUB ALLOC
232 GOTO DO_FUNCTION_DONE
234 T
=2:L
=A
/B
:GOSUB ALLOC
235 GOTO DO_FUNCTION_DONE
242 AZ
=A
:B
=1:GOSUB PR_STR
246 REM Assume D has repl_env
251 IF ER
<>-2 THEN GOTO REP_DONE
255 IF ER
<>-2 THEN GOTO REP_DONE
260 REM Release memory from MAL_READ and EVAL
272 C
=0:GOSUB ENV_NEW
:D
=R
276 T
=9:L
=1:GOSUB ALLOC
: REM native function
277 B
$="+":C=R:GOSUB ENV_SET_S
280 T
=9:L
=2:GOSUB ALLOC
: REM native function
281 B
$="-":C=R:GOSUB ENV_SET_S
284 T
=9:L
=3:GOSUB ALLOC
: REM native function
285 B
$="*":C=R:GOSUB ENV_SET_S
288 T
=9:L
=4:GOSUB ALLOC
: REM native function
289 B
$="/":C=R:GOSUB ENV_SET_S
291 ZT
=ZI
: REM top of memory after base repl_env
294 A
$="user> ":GOSUB READLINE: REM call input parser
295 IF EZ=1 THEN GOTO QUIT
296 IF R$="" THEN GOTO REPL_LOOP
298 A$=R$:CALL REP: REM call REP
300 IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
305 REM GOSUB PR_MEMORY_SUMMARY_SMALL