- Use variables A1, A2, B2 for Z%(A+1), Z%(A+2), Z%(B+2) respectively.
- Replace Z%(R)=Z%(R)+32 with GOSUB INC_REF_R
- Add functions TYPE_A and TYPE_F for (Z%(A)AND 31) and (Z%(F)AND 31)
respectively.
- Inline NATIVE_FUNCTION and MAL_FUNCTION.
All together saves over 500 bytes so increase Z% value memory by 250
entries.
REM - call using GOTO and with return label/address on the stack
SUB APPLY
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- ON (Z%(F)AND 31)-8 GOTO APPLY_FUNCTION,APPLY_MAL_FUNCTION,APPLY_MAL_FUNCTION
+ ON T-8 GOTO APPLY_FUNCTION,APPLY_MAL_FUNCTION,APPLY_MAL_FUNCTION
APPLY_FUNCTION:
REM regular function
A=Z%(AR+2)
B=Z%(Z%(AR+1)+2)
+REM PRINT "F:"+STR$(F)+", Z%(F):"+STR$(Z%(F))+", G:"+STR$(G)
ON G-60 GOTO DO_APPLY,DO_MAP,DO_SWAP_BANG
DO_APPLY:
A=Z%(AR+2)
REM no intermediate args, but not a list, so convert it first
- IF C<=1 AND (Z%(A)AND 31)<>6 THEN T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2
+ GOSUB TYPE_A
+ IF C<=1 AND T<>6 THEN T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2
REM no intermediate args, just call APPLY directly
IF C<=1 THEN GOTO DO_APPLY_1
REM a real non-empty list
AY=Z%(R6+1):GOSUB RELEASE
REM attach end of slice to final args element
- Z%(R6+1)=Z%(A+2)
- Z%(Z%(A+2))=Z%(Z%(A+2))+32
+ A2=Z%(A+2)
+ Z%(R6+1)=A2
+ Z%(A2)=Z%(A2)+32
GOTO DO_APPLY_2
Q=AR:GOSUB PUSH_Q
REM push atom
- Q=A:GOSUB PUSH_Q
+ GOSUB PUSH_A
CALL APPLY
REM pop atom
- GOSUB POP_Q:A=Q
+ GOSUB POP_A
REM pop and release args
GOSUB POP_Q:AY=Q
DO_TCO_FUNCTION_DONE:
END SUB
-REM RETURN_INC_REF(R) -> R
-REM - return R with 1 ref cnt increase
-REM - called with GOTO as a return RETURN
-RETURN_INC_REF:
- Z%(R)=Z%(R)+32
- RETURN
-
-REM RETURN_TRUE_FALSE(R) -> R
-REM - take BASIC true/false R, return mal true/false R with ref cnt
-REM - called with GOTO as a return RETURN
-RETURN_TRUE_FALSE:
- IF R THEN R=4
- IF R=0 THEN R=2
- GOTO RETURN_INC_REF
-
REM DO_FUNCTION(F, AR)
DO_FUNCTION:
REM Get the function number
G=Z%(F+1)
REM Get argument values
- A=Z%(AR+2)
- B=Z%(Z%(AR+1)+2)
+ A=Z%(AR+2):A1=Z%(A+1)
+ B=Z%(Z%(AR+1)+2):B1=Z%(B+1)
REM Switch on the function number
IF G>59 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
GOTO RETURN_TRUE_FALSE
DO_STRING_Q:
R=0
- IF (Z%(A)AND 31)<>4 THEN GOTO RETURN_TRUE_FALSE
- IF MID$(S$(Z%(A+1)),1,1)=CHR$(127) THEN GOTO RETURN_TRUE_FALSE
+ GOSUB TYPE_A
+ IF T<>4 THEN GOTO RETURN_TRUE_FALSE
+ IF MID$(S$(A1),1,1)=CHR$(127) THEN GOTO RETURN_TRUE_FALSE
R=1
GOTO RETURN_TRUE_FALSE
DO_SYMBOL:
- B$=S$(Z%(A+1))
+ B$=S$(A1)
T=5:GOSUB STRING
RETURN
DO_SYMBOL_Q:
- R=(Z%(A)AND 31)=5
+ GOSUB TYPE_A
+ R=T=5
GOTO RETURN_TRUE_FALSE
DO_KEYWORD:
- B$=S$(Z%(A+1))
+ B$=S$(A1)
IF MID$(B$,1,1)<>CHR$(127) THEN B$=CHR$(127)+B$
T=4:GOSUB STRING
RETURN
DO_KEYWORD_Q:
R=0
- IF (Z%(A)AND 31)<>4 THEN GOTO RETURN_TRUE_FALSE
- IF MID$(S$(Z%(A+1)),1,1)<>CHR$(127) THEN GOTO RETURN_TRUE_FALSE
+ GOSUB TYPE_A
+ IF T<>4 THEN GOTO RETURN_TRUE_FALSE
+ IF MID$(S$(A1),1,1)<>CHR$(127) THEN GOTO RETURN_TRUE_FALSE
R=1
GOTO RETURN_TRUE_FALSE
AZ=AR:B=1:B$=" ":GOSUB PR_STR_SEQ
PRINT R$
R=0
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_PRINTLN:
AZ=AR:B=0:B$=" ":GOSUB PR_STR_SEQ
PRINT R$
R=0
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_READ_STRING:
- A$=S$(Z%(A+1))
+ A$=S$(A1)
GOSUB READ_STR
RETURN
DO_READLINE:
- A$=S$(Z%(A+1)):GOSUB READLINE
- IF EZ=1 THEN EZ=0:R=0:GOTO RETURN_INC_REF
+ A$=S$(A1):GOSUB READLINE
+ IF EZ=1 THEN EZ=0:R=0:GOTO INC_REF_R
B$=R$:T=4:GOSUB STRING
RETURN
DO_SLURP:
R$=""
- #cbm OPEN 1,8,0,S$(Z%(A+1))
- #qbasic A$=S$(Z%(A+1))
+ #cbm OPEN 1,8,0,S$(A1)
+ #qbasic A$=S$(A1)
#qbasic IF NOT _FILEEXISTS(A$) THEN ER=-1:E$="File not found":RETURN
#qbasic OPEN A$ FOR INPUT AS #1
DO_SLURP_LOOP:
RETURN
DO_LT:
- R=Z%(A+1)<Z%(B+1)
+ R=A1<B1
GOTO RETURN_TRUE_FALSE
DO_LTE:
- R=Z%(A+1)<=Z%(B+1)
+ R=A1<=B1
GOTO RETURN_TRUE_FALSE
DO_GT:
- R=Z%(A+1)>Z%(B+1)
+ R=A1>B1
GOTO RETURN_TRUE_FALSE
DO_GTE:
- R=Z%(A+1)>=Z%(B+1)
+ R=A1>=B1
GOTO RETURN_TRUE_FALSE
DO_ADD:
- T=2:L=Z%(A+1)+Z%(B+1):GOSUB ALLOC
+ T=2:L=A1+B1:GOSUB ALLOC
RETURN
DO_SUB:
- T=2:L=Z%(A+1)-Z%(B+1):GOSUB ALLOC
+ T=2:L=A1-B1:GOSUB ALLOC
RETURN
DO_MULT:
- T=2:L=Z%(A+1)*Z%(B+1):GOSUB ALLOC
+ T=2:L=A1*B1:GOSUB ALLOC
RETURN
DO_DIV:
- T=2:L=Z%(A+1)/Z%(B+1):GOSUB ALLOC
+ T=2:L=A1/B1:GOSUB ALLOC
RETURN
DO_TIME_MS:
T=2:L=INT((TI-BT)*16.667):GOSUB ALLOC
DO_LIST:
R=AR
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_LIST_Q:
GOSUB LIST_Q
GOTO RETURN_TRUE_FALSE
A=AR:T=7:GOSUB FORCE_SEQ_TYPE
RETURN
DO_VECTOR_Q:
- R=(Z%(A)AND 31)=7
+ GOSUB TYPE_A
+ R=T=7
GOTO RETURN_TRUE_FALSE
DO_HASH_MAP:
REM setup the stack for the loop
RETURN
DO_MAP_Q:
- R=(Z%(A)AND 31)=8
+ GOSUB TYPE_A
+ R=T=8
GOTO RETURN_TRUE_FALSE
DO_ASSOC:
H=A
IF AR=0 OR Z%(AR+1)=0 THEN RETURN
GOTO DO_ASSOC_LOOP
DO_GET:
- IF A=0 THEN R=0:GOTO RETURN_INC_REF
+ IF A=0 THEN R=0:GOTO INC_REF_R
H=A:K=B:GOSUB HASHMAP_GET
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_CONTAINS:
H=A:K=B:GOSUB HASHMAP_CONTAINS
GOTO RETURN_TRUE_FALSE
RETURN
DO_SEQUENTIAL_Q:
- R=(Z%(A)AND 31)=6 OR (Z%(A)AND 31)=7
+ GOSUB TYPE_A
+ R=T=6 OR T=7
GOTO RETURN_TRUE_FALSE
DO_CONS:
T=6:L=B:M=A:GOSUB ALLOC
RETURN
DO_CONCAT:
REM if empty arguments, return empty list
- IF Z%(AR+1)=0 THEN R=6:GOTO RETURN_INC_REF
+ IF Z%(AR+1)=0 THEN R=6:GOTO INC_REF_R
REM single argument
IF Z%(Z%(AR+1)+1)<>0 THEN GOTO DO_CONCAT_MULT
B=R
GOTO DO_CONCAT_LOOP
DO_NTH:
+ B=B1
GOSUB COUNT
- B=Z%(B+1)
IF R<=B THEN R=-1:ER=-1:E$="nth: index out of range":RETURN
DO_NTH_LOOP:
IF B=0 THEN GOTO DO_NTH_DONE
GOTO DO_NTH_LOOP
DO_NTH_DONE:
R=Z%(A+2)
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_FIRST:
R=0
- IF A=0 THEN GOTO RETURN_INC_REF
- IF Z%(A+1)<>0 THEN R=Z%(A+2)
- GOTO RETURN_INC_REF
+ IF A=0 THEN GOTO INC_REF_R
+ IF A1<>0 THEN R=Z%(A+2)
+ GOTO INC_REF_R
DO_REST:
- IF A=0 THEN R=6:GOTO RETURN_INC_REF
- IF Z%(A+1)<>0 THEN A=Z%(A+1): REM get the next sequence element
+ IF A=0 THEN R=6:GOTO INC_REF_R
+ IF A1<>0 THEN A=A1: REM get the next sequence element
T=6:GOSUB FORCE_SEQ_TYPE
RETURN
DO_EMPTY_Q:
- R=Z%(A+1)=0
+ R=A1=0
GOTO RETURN_TRUE_FALSE
DO_COUNT:
GOSUB COUNT
RETURN
DO_CONJ:
R=0
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_SEQ:
R=0
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
DO_WITH_META:
- T=Z%(A)AND 31
+ GOSUB TYPE_A
REM remove existing metadata first
- IF T=14 THEN A=Z%(A+1):GOTO DO_WITH_META
+ IF T=14 THEN A=A1:GOTO DO_WITH_META
T=14:L=A:M=B:GOSUB ALLOC
RETURN
DO_META:
R=0
- IF (Z%(A)AND 31)=14 THEN R=Z%(A+2)
- GOTO RETURN_INC_REF
+ GOSUB TYPE_A
+ IF T=14 THEN R=Z%(A+2)
+ GOTO INC_REF_R
DO_ATOM:
T=12:L=A:GOSUB ALLOC
RETURN
DO_ATOM_Q:
- R=(Z%(A)AND 31)=12
+ GOSUB TYPE_A
+ R=T=12
GOTO RETURN_TRUE_FALSE
DO_DEREF:
- R=Z%(A+1)
- GOTO RETURN_INC_REF
+ R=A1
+ GOTO INC_REF_R
DO_RESET_BANG:
R=B
REM release current value
+ REM can't use A1 here because DO_RESET_BANG is called from swap!
AY=Z%(A+1):GOSUB RELEASE
REM inc ref by 2 for atom ownership and since we are returning it
Z%(R)=Z%(R)+64
REM GOSUB PR_MEMORY_SUMMARY
GOSUB PR_MEMORY_SUMMARY_SMALL
R=0
- GOTO RETURN_INC_REF
+ GOTO INC_REF_R
RETURN
DO_EVAL:
RETURN
DO_READ_FILE:
- A$=S$(Z%(A+1))
+ A$=S$(A1)
GOSUB READ_FILE
RETURN
INIT_CORE_SET_FUNCTION:
- GOSUB NATIVE_FUNCTION
+ T=9:L=A:GOSUB ALLOC: REM native function
C=R:GOSUB ENV_SET_S
A=A+1
RETURN
REM #qbasic PRINT "Stack (X%) :"+STR$(X+1)+" /"+STR$(Z3)
REM #cbm PRINT "Stack :"+STR$(X+2-Z3)+" / 1920"
REM RETURN
-REM
-REM #cbm PR_MEMORY_MAP:
-REM #cbm PRINT
-REM #cbm P1=PEEK(43)+PEEK(44)*256
-REM #cbm P2=PEEK(45)+PEEK(46)*256
-REM #cbm P3=PEEK(47)+PEEK(48)*256
-REM #cbm P4=PEEK(49)+PEEK(50)*256
-REM #cbm P5=PEEK(51)+PEEK(52)*256
-REM #cbm P6=PEEK(53)+PEEK(54)*256
-REM #cbm P7=PEEK(55)+PEEK(56)*256
-REM #cbm PRINT "BASIC beg. :"STR$(P1)
-REM #cbm PRINT "Variable beg.:"STR$(P2)
-REM #cbm PRINT "Array beg. :"STR$(P3)
-REM #cbm PRINT "Array end :"STR$(P4)
-REM #cbm PRINT "String beg. :"STR$(P5)
-REM #cbm PRINT "String cur. :"STR$(P6)
-REM #cbm PRINT "BASIC end :"STR$(P7)
-REM #cbm PRINT
-REM #cbm PRINT "Program Code :"STR$(P2-P1)
-REM #cbm PRINT "Variables :"STR$(P3-P2)
-REM #cbm PRINT "Arrays :"STR$(P4-P3)
-REM #cbm PRINT "String Heap :"STR$(P7-P5)
-REM #cbm RETURN
-REM
+
+#cbm PR_MEMORY_MAP:
+ #cbm PRINT
+ #cbm P1=PEEK(43)+PEEK(44)*256
+ #cbm P2=PEEK(45)+PEEK(46)*256
+ #cbm P3=PEEK(47)+PEEK(48)*256
+ #cbm P4=PEEK(49)+PEEK(50)*256
+ #cbm P5=PEEK(51)+PEEK(52)*256
+ #cbm P6=PEEK(53)+PEEK(54)*256
+ #cbm P7=PEEK(55)+PEEK(56)*256
+ #cbm PRINT "BASIC beg. :"STR$(P1)
+ #cbm PRINT "Variable beg.:"STR$(P2)
+ #cbm PRINT "Array beg. :"STR$(P3)
+ #cbm PRINT "Array end :"STR$(P4)
+ #cbm PRINT "String beg. :"STR$(P5)
+ #cbm PRINT "String cur. :"STR$(P6)
+ #cbm PRINT "BASIC end :"STR$(P7)
+ #cbm PRINT
+ #cbm PRINT "Program Code :"STR$(P2-P1)
+ #cbm PRINT "Variables :"STR$(P3-P2)
+ #cbm PRINT "Arrays :"STR$(P4-P3)
+ #cbm PRINT "String Heap :"STR$(P7-P5)
+ #cbm RETURN
+
REM REM PR_MEMORY_VALUE(I) -> J:
REM REM - I is memory value to print
REM REM - I is returned as last byte of value printed
CALL ENV_FIND
IF R=-1 THEN ER=-1:E$="'"+S$(Z%(K+1))+"' not found":GOTO ENV_GET_RETURN
R=R4
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO ENV_GET_RETURN
RETURN
+REM INC_REF_R(R) -> R
+REM - return R with 1 ref cnt increase
+REM - call with GOTO to return at caller callsite
+REM - call with GOSUB to return to caller
+INC_REF_R:
+ Z%(R)=Z%(R)+32
+ RETURN
+
+REM RETURN_TRUE_FALSE(R) -> R
+REM - take BASIC true/false R, return mal true/false R with ref cnt
+REM - called with GOTO as a return RETURN
+RETURN_TRUE_FALSE:
+ IF R THEN R=4
+ IF R=0 THEN R=2
+ GOTO INC_REF_R
+
+
REM release stack functions
#qbasic PEND_A_LV:
#cbm T=FRE(0)
#qbasic T=0
- Z1=8191+400: REM Z% (boxed memory) size (2 bytes each)
+ Z1=8191+650: REM Z% (boxed memory) size (2 bytes each)
Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
#qbasic Z3=200: REM X% (call stack) size (2 bytes each)
#cbm Z3=49152: REM X starting point at $C000 (2 bytes each)
IF ER<>-2 THEN GOTO READ_FORM_RETURN
GOSUB READ_TOKEN
REM PRINT "READ_FORM T$: ["+T$+"]"
- IF T$="" THEN R=0:Z%(R)=Z%(R)+32:GOTO READ_FORM_RETURN
+ IF T$="" THEN R=0:GOSUB INC_REF_R:GOTO READ_FORM_RETURN
IF T$="nil" THEN T=0:GOTO READ_NIL_BOOL
IF T$="false" THEN T=1:GOTO READ_NIL_BOOL
IF T$="true" THEN T=2:GOTO READ_NIL_BOOL
READ_NIL_BOOL:
REM PRINT "READ_NIL_BOOL"
R=T*2
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO READ_FORM_RETURN
READ_NUMBER:
REM PRINT "READ_NUMBER"
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
H=E:K=A:GOSUB HASHMAP_GET
IF R3=0 THEN R=-1:ER=-1:E$="'"+S$(Z%(A+1))+"' not found":GOTO EVAL_AST_RETURN
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
EVAL_INVOKE:
CALL EVAL_AST
AR=Z%(R+1): REM rest
F=Z%(R+2)
- IF (Z%(F)AND 31)<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE
+ GOSUB TYPE_F
+ IF T<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE
GOSUB DO_FUNCTION
EVAL_INVOKE_DONE:
AY=W:GOSUB RELEASE
GOSUB HASHMAP:D=R
REM + function
- A=1:GOSUB NATIVE_FUNCTION
+ T=9:L=1:GOSUB ALLOC: REM native function
H=D:B$="+":C=R:GOSUB ASSOC1_S:D=R
REM - function
- A=2:GOSUB NATIVE_FUNCTION
+ T=9:L=2:GOSUB ALLOC: REM native function
H=D:B$="-":C=R:GOSUB ASSOC1_S:D=R
REM * function
- A=3:GOSUB NATIVE_FUNCTION
+ T=9:L=3:GOSUB ALLOC: REM native function
H=D:B$="*":C=R:GOSUB ASSOC1_S:D=R
REM / function
- A=4:GOSUB NATIVE_FUNCTION
+ T=9:L=4:GOSUB ALLOC: REM native function
H=D:B$="/":C=R:GOSUB ASSOC1_S:D=R
ZT=ZI: REM top of memory after base repl_env
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
AR=Z%(R+1): REM rest
F=Z%(R+2)
- IF (Z%(F)AND 31)<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE
+ GOSUB TYPE_F
+ IF T<>9 THEN R=-1:ER=-1:E$="apply of non-function":GOTO EVAL_INVOKE_DONE
GOSUB DO_FUNCTION
EVAL_INVOKE_DONE:
AY=W:GOSUB RELEASE
E=D
REM + function
- A=1:GOSUB NATIVE_FUNCTION
+ T=9:L=1:GOSUB ALLOC: REM native function
B$="+":C=R:GOSUB ENV_SET_S
REM - function
- A=2:GOSUB NATIVE_FUNCTION
+ T=9:L=2:GOSUB ALLOC: REM native function
B$="-":C=R:GOSUB ENV_SET_S
REM * function
- A=3:GOSUB NATIVE_FUNCTION
+ T=9:L=3:GOSUB ALLOC: REM native function
B$="*":C=R:GOSUB ENV_SET_S
REM / function
- A=4:GOSUB NATIVE_FUNCTION
+ T=9:L=4:GOSUB ALLOC: REM native function
B$="/":C=R:GOSUB ENV_SET_S
ZT=ZI: REM top of memory after base repl_env
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM Assume D has repl_env
REM caller must release result
RE:
- R1=0
+ R1=-1
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO RE_DONE
RE_DONE:
REM Release memory from MAL_READ
- IF R1<>0 THEN AY=R1:GOSUB RELEASE
+ AY=R1:GOSUB RELEASE
RETURN: REM caller must release result of EVAL
REM REP(A$) -> R$
REM Assume D has repl_env
SUB REP
- R1=-1:R2=-1
- GOSUB MAL_READ
- R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ R2=-1
- A=R:E=D:CALL EVAL
+ GOSUB RE
R2=R
IF ER<>-2 THEN GOTO REP_DONE
REP_DONE:
REM Release memory from MAL_READ and EVAL
AY=R2:GOSUB RELEASE
- AY=R1:GOSUB RELEASE
END SUB
REM MAIN program
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM Assume D has repl_env
REM caller must release result
RE:
- R1=0
+ R1=-1
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO RE_DONE
RE_DONE:
REM Release memory from MAL_READ
- IF R1<>0 THEN AY=R1:GOSUB RELEASE
+ AY=R1:GOSUB RELEASE
RETURN: REM caller must release result of EVAL
REM REP(A$) -> R$
REM Assume D has repl_env
SUB REP
- R1=-1:R2=-1
- GOSUB MAL_READ
- R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ R2=-1
- A=R:E=D:CALL EVAL
+ GOSUB RE
R2=R
IF ER<>-2 THEN GOTO REP_DONE
REP_DONE:
REM Release memory from MAL_READ and EVAL
AY=R2:GOSUB RELEASE
- AY=R1:GOSUB RELEASE
END SUB
REM MAIN program
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM Assume D has repl_env
REM caller must release result
RE:
- R1=0
+ R1=-1
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO RE_DONE
RE_DONE:
REM Release memory from MAL_READ
- IF R1<>0 THEN AY=R1:GOSUB RELEASE
+ AY=R1:GOSUB RELEASE
RETURN: REM caller must release result of EVAL
REM REP(A$) -> R$
REM Assume D has repl_env
SUB REP
- R1=-1:R2=-1
- GOSUB MAL_READ
- R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ R2=-1
- A=R:E=D:CALL EVAL
+ GOSUB RE
R2=R
IF ER<>-2 THEN GOTO REP_DONE
REP_DONE:
REM Release memory from MAL_READ and EVAL
AY=R2:GOSUB RELEASE
- AY=R1:GOSUB RELEASE
END SUB
REM MAIN program
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_QUOTE
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_QUOTE
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
GOTO QQ_UNQUOTE
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
REM [ast[1]]
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO QQ_DONE
A=Z%(A+2)
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_DEFAULT
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
B=Z%(A+2)
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
APPLY_LIST:
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
EVAL_QUOTE:
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_QUASIQUOTE:
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM Assume D has repl_env
REM caller must release result
RE:
- R1=0
+ R1=-1
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO RE_DONE
RE_DONE:
REM Release memory from MAL_READ
- IF R1<>0 THEN AY=R1:GOSUB RELEASE
+ AY=R1:GOSUB RELEASE
RETURN: REM caller must release result of EVAL
REM REP(A$) -> R$
REM Assume D has repl_env
SUB REP
- R1=-1:R2=-1
- GOSUB MAL_READ
- R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ R2=-1
- A=R:E=D:CALL EVAL
+ GOSUB RE
R2=R
IF ER<>-2 THEN GOTO REP_DONE
REP_DONE:
REM Release memory from MAL_READ and EVAL
AY=R2:GOSUB RELEASE
- AY=R1:GOSUB RELEASE
END SUB
REM MAIN program
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_QUOTE
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_QUOTE
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
GOTO QQ_UNQUOTE
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
REM [ast[1]]
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO QQ_DONE
A=Z%(A+2)
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_DEFAULT
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
B=Z%(A+2)
MACROEXPAND_LOOP:
REM list?
- IF (Z%(A)AND 31)<>6 THEN GOTO MACROEXPAND_DONE
+ GOSUB TYPE_A
+ IF T<>6 THEN GOTO MACROEXPAND_DONE
REM non-empty?
IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE
B=Z%(A+2)
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
IF R<>1 THEN GOTO EVAL_NOT_LIST
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
EVAL_QUOTE:
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_QUASIQUOTE:
R=A
REM since we are returning it unevaluated, inc the ref cnt
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_IF:
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM Assume D has repl_env
REM caller must release result
RE:
- R1=0
+ R1=-1
GOSUB MAL_READ
R1=R
IF ER<>-2 THEN GOTO RE_DONE
RE_DONE:
REM Release memory from MAL_READ
- IF R1<>0 THEN AY=R1:GOSUB RELEASE
+ AY=R1:GOSUB RELEASE
RETURN: REM caller must release result of EVAL
REM REP(A$) -> R$
REM Assume D has repl_env
SUB REP
- R1=-1:R2=-1
- GOSUB MAL_READ
- R1=R
- IF ER<>-2 THEN GOTO REP_DONE
+ R2=-1
- A=R:E=D:CALL EVAL
+ GOSUB RE
R2=R
IF ER<>-2 THEN GOTO REP_DONE
REP_DONE:
REM Release memory from MAL_READ and EVAL
AY=R2:GOSUB RELEASE
- AY=R1:GOSUB RELEASE
END SUB
REM MAIN program
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_QUOTE
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_QUOTE
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
GOTO QQ_UNQUOTE
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
REM [ast[1]]
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO QQ_DONE
A=Z%(A+2)
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_DEFAULT
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
B=Z%(A+2)
MACROEXPAND_LOOP:
REM list?
- IF (Z%(A)AND 31)<>6 THEN GOTO MACROEXPAND_DONE
+ GOSUB TYPE_A
+ IF T<>6 THEN GOTO MACROEXPAND_DONE
REM non-empty?
IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE
B=Z%(A+2)
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
IF R<>1 THEN GOTO EVAL_NOT_LIST
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
EVAL_QUOTE:
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_QUASIQUOTE:
R=A
REM since we are returning it unevaluated, inc the ref cnt
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_TRY:
A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block
REM create object for ER=-1 type raw string errors
- IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:Z%(R)=Z%(R)+32
+ IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R
REM bind the catch symbol to the error object
K=A1:C=ER:GOSUB ENV_SET
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
REM QUASIQUOTE(A) -> R
SUB QUASIQUOTE
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_QUOTE
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_QUOTE
IF (Z%(A+1)=0) THEN GOTO QQ_QUOTE
GOTO QQ_UNQUOTE
IF S$(Z%(R+1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
REM [ast[1]]
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO QQ_DONE
A=Z%(A+2)
REM pair?
- IF (Z%(A)AND 31)<6 OR (Z%(A)AND 31)>7 THEN GOTO QQ_DEFAULT
+ GOSUB TYPE_A
+ IF T<6 OR T>7 THEN GOTO QQ_DEFAULT
IF (Z%(A+1)=0) THEN GOTO QQ_DEFAULT
B=Z%(A+2)
MACROEXPAND_LOOP:
REM list?
- IF (Z%(A)AND 31)<>6 THEN GOTO MACROEXPAND_DONE
+ GOSUB TYPE_A
+ IF T<>6 THEN GOTO MACROEXPAND_DONE
REM non-empty?
IF Z%(A+1)=0 THEN GOTO MACROEXPAND_DONE
B=Z%(A+2)
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
- T=Z%(A)AND 31
+ GOSUB TYPE_A
IF T=5 THEN GOTO EVAL_AST_SYMBOL
IF T>=6 AND T<=8 THEN GOTO EVAL_AST_SEQ
REM scalar: deref to actual value and inc ref cnt
R=A
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_AST_RETURN
EVAL_AST_SYMBOL:
IF R<>1 THEN GOTO EVAL_NOT_LIST
GOSUB EMPTY_Q
- IF R THEN R=A:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R THEN R=A:GOSUB INC_REF_R:GOTO EVAL_RETURN
A0=Z%(A+2)
EVAL_QUOTE:
R=Z%(Z%(A+1)+2)
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_QUASIQUOTE:
R=A
REM since we are returning it unevaluated, inc the ref cnt
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
GOTO EVAL_RETURN
EVAL_TRY:
A=A2:GOSUB EVAL_GET_A2: REM set A1 and A2 from catch block
REM create object for ER=-1 type raw string errors
- IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:Z%(R)=Z%(R)+32
+ IF ER=-1 THEN B$=E$:T=4:GOSUB STRING:ER=R:GOSUB INC_REF_R
REM bind the catch symbol to the error object
K=A1:C=ER:GOSUB ENV_SET
AY=R:GOSUB RELEASE
REM if no false case (A3), return nil
GOSUB COUNT
- IF R<4 THEN R=0:Z%(R)=Z%(R)+32:GOTO EVAL_RETURN
+ IF R<4 THEN R=0:GOSUB INC_REF_R:GOTO EVAL_RETURN
GOSUB EVAL_GET_A3: REM set A1 - A3 after EVAL
A=A3:GOTO EVAL_TCO_RECUR: REM TCO loop
EVAL_FN:
GOSUB EVAL_GET_A2: REM set A1 and A2
- A=A2:B=A1:GOSUB MAL_FUNCTION
+ T=10:L=A2:M=A1:N=E:GOSUB ALLOC: REM mal function
GOTO EVAL_RETURN
EVAL_INVOKE:
F=Z%(R+2)
REM if metadata, get the actual object
- IF (Z%(F)AND 31)=14 THEN F=Z%(F+1)
+ GOSUB TYPE_F
+ IF T=14 THEN F=Z%(F+1):GOSUB TYPE_F
- IF (Z%(F)AND 31)=9 THEN GOTO EVAL_DO_FUNCTION
- IF (Z%(F)AND 31)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
+ ON T-8 GOTO EVAL_DO_FUNCTION,EVAL_DO_MAL_FUNCTION,EVAL_DO_MAL_FUNCTION
REM if error, pop and return f/args for release by caller
GOSUB POP_R
QUIT:
REM GOSUB PR_MEMORY_SUMMARY_SMALL
PRINT:GOSUB PR_MEMORY_SUMMARY_SMALL
- REM GOSUB PR_MEMORY_MAP
+ GOSUB PR_MEMORY_MAP
REM P1=0:P2=ZI:GOSUB PR_MEMORY
REM P1=D:GOSUB PR_OBJECT
REM P1=ZK:GOSUB PR_OBJECT
REM general functions
+REM TYPE_A(A) -> T
+TYPE_A:
+ T=Z%(A)AND 31
+ RETURN
+
+REM TYPE_F(F) -> T
+TYPE_F:
+ T=Z%(F)AND 31
+ RETURN
+
REM EQUAL_Q(A, B) -> R
EQUAL_Q:
ED=0: REM recursion depth
Q=B:GOSUB PUSH_Q
ED=ED+1
- T1=Z%(A)AND 31
+ GOSUB TYPE_A
T2=Z%(B)AND 31
- IF T1>5 AND T1<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ
- IF T1=8 AND T2=8 THEN GOTO EQUAL_Q_HM
+ IF T>5 AND T<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ
+ IF T=8 AND T2=8 THEN GOTO EQUAL_Q_HM
- IF T1<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0
+ IF T<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0
GOTO EQUAL_Q_DONE
EQUAL_Q_SEQ:
REM FORCE_SEQ_TYPE(A,T) -> R
FORCE_SEQ_TYPE:
REM if it's already the right type, inc ref cnt and return it
- IF (Z%(A)AND 31)=T THEN R=A:Z%(R)=Z%(R)+32:RETURN
+ IF (Z%(A)AND 31)=T THEN R=A:GOTO INC_REF_R
REM if it's empty, return the empty sequence match T
- IF A<16 THEN R=(T-4)*3:Z%(R)=Z%(R)+32:RETURN
+ IF A<16 THEN R=(T-4)*3:GOTO INC_REF_R
REM otherwise, copy first element to turn it into correct type
B=Z%(A+2): REM value to copy
L=Z%(A+1):M=B:GOSUB ALLOC: REM T already set
MAP_LOOP_START:
REM point to empty sequence to start off
R=(T-4)*3: REM calculate location of empty seq
- Z%(R)=Z%(R)+32
GOSUB PUSH_R: REM push return ptr
GOSUB PUSH_R: REM push empty ptr
GOSUB PUSH_R: REM push current ptr
- RETURN
+ GOTO INC_REF_R
REM MAP_LOOP_UPDATE(C,M):
REM MAP_LOOP_UPDATE(C,M,N):
REM LIST_Q(A) -> R
LIST_Q:
R=0
- IF (Z%(A)AND 31)=6 THEN R=1
+ GOSUB TYPE_A
+ IF T=6 THEN R=1
RETURN
REM EMPTY_Q(A) -> R
GOTO LAST_LOOP
LAST_DONE:
R=Z%(W+2)
- Z%(R)=Z%(R)+32
- RETURN
+ GOTO INC_REF_R
REM SLICE(A,B,C) -> R
REM make copy of sequence A from index B to C
SLICE:
I=0
R=6: REM always a list
- Z%(R)=Z%(R)+32
+ GOSUB INC_REF_R
R6=-1: REM last list element before empty
W=R: REM temporary for return as R
REM advance A to position B
HASHMAP:
REM just point to static empty hash-map
R=12
- Z%(R)=Z%(R)+32
- RETURN
+ GOTO INC_REF_R
REM ASSOC1(H, K, C) -> R
ASSOC1:
R=R3
RETURN
-
-REM function functions
-
-REM NATIVE_FUNCTION(A) -> R
-NATIVE_FUNCTION:
- T=9:L=A:GOSUB ALLOC
- RETURN
-
-REM MAL_FUNCTION(A, B, E) -> R
-MAL_FUNCTION:
- T=10:L=A:M=B:N=E:GOSUB ALLOC
- RETURN
Other temporaries:
A0 : EVAL ast elements
-A1 : EVAL ast elements
-A2 : EVAL ast elements
+A1 : EVAL ast elements, DO_FUNCTION temp
+A2 : EVAL ast elements, DO_FUNCTION temp
A3 : EVAL ast elements
+B1 : DO_FUNCTION temp
CZ : DO_CONCAT stack position
ED : EQUAL_Q recursion depth counter
HCoop / jackhill / mal.git / commitdiff