R=Z%(AR,1)+1:GOSUB DEREF_R:AB=R
REM Switch on the function number
- IF FF>=61 THEN ER=-1:ER$="unknown function"+STR$(FF):RETURN
- IF FF>=53 THEN DO_53
- IF FF>=39 THEN DO_39
- IF FF>=27 THEN DO_27
- IF FF>=18 THEN DO_18
- IF FF>=11 THEN DO_11
-
- ON FF GOTO DO_EQUAL_Q,DO_THROW,DO_NIL_Q,DO_TRUE_Q,DO_FALSE_Q,DO_STRING_Q,DO_SYMBOL,DO_SYMBOL_Q
- DO_11:
- ON FF-10 GOTO DO_PR_STR,DO_STR,DO_PRN,DO_PRINTLN,DO_READ_STRING,DO_READLINE,DO_SLURP
- DO_18:
- ON FF-17 GOTO DO_LT,DO_LTE,DO_GT,DO_GTE,DO_ADD,DO_SUB,DO_MULT,DO_DIV,DO_TIME_MS
- DO_27:
- ON FF-26 GOTO DO_LIST,DO_LIST_Q,DO_VECTOR,DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q
- DO_39:
- ON FF-38 GOTO DO_SEQUENTIAL_Q,DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_APPLY,DO_MAP
- DO_53:
- ON FF-52 GOTO DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_SWAP_BANG,DO_PR_MEMORY,DO_PR_MEMORY_SUMMARY,DO_EVAL
+ IF FF>58 THEN ER=-1:ER$="unknown function"+STR$(FF):RETURN
+ ON FF/10+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59
+
+ DO_1_9:
+ ON FF GOTO DO_EQUAL_Q,DO_THROW,DO_NIL_Q,DO_TRUE_Q,DO_FALSE_Q,DO_STRING_Q,DO_SYMBOL,DO_SYMBOL_Q,DO_KEYWORD
+ DO_10_19:
+ ON FF-9 GOTO DO_KEYWORD_Q,DO_PR_STR,DO_STR,DO_PRN,DO_PRINTLN,DO_READ_STRING,DO_READLINE,DO_SLURP,DO_LT,DO_LTE
+ DO_20_29:
+ ON FF-19 GOTO DO_GT,DO_GTE,DO_ADD,DO_SUB,DO_MULT,DO_DIV,DO_TIME_MS,DO_LIST,DO_LIST_Q,DO_VECTOR
+ DO_30_39:
+ ON FF-29 GOTO DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_THROW,DO_THROW,DO_THROW,DO_THROW,DO_THROW,DO_THROW,DO_SEQUENTIAL_Q
+ DO_40_49:
+ ON FF-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_APPLY,DO_MAP,DO_THROW
+ DO_50_59:
+ ON FF-49 GOTO DO_THROW,DO_THROW,DO_THROW,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_SWAP_BANG,DO_EVAL
DO_EQUAL_Q:
A=AA:B=AB:GOSUB EQUAL_Q
IF (Z%(AA,0)AND15)=4 THEN R=2
RETURN
DO_SYMBOL:
- R=0
+ T=5:L=Z%(AA,1):GOSUB ALLOC
RETURN
DO_SYMBOL_Q:
R=1
IF (Z%(AA,0)AND15)=5 THEN R=2
RETURN
+ DO_KEYWORD:
+ A=Z%(AA,1)
+ AS$=S$(A)
+ IF MID$(AS$,1,1)<>CHR$(127) THEN AS$=CHR$(127)+AS$
+ GOSUB STRING_
+ T=4:L=R:GOSUB ALLOC
+ RETURN
+ DO_KEYWORD_Q:
+ R=1
+ IF (Z%(AA,0)AND15)<>4 THEN RETURN
+ IF MID$(S$(Z%(AA,1)),1,1)<>CHR$(127) THEN RETURN
+ R=2
+ RETURN
DO_PR_STR:
AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
- AS$=R$:T=4+16:GOSUB STRING
+ AS$=R$:T=4:GOSUB STRING
RETURN
DO_STR:
AZ=AR:PR=0:SE$="":GOSUB PR_STR_SEQ
- AS$=R$:T=4+16:GOSUB STRING
+ AS$=R$:T=4:GOSUB STRING
RETURN
DO_PRN:
AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
A$=S$(Z%(AA,1)):GOSUB READLINE
IF EOF=1 THEN EOF=0:R=0:RETURN
AS$=R$:T=4:GOSUB STRING
- Z%(R,0)=Z%(R,0)+16
RETURN
DO_SLURP:
R$=""
GOTO DO_SLURP_LOOP
DO_SLURP_DONE:
CLOSE 1
- AS$=R$:T=4+16:GOSUB STRING
+ AS$=R$:T=4:GOSUB STRING
RETURN
DO_LT:
RETURN
DO_ADD:
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=Z%(AA,1)+Z%(AB,1)
+ T=2:L=Z%(AA,1)+Z%(AB,1):GOSUB ALLOC
RETURN
DO_SUB:
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=Z%(AA,1)-Z%(AB,1)
+ T=2:L=Z%(AA,1)-Z%(AB,1):GOSUB ALLOC
RETURN
DO_MULT:
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=Z%(AA,1)*Z%(AB,1)
+ T=2:L=Z%(AA,1)*Z%(AB,1):GOSUB ALLOC
RETURN
DO_DIV:
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=Z%(AA,1)/Z%(AB,1)
+ T=2:L=Z%(AA,1)/Z%(AB,1):GOSUB ALLOC
RETURN
DO_TIME_MS:
R=0
R=R+1: REM map to mal false/true
RETURN
DO_VECTOR:
- R=0
+ A=AR:T=7:GOSUB FORCE_SEQ_TYPE
RETURN
DO_VECTOR_Q:
R=1
IF (Z%(AA,0)AND15)=7 THEN R=2
RETURN
DO_HASH_MAP:
- R=0
+ A=AR:T=8:GOSUB FORCE_SEQ_TYPE
RETURN
DO_MAP_Q:
R=1
IF (Z%(AA,0)AND15)=6 OR (Z%(AA,0)AND15)=7 THEN R=2
RETURN
DO_CONS:
- A=AA:B=AB:GOSUB CONS
+ T=6:L=AB:N=AA:GOSUB ALLOC
RETURN
DO_CONCAT:
REM if empty arguments, return empty list
REM single argument
IF Z%(Z%(AR,1),1)<>0 THEN GOTO DO_CONCAT_MULT
- REM if single argument and it's a list, return it
- IF (Z%(AA,0)AND15)=6 THEN R=AA:Z%(R,0)=Z%(R,0)+16:RETURN
- REM otherwise, copy first element to turn it into a list
- B=AA+1:GOSUB DEREF_B: REM value to copy
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=Z%(AA,1)
- Z%(R+1,0)=14:Z%(R+1,1)=B
- REM inc ref count of trailing list part and of copied value
- Z%(Z%(AA,1),0)=Z%(Z%(AA,1),0)+16
- Z%(B,0)=Z%(B,0)+16
+ REM force to list type
+ A=AA:T=6:GOSUB FORCE_SEQ_TYPE
RETURN
REM multiple arguments
Z%(R,0)=Z%(R,0)+16
RETURN
DO_FIRST:
+ IF AA=0 THEN R=0:RETURN
IF Z%(AA,1)=0 THEN R=0
IF Z%(AA,1)<>0 THEN R=AA+1:GOSUB DEREF_R
IF R<>0 THEN Z%(R,0)=Z%(R,0)+16
RETURN
DO_REST:
- IF Z%(AA,1)=0 THEN R=AA
- IF Z%(AA,1)<>0 THEN R=Z%(AA,1)
- Z%(R,0)=Z%(R,0)+16
+ IF AA=0 THEN R=3:Z%(R,0)=Z%(R,0)+16:RETURN
+ IF Z%(AA,1)=0 THEN A=AA
+ IF Z%(AA,1)<>0 THEN A=Z%(AA,1)
+ T=6:GOSUB FORCE_SEQ_TYPE
RETURN
DO_EMPTY_Q:
R=1
IF Z%(AA,1)=0 THEN R=2
RETURN
DO_COUNT:
- A=AA:GOSUB COUNT:R4=R
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=R4
+ A=AA:GOSUB COUNT
+ T=2:L=R:GOSUB ALLOC
RETURN
DO_APPLY:
F=AA
AR=Z%(AR,1)
A=AR:GOSUB COUNT:R4=R
+ A=Z%(AR+1,1)
+ REM no intermediate args, but not a list, so convert it first
+ IF R4<=1 AND (Z%(A,0)AND15)<>6 THEN :T=6:GOSUB FORCE_SEQ_TYPE:GOTO DO_APPLY_2
REM no intermediate args, just call APPLY directly
- IF R4<=1 THEN AR=Z%(AR+1,1):GOSUB APPLY:RETURN
+ IF R4<=1 THEN AR=A:GOSUB APPLY:RETURN
REM prepend intermediate args to final args element
A=AR:B=0:C=R4-1:GOSUB SLICE
Z%(R6,1)=Z%(A+1,1)
Z%(Z%(A+1,1),0)=Z%(Z%(A+1,1),0)+16
- X=X+1:S%(X)=R: REM push/save new args for release
- AR=R:GOSUB APPLY
- AY=S%(X):X=X-1:GOSUB RELEASE: REM pop/release new args
- RETURN
+ DO_APPLY_2:
+ X=X+1:S%(X)=R: REM push/save new args for release
+ AR=R:GOSUB APPLY
+ AY=S%(X):X=X-1:GOSUB RELEASE: REM pop/release new args
+ RETURN
DO_MAP:
F=AA
REM first result list element
- SZ=2:GOSUB ALLOC
+ T=6:L=0:N=0:GOSUB ALLOC
REM push future return val, prior entry, F and AB
X=X+4:S%(X-3)=R:S%(X-2)=0:S%(X-1)=F:S%(X)=AB
DO_MAP_LOOP:
- REM set base values
- Z%(R,0)=6+16:Z%(R,1)=0
- Z%(R+1,0)=14:Z%(R+1,1)=0
-
REM set previous to current if not the first element
IF S%(X-2)<>0 THEN Z%(S%(X-2),1)=R
REM update previous reference to current
IF Z%(AB,1)=0 THEN GOTO DO_MAP_DONE
REM create argument list for apply call
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=0
- Z%(R+1,0)=14:Z%(R+1,1)=0
- AR=R: REM save end of list temporarily
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=AR
+ Z%(3,0)=Z%(3,0)+16
REM inc ref cnt of referred argument
- A=Z%(AB+1,1): Z%(A,0)=Z%(A,0)+16
- Z%(R+1,0)=14:Z%(R+1,1)=A
+ T=6:L=3:N=Z%(AB+1,1):GOSUB ALLOC
REM push argument list
X=X+1:S%(X)=R
AB=S%(X)
REM allocate next element
- SZ=2:GOSUB ALLOC
+ T=6:L=0:N=0:GOSUB ALLOC
GOTO DO_MAP_LOOP
RETURN
DO_ATOM:
- SZ=1:GOSUB ALLOC
- Z%(AA,0)=Z%(AA,0)+16: REM inc ref cnt of contained value
- Z%(R,0)=12+16
- Z%(R,1)=AA
+ T=12:L=AA:GOSUB ALLOC
RETURN
DO_ATOM_Q:
R=1
F=AB
REM add atom to front of the args list
- A=Z%(AA,1):B=Z%(Z%(AR,1),1):GOSUB CONS
+ T=6:L=Z%(Z%(AR,1),1):N=Z%(AA,1):GOSUB ALLOC: REM cons
AR=R
REM push args for release after
K$="string?":A=6:GOSUB INIT_CORE_SET_FUNCTION
K$="symbol":A=7:GOSUB INIT_CORE_SET_FUNCTION
K$="symbol?":A=8:GOSUB INIT_CORE_SET_FUNCTION
+ K$="keyword":A=9:GOSUB INIT_CORE_SET_FUNCTION
+ K$="keyword?":A=10:GOSUB INIT_CORE_SET_FUNCTION
K$="pr-str":A=11:GOSUB INIT_CORE_SET_FUNCTION
K$="str":A=12:GOSUB INIT_CORE_SET_FUNCTION
K$="vector?":A=30:GOSUB INIT_CORE_SET_FUNCTION
K$="hash-map":A=31:GOSUB INIT_CORE_SET_FUNCTION
K$="map?":A=32:GOSUB INIT_CORE_SET_FUNCTION
+ K$="assoc":A=33:GOSUB INIT_CORE_SET_FUNCTION
+ K$="dissoc":A=34:GOSUB INIT_CORE_SET_FUNCTION
+ K$="get":A=35:GOSUB INIT_CORE_SET_FUNCTION
+ K$="contains?":A=36:GOSUB INIT_CORE_SET_FUNCTION
+ K$="keys":A=37:GOSUB INIT_CORE_SET_FUNCTION
+ K$="vals":A=38:GOSUB INIT_CORE_SET_FUNCTION
K$="sequential?":A=39:GOSUB INIT_CORE_SET_FUNCTION
K$="cons":A=40:GOSUB INIT_CORE_SET_FUNCTION
K$="apply":A=47:GOSUB INIT_CORE_SET_FUNCTION
K$="map":A=48:GOSUB INIT_CORE_SET_FUNCTION
+ K$="with-meta":A=51:GOSUB INIT_CORE_SET_FUNCTION
+ K$="meta":A=52:GOSUB INIT_CORE_SET_FUNCTION
K$="atom":A=53:GOSUB INIT_CORE_SET_FUNCTION
K$="atom?":A=54:GOSUB INIT_CORE_SET_FUNCTION
K$="deref":A=55:GOSUB INIT_CORE_SET_FUNCTION
K$="reset!":A=56:GOSUB INIT_CORE_SET_FUNCTION
K$="swap!":A=57:GOSUB INIT_CORE_SET_FUNCTION
- K$="pr-memory":A=58:GOSUB INIT_CORE_SET_FUNCTION
- K$="pr-memory-summary":A=59:GOSUB INIT_CORE_SET_FUNCTION
- K$="eval":A=60:GOSUB INIT_CORE_SET_FUNCTION
+ K$="eval":A=58:GOSUB INIT_CORE_SET_FUNCTION
RETURN
+REM CHECK_FREE_LIST
+CHECK_FREE_LIST:
+ REM start and accumulator
+ P1%=ZK
+ P2%=0
+ CHECK_FREE_LIST_LOOP:
+ IF P1%>=ZI THEN GOTO CHECK_FREE_LIST_DONE
+ IF (Z%(P1%,0)AND15)<>15 THEN P2%=-1:GOTO CHECK_FREE_LIST_DONE
+ P2%=P2%+(Z%(P1%,0)AND-16)/16
+ P1%=Z%(P1%,1)
+ GOTO CHECK_FREE_LIST_LOOP
+ CHECK_FREE_LIST_DONE:
+ IF P2%=-1 THEN PRINT "corrupt free list at "+STR$(P1%)
+ RETURN
+
PR_MEMORY_SUMMARY:
GOSUB CHECK_FREE_LIST: REM get count in P2%
PRINT
ENV_NEW:
REM allocate the data hashmap
GOSUB HASHMAP
- ET%=R
+ ET=R
REM set the outer and data pointer
- SZ=2:GOSUB ALLOC
- Z%(R,0)=13+16
- Z%(R,1)=ET%
- Z%(R+1,0)=13
- Z%(R+1,1)=O
- IF O<>-1 THEN Z%(O,0)=Z%(O,0)+16
+ T=13:L=R:N=O:GOSUB ALLOC
+ AY=ET:GOSUB RELEASE: REM environment takes ownership
RETURN
REM see RELEASE types.in.bas for environment cleanup
T=Z%(AZ,0)AND15
REM PRINT "AZ: "+STR$(AZ)+", T: "+STR$(T)+", V: "+STR$(Z%(AZ,1))
IF T=0 THEN R$="nil":RETURN
- ON T GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_MAL_FUNCTION,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE
+ ON T GOTO PR_BOOLEAN,PR_INTEGER,PR_UNKNOWN,PR_STRING_MAYBE,PR_SYMBOL,PR_SEQ,PR_SEQ,PR_SEQ,PR_FUNCTION,PR_MAL_FUNCTION,PR_MAL_FUNCTION,PR_ATOM,PR_ENV,PR_RECUR,PR_FREE
PR_UNKNOWN:
R$="#<unknown>"
REM Remove initial space
R$=RIGHT$(R$, LEN(R$)-1)
RETURN
+ PR_STRING_MAYBE:
+ R$=S$(Z%(AZ,1))
+ IF LEN(R$)=0 THEN GOTO PR_STRING
+ IF MID$(R$,1,1)=CHR$(127) THEN R$=":"+MID$(R$,2,LEN(R$)-1):RETURN
PR_STRING:
IF PR=1 THEN PR_STRING_READABLY
- R$=S$(Z%(AZ,1))
RETURN
PR_STRING_READABLY:
- R$=S$(Z%(AZ,1))
S1$=CHR$(92):S2$=CHR$(92)+CHR$(92):GOSUB REPLACE: REM escape backslash
S1$=CHR$(34):S2$=CHR$(92)+CHR$(34):GOSUB REPLACE: REM escape quotes
S1$=CHR$(13):S2$=CHR$(92)+"n":GOSUB REPLACE: REM escape newlines
IF CH$="-" THEN GOTO READ_SYMBOL_MAYBE
IF CH$=CHR$(34) THEN GOTO READ_STRING
+ IF CH$=":" THEN GOTO READ_KEYWORD
IF CH$="(" THEN T=6:GOTO READ_SEQ
IF CH$=")" THEN T=6:GOTO READ_SEQ_END
IF CH$="[" THEN T=7:GOTO READ_SEQ
GOTO READ_FORM_DONE
READ_NUMBER:
REM PRINT "READ_NUMBER"
- SZ=1:GOSUB ALLOC
- Z%(R,0)=2+16
- Z%(R,1)=VAL(T$)
+ T=2:L=VAL(T$):GOSUB ALLOC
GOTO READ_FORM_DONE
READ_MACRO:
IDX%=IDX%+LEN(T$)
SD=S%(X-1):B2%=S%(X):X=X-2: REM pop SD, pop symbol into B2%
GOSUB LIST2
- AY=B1%:GOSUB RELEASE: REM release value, list has ownership
+ REM release values, list has ownership
+ AY=B1%:GOSUB RELEASE
+ AY=B2%:GOSUB RELEASE
T$=""
GOTO READ_FORM_DONE
S1$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE: REM unescape newlines
S1$=CHR$(92)+CHR$(92):S2$=CHR$(92):GOSUB REPLACE: REM unescape backslashes
REM intern string value
- AS$=R$:T=4+16:GOSUB STRING
+ AS$=R$:T=4:GOSUB STRING
+ GOTO READ_FORM_DONE
+ READ_KEYWORD:
+ R$=CHR$(127)+MID$(T$,2,LEN(T$)-1)
+ AS$=R$:T=4:GOSUB STRING
GOTO READ_FORM_DONE
READ_SYMBOL_MAYBE:
CH$=MID$(T$,2,1)
IF CH$>="0" AND CH$<="9" THEN GOTO READ_NUMBER
READ_SYMBOL:
REM PRINT "READ_SYMBOL"
- AS$=T$:T=5+16:GOSUB STRING
+ AS$=T$:T=5:GOSUB STRING
GOTO READ_FORM_DONE
READ_SEQ:
SD=SD+1: REM increase read sequence depth
REM allocate first sequence entry and space for value
- SZ=2:GOSUB ALLOC
+ L=0:N=0:GOSUB ALLOC: REM T alread set above
REM set reference value/pointer to new embedded sequence
IF SD>1 THEN Z%(S%(X)+1,1)=R
- REM set the type (with 1 ref cnt) and next pointer to current end
- Z%(R,0)=T+16
- Z%(R,1)=0
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM push start ptr on the stack
X=X+1
S%(X)=R
REM PRINT "READ_FORM_DONE next list entry"
REM allocate new sequence entry and space for value
- SZ=2:GOSUB ALLOC
+ REM set type to previous type, with ref count of 1 (from previous)
+ T=S%(X-1):L=0:N=0:GOSUB ALLOC
REM previous element
T7=S%(X)
Z%(T7,1)=R
REM set the list value pointer
Z%(T7+1,1)=T8
- REM set type to previous type, with ref count of 1 (from previous)
- Z%(R,0)=S%(X-1)+16
- Z%(R,1)=0: REM current end of sequence
- Z%(R+1,0)=14
- Z%(R+1,1)=0
IF T7=S%(X-2) THEN GOTO READ_FORM_SKIP_FIRST
Z%(T7,1)=R
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
R=AR+1:GOSUB DEREF_R:AA=Z%(R,1)
R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1)
- REM Allocate the return value
- SZ=1:GOSUB ALLOC
-
REM Switch on the function number
IF FF=1 THEN GOTO DO_ADD
IF FF=2 THEN GOTO DO_SUB
ER=-1:ER$="unknown function"+STR$(FF):RETURN
DO_ADD:
- Z%(R,0)=2+16
- Z%(R,1)=AA+AB
+ T=2:L=AA+AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_SUB:
- Z%(R,0)=2+16
- Z%(R,1)=AA-AB
+ T=2:L=AA-AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_MULT:
- Z%(R,0)=2+16
- Z%(R,1)=AA*AB
+ T=2:L=AA*AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_DIV:
- Z%(R,0)=2+16
- Z%(R,1)=AA/AB
+ T=2:L=AA/AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_FUNCTION_DONE:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
R=AR+1:GOSUB DEREF_R:AA=Z%(R,1)
R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1)
- REM Allocate the return value
- SZ=1:GOSUB ALLOC
-
REM Switch on the function number
IF FF=1 THEN GOTO DO_ADD
IF FF=2 THEN GOTO DO_SUB
ER=-1:ER$="unknown function"+STR$(FF):RETURN
DO_ADD:
- Z%(R,0)=2+16
- Z%(R,1)=AA+AB
+ T=2:L=AA+AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_SUB:
- Z%(R,0)=2+16
- Z%(R,1)=AA-AB
+ T=2:L=AA-AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_MULT:
- Z%(R,0)=2+16
- Z%(R,1)=AA*AB
+ T=2:L=AA*AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_DIV:
- Z%(R,0)=2+16
- Z%(R,1)=AA/AB
+ T=2:L=AA/AB:GOSUB ALLOC
GOTO DO_FUNCTION_DONE
DO_FUNCTION_DONE:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
REM ['quote, ast]
AS$="quote":T=5:GOSUB STRING
B2%=R:B1%=A:GOSUB LIST2
+ AY=B2%:GOSUB RELEASE
RETURN
B1%=T6:GOSUB LIST3
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
QQ_DEFAULT:
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
AY=B2%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
REM ['quote, ast]
AS$="quote":T=5:GOSUB STRING
B2%=R:B1%=A:GOSUB LIST2
+ AY=B2%:GOSUB RELEASE
RETURN
B1%=T6:GOSUB LIST3
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
QQ_DEFAULT:
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
AY=B2%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
REM MACROEXPAND(A, E) -> A:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
REM ['quote, ast]
AS$="quote":T=5:GOSUB STRING
B2%=R:B1%=A:GOSUB LIST2
+ AY=B2%:GOSUB RELEASE
RETURN
B1%=T6:GOSUB LIST3
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
QQ_DEFAULT:
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
AY=B2%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
REM MACROEXPAND(A, E) -> A:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
REM ['quote, ast]
AS$="quote":T=5:GOSUB STRING
B2%=R:B1%=A:GOSUB LIST2
+ AY=B2%:GOSUB RELEASE
RETURN
B1%=T6:GOSUB LIST3
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
QQ_DEFAULT:
REM release inner quasiquoted since outer list takes ownership
AY=B1%:GOSUB RELEASE
AY=B2%:GOSUB RELEASE
+ AY=B3%:GOSUB RELEASE
RETURN
REM MACROEXPAND(A, E) -> A:
GOTO EVAL_AST_RETURN
EVAL_AST_SEQ:
- REM allocate the first entry
- SZ=2:GOSUB ALLOC
+ REM allocate the first entry (T already set above)
+ L=0:N=0:GOSUB ALLOC
REM make space on the stack
X=X+4
S%(X)=R
EVAL_AST_SEQ_LOOP:
- REM set new sequence entry type (with 1 ref cnt)
- Z%(R,0)=S%(X-3)+16
- Z%(R,1)=0
- REM create value ptr placeholder
- Z%(R+1,0)=14
- Z%(R+1,1)=0
-
REM update index
S%(X-2)=S%(X-2)+1
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
REM allocate the next entry
- SZ=2:GOSUB ALLOC
+ REM same new sequence entry type
+ T=S%(X-3):L=0:N=0:GOSUB ALLOC
REM update previous sequence entry value to point to new entry
Z%(S%(X),1)=R
REM string/kw 4 -> S$ index
REM symbol 5 -> S$ index
REM list next/val 6 -> next Z% index (0 for last)
-REM followed by value (unless empty)
+REM followed by 14 and value (unless empty)
REM vector next/val 7 -> next Z% index (0 for last)
-REM followed by value (unless empty)
+REM followed by 14 and value (unless empty)
REM hashmap next/val 8 -> next Z% index (0 for last)
-REM followed by key or value (alternating)
+REM followed by 14 and key/value (alternating)
REM function 9 -> function index
REM mal function 10 -> body AST Z% index
REM followed by param and env Z% index
REM followed by param and env Z% index
REM atom 12 -> Z% index
REM environment 13 -> data/hashmap Z% index
-REM followed by 13 and outer Z% index (-1 for none)
+REM followed by 14 and outer Z% index (-1 for none)
REM reference/ptr 14 -> Z% index / or 0
REM next free ptr 15 -> Z% index / or 0
REM PRINT "Interpreter working memory: "+STR$(FRE(0))
RETURN
+
REM memory functions
-REM ALLOC(SZ) -> R
+REM ALLOC(T,L) -> R
+REM ALLOC(T,L,N) -> R
+REM ALLOC(T,L,M,N) -> R
+REM L is default for Z%(R,1)
+REM M is default for Z%(R+1,0), if relevant for T
+REM N is default for Z%(R+1,1), if relevant for T
ALLOC:
- REM PRINT "ALLOC SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
+ SZ=2
+ IF T<6 OR T=9 OR T=12 OR T>13 THEN SZ=1
+ REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
U3=ZK
U4=ZK
ALLOC_LOOP:
IF U4=ZK THEN ZK=Z%(U4,1)
REM set previous free to next free
IF U4<>ZK THEN Z%(U3,1)=Z%(U4,1)
- RETURN
+ GOTO ALLOC_DONE
ALLOC_UNUSED:
REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U3: "+STR$(U3)+", U4: "+STR$(U4)
R=U4
IF U3=U4 THEN ZK=ZI
REM set previous free to new memory top
IF U3<>U4 THEN Z%(U3,1)=ZI
+ GOTO ALLOC_DONE
+ ALLOC_DONE:
+ Z%(R,0)=T+16
+ REM set Z%(R,1) to default L
+ IF T>=6 AND T<>9 AND L>0 THEN Z%(L,0)=Z%(L,0)+16
+ Z%(R,1)=L
+
+ IF SZ=1 THEN RETURN
+ Z%(R+1,0)=14: REM default for 6-8, and 13
+
+ REM function/macro sets Z%(R+1,0) to default M
+ IF T=10 OR T=11 THEN Z%(M,0)=Z%(M,0)+16:Z%(R+1,0)=M
+
+ REM seq, function/macro, environment sets Z%(R+1,1) to default N
+ IF N>0 THEN Z%(N,0)=Z%(N,0)+16
+ Z%(R+1,1)=N
RETURN
REM FREE(AY, SZ) -> nil
IF (Z%(B,0)AND15)=14 THEN B=Z%(B,1):GOTO DEREF_B
RETURN
-CHECK_FREE_LIST:
- REM start and accumulator
- P1%=ZK
- P2%=0
- CHECK_FREE_LIST_LOOP:
- IF P1%>=ZI THEN GOTO CHECK_FREE_LIST_DONE
- IF (Z%(P1%,0)AND15)<>15 THEN P2%=-1:GOTO CHECK_FREE_LIST_DONE
- P2%=P2%+(Z%(P1%,0)AND-16)/16
- P1%=Z%(P1%,1)
- GOTO CHECK_FREE_LIST_LOOP
- CHECK_FREE_LIST_DONE:
- IF P2%=-1 THEN PRINT "corrupt free list at "+STR$(P1%)
- RETURN
-
REM general functions
GOSUB DEREF_B
R=0
- U1=(Z%(A,0)AND15)
- U2=(Z%(B,0)AND15)
- IF NOT ((U1=U2) OR ((U1=6 OR U1=7) AND (U2=6 OR U2=7))) THEN RETURN
+ U1=Z%(A,0)AND15
+ U2=Z%(B,0)AND15
+ IF NOT (U1=U2 OR ((U1=6 OR U1=7) AND (U2=6 OR U2=7))) THEN RETURN
IF U1=6 THEN GOTO EQUAL_Q_SEQ
IF U1=7 THEN GOTO EQUAL_Q_SEQ
IF U1=8 THEN GOTO EQUAL_Q_HM
REM intern string and allocate reference (return Z% index)
STRING:
GOSUB STRING_
- TS%=R
- SZ=1:GOSUB ALLOC
- Z%(R,0)=T
- Z%(R,1)=TS%
+ L=R:GOSUB ALLOC
RETURN
REM REPLACE(R$, S1$, S2$) -> R$
GOTO REPLACE_LOOP
-REM list functions
+REM sequence functions
+
+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,0)AND15)=T THEN R=A:Z%(R,0)=Z%(R,0)+16:RETURN
+ REM otherwise, copy first element to turn it into correct type
+ B=A+1:GOSUB DEREF_B: REM value to copy
+ L=Z%(A,1):N=B:GOSUB ALLOC: REM T already set
+ IF Z%(A,1)=0 THEN RETURN
+ RETURN
+
REM LIST_Q(A) -> R
LIST_Q:
Z%(R,0)=Z%(R,0)+16
RETURN
-REM CONS(A,B) -> R
-CONS:
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16
- Z%(R,1)=B
- Z%(R+1,0)=14
- Z%(R+1,1)=A
- REM inc ref cnt of item we are including
- Z%(A,0)=Z%(A,0)+16
- REM inc ref cnt of list we are prepending
- Z%(B,0)=Z%(B,0)+16
- RETURN
-
REM SLICE(A,B,C) -> R
REM make copy of sequence A from index B to C
REM returns R6 as reference to last element of slice
R6=0: REM previous list element
SLICE_LOOP:
REM always allocate at least one list element
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=0:Z%(R+1,0)=14:Z%(R+1,1)=0
+ T=6:L=0:N=0:GOSUB ALLOC
IF R5=-1 THEN R5=R
IF R5<>-1 THEN Z%(R6,1)=R
REM advance A to position B
REM LIST2(B2%,B1%) -> R
LIST2:
- REM terminator
- SZ=2:GOSUB ALLOC:TB%=R
- Z%(R,0)=6+16:Z%(R,1)=0:Z%(R+1,0)=0:Z%(R+1,1)=0
-
- REM second element is B1%
- SZ=2:GOSUB ALLOC:TC%=R
- Z%(R,0)=6+16:Z%(R,1)=TB%:Z%(R+1,0)=14:Z%(R+1,1)=B1%
- Z%(B1%,0)=Z%(B1%,0)+16
+ REM last element is 3 (empty list), second element is B1%
+ T=6:L=3:N=B1%:GOSUB ALLOC
REM first element is B2%
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=TC%:Z%(R+1,0)=14:Z%(R+1,1)=B2%
- Z%(B2%,0)=Z%(B2%,0)+16
+ T=6:L=R:N=B2%:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM new list takes ownership of previous
RETURN
REM LIST3(B3%,B2%,B1%) -> R
LIST3:
- GOSUB LIST2:TC%=R
+ GOSUB LIST2
REM first element is B3%
- SZ=2:GOSUB ALLOC
- Z%(R,0)=6+16:Z%(R,1)=TC%:Z%(R+1,0)=14:Z%(R+1,1)=B3%
- Z%(B3%,0)=Z%(B3%,0)+16
+ T=6:L=R:N=B3%:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM new list takes ownership of previous
RETURN
+
REM hashmap functions
REM HASHMAP() -> R
HASHMAP:
- SZ=2:GOSUB ALLOC
- Z%(R,0)=8+16
- Z%(R,1)=0
- Z%(R+1,0)=14
- Z%(R+1,1)=0
+ T=8:L=0:N=0:GOSUB ALLOC
RETURN
REM ASSOC1(H, K, V) -> R
ASSOC1:
- REM deref to actual key and value
- R=K:GOSUB DEREF_R:K=R
+ REM deref K and V
R=V:GOSUB DEREF_R:V=R
+ R=K:GOSUB DEREF_R:K=R
- REM inc ref count of key and value
- Z%(K,0)=Z%(K,0)+16
- Z%(V,0)=Z%(V,0)+16
- SZ=4:GOSUB ALLOC
- REM key ptr
- Z%(R,0)=8+16
- Z%(R,1)=R+2: REM point to next element (value)
- Z%(R+1,0)=14
- Z%(R+1,1)=K
REM value ptr
- Z%(R+2,0)=8+16
- Z%(R+2,1)=H: REM hashmap to assoc onto
- Z%(R+3,0)=14
- Z%(R+3,1)=V
+ T=8:L=H:N=V:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap
+ REM key ptr
+ T=8:L=R:N=K:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap
RETURN
REM ASSOC1(H, K$, V) -> R
ASSOC1_S:
- REM add the key string, then call ASSOC1
- SZ=1:GOSUB ALLOC
- K=R
S$(ZJ)=K$
- Z%(R,0)=4: REM key ref cnt will be inc'd by ASSOC1
- Z%(R,1)=ZJ
+ REM add the key string
+ T=4:L=ZJ:GOSUB ALLOC
ZJ=ZJ+1
- GOSUB ASSOC1
+ K=R:GOSUB ASSOC1
+ AY=K:GOSUB RELEASE: REM map took ownership of key
RETURN
REM HASHMAP_GET(H, K) -> R
R=T3
RETURN
+
+REM function functions
+
REM NATIVE_FUNCTION(A) -> R
NATIVE_FUNCTION:
- SZ=1:GOSUB ALLOC
- Z%(R,0)=9+16
- Z%(R,1)=A
+ T=9:L=A:GOSUB ALLOC
RETURN
REM MAL_FUNCTION(A, P, E) -> R
MAL_FUNCTION:
- SZ=2:GOSUB ALLOC
- Z%(A,0)=Z%(A,0)+16
- Z%(P,0)=Z%(P,0)+16
- Z%(E,0)=Z%(E,0)+16
-
- Z%(R,0)=10+16
- Z%(R,1)=A
- Z%(R+1,0)=P
- Z%(R+1,1)=E
+ T=10:L=A:M=P:N=E:GOSUB ALLOC
RETURN
REM APPLY(F, AR) -> R
H : hash map
K : hash map key (Z% index)
K$ : hash map key string
+L : ALLOC* Z%(R,1) default
+M : ALLOC* Z%(R+1,0) default
+N : ALLOC* Z%(R+1,1) default
O : outer environment
P : MAL_FUNCTION
R : common return value
HCoop / jackhill / mal.git / commitdiff