mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 01:57:09 +03:00
Basic: variable renaming. Save 2 kbytes.
Also, add variables.txt file with start of documenting meanings of variables. List of renamings/savings: ZZ% -> S% : 131 bytes ZL% -> X : 550 bytes A% -> A : 192 bytes E% -> E : 32 bytes R% -> R : 381 bytes AR% -> AR : 30 bytes AY% -> AY : 71 bytes AZ% -> AZ : 33 bytes B% -> B : 47 bytes AA% -> AA : 64 bytes AB% -> AB : 25 bytes F% -> F : 21 bytes FF% -> FF : 14 bytes ER% -> ER : 41 bytes PR% -> PR : 7 bytes T% -> T : 46 bytes R0-9% -> R0-9 : 31 bytes T0-9% -> T0-9 : 42 bytes S1-4% -> S1-4 : 25 bytes U0-9% -> U0-9 : 44 bytes ZK% -> ZK : 10 bytes ZI% -> ZI : 10 bytes RC% -> RC : 16 bytes K%/V% -> K/V : 21 bytes SD% -> SD : 16 bytes ZS$ -> S$ : 40 bytes HM% -> H : 10 bytes SZ% -> SZ : 39 bytes LV% -> LV : 9 bytes EO% -> O : 18 bytes C% -> C : 4 bytes P% -> P : 4 bytes
This commit is contained in:
Joel Martin
parent
30a3d8286f
commit
cc9dbd92e3
@ -1,393 +1,393 @@
|
||||
|
||||
REM DO_FUNCTION(F%, AR%)
|
||||
REM DO_FUNCTION(F, AR)
|
||||
DO_FUNCTION:
|
||||
REM Get the function number
|
||||
FF%=Z%(F%,1)
|
||||
FF=Z%(F,1)
|
||||
|
||||
REM Get argument values
|
||||
R%=AR%+1:GOSUB DEREF_R:AA%=R%
|
||||
R%=Z%(AR%,1)+1:GOSUB DEREF_R:AB%=R%
|
||||
R=AR+1:GOSUB DEREF_R:AA=R
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
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
|
||||
|
||||
DO_EQUAL_Q:
|
||||
A%=AA%:B%=AB%:GOSUB EQUAL_Q
|
||||
R%=R%+1
|
||||
A=AA:B=AB:GOSUB EQUAL_Q
|
||||
R=R+1
|
||||
RETURN
|
||||
DO_THROW:
|
||||
ER%=AA%
|
||||
Z%(ER%,0)=Z%(ER%,0)+16
|
||||
R%=0
|
||||
ER=AA
|
||||
Z%(ER,0)=Z%(ER,0)+16
|
||||
R=0
|
||||
RETURN
|
||||
DO_NIL_Q:
|
||||
R%=1
|
||||
IF AA%=0 THEN R%=2
|
||||
R=1
|
||||
IF AA=0 THEN R=2
|
||||
RETURN
|
||||
DO_TRUE_Q:
|
||||
R%=1
|
||||
IF AA%=2 THEN R%=2
|
||||
R=1
|
||||
IF AA=2 THEN R=2
|
||||
RETURN
|
||||
DO_FALSE_Q:
|
||||
R%=1
|
||||
IF AA%=1 THEN R%=2
|
||||
R=1
|
||||
IF AA=1 THEN R=2
|
||||
RETURN
|
||||
DO_STRING_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=4 THEN R%=2
|
||||
R=1
|
||||
IF (Z%(AA,0)AND15)=4 THEN R=2
|
||||
RETURN
|
||||
DO_SYMBOL:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
DO_SYMBOL_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=5 THEN R%=2
|
||||
R=1
|
||||
IF (Z%(AA,0)AND15)=5 THEN R=2
|
||||
RETURN
|
||||
|
||||
DO_PR_STR:
|
||||
AZ%=AR%:PR%=1:SE$=" ":GOSUB PR_STR_SEQ
|
||||
AS$=R$:T%=4+16:GOSUB STRING
|
||||
AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
|
||||
AS$=R$:T=4+16:GOSUB STRING
|
||||
RETURN
|
||||
DO_STR:
|
||||
AZ%=AR%:PR%=0:SE$="":GOSUB PR_STR_SEQ
|
||||
AS$=R$:T%=4+16:GOSUB STRING
|
||||
AZ=AR:PR=0:SE$="":GOSUB PR_STR_SEQ
|
||||
AS$=R$:T=4+16:GOSUB STRING
|
||||
RETURN
|
||||
DO_PRN:
|
||||
AZ%=AR%:PR%=1:SE$=" ":GOSUB PR_STR_SEQ
|
||||
AZ=AR:PR=1:SE$=" ":GOSUB PR_STR_SEQ
|
||||
PRINT R$
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
DO_PRINTLN:
|
||||
AZ%=AR%:PR%=0:SE$=" ":GOSUB PR_STR_SEQ
|
||||
AZ=AR:PR=0:SE$=" ":GOSUB PR_STR_SEQ
|
||||
PRINT R$
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
DO_READ_STRING:
|
||||
A$=ZS$(Z%(AA%,1))
|
||||
A$=S$(Z%(AA,1))
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
DO_READLINE:
|
||||
A$=ZS$(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
|
||||
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$=""
|
||||
REM OPEN 1,8,2,ZS$(Z%(AA%,1))+",SEQ,R"
|
||||
REM OPEN 1,8,2,ZS$(Z%(AA%,1))
|
||||
OPEN 1,8,0,ZS$(Z%(AA%,1))
|
||||
REM OPEN 1,8,2,S$(Z%(AA,1))+",SEQ,R"
|
||||
REM OPEN 1,8,2,S$(Z%(AA,1))
|
||||
OPEN 1,8,0,S$(Z%(AA,1))
|
||||
DO_SLURP_LOOP:
|
||||
A$=""
|
||||
GET#1,A$
|
||||
IF ASC(A$)=10 THEN R$=R$+CHR$(13)
|
||||
IF (ASC(A$)<>10) AND (A$<>"") THEN R$=R$+A$
|
||||
IF (ST AND 64) THEN GOTO DO_SLURP_DONE
|
||||
IF (ST AND 255) THEN ER%=-1:ER$="File read error "+STR$(ST):RETURN
|
||||
IF (ST AND 255) THEN ER=-1:ER$="File read error "+STR$(ST):RETURN
|
||||
GOTO DO_SLURP_LOOP
|
||||
DO_SLURP_DONE:
|
||||
CLOSE 1
|
||||
AS$=R$:T%=4+16:GOSUB STRING
|
||||
AS$=R$:T=4+16:GOSUB STRING
|
||||
RETURN
|
||||
|
||||
DO_LT:
|
||||
R%=1
|
||||
IF Z%(AA%,1)<Z%(AB%,1) THEN R%=2
|
||||
R=1
|
||||
IF Z%(AA,1)<Z%(AB,1) THEN R=2
|
||||
RETURN
|
||||
DO_LTE:
|
||||
R%=1
|
||||
IF Z%(AA%,1)<=Z%(AB%,1) THEN R%=2
|
||||
R=1
|
||||
IF Z%(AA,1)<=Z%(AB,1) THEN R=2
|
||||
RETURN
|
||||
DO_GT:
|
||||
R%=1
|
||||
IF Z%(AA%,1)>Z%(AB%,1) THEN R%=2
|
||||
R=1
|
||||
IF Z%(AA,1)>Z%(AB,1) THEN R=2
|
||||
RETURN
|
||||
DO_GTE:
|
||||
R%=1
|
||||
IF Z%(AA%,1)>=Z%(AB%,1) THEN R%=2
|
||||
R=1
|
||||
IF Z%(AA,1)>=Z%(AB,1) THEN R=2
|
||||
RETURN
|
||||
|
||||
DO_ADD:
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=Z%(AA%,1)+Z%(AB%,1)
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=Z%(AA,1)+Z%(AB,1)
|
||||
RETURN
|
||||
DO_SUB:
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=Z%(AA%,1)-Z%(AB%,1)
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=Z%(AA,1)-Z%(AB,1)
|
||||
RETURN
|
||||
DO_MULT:
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=Z%(AA%,1)*Z%(AB%,1)
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=Z%(AA,1)*Z%(AB,1)
|
||||
RETURN
|
||||
DO_DIV:
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=Z%(AA%,1)/Z%(AB%,1)
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=Z%(AA,1)/Z%(AB,1)
|
||||
RETURN
|
||||
DO_TIME_MS:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
|
||||
DO_LIST:
|
||||
R%=AR%
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=AR
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
DO_LIST_Q:
|
||||
A%=AA%:GOSUB LIST_Q
|
||||
R%=R%+1: REM map to mal false/true
|
||||
A=AA:GOSUB LIST_Q
|
||||
R=R+1: REM map to mal false/true
|
||||
RETURN
|
||||
DO_VECTOR:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
DO_VECTOR_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=7 THEN R%=2
|
||||
R=1
|
||||
IF (Z%(AA,0)AND15)=7 THEN R=2
|
||||
RETURN
|
||||
DO_HASH_MAP:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
DO_MAP_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=8 THEN R%=2
|
||||
R=1
|
||||
IF (Z%(AA,0)AND15)=8 THEN R=2
|
||||
RETURN
|
||||
|
||||
DO_SEQUENTIAL_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=6 OR (Z%(AA%,0)AND15)=7 THEN R%=2
|
||||
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
|
||||
A=AA:B=AB:GOSUB CONS
|
||||
RETURN
|
||||
DO_CONCAT:
|
||||
REM if empty arguments, return empty list
|
||||
IF Z%(AR%,1)=0 THEN R%=3:Z%(R%,0)=Z%(R%,0)+16:RETURN
|
||||
IF Z%(AR,1)=0 THEN R=3:Z%(R,0)=Z%(R,0)+16:RETURN
|
||||
|
||||
REM single argument
|
||||
IF Z%(Z%(AR%,1),1)<>0 THEN GOTO DO_CONCAT_MULT
|
||||
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
|
||||
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%
|
||||
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
|
||||
Z%(Z%(AA,1),0)=Z%(Z%(AA,1),0)+16
|
||||
Z%(B,0)=Z%(B,0)+16
|
||||
RETURN
|
||||
|
||||
REM multiple arguments
|
||||
DO_CONCAT_MULT:
|
||||
CZ%=ZL%: REM save current stack position
|
||||
CZ%=X: REM save current stack position
|
||||
REM push arguments onto the stack
|
||||
DO_CONCAT_STACK:
|
||||
R%=AR%+1:GOSUB DEREF_R
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push sequence
|
||||
AR%=Z%(AR%,1)
|
||||
IF Z%(AR%,1)<>0 THEN GOTO DO_CONCAT_STACK
|
||||
R=AR+1:GOSUB DEREF_R
|
||||
X=X+1:S%(X)=R: REM push sequence
|
||||
AR=Z%(AR,1)
|
||||
IF Z%(AR,1)<>0 THEN GOTO DO_CONCAT_STACK
|
||||
|
||||
REM pop last argument as our seq to prepend to
|
||||
AB%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
AB=S%(X):X=X-1
|
||||
REM last arg/seq is not copied so we need to inc ref to it
|
||||
Z%(AB%,0)=Z%(AB%,0)+16
|
||||
Z%(AB,0)=Z%(AB,0)+16
|
||||
DO_CONCAT_LOOP:
|
||||
IF ZL%=CZ% THEN R%=AB%:RETURN
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1: REM pop off next seq to prepend
|
||||
IF Z%(AA%,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
|
||||
A%=AA%:B%=0:C%=-1:GOSUB SLICE
|
||||
IF X=CZ% THEN R=AB:RETURN
|
||||
AA=S%(X):X=X-1: REM pop off next seq to prepend
|
||||
IF Z%(AA,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
|
||||
A=AA:B=0:C=-1:GOSUB SLICE
|
||||
|
||||
REM release the terminator of new list (we skip over it)
|
||||
AY%=Z%(R6%,1):GOSUB RELEASE
|
||||
AY=Z%(R6,1):GOSUB RELEASE
|
||||
REM attach new list element before terminator (last actual
|
||||
REM element to the next sequence
|
||||
Z%(R6%,1)=AB%
|
||||
Z%(R6,1)=AB
|
||||
|
||||
AB%=R%
|
||||
AB=R
|
||||
GOTO DO_CONCAT_LOOP
|
||||
DO_NTH:
|
||||
B%=Z%(AB%,1)
|
||||
A%=AA%:GOSUB COUNT
|
||||
IF R%<=B% THEN R%=0:ER%=-1:ER$="nth: index out of range":RETURN
|
||||
B=Z%(AB,1)
|
||||
A=AA:GOSUB COUNT
|
||||
IF R<=B THEN R=0:ER=-1:ER$="nth: index out of range":RETURN
|
||||
DO_NTH_LOOP:
|
||||
IF B%=0 THEN GOTO DO_NTH_DONE
|
||||
B%=B%-1
|
||||
AA%=Z%(AA%,1)
|
||||
IF B=0 THEN GOTO DO_NTH_DONE
|
||||
B=B-1
|
||||
AA=Z%(AA,1)
|
||||
GOTO DO_NTH_LOOP
|
||||
DO_NTH_DONE:
|
||||
R%=Z%(AA%+1,1)
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(AA+1,1)
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
DO_FIRST:
|
||||
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
|
||||
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 Z%(AA,1)=0 THEN R=AA
|
||||
IF Z%(AA,1)<>0 THEN R=Z%(AA,1)
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
DO_EMPTY_Q:
|
||||
R%=1
|
||||
IF Z%(AA%,1)=0 THEN R%=2
|
||||
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:R4=R
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=R4
|
||||
RETURN
|
||||
DO_APPLY:
|
||||
F%=AA%
|
||||
AR%=Z%(AR%,1)
|
||||
A%=AR%:GOSUB COUNT:R4%=R%
|
||||
F=AA
|
||||
AR=Z%(AR,1)
|
||||
A=AR:GOSUB COUNT:R4=R
|
||||
|
||||
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=Z%(AR+1,1):GOSUB APPLY:RETURN
|
||||
|
||||
REM prepend intermediate args to final args element
|
||||
A%=AR%:B%=0:C%=R4%-1:GOSUB SLICE
|
||||
A=AR:B=0:C=R4-1:GOSUB SLICE
|
||||
REM release the terminator of new list (we skip over it)
|
||||
AY%=Z%(R6%,1):GOSUB RELEASE
|
||||
AY=Z%(R6,1):GOSUB RELEASE
|
||||
REM attach end of slice to final args element
|
||||
Z%(R6%,1)=Z%(A%+1,1)
|
||||
Z%(Z%(A%+1,1),0)=Z%(Z%(A%+1,1),0)+16
|
||||
Z%(R6,1)=Z%(A+1,1)
|
||||
Z%(Z%(A+1,1),0)=Z%(Z%(A+1,1),0)+16
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push/save new args for release
|
||||
AR%=R%:GOSUB APPLY
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE: REM pop/release new args
|
||||
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%
|
||||
F=AA
|
||||
|
||||
REM first result list element
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM push future return val, prior entry, F% and AB%
|
||||
ZL%=ZL%+4:ZZ%(ZL%-3)=R%:ZZ%(ZL%-2)=0:ZZ%(ZL%-1)=F%:ZZ%(ZL%)=AB%
|
||||
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
|
||||
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 ZZ%(ZL%-2)<>0 THEN Z%(ZZ%(ZL%-2),1)=R%
|
||||
IF S%(X-2)<>0 THEN Z%(S%(X-2),1)=R
|
||||
REM update previous reference to current
|
||||
ZZ%(ZL%-2)=R%
|
||||
S%(X-2)=R
|
||||
|
||||
IF Z%(AB%,1)=0 THEN GOTO DO_MAP_DONE
|
||||
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%
|
||||
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
|
||||
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%
|
||||
A=Z%(AB+1,1): Z%(A,0)=Z%(A,0)+16
|
||||
Z%(R+1,0)=14:Z%(R+1,1)=A
|
||||
|
||||
REM push argument list
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
AR%=R%:GOSUB APPLY
|
||||
AR=R:GOSUB APPLY
|
||||
|
||||
REM pop apply args are release them
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM set the result value
|
||||
Z%(ZZ%(ZL%-2)+1,1)=R%
|
||||
Z%(S%(X-2)+1,1)=R
|
||||
|
||||
REM restore F%
|
||||
F%=ZZ%(ZL%-1)
|
||||
REM restore F
|
||||
F=S%(X-1)
|
||||
|
||||
REM update AB% to next source element
|
||||
ZZ%(ZL%)=Z%(ZZ%(ZL%),1)
|
||||
AB%=ZZ%(ZL%)
|
||||
REM update AB to next source element
|
||||
S%(X)=Z%(S%(X),1)
|
||||
AB=S%(X)
|
||||
|
||||
REM allocate next element
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
GOTO DO_MAP_LOOP
|
||||
|
||||
DO_MAP_DONE:
|
||||
REM get return val
|
||||
R%=ZZ%(ZL%-3)
|
||||
R=S%(X-3)
|
||||
REM pop everything off stack
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
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%
|
||||
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
|
||||
RETURN
|
||||
DO_ATOM_Q:
|
||||
R%=1
|
||||
IF (Z%(AA%,0)AND15)=12 THEN R%=2
|
||||
R=1
|
||||
IF (Z%(AA,0)AND15)=12 THEN R=2
|
||||
RETURN
|
||||
DO_DEREF:
|
||||
R%=Z%(AA%,1):GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(AA,1):GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
DO_RESET_BANG:
|
||||
R%=AB%
|
||||
R=AB
|
||||
REM release current value
|
||||
AY%=Z%(AA%,1):GOSUB RELEASE
|
||||
AY=Z%(AA,1):GOSUB RELEASE
|
||||
REM inc ref by 2 for atom ownership and since we are returning it
|
||||
Z%(R%,0)=Z%(R%,0)+32
|
||||
Z%(R,0)=Z%(R,0)+32
|
||||
REM update value
|
||||
Z%(AA%,1)=R%
|
||||
Z%(AA,1)=R
|
||||
RETURN
|
||||
DO_SWAP_BANG:
|
||||
F%=AB%
|
||||
F=AB
|
||||
|
||||
REM add atom to front of the args list
|
||||
A%=Z%(AA%,1):B%=Z%(Z%(AR%,1),1):GOSUB CONS
|
||||
AR%=R%
|
||||
A=Z%(AA,1):B=Z%(Z%(AR,1),1):GOSUB CONS
|
||||
AR=R
|
||||
|
||||
REM push args for release after
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AR%
|
||||
X=X+1:S%(X)=AR
|
||||
|
||||
REM push atom
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=AA%
|
||||
X=X+1:S%(X)=AA
|
||||
|
||||
GOSUB APPLY
|
||||
|
||||
REM pop atom
|
||||
AA%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
AA=S%(X):X=X-1
|
||||
|
||||
REM pop and release args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM use reset to update the value
|
||||
AB%=R%:GOSUB DO_RESET_BANG
|
||||
AB=R:GOSUB DO_RESET_BANG
|
||||
|
||||
REM but decrease ref cnt of return by 1 (not sure why)
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
|
||||
RETURN
|
||||
|
||||
@ -399,72 +399,72 @@ DO_FUNCTION:
|
||||
RETURN
|
||||
|
||||
DO_EVAL:
|
||||
A%=AA%:E%=RE%:GOSUB EVAL
|
||||
A=AA:E=RE%:GOSUB EVAL
|
||||
RETURN
|
||||
|
||||
INIT_CORE_SET_FUNCTION:
|
||||
GOSUB NATIVE_FUNCTION
|
||||
V%=R%:GOSUB ENV_SET_S
|
||||
V=R:GOSUB ENV_SET_S
|
||||
RETURN
|
||||
|
||||
REM INIT_CORE_NS(E%)
|
||||
REM INIT_CORE_NS(E)
|
||||
INIT_CORE_NS:
|
||||
REM create the environment mapping
|
||||
REM must match DO_FUNCTION mappings
|
||||
|
||||
K$="=":A%=1:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="throw":A%=2:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="nil?":A%=3:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="true?":A%=4:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="false?":A%=5:GOSUB INIT_CORE_SET_FUNCTION
|
||||
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$="=":A=1:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="throw":A=2:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="nil?":A=3:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="true?":A=4:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="false?":A=5:GOSUB INIT_CORE_SET_FUNCTION
|
||||
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$="pr-str":A%=11:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="str":A%=12:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="prn":A%=13:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="println":A%=14:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="read-string":A%=15:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="readline":A%=16:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="slurp":A%=17: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$="prn":A=13:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="println":A=14:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="read-string":A=15:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="readline":A=16:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="slurp":A=17:GOSUB INIT_CORE_SET_FUNCTION
|
||||
|
||||
K$="<":A%=18:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="<=":A%=19:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$=">":A%=20:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$=">=":A%=21:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="+":A%=22:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="-":A%=23:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="*":A%=24:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="/":A%=25:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="time-ms":A%=26:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="<":A=18:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="<=":A=19:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$=">":A=20:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$=">=":A=21:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="+":A=22:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="-":A=23:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="*":A=24:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="/":A=25:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="time-ms":A=26:GOSUB INIT_CORE_SET_FUNCTION
|
||||
|
||||
K$="list":A%=27:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="list?":A%=28:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="vector":A%=29: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$="list":A=27:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="list?":A=28:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="vector":A=29: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$="sequential?":A%=39:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="cons":A%=40:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="concat":A%=41:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="nth":A%=42:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="first":A%=43:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="rest":A%=44:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="empty?":A%=45:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="count":A%=46:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="apply":A%=47:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="map":A%=48:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="sequential?":A=39:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="cons":A=40:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="concat":A=41:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="nth":A=42:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="first":A=43:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="rest":A=44:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="empty?":A=45:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="count":A=46:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="apply":A=47:GOSUB INIT_CORE_SET_FUNCTION
|
||||
K$="map":A=48: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$="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$="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
|
||||
|
||||
RETURN
|
||||
|
||||
@ -2,20 +2,20 @@ PR_MEMORY_SUMMARY:
|
||||
GOSUB CHECK_FREE_LIST: REM get count in P2%
|
||||
PRINT
|
||||
PRINT "Free memory (FRE) : "+STR$(FRE(0))
|
||||
PRINT "Value memory (Z%) : "+STR$(ZI%-1)+" /"+STR$(S1%)
|
||||
PRINT "Value memory (Z%) : "+STR$(ZI-1)+" /"+STR$(Z1)
|
||||
PRINT " ";
|
||||
PRINT " used:"+STR$(ZI%-1-P2%)+", freed:"+STR$(P2%);
|
||||
PRINT " used:"+STR$(ZI-1-P2%)+", freed:"+STR$(P2%);
|
||||
PRINT ", post repl_env:"+STR$(ZT%)
|
||||
PRINT "String values (ZS$) : "+STR$(ZJ%)+" /"+STR$(S2%)
|
||||
PRINT "Call stack size (ZZ%) : "+STR$(ZL%+1)+" /"+STR$(S3%)
|
||||
PRINT "String values (S$) : "+STR$(ZJ)+" /"+STR$(Z2)
|
||||
PRINT "Call stack size (S%) : "+STR$(X+1)+" /"+STR$(Z3)
|
||||
RETURN
|
||||
|
||||
REM REM PR_MEMORY(P1%, P2%) -> nil
|
||||
REM PR_MEMORY:
|
||||
REM IF P2%<P1% THEN P2%=ZI%-1
|
||||
REM IF P2%<P1% THEN P2%=ZI-1
|
||||
REM PRINT "vvvvvv"
|
||||
REM PRINT "Z% Value Memory"+STR$(P1%)+"->"+STR$(P2%);
|
||||
REM PRINT " (ZI%: "+STR$(ZI%)+", ZK%: "+STR$(ZK%)+"):"
|
||||
REM PRINT " (ZI: "+STR$(ZI)+", ZK: "+STR$(ZK)+"):"
|
||||
REM IF P2%<P1% THEN PRINT " ---":GOTO PR_MEMORY_AFTER_VALUES
|
||||
REM I=P1%
|
||||
REM PR_MEMORY_VALUE_LOOP:
|
||||
@ -24,8 +24,8 @@ REM PRINT " "+STR$(I);
|
||||
REM IF (Z%(I,0)AND15)=15 THEN GOTO PR_MEMORY_FREE
|
||||
REM PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16);
|
||||
REM PRINT ", type: "+STR$(Z%(I,0)AND15)+", value: "+STR$(Z%(I,1));
|
||||
REM IF (Z%(I,0)AND15)=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'";
|
||||
REM IF (Z%(I,0)AND15)=5 THEN PRINT " "+ZS$(Z%(I,1))+"";
|
||||
REM IF (Z%(I,0)AND15)=4 THEN PRINT " '"+S$(Z%(I,1))+"'";
|
||||
REM IF (Z%(I,0)AND15)=5 THEN PRINT " "+S$(Z%(I,1))+"";
|
||||
REM PRINT
|
||||
REM I=I+1
|
||||
REM IF (Z%(I-1,0)AND15)<>10 THEN GOTO PR_MEMORY_VALUE_LOOP
|
||||
@ -35,22 +35,22 @@ REM I=I+1
|
||||
REM GOTO PR_MEMORY_VALUE_LOOP
|
||||
REM PR_MEMORY_FREE:
|
||||
REM PRINT ": FREE size: "+STR$((Z%(I,0)AND-16)/16)+", next: "+STR$(Z%(I,1));
|
||||
REM IF I=ZK% THEN PRINT " (free list start)";
|
||||
REM IF I=ZK THEN PRINT " (free list start)";
|
||||
REM PRINT
|
||||
REM IF (Z%(I,0)AND-16)=32 THEN I=I+1:PRINT " "+STR$(I)+": ---"
|
||||
REM I=I+1
|
||||
REM GOTO PR_MEMORY_VALUE_LOOP
|
||||
REM PR_MEMORY_AFTER_VALUES:
|
||||
REM PRINT "ZS% String Memory (ZJ%: "+STR$(ZJ%)+"):"
|
||||
REM IF ZJ%<=0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STRINGS
|
||||
REM FOR I=0 TO ZJ%-1
|
||||
REM PRINT " "+STR$(I)+": '"+ZS$(I)+"'"
|
||||
REM PRINT "ZS% String Memory (ZJ: "+STR$(ZJ)+"):"
|
||||
REM IF ZJ<=0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STRINGS
|
||||
REM FOR I=0 TO ZJ-1
|
||||
REM PRINT " "+STR$(I)+": '"+S$(I)+"'"
|
||||
REM NEXT I
|
||||
REM PR_MEMORY_SKIP_STRINGS:
|
||||
REM PRINT "ZZ% Stack Memory (ZL%: "+STR$(ZL%)+"):"
|
||||
REM IF ZL%<0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STACK
|
||||
REM FOR I=0 TO ZL%
|
||||
REM PRINT " "+STR$(I)+": "+STR$(ZZ%(I))
|
||||
REM PRINT "S% Stack Memory (X: "+STR$(X)+"):"
|
||||
REM IF X<0 THEN PRINT " ---":GOTO PR_MEMORY_SKIP_STACK
|
||||
REM FOR I=0 TO X
|
||||
REM PRINT " "+STR$(I)+": "+STR$(S%(I))
|
||||
REM NEXT I
|
||||
REM PR_MEMORY_SKIP_STACK:
|
||||
REM PRINT "^^^^^^"
|
||||
@ -60,20 +60,20 @@ REM REM PR_OBJECT(P1%) -> nil
|
||||
REM PR_OBJECT:
|
||||
REM RD%=0
|
||||
REM
|
||||
REM RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=P1%
|
||||
REM RD%=RD%+1:X=X+1:S%(X)=P1%
|
||||
REM
|
||||
REM PR_OBJ_LOOP:
|
||||
REM IF RD%=0 THEN RETURN
|
||||
REM I=ZZ%(ZL%):RD%=RD%-1:ZL%=ZL%-1
|
||||
REM I=S%(X):RD%=RD%-1:X=X-1
|
||||
REM
|
||||
REM P2%=Z%(I,0)AND15
|
||||
REM PRINT " "+STR$(I);
|
||||
REM PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16);
|
||||
REM PRINT ", type: "+STR$(P2%)+", value: "+STR$(Z%(I,1));
|
||||
REM IF P2%=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'";
|
||||
REM IF P2%=5 THEN PRINT " "+ZS$(Z%(I,1))+"";
|
||||
REM IF P2%=4 THEN PRINT " '"+S$(Z%(I,1))+"'";
|
||||
REM IF P2%=5 THEN PRINT " "+S$(Z%(I,1))+"";
|
||||
REM PRINT
|
||||
REM IF P2%<=5 OR P2%=9 THEN GOTO PR_OBJ_LOOP
|
||||
REM IF Z%(I,1)<>0 THEN RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(I,1)
|
||||
REM IF P2%>=6 AND P2%<=8 THEN RD%=RD%+1:ZL%=ZL%+1:ZZ%(ZL%)=I+1
|
||||
REM IF Z%(I,1)<>0 THEN RD%=RD%+1:X=X+1:S%(X)=Z%(I,1)
|
||||
REM IF P2%>=6 AND P2%<=8 THEN RD%=RD%+1:X=X+1:S%(X)=I+1
|
||||
REM GOTO PR_OBJ_LOOP
|
||||
|
||||
@ -1,38 +1,38 @@
|
||||
|
||||
REM ENV_NEW(EO%) -> R%
|
||||
REM ENV_NEW(O) -> R
|
||||
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)=EO%
|
||||
IF EO%<>-1 THEN Z%(EO%,0)=Z%(EO%,0)+16
|
||||
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
|
||||
RETURN
|
||||
|
||||
REM see RELEASE types.in.bas for environment cleanup
|
||||
|
||||
REM ENV_NEW_BINDS(EO%, BI%, EX%) -> R%
|
||||
REM ENV_NEW_BINDS(O, BI%, EX%) -> R
|
||||
ENV_NEW_BINDS:
|
||||
GOSUB ENV_NEW
|
||||
E%=R%
|
||||
E=R
|
||||
REM process bindings
|
||||
ENV_NEW_BINDS_LOOP:
|
||||
IF Z%(BI%,1)=0 THEN R%=E%:RETURN
|
||||
IF Z%(BI%,1)=0 THEN R=E:RETURN
|
||||
REM get/deref the key from BI%
|
||||
R%=BI%+1:GOSUB DEREF_R
|
||||
K%=R%
|
||||
R=BI%+1:GOSUB DEREF_R
|
||||
K=R
|
||||
|
||||
IF ZS$(Z%(K%,1))="&" THEN GOTO EVAL_NEW_BINDS_VARGS
|
||||
IF S$(Z%(K,1))="&" THEN GOTO EVAL_NEW_BINDS_VARGS
|
||||
|
||||
EVAL_NEW_BINDS_1x1:
|
||||
REM get/deref the key from EX%
|
||||
R%=EX%+1:GOSUB DEREF_R
|
||||
V%=R%
|
||||
R=EX%+1:GOSUB DEREF_R
|
||||
V=R
|
||||
REM set the binding in the environment data
|
||||
GOSUB ENV_SET
|
||||
REM go to next element of BI% and EX%
|
||||
@ -43,52 +43,52 @@ ENV_NEW_BINDS:
|
||||
EVAL_NEW_BINDS_VARGS:
|
||||
REM get/deref the key from next element of BI%
|
||||
BI%=Z%(BI%,1)
|
||||
R%=BI%+1:GOSUB DEREF_R
|
||||
K%=R%
|
||||
R=BI%+1:GOSUB DEREF_R
|
||||
K=R
|
||||
REM the value is the remaining list in EX%
|
||||
V%=EX%
|
||||
V=EX%
|
||||
REM set the binding in the environment data
|
||||
GOSUB ENV_SET
|
||||
R%=E%
|
||||
R=E
|
||||
RETURN
|
||||
|
||||
REM ENV_SET(E%, K%, V%) -> R%
|
||||
REM ENV_SET(E, K, V) -> R
|
||||
ENV_SET:
|
||||
HM%=Z%(E%,1)
|
||||
H=Z%(E,1)
|
||||
GOSUB ASSOC1
|
||||
Z%(E%,1)=R%
|
||||
R%=V%
|
||||
Z%(E,1)=R
|
||||
R=V
|
||||
RETURN
|
||||
|
||||
REM ENV_SET_S(E%, K$, V%) -> R%
|
||||
REM ENV_SET_S(E, K$, V) -> R
|
||||
ENV_SET_S:
|
||||
HM%=Z%(E%,1)
|
||||
H=Z%(E,1)
|
||||
GOSUB ASSOC1_S
|
||||
Z%(E%,1)=R%
|
||||
R%=V%
|
||||
Z%(E,1)=R
|
||||
R=V
|
||||
RETURN
|
||||
|
||||
REM ENV_FIND(E%, K%) -> R%
|
||||
REM Returns environment (R%) containing K%. If found, value found is
|
||||
REM in T4%
|
||||
REM ENV_FIND(E, K) -> R
|
||||
REM Returns environment (R) containing K. If found, value found is
|
||||
REM in T4
|
||||
ENV_FIND:
|
||||
EF%=E%
|
||||
EF%=E
|
||||
ENV_FIND_LOOP:
|
||||
HM%=Z%(EF%,1)
|
||||
REM More efficient to use GET for value (R%) and contains? (T3%)
|
||||
H=Z%(EF%,1)
|
||||
REM More efficient to use GET for value (R) and contains? (T3)
|
||||
GOSUB HASHMAP_GET
|
||||
REM if we found it, save value in T4% for ENV_GET
|
||||
IF T3%=1 THEN T4%=R%:GOTO ENV_FIND_DONE
|
||||
REM if we found it, save value in T4 for ENV_GET
|
||||
IF T3=1 THEN T4=R:GOTO ENV_FIND_DONE
|
||||
EF%=Z%(EF%+1,1): REM get outer environment
|
||||
IF EF%<>-1 THEN GOTO ENV_FIND_LOOP
|
||||
ENV_FIND_DONE:
|
||||
R%=EF%
|
||||
R=EF%
|
||||
RETURN
|
||||
|
||||
REM ENV_GET(E%, K%) -> R%
|
||||
REM ENV_GET(E, K) -> R
|
||||
ENV_GET:
|
||||
GOSUB ENV_FIND
|
||||
IF R%=-1 THEN R%=0:ER%=-1:ER$="'"+ZS$(Z%(K%,1))+"' not found":RETURN
|
||||
R%=T4%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
IF R=-1 THEN R=0:ER=-1:ER$="'"+S$(Z%(K,1))+"' not found":RETURN
|
||||
R=T4:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
|
||||
@ -1,105 +1,105 @@
|
||||
REM PR_STR(AZ%, PR%) -> R$
|
||||
REM PR_STR(AZ, PR) -> R$
|
||||
PR_STR:
|
||||
RR$=""
|
||||
PR_STR_RECUR:
|
||||
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
|
||||
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
|
||||
|
||||
PR_UNKNOWN:
|
||||
R$="#<unknown>"
|
||||
RETURN
|
||||
PR_RECUR:
|
||||
AZ%=Z%(AZ%,1)
|
||||
AZ=Z%(AZ,1)
|
||||
GOTO PR_STR_RECUR
|
||||
PR_BOOLEAN:
|
||||
R$="true"
|
||||
IF Z%(AZ%,1)=0 THEN R$="false"
|
||||
IF Z%(AZ,1)=0 THEN R$="false"
|
||||
RETURN
|
||||
PR_INTEGER:
|
||||
T5%=Z%(AZ%,1)
|
||||
R$=STR$(T5%)
|
||||
IF T5%<0 THEN RETURN
|
||||
T5=Z%(AZ,1)
|
||||
R$=STR$(T5)
|
||||
IF T5<0 THEN RETURN
|
||||
REM Remove initial space
|
||||
R$=RIGHT$(R$, LEN(R$)-1)
|
||||
RETURN
|
||||
PR_STRING:
|
||||
IF PR%=1 THEN PR_STRING_READABLY
|
||||
R$=ZS$(Z%(AZ%,1))
|
||||
IF PR=1 THEN PR_STRING_READABLY
|
||||
R$=S$(Z%(AZ,1))
|
||||
RETURN
|
||||
PR_STRING_READABLY:
|
||||
R$=ZS$(Z%(AZ%,1))
|
||||
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
|
||||
R$=CHR$(34)+R$+CHR$(34)
|
||||
RETURN
|
||||
PR_SYMBOL:
|
||||
R$=ZS$(Z%(AZ%,1))
|
||||
R$=S$(Z%(AZ,1))
|
||||
RETURN
|
||||
PR_SEQ:
|
||||
IF T%=6 THEN RR$=RR$+"("
|
||||
IF T%=7 THEN RR$=RR$+"["
|
||||
IF T%=8 THEN RR$=RR$+"{"
|
||||
IF T=6 THEN RR$=RR$+"("
|
||||
IF T=7 THEN RR$=RR$+"["
|
||||
IF T=8 THEN RR$=RR$+"{"
|
||||
REM push the type and where we are in the sequence
|
||||
ZL%=ZL%+2
|
||||
ZZ%(ZL%-1)=T%
|
||||
ZZ%(ZL%)=AZ%
|
||||
X=X+2
|
||||
S%(X-1)=T
|
||||
S%(X)=AZ
|
||||
PR_SEQ_LOOP:
|
||||
IF Z%(AZ%,1)=0 THEN PR_SEQ_DONE
|
||||
AZ%=AZ%+1
|
||||
IF Z%(AZ,1)=0 THEN PR_SEQ_DONE
|
||||
AZ=AZ+1
|
||||
GOSUB PR_STR_RECUR
|
||||
REM if we just rendered a non-sequence, then append it
|
||||
IF T%<6 OR T%>8 THEN RR$=RR$+R$
|
||||
IF T<6 OR T>8 THEN RR$=RR$+R$
|
||||
REM restore current seq type
|
||||
T%=ZZ%(ZL%-1)
|
||||
T=S%(X-1)
|
||||
REM Go to next list element
|
||||
AZ%=Z%(ZZ%(ZL%),1)
|
||||
ZZ%(ZL%)=AZ%
|
||||
IF Z%(AZ%,1)<>0 THEN RR$=RR$+" "
|
||||
AZ=Z%(S%(X),1)
|
||||
S%(X)=AZ
|
||||
IF Z%(AZ,1)<>0 THEN RR$=RR$+" "
|
||||
GOTO PR_SEQ_LOOP
|
||||
PR_SEQ_DONE:
|
||||
REM get type
|
||||
T%=ZZ%(ZL%-1)
|
||||
T=S%(X-1)
|
||||
REM pop where we are the sequence and type
|
||||
ZL%=ZL%-2
|
||||
IF T%=6 THEN RR$=RR$+")"
|
||||
IF T%=7 THEN RR$=RR$+"]"
|
||||
IF T%=8 THEN RR$=RR$+"}"
|
||||
X=X-2
|
||||
IF T=6 THEN RR$=RR$+")"
|
||||
IF T=7 THEN RR$=RR$+"]"
|
||||
IF T=8 THEN RR$=RR$+"}"
|
||||
R$=RR$
|
||||
RETURN
|
||||
PR_FUNCTION:
|
||||
T1%=Z%(AZ%,1)
|
||||
R$="#<function"+STR$(T1%)+">"
|
||||
T1=Z%(AZ,1)
|
||||
R$="#<function"+STR$(T1)+">"
|
||||
RETURN
|
||||
PR_MAL_FUNCTION:
|
||||
T1%=AZ%
|
||||
AZ%=Z%(T1%+1,0):GOSUB PR_STR_RECUR
|
||||
T1=AZ
|
||||
AZ=Z%(T1+1,0):GOSUB PR_STR_RECUR
|
||||
T7$="(fn* "+R$
|
||||
AZ%=Z%(T1%,1):GOSUB PR_STR_RECUR
|
||||
AZ=Z%(T1,1):GOSUB PR_STR_RECUR
|
||||
R$=T7$+" "+R$+")"
|
||||
RETURN
|
||||
PR_ATOM:
|
||||
AZ%=Z%(AZ%,1):GOSUB PR_STR_RECUR
|
||||
AZ=Z%(AZ,1):GOSUB PR_STR_RECUR
|
||||
R$="(atom "+R$+")"
|
||||
RETURN
|
||||
PR_ENV:
|
||||
R$="#<env"+STR$(AZ%)+", data"+STR$(Z%(AZ%,1))+">"
|
||||
R$="#<env"+STR$(AZ)+", data"+STR$(Z%(AZ,1))+">"
|
||||
RETURN
|
||||
PR_FREE:
|
||||
R$="#<free memory "+STR$(AZ%)+", next"+STR$(Z%(AZ%,1))+">"
|
||||
R$="#<free memory "+STR$(AZ)+", next"+STR$(Z%(AZ,1))+">"
|
||||
RETURN
|
||||
|
||||
REM PR_STR_SEQ(AZ%, PR%, SE$) -> R$
|
||||
REM PR_STR_SEQ(AZ, PR, SE$) -> R$
|
||||
PR_STR_SEQ:
|
||||
T9%=AZ%
|
||||
T9=AZ
|
||||
R1$=""
|
||||
PR_STR_SEQ_LOOP:
|
||||
IF Z%(T9%,1)=0 THEN R$=R1$:RETURN
|
||||
AZ%=T9%+1:GOSUB PR_STR
|
||||
IF Z%(T9,1)=0 THEN R$=R1$:RETURN
|
||||
AZ=T9+1:GOSUB PR_STR
|
||||
REM goto the next sequence element
|
||||
T9%=Z%(T9%,1)
|
||||
IF Z%(T9%,1)=0 THEN R1$=R1$+R$
|
||||
IF Z%(T9%,1)<>0 THEN R1$=R1$+R$+SE$
|
||||
T9=Z%(T9,1)
|
||||
IF Z%(T9,1)=0 THEN R1$=R1$+R$
|
||||
IF Z%(T9,1)<>0 THEN R1$=R1$+R$+SE$
|
||||
GOTO PR_STR_SEQ_LOOP
|
||||
|
||||
@ -33,20 +33,20 @@ SKIP_SPACES:
|
||||
|
||||
|
||||
READ_ATOM:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
|
||||
REM READ_FORM(A$, IDX%) -> R%
|
||||
REM READ_FORM(A$, IDX%) -> R
|
||||
READ_FORM:
|
||||
IF ER%<>-2 THEN RETURN
|
||||
IF ER<>-2 THEN RETURN
|
||||
GOSUB SKIP_SPACES
|
||||
GOSUB READ_TOKEN
|
||||
IF T$="" AND SD%>0 THEN ER$="unexpected EOF":GOTO READ_FORM_ABORT
|
||||
IF T$="" AND SD>0 THEN ER$="unexpected EOF":GOTO READ_FORM_ABORT
|
||||
REM PRINT "READ_FORM T$: ["+T$+"]"
|
||||
IF T$="" THEN R%=0:GOTO READ_FORM_DONE
|
||||
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
|
||||
IF T$="" THEN R=0:GOTO READ_FORM_DONE
|
||||
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
|
||||
IF T$="'" THEN AS$="quote":GOTO READ_MACRO
|
||||
IF T$="`" THEN AS$="quasiquote":GOTO READ_MACRO
|
||||
IF T$="~" THEN AS$="unquote":GOTO READ_MACRO
|
||||
@ -54,17 +54,17 @@ READ_FORM:
|
||||
IF T$="@" THEN AS$="deref":GOTO READ_MACRO
|
||||
CH$=MID$(T$,1,1)
|
||||
REM PRINT "CH$: ["+CH$+"]("+STR$(ASC(CH$))+")"
|
||||
IF (CH$=";") THEN R%=0:GOTO READ_TO_EOL
|
||||
IF (CH$=";") THEN R=0:GOTO READ_TO_EOL
|
||||
IF CH$>="0" AND CH$<="9" THEN GOTO READ_NUMBER
|
||||
IF CH$="-" THEN GOTO READ_SYMBOL_MAYBE
|
||||
|
||||
IF CH$=CHR$(34) THEN GOTO READ_STRING
|
||||
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
|
||||
IF CH$="]" THEN T%=7:GOTO READ_SEQ_END
|
||||
IF CH$="{" THEN T%=8:GOTO READ_SEQ
|
||||
IF CH$="}" THEN T%=8:GOTO READ_SEQ_END
|
||||
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
|
||||
IF CH$="]" THEN T=7:GOTO READ_SEQ_END
|
||||
IF CH$="{" THEN T=8:GOTO READ_SEQ
|
||||
IF CH$="}" THEN T=8:GOTO READ_SEQ_END
|
||||
GOTO READ_SYMBOL
|
||||
|
||||
READ_TO_EOL:
|
||||
@ -74,27 +74,27 @@ READ_FORM:
|
||||
GOTO READ_TO_EOL
|
||||
READ_NIL_BOOL:
|
||||
REM PRINT "READ_NIL_BOOL"
|
||||
R%=T%
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=T
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO READ_FORM_DONE
|
||||
READ_NUMBER:
|
||||
REM PRINT "READ_NUMBER"
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=VAL(T$)
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=VAL(T$)
|
||||
GOTO READ_FORM_DONE
|
||||
READ_MACRO:
|
||||
IDX%=IDX%+LEN(T$)
|
||||
T%=5:GOSUB STRING: REM AS$ set above
|
||||
T=5:GOSUB STRING: REM AS$ set above
|
||||
|
||||
REM to call READ_FORM recursively, SD% needs to be saved, set to
|
||||
REM to call READ_FORM recursively, SD needs to be saved, set to
|
||||
REM 0 for the call and then restored afterwards.
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=SD%:ZZ%(ZL%)=R%: REM push SD% and symbol
|
||||
SD%=0:GOSUB READ_FORM:B1%=R%
|
||||
SD%=ZZ%(ZL%-1):B2%=ZZ%(ZL%):ZL%=ZL%-2: REM pop SD%, pop symbol into B2%
|
||||
X=X+2:S%(X-1)=SD:S%(X)=R: REM push SD and symbol
|
||||
SD=0:GOSUB READ_FORM:B1%=R
|
||||
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
|
||||
AY=B1%:GOSUB RELEASE: REM release value, list has ownership
|
||||
|
||||
T$=""
|
||||
GOTO READ_FORM_DONE
|
||||
@ -107,102 +107,102 @@ READ_FORM:
|
||||
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+16: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+16:GOSUB STRING
|
||||
GOTO READ_FORM_DONE
|
||||
|
||||
READ_SEQ:
|
||||
REM PRINT "READ_SEQ"
|
||||
SD%=SD%+1: REM increase read sequence depth
|
||||
SD=SD+1: REM increase read sequence depth
|
||||
|
||||
REM allocate first sequence entry and space for value
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM set reference value/pointer to new embedded sequence
|
||||
IF SD%>1 THEN Z%(ZZ%(ZL%)+1,1)=R%
|
||||
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
|
||||
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
|
||||
ZL%=ZL%+1
|
||||
ZZ%(ZL%)=R%
|
||||
X=X+1
|
||||
S%(X)=R
|
||||
REM push current sequence type
|
||||
ZL%=ZL%+1
|
||||
ZZ%(ZL%)=T%
|
||||
X=X+1
|
||||
S%(X)=T
|
||||
REM push previous ptr on the stack
|
||||
ZL%=ZL%+1
|
||||
ZZ%(ZL%)=R%
|
||||
X=X+1
|
||||
S%(X)=R
|
||||
|
||||
IDX%=IDX%+LEN(T$)
|
||||
GOTO READ_FORM
|
||||
|
||||
READ_SEQ_END:
|
||||
REM PRINT "READ_SEQ_END"
|
||||
IF SD%=0 THEN ER$="unexpected '"+CH$+"'":GOTO READ_FORM_ABORT
|
||||
IF ZZ%(ZL%-1)<>T% THEN ER$="sequence mismatch":GOTO READ_FORM_ABORT
|
||||
SD%=SD%-1: REM decrease read sequence depth
|
||||
R%=ZZ%(ZL%-2): REM ptr to start of sequence to return
|
||||
T%=ZZ%(ZL%-1): REM type prior to recur
|
||||
ZL%=ZL%-3: REM pop previous, type, and start off the stack
|
||||
IF SD=0 THEN ER$="unexpected '"+CH$+"'":GOTO READ_FORM_ABORT
|
||||
IF S%(X-1)<>T THEN ER$="sequence mismatch":GOTO READ_FORM_ABORT
|
||||
SD=SD-1: REM decrease read sequence depth
|
||||
R=S%(X-2): REM ptr to start of sequence to return
|
||||
T=S%(X-1): REM type prior to recur
|
||||
X=X-3: REM pop previous, type, and start off the stack
|
||||
GOTO READ_FORM_DONE
|
||||
|
||||
|
||||
READ_FORM_DONE:
|
||||
IDX%=IDX%+LEN(T$)
|
||||
|
||||
T8%=R%: REM save previous value
|
||||
T8=R: REM save previous value
|
||||
|
||||
REM check read sequence depth
|
||||
IF SD%=0 THEN RETURN
|
||||
IF SD=0 THEN RETURN
|
||||
REM PRINT "READ_FORM_DONE next list entry"
|
||||
|
||||
REM allocate new sequence entry and space for value
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM previous element
|
||||
T7%=ZZ%(ZL%)
|
||||
T7=S%(X)
|
||||
REM set previous list element to point to new element
|
||||
Z%(T7%,1)=R%
|
||||
Z%(T7,1)=R
|
||||
REM set the list value pointer
|
||||
Z%(T7%+1,1)=T8%
|
||||
Z%(T7+1,1)=T8
|
||||
REM set type to previous type, with ref count of 1 (from previous)
|
||||
Z%(R%,0)=ZZ%(ZL%-1)+16
|
||||
Z%(R%,1)=0: REM current end of sequence
|
||||
Z%(R%+1,0)=14
|
||||
Z%(R%+1,1)=0
|
||||
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%=ZZ%(ZL%-2) THEN GOTO READ_FORM_SKIP_FIRST
|
||||
Z%(T7%,1)=R%
|
||||
IF T7=S%(X-2) THEN GOTO READ_FORM_SKIP_FIRST
|
||||
Z%(T7,1)=R
|
||||
|
||||
READ_FORM_SKIP_FIRST:
|
||||
REM update previous pointer to current element
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
GOTO READ_FORM
|
||||
|
||||
READ_FORM_ABORT:
|
||||
ER%=-1
|
||||
R%=0
|
||||
ER=-1
|
||||
R=0
|
||||
READ_FORM_ABORT_UNWIND:
|
||||
IF SD%=0 THEN RETURN
|
||||
ZL%=ZL%-3: REM pop previous, type, and start off the stack
|
||||
SD%=SD%-1
|
||||
IF SD%=0 THEN AY%=ZZ%(ZL%+1):GOSUB RELEASE
|
||||
IF SD=0 THEN RETURN
|
||||
X=X-3: REM pop previous, type, and start off the stack
|
||||
SD=SD-1
|
||||
IF SD=0 THEN AY=S%(X+1):GOSUB RELEASE
|
||||
GOTO READ_FORM_ABORT_UNWIND
|
||||
|
||||
|
||||
REM READ_STR(A$) -> R%
|
||||
REM READ_STR(A$) -> R
|
||||
READ_STR:
|
||||
IDX%=1
|
||||
SD%=0: REM sequence read depth
|
||||
SD=0: REM sequence read depth
|
||||
GOSUB READ_FORM
|
||||
RETURN
|
||||
|
||||
@ -7,7 +7,7 @@ MAL_READ:
|
||||
R$=A$
|
||||
RETURN
|
||||
|
||||
REM EVAL(A$, E%) -> R$
|
||||
REM EVAL(A$, E) -> R$
|
||||
EVAL:
|
||||
R$=A$
|
||||
RETURN
|
||||
@ -20,8 +20,8 @@ MAL_PRINT:
|
||||
REM REP(A$) -> R$
|
||||
REP:
|
||||
GOSUB MAL_READ
|
||||
A%=R%:GOSUB EVAL
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB EVAL
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RETURN
|
||||
|
||||
REM MAIN program
|
||||
|
||||
@ -7,35 +7,35 @@ REM $INCLUDE: 'printer.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%) -> R%
|
||||
REM EVAL(A, E) -> R
|
||||
EVAL:
|
||||
R%=A%
|
||||
R=A
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REP:
|
||||
GOSUB MAL_READ
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB EVAL
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:GOSUB EVAL
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from EVAL
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -43,7 +43,7 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -51,7 +51,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -62,6 +62,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -7,233 +7,233 @@ REM $INCLUDE: 'printer.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
EVAL_AST:
|
||||
LV%=LV%+1
|
||||
LV=LV+1
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
HM%=E%:K%=A%:GOSUB HASHMAP_GET
|
||||
H=E:K=A:GOSUB HASHMAP_GET
|
||||
GOSUB DEREF_R
|
||||
IF T3%=0 THEN ER%=-1:ER$="'"+ZS$(Z%(A%,1))+"' not found":GOTO EVAL_AST_RETURN
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
IF T3=0 THEN ER=-1:ER$="'"+S$(Z%(A,1))+"' not found":GOTO EVAL_AST_RETURN
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM get return value (new seq), index, and seq type
|
||||
R%=ZZ%(ZL%-1)
|
||||
R=S%(X-1)
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
LV%=LV%-1
|
||||
LV=LV-1
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
GOSUB EVAL_AST
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
GOSUB EVAL_AST
|
||||
R3%=R%
|
||||
R3=R
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
F%=R%+1
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
IF (Z%(F%,0)AND15)<>9 THEN ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
IF (Z%(F,0)AND15)<>9 THEN ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
GOSUB DO_FUNCTION
|
||||
AY%=R3%:GOSUB RELEASE
|
||||
AY=R3:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_RETURN:
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM DO_FUNCTION(F%, AR%)
|
||||
REM DO_FUNCTION(F, AR)
|
||||
DO_FUNCTION:
|
||||
AZ%=F%:GOSUB PR_STR
|
||||
AZ=F:GOSUB PR_STR
|
||||
F$=R$
|
||||
AZ%=AR%:GOSUB PR_STR
|
||||
AZ=AR:GOSUB PR_STR
|
||||
AR$=R$
|
||||
|
||||
REM Get the function number
|
||||
FF%=Z%(F%,1)
|
||||
FF=Z%(F,1)
|
||||
|
||||
REM Get argument values
|
||||
R%=AR%+1:GOSUB DEREF_R:AA%=Z%(R%,1)
|
||||
R%=Z%(AR%,1)+1:GOSUB DEREF_R:AB%=Z%(R%,1)
|
||||
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
|
||||
SZ=1:GOSUB ALLOC
|
||||
|
||||
REM Switch on the function number
|
||||
IF FF%=1 THEN GOTO DO_ADD
|
||||
IF FF%=2 THEN GOTO DO_SUB
|
||||
IF FF%=3 THEN GOTO DO_MULT
|
||||
IF FF%=4 THEN GOTO DO_DIV
|
||||
ER%=-1:ER$="unknown function"+STR$(FF%):RETURN
|
||||
IF FF=1 THEN GOTO DO_ADD
|
||||
IF FF=2 THEN GOTO DO_SUB
|
||||
IF FF=3 THEN GOTO DO_MULT
|
||||
IF FF=4 THEN GOTO DO_DIV
|
||||
ER=-1:ER$="unknown function"+STR$(FF):RETURN
|
||||
|
||||
DO_ADD:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%+AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA+AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_SUB:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%-AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA-AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_MULT:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%*AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA*AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_DIV:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%/AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA/AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
|
||||
DO_FUNCTION_DONE:
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -241,28 +241,28 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
GOSUB HASHMAP:RE%=R%
|
||||
GOSUB HASHMAP:RE%=R
|
||||
|
||||
REM + function
|
||||
A%=1:GOSUB NATIVE_FUNCTION
|
||||
HM%=RE%:K$="+":V%=R%:GOSUB ASSOC1_S:RE%=R%
|
||||
A=1:GOSUB NATIVE_FUNCTION
|
||||
H=RE%:K$="+":V=R:GOSUB ASSOC1_S:RE%=R
|
||||
|
||||
REM - function
|
||||
A%=2:GOSUB NATIVE_FUNCTION
|
||||
HM%=RE%:K$="-":V%=R%:GOSUB ASSOC1_S:RE%=R%
|
||||
A=2:GOSUB NATIVE_FUNCTION
|
||||
H=RE%:K$="-":V=R:GOSUB ASSOC1_S:RE%=R
|
||||
|
||||
REM * function
|
||||
A%=3:GOSUB NATIVE_FUNCTION
|
||||
HM%=RE%:K$="*":V%=R%:GOSUB ASSOC1_S:RE%=R%
|
||||
A=3:GOSUB NATIVE_FUNCTION
|
||||
H=RE%:K$="*":V=R:GOSUB ASSOC1_S:RE%=R
|
||||
|
||||
REM / function
|
||||
A%=4:GOSUB NATIVE_FUNCTION
|
||||
HM%=RE%:K$="/":V%=R%:GOSUB ASSOC1_S:RE%=R%
|
||||
A=4:GOSUB NATIVE_FUNCTION
|
||||
H=RE%:K$="/":V=R:GOSUB ASSOC1_S:RE%=R
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -270,7 +270,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -281,6 +281,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -8,302 +8,302 @@ REM $INCLUDE: 'env.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
EVAL_AST:
|
||||
LV%=LV%+1
|
||||
LV=LV+1
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
LV%=LV%-1
|
||||
LV=LV-1
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
GOSUB EVAL_AST
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
GOTO EVAL_RETURN
|
||||
EVAL_INVOKE:
|
||||
GOSUB EVAL_AST
|
||||
R3%=R%
|
||||
R3=R
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
F%=R%+1
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
IF (Z%(F%,0)AND15)<>9 THEN ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
IF (Z%(F,0)AND15)<>9 THEN ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
GOSUB DO_FUNCTION
|
||||
AY%=R3%:GOSUB RELEASE
|
||||
AY=R3:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM DO_FUNCTION(F%, AR%)
|
||||
REM DO_FUNCTION(F, AR)
|
||||
DO_FUNCTION:
|
||||
AZ%=F%:GOSUB PR_STR
|
||||
AZ=F:GOSUB PR_STR
|
||||
F$=R$
|
||||
AZ%=AR%:GOSUB PR_STR
|
||||
AZ=AR:GOSUB PR_STR
|
||||
AR$=R$
|
||||
|
||||
REM Get the function number
|
||||
FF%=Z%(F%,1)
|
||||
FF=Z%(F,1)
|
||||
|
||||
REM Get argument values
|
||||
R%=AR%+1:GOSUB DEREF_R:AA%=Z%(R%,1)
|
||||
R%=Z%(AR%,1)+1:GOSUB DEREF_R:AB%=Z%(R%,1)
|
||||
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
|
||||
SZ=1:GOSUB ALLOC
|
||||
|
||||
REM Switch on the function number
|
||||
IF FF%=1 THEN GOTO DO_ADD
|
||||
IF FF%=2 THEN GOTO DO_SUB
|
||||
IF FF%=3 THEN GOTO DO_MULT
|
||||
IF FF%=4 THEN GOTO DO_DIV
|
||||
ER%=-1:ER$="unknown function"+STR$(FF%):RETURN
|
||||
IF FF=1 THEN GOTO DO_ADD
|
||||
IF FF=2 THEN GOTO DO_SUB
|
||||
IF FF=3 THEN GOTO DO_MULT
|
||||
IF FF=4 THEN GOTO DO_DIV
|
||||
ER=-1:ER$="unknown function"+STR$(FF):RETURN
|
||||
|
||||
DO_ADD:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%+AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA+AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_SUB:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%-AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA-AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_MULT:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%*AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA*AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
DO_DIV:
|
||||
Z%(R%,0)=2+16
|
||||
Z%(R%,1)=AA%/AB%
|
||||
Z%(R,0)=2+16
|
||||
Z%(R,1)=AA/AB
|
||||
GOTO DO_FUNCTION_DONE
|
||||
|
||||
DO_FUNCTION_DONE:
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -311,29 +311,29 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
E%=RE%
|
||||
E=RE%
|
||||
REM + function
|
||||
A%=1:GOSUB NATIVE_FUNCTION
|
||||
K$="+":V%=R%:GOSUB ENV_SET_S
|
||||
A=1:GOSUB NATIVE_FUNCTION
|
||||
K$="+":V=R:GOSUB ENV_SET_S
|
||||
|
||||
REM - function
|
||||
A%=2:GOSUB NATIVE_FUNCTION
|
||||
K$="-":V%=R%:GOSUB ENV_SET_S
|
||||
A=2:GOSUB NATIVE_FUNCTION
|
||||
K$="-":V=R:GOSUB ENV_SET_S
|
||||
|
||||
REM * function
|
||||
A%=3:GOSUB NATIVE_FUNCTION
|
||||
K$="*":V%=R%:GOSUB ENV_SET_S
|
||||
A=3:GOSUB NATIVE_FUNCTION
|
||||
K$="*":V=R:GOSUB ENV_SET_S
|
||||
|
||||
REM / function
|
||||
A%=4:GOSUB NATIVE_FUNCTION
|
||||
K$="/":V%=R%:GOSUB ENV_SET_S
|
||||
A=4:GOSUB NATIVE_FUNCTION
|
||||
K$="/":V=R:GOSUB ENV_SET_S
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -341,7 +341,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -352,6 +352,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -9,136 +9,136 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -146,14 +146,14 @@ EVAL:
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -163,159 +163,159 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOSUB EVAL: REM eval a2 using let_env
|
||||
GOTO EVAL_RETURN
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -323,51 +323,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -375,19 +375,19 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -395,7 +395,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -406,6 +406,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -9,136 +9,136 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -146,14 +146,14 @@ EVAL:
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -163,168 +163,168 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -332,51 +332,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -384,19 +384,19 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -404,7 +404,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -415,6 +415,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -9,136 +9,136 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -146,14 +146,14 @@ EVAL:
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -163,168 +163,168 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -332,51 +332,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -384,46 +384,46 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
IF R<>0 THEN AY=R:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL_LOOP
|
||||
IF R=0 THEN GOTO REPL_LOOP
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL_LOOP:
|
||||
@ -432,7 +432,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -443,6 +443,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -11,207 +11,207 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM PAIR_Q(B%) -> R%
|
||||
REM PAIR_Q(B) -> R
|
||||
PAIR_Q:
|
||||
R%=0
|
||||
IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B%,1)=0) THEN RETURN
|
||||
R%=1
|
||||
R=0
|
||||
IF (Z%(B,0)AND15)<>6 AND (Z%(B,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B,1)=0) THEN RETURN
|
||||
R=1
|
||||
RETURN
|
||||
|
||||
REM QUASIQUOTE(A%) -> R%
|
||||
REM QUASIQUOTE(A) -> R
|
||||
QUASIQUOTE:
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=1 THEN GOTO QQ_UNQUOTE
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=1 THEN GOTO QQ_UNQUOTE
|
||||
REM ['quote, ast]
|
||||
AS$="quote":T%=5:GOSUB STRING
|
||||
B2%=R%:B1%=A%:GOSUB LIST2
|
||||
AS$="quote":T=5:GOSUB STRING
|
||||
B2%=R:B1%=A:GOSUB LIST2
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R%=A%+1:GOSUB DEREF_R
|
||||
IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
R=A+1:GOSUB DEREF_R
|
||||
IF (Z%(R,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
REM push A% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push A on the stack
|
||||
X=X+1:S%(X)=A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A%=Z%(A%,1):GOSUB QUASIQUOTE:T6%=R%
|
||||
REM pop A% off the stack
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A=Z%(A,1):GOSUB QUASIQUOTE:T6=R
|
||||
REM pop A off the stack
|
||||
A=S%(X):X=X-1
|
||||
|
||||
REM set A% to ast[0] for last two cases
|
||||
A%=A%+1:GOSUB DEREF_A
|
||||
REM set A to ast[0] for last two cases
|
||||
A=A+1:GOSUB DEREF_A
|
||||
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=0 THEN GOTO QQ_DEFAULT
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=0 THEN GOTO QQ_DEFAULT
|
||||
B=A+1:GOSUB DEREF_B
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
|
||||
B%=Z%(A%,1)+1:GOSUB DEREF_B:B2%=B%
|
||||
AS$="concat":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
B=Z%(A,1)+1:GOSUB DEREF_B:B2%=B
|
||||
AS$="concat":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
|
||||
REM push T6% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=T6%
|
||||
REM A% set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R%
|
||||
REM pop T6% off the stack
|
||||
T6%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
REM push T6 on the stack
|
||||
X=X+1:S%(X)=T6
|
||||
REM A set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R
|
||||
REM pop T6 off the stack
|
||||
T6=S%(X):X=X-1
|
||||
|
||||
AS$="cons":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
AS$="cons":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY%=B2%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
AY=B2%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -219,14 +219,14 @@ EVAL:
|
||||
|
||||
APPLY_LIST:
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -238,182 +238,182 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB QUASIQUOTE
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB QUASIQUOTE
|
||||
REM add quasiquote result to pending release queue to free when
|
||||
REM next lower EVAL level returns (LV%)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R%:ZR%(ZM%,1)=LV%
|
||||
REM next lower EVAL level returns (LV)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R:ZR%(ZM%,1)=LV
|
||||
|
||||
A%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -421,51 +421,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -473,46 +473,46 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
IF R<>0 THEN AY=R:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL_LOOP
|
||||
IF R=0 THEN GOTO REPL_LOOP
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL_LOOP:
|
||||
@ -521,7 +521,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -532,6 +532,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -11,243 +11,243 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM PAIR_Q(B%) -> R%
|
||||
REM PAIR_Q(B) -> R
|
||||
PAIR_Q:
|
||||
R%=0
|
||||
IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B%,1)=0) THEN RETURN
|
||||
R%=1
|
||||
R=0
|
||||
IF (Z%(B,0)AND15)<>6 AND (Z%(B,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B,1)=0) THEN RETURN
|
||||
R=1
|
||||
RETURN
|
||||
|
||||
REM QUASIQUOTE(A%) -> R%
|
||||
REM QUASIQUOTE(A) -> R
|
||||
QUASIQUOTE:
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=1 THEN GOTO QQ_UNQUOTE
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=1 THEN GOTO QQ_UNQUOTE
|
||||
REM ['quote, ast]
|
||||
AS$="quote":T%=5:GOSUB STRING
|
||||
B2%=R%:B1%=A%:GOSUB LIST2
|
||||
AS$="quote":T=5:GOSUB STRING
|
||||
B2%=R:B1%=A:GOSUB LIST2
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R%=A%+1:GOSUB DEREF_R
|
||||
IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
R=A+1:GOSUB DEREF_R
|
||||
IF (Z%(R,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
REM push A% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push A on the stack
|
||||
X=X+1:S%(X)=A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A%=Z%(A%,1):GOSUB QUASIQUOTE:T6%=R%
|
||||
REM pop A% off the stack
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A=Z%(A,1):GOSUB QUASIQUOTE:T6=R
|
||||
REM pop A off the stack
|
||||
A=S%(X):X=X-1
|
||||
|
||||
REM set A% to ast[0] for last two cases
|
||||
A%=A%+1:GOSUB DEREF_A
|
||||
REM set A to ast[0] for last two cases
|
||||
A=A+1:GOSUB DEREF_A
|
||||
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=0 THEN GOTO QQ_DEFAULT
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=0 THEN GOTO QQ_DEFAULT
|
||||
B=A+1:GOSUB DEREF_B
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
|
||||
B%=Z%(A%,1)+1:GOSUB DEREF_B:B2%=B%
|
||||
AS$="concat":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
B=Z%(A,1)+1:GOSUB DEREF_B:B2%=B
|
||||
AS$="concat":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
|
||||
REM push T6% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=T6%
|
||||
REM A% set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R%
|
||||
REM pop T6% off the stack
|
||||
T6%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
REM push T6 on the stack
|
||||
X=X+1:S%(X)=T6
|
||||
REM A set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R
|
||||
REM pop T6 off the stack
|
||||
T6=S%(X):X=X-1
|
||||
|
||||
AS$="cons":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
AS$="cons":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY%=B2%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
AY=B2%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
REM MACROEXPAND(A%, E%) -> A%:
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
MACROEXPAND:
|
||||
REM push original A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push original A
|
||||
X=X+1:S%(X)=A
|
||||
|
||||
MACROEXPAND_LOOP:
|
||||
REM list?
|
||||
IF (Z%(A%,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(A,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
REM non-empty?
|
||||
IF Z%(A%,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF Z%(A,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B=A+1:GOSUB DEREF_B
|
||||
REM symbol? in first position
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
REM defined in environment?
|
||||
K%=B%:GOSUB ENV_FIND
|
||||
IF R%=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B%=T4%:GOSUB DEREF_B
|
||||
K=B:GOSUB ENV_FIND
|
||||
IF R=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B=T4:GOSUB DEREF_B
|
||||
REM macro?
|
||||
IF (Z%(B%,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
|
||||
REM apply
|
||||
F%=B%:AR%=Z%(A%,1):GOSUB APPLY
|
||||
A%=R%
|
||||
F=B:AR=Z%(A,1):GOSUB APPLY
|
||||
A=R
|
||||
|
||||
AY%=ZZ%(ZL%)
|
||||
REM if previous A% was not the first A% into macroexpand (i.e. an
|
||||
AY=S%(X)
|
||||
REM if previous A was not the first A into macroexpand (i.e. an
|
||||
REM intermediate form) then free it
|
||||
IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
|
||||
IF A<>AY THEN ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV
|
||||
|
||||
IF ER%<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
IF ER<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
GOTO MACROEXPAND_LOOP
|
||||
|
||||
MACROEXPAND_DONE:
|
||||
ZL%=ZL%-1: REM pop original A%
|
||||
X=X-1: REM pop original A
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
EVAL_NOT_LIST:
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -257,17 +257,17 @@ EVAL:
|
||||
GOSUB MACROEXPAND
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R%<>1 THEN GOTO EVAL_NOT_LIST
|
||||
IF R<>1 THEN GOTO EVAL_NOT_LIST
|
||||
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -281,206 +281,206 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB QUASIQUOTE
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB QUASIQUOTE
|
||||
REM add quasiquote result to pending release queue to free when
|
||||
REM next lower EVAL level returns (LV%)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R%:ZR%(ZM%,1)=LV%
|
||||
REM next lower EVAL level returns (LV)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R:ZR%(ZM%,1)=LV
|
||||
|
||||
A%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DEFMACRO:
|
||||
REM PRINT "defmacro!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM change function to macro
|
||||
Z%(R%,0)=Z%(R%,0)+1
|
||||
Z%(R,0)=Z%(R,0)+1
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_MACROEXPAND:
|
||||
REM PRINT "macroexpand"
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB MACROEXPAND:R%=A%
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB MACROEXPAND:R=A
|
||||
|
||||
REM since we are returning it unevaluated, inc the ref cnt
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -488,51 +488,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -540,55 +540,55 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)"
|
||||
A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of"
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
IF R<>0 THEN AY=R:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL_LOOP
|
||||
IF R=0 THEN GOTO REPL_LOOP
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL_LOOP:
|
||||
@ -597,7 +597,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -608,6 +608,6 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -11,243 +11,243 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM PAIR_Q(B%) -> R%
|
||||
REM PAIR_Q(B) -> R
|
||||
PAIR_Q:
|
||||
R%=0
|
||||
IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B%,1)=0) THEN RETURN
|
||||
R%=1
|
||||
R=0
|
||||
IF (Z%(B,0)AND15)<>6 AND (Z%(B,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B,1)=0) THEN RETURN
|
||||
R=1
|
||||
RETURN
|
||||
|
||||
REM QUASIQUOTE(A%) -> R%
|
||||
REM QUASIQUOTE(A) -> R
|
||||
QUASIQUOTE:
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=1 THEN GOTO QQ_UNQUOTE
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=1 THEN GOTO QQ_UNQUOTE
|
||||
REM ['quote, ast]
|
||||
AS$="quote":T%=5:GOSUB STRING
|
||||
B2%=R%:B1%=A%:GOSUB LIST2
|
||||
AS$="quote":T=5:GOSUB STRING
|
||||
B2%=R:B1%=A:GOSUB LIST2
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R%=A%+1:GOSUB DEREF_R
|
||||
IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
R=A+1:GOSUB DEREF_R
|
||||
IF (Z%(R,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
REM push A% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push A on the stack
|
||||
X=X+1:S%(X)=A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A%=Z%(A%,1):GOSUB QUASIQUOTE:T6%=R%
|
||||
REM pop A% off the stack
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A=Z%(A,1):GOSUB QUASIQUOTE:T6=R
|
||||
REM pop A off the stack
|
||||
A=S%(X):X=X-1
|
||||
|
||||
REM set A% to ast[0] for last two cases
|
||||
A%=A%+1:GOSUB DEREF_A
|
||||
REM set A to ast[0] for last two cases
|
||||
A=A+1:GOSUB DEREF_A
|
||||
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=0 THEN GOTO QQ_DEFAULT
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=0 THEN GOTO QQ_DEFAULT
|
||||
B=A+1:GOSUB DEREF_B
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
|
||||
B%=Z%(A%,1)+1:GOSUB DEREF_B:B2%=B%
|
||||
AS$="concat":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
B=Z%(A,1)+1:GOSUB DEREF_B:B2%=B
|
||||
AS$="concat":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
|
||||
REM push T6% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=T6%
|
||||
REM A% set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R%
|
||||
REM pop T6% off the stack
|
||||
T6%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
REM push T6 on the stack
|
||||
X=X+1:S%(X)=T6
|
||||
REM A set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R
|
||||
REM pop T6 off the stack
|
||||
T6=S%(X):X=X-1
|
||||
|
||||
AS$="cons":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
AS$="cons":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY%=B2%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
AY=B2%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
REM MACROEXPAND(A%, E%) -> A%:
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
MACROEXPAND:
|
||||
REM push original A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push original A
|
||||
X=X+1:S%(X)=A
|
||||
|
||||
MACROEXPAND_LOOP:
|
||||
REM list?
|
||||
IF (Z%(A%,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(A,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
REM non-empty?
|
||||
IF Z%(A%,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF Z%(A,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B=A+1:GOSUB DEREF_B
|
||||
REM symbol? in first position
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
REM defined in environment?
|
||||
K%=B%:GOSUB ENV_FIND
|
||||
IF R%=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B%=T4%:GOSUB DEREF_B
|
||||
K=B:GOSUB ENV_FIND
|
||||
IF R=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B=T4:GOSUB DEREF_B
|
||||
REM macro?
|
||||
IF (Z%(B%,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
|
||||
REM apply
|
||||
F%=B%:AR%=Z%(A%,1):GOSUB APPLY
|
||||
A%=R%
|
||||
F=B:AR=Z%(A,1):GOSUB APPLY
|
||||
A=R
|
||||
|
||||
AY%=ZZ%(ZL%)
|
||||
REM if previous A% was not the first A% into macroexpand (i.e. an
|
||||
AY=S%(X)
|
||||
REM if previous A was not the first A into macroexpand (i.e. an
|
||||
REM intermediate form) then free it
|
||||
IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
|
||||
IF A<>AY THEN ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV
|
||||
|
||||
IF ER%<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
IF ER<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
GOTO MACROEXPAND_LOOP
|
||||
|
||||
MACROEXPAND_DONE:
|
||||
ZL%=ZL%-1: REM pop original A%
|
||||
X=X-1: REM pop original A
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
EVAL_NOT_LIST:
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -257,17 +257,17 @@ EVAL:
|
||||
GOSUB MACROEXPAND
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R%<>1 THEN GOTO EVAL_NOT_LIST
|
||||
IF R<>1 THEN GOTO EVAL_NOT_LIST
|
||||
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -282,237 +282,237 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB QUASIQUOTE
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB QUASIQUOTE
|
||||
REM add quasiquote result to pending release queue to free when
|
||||
REM next lower EVAL level returns (LV%)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R%:ZR%(ZM%,1)=LV%
|
||||
REM next lower EVAL level returns (LV)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R:ZR%(ZM%,1)=LV
|
||||
|
||||
A%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DEFMACRO:
|
||||
REM PRINT "defmacro!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM change function to macro
|
||||
Z%(R%,0)=Z%(R%,0)+1
|
||||
Z%(R,0)=Z%(R,0)+1
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_MACROEXPAND:
|
||||
REM PRINT "macroexpand"
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB MACROEXPAND:R%=A%
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB MACROEXPAND:R=A
|
||||
|
||||
REM since we are returning it unevaluated, inc the ref cnt
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_TRY:
|
||||
REM PRINT "try*"
|
||||
GOSUB EVAL_GET_A1: REM set a1%, a2%, and a3%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%: REM push/save A%
|
||||
A%=A1%:GOSUB EVAL: REM eval a1
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1: REM pop/restore A%
|
||||
X=X+1:S%(X)=A: REM push/save A
|
||||
A=A1%:GOSUB EVAL: REM eval a1
|
||||
A=S%(X):X=X-1: REM pop/restore A
|
||||
|
||||
REM if there is not error or catch block then return
|
||||
IF ER%=-2 OR Z%(A%,1)=0 THEN GOTO EVAL_RETURN
|
||||
IF ER=-2 OR Z%(A,1)=0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM create environment for the catch block eval
|
||||
EO%=E%:GOSUB ENV_NEW:E%=R%
|
||||
O=E:GOSUB ENV_NEW:E=R
|
||||
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:GOSUB EVAL_GET_A2: REM set a1% and a2% from catch block
|
||||
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 AS$=ER$:T%=4:GOSUB STRING:ER%=R%:Z%(R%,0)=Z%(R%,0)+16
|
||||
REM create object for ER=-1 type raw string errors
|
||||
IF ER=-1 THEN AS$=ER$:T=4:GOSUB STRING:ER=R:Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
REM bind the catch symbol to the error object
|
||||
K%=A1%:V%=ER%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release out use, env took ownership
|
||||
K=A1%:V=ER:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release out use, env took ownership
|
||||
|
||||
REM unset error for catch eval
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
|
||||
A%=A2%:GOSUB EVAL
|
||||
A=A2%:GOSUB EVAL
|
||||
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -520,51 +520,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -572,55 +572,55 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)"
|
||||
A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of"
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
IF R<>0 THEN AY=R:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL_LOOP
|
||||
IF R=0 THEN GOTO REPL_LOOP
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL_LOOP:
|
||||
@ -629,7 +629,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -640,8 +640,8 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
REM if the error is an object, then print and free it
|
||||
IF ER%>=0 THEN AZ%=ER%:PR%=0:GOSUB PR_STR:ER$=R$:AY%=ER%:GOSUB RELEASE
|
||||
IF ER>=0 THEN AZ=ER:PR=0:GOSUB PR_STR:ER$=R$:AY=ER:GOSUB RELEASE
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -11,243 +11,243 @@ REM $INCLUDE: 'core.in.bas'
|
||||
|
||||
REM $INCLUDE: 'debug.in.bas'
|
||||
|
||||
REM READ(A$) -> R%
|
||||
REM READ(A$) -> R
|
||||
MAL_READ:
|
||||
GOSUB READ_STR
|
||||
RETURN
|
||||
|
||||
REM PAIR_Q(B%) -> R%
|
||||
REM PAIR_Q(B) -> R
|
||||
PAIR_Q:
|
||||
R%=0
|
||||
IF (Z%(B%,0)AND15)<>6 AND (Z%(B%,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B%,1)=0) THEN RETURN
|
||||
R%=1
|
||||
R=0
|
||||
IF (Z%(B,0)AND15)<>6 AND (Z%(B,0)AND15)<>7 THEN RETURN
|
||||
IF (Z%(B,1)=0) THEN RETURN
|
||||
R=1
|
||||
RETURN
|
||||
|
||||
REM QUASIQUOTE(A%) -> R%
|
||||
REM QUASIQUOTE(A) -> R
|
||||
QUASIQUOTE:
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=1 THEN GOTO QQ_UNQUOTE
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=1 THEN GOTO QQ_UNQUOTE
|
||||
REM ['quote, ast]
|
||||
AS$="quote":T%=5:GOSUB STRING
|
||||
B2%=R%:B1%=A%:GOSUB LIST2
|
||||
AS$="quote":T=5:GOSUB STRING
|
||||
B2%=R:B1%=A:GOSUB LIST2
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_UNQUOTE:
|
||||
R%=A%+1:GOSUB DEREF_R
|
||||
IF (Z%(R%,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF ZS$(Z%(R%,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
R=A+1:GOSUB DEREF_R
|
||||
IF (Z%(R,0)AND15)<>5 THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
IF S$(Z%(R,1))<>"unquote" THEN GOTO QQ_SPLICE_UNQUOTE
|
||||
REM [ast[1]]
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
RETURN
|
||||
|
||||
QQ_SPLICE_UNQUOTE:
|
||||
REM push A% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push A on the stack
|
||||
X=X+1:S%(X)=A
|
||||
REM rest of cases call quasiquote on ast[1..]
|
||||
A%=Z%(A%,1):GOSUB QUASIQUOTE:T6%=R%
|
||||
REM pop A% off the stack
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
A=Z%(A,1):GOSUB QUASIQUOTE:T6=R
|
||||
REM pop A off the stack
|
||||
A=S%(X):X=X-1
|
||||
|
||||
REM set A% to ast[0] for last two cases
|
||||
A%=A%+1:GOSUB DEREF_A
|
||||
REM set A to ast[0] for last two cases
|
||||
A=A+1:GOSUB DEREF_A
|
||||
|
||||
B%=A%:GOSUB PAIR_Q
|
||||
IF R%=0 THEN GOTO QQ_DEFAULT
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF ZS$(Z%(B%,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
B=A:GOSUB PAIR_Q
|
||||
IF R=0 THEN GOTO QQ_DEFAULT
|
||||
B=A+1:GOSUB DEREF_B
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO QQ_DEFAULT
|
||||
IF S$(Z%(B,1))<>"splice-unquote" THEN QQ_DEFAULT
|
||||
REM ['concat, ast[0][1], quasiquote(ast[1..])]
|
||||
|
||||
B%=Z%(A%,1)+1:GOSUB DEREF_B:B2%=B%
|
||||
AS$="concat":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
B=Z%(A,1)+1:GOSUB DEREF_B:B2%=B
|
||||
AS$="concat":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
QQ_DEFAULT:
|
||||
REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
|
||||
|
||||
REM push T6% on the stack
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=T6%
|
||||
REM A% set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R%
|
||||
REM pop T6% off the stack
|
||||
T6%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
REM push T6 on the stack
|
||||
X=X+1:S%(X)=T6
|
||||
REM A set above to ast[0]
|
||||
GOSUB QUASIQUOTE:B2%=R
|
||||
REM pop T6 off the stack
|
||||
T6=S%(X):X=X-1
|
||||
|
||||
AS$="cons":T%=5:GOSUB STRING:B3%=R%
|
||||
B1%=T6%:GOSUB LIST3
|
||||
AS$="cons":T=5:GOSUB STRING:B3%=R
|
||||
B1%=T6:GOSUB LIST3
|
||||
REM release inner quasiquoted since outer list takes ownership
|
||||
AY%=B1%:GOSUB RELEASE
|
||||
AY%=B2%:GOSUB RELEASE
|
||||
AY=B1%:GOSUB RELEASE
|
||||
AY=B2%:GOSUB RELEASE
|
||||
RETURN
|
||||
|
||||
REM MACROEXPAND(A%, E%) -> A%:
|
||||
REM MACROEXPAND(A, E) -> A:
|
||||
MACROEXPAND:
|
||||
REM push original A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
REM push original A
|
||||
X=X+1:S%(X)=A
|
||||
|
||||
MACROEXPAND_LOOP:
|
||||
REM list?
|
||||
IF (Z%(A%,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(A,0)AND15)<>6 THEN GOTO MACROEXPAND_DONE
|
||||
REM non-empty?
|
||||
IF Z%(A%,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B%=A%+1:GOSUB DEREF_B
|
||||
IF Z%(A,1)=0 THEN GOTO MACROEXPAND_DONE
|
||||
B=A+1:GOSUB DEREF_B
|
||||
REM symbol? in first position
|
||||
IF (Z%(B%,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>5 THEN GOTO MACROEXPAND_DONE
|
||||
REM defined in environment?
|
||||
K%=B%:GOSUB ENV_FIND
|
||||
IF R%=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B%=T4%:GOSUB DEREF_B
|
||||
K=B:GOSUB ENV_FIND
|
||||
IF R=-1 THEN GOTO MACROEXPAND_DONE
|
||||
B=T4:GOSUB DEREF_B
|
||||
REM macro?
|
||||
IF (Z%(B%,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
IF (Z%(B,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
|
||||
|
||||
REM apply
|
||||
F%=B%:AR%=Z%(A%,1):GOSUB APPLY
|
||||
A%=R%
|
||||
F=B:AR=Z%(A,1):GOSUB APPLY
|
||||
A=R
|
||||
|
||||
AY%=ZZ%(ZL%)
|
||||
REM if previous A% was not the first A% into macroexpand (i.e. an
|
||||
AY=S%(X)
|
||||
REM if previous A was not the first A into macroexpand (i.e. an
|
||||
REM intermediate form) then free it
|
||||
IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
|
||||
IF A<>AY THEN ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV
|
||||
|
||||
IF ER%<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
IF ER<>-2 THEN GOTO MACROEXPAND_DONE
|
||||
GOTO MACROEXPAND_LOOP
|
||||
|
||||
MACROEXPAND_DONE:
|
||||
ZL%=ZL%-1: REM pop original A%
|
||||
X=X-1: REM pop original A
|
||||
RETURN
|
||||
|
||||
REM EVAL_AST(A%, E%) -> R%
|
||||
REM EVAL_AST(A, E) -> R
|
||||
REM called using GOTO to avoid basic return address stack usage
|
||||
REM top of stack should have return label index
|
||||
EVAL_AST:
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_RETURN
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
T%=Z%(A%,0)AND15
|
||||
IF T%=5 THEN GOTO EVAL_AST_SYMBOL
|
||||
IF T%>=6 AND T%<=8 THEN GOTO EVAL_AST_SEQ
|
||||
T=Z%(A,0)AND15
|
||||
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%:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=A:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SYMBOL:
|
||||
K%=A%:GOSUB ENV_GET
|
||||
K=A:GOSUB ENV_GET
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_SEQ:
|
||||
REM allocate the first entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM make space on the stack
|
||||
ZL%=ZL%+4
|
||||
X=X+4
|
||||
REM push type of sequence
|
||||
ZZ%(ZL%-3)=T%
|
||||
S%(X-3)=T
|
||||
REM push sequence index
|
||||
ZZ%(ZL%-2)=-1
|
||||
S%(X-2)=-1
|
||||
REM push future return value (new sequence)
|
||||
ZZ%(ZL%-1)=R%
|
||||
S%(X-1)=R
|
||||
REM push previous new sequence entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
EVAL_AST_SEQ_LOOP:
|
||||
REM set new sequence entry type (with 1 ref cnt)
|
||||
Z%(R%,0)=ZZ%(ZL%-3)+16
|
||||
Z%(R%,1)=0
|
||||
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
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
|
||||
REM update index
|
||||
ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
|
||||
S%(X-2)=S%(X-2)+1
|
||||
|
||||
REM check if we are done evaluating the source sequence
|
||||
IF Z%(A%,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM if hashmap, skip eval of even entries (keys)
|
||||
IF (ZZ%(ZL%-3)=8) AND ((ZZ%(ZL%-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
IF (S%(X-3)=8) AND ((S%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
|
||||
GOTO EVAL_AST_DO_EVAL
|
||||
|
||||
EVAL_AST_DO_REF:
|
||||
R%=A%+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R%,0)=Z%(R%,0)+16: REM inc ref cnt of referred value
|
||||
R=A+1:GOSUB DEREF_R: REM deref to target of referred entry
|
||||
Z%(R,0)=Z%(R,0)+16: REM inc ref cnt of referred value
|
||||
GOTO EVAL_AST_ADD_VALUE
|
||||
|
||||
EVAL_AST_DO_EVAL:
|
||||
REM call EVAL for each entry
|
||||
A%=A%+1:GOSUB EVAL
|
||||
A%=A%-1
|
||||
A=A+1:GOSUB EVAL
|
||||
A=A-1
|
||||
GOSUB DEREF_R: REM deref to target of evaluated entry
|
||||
|
||||
EVAL_AST_ADD_VALUE:
|
||||
|
||||
REM update previous value pointer to evaluated entry
|
||||
Z%(ZZ%(ZL%)+1,1)=R%
|
||||
Z%(S%(X)+1,1)=R
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
IF ER<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
|
||||
|
||||
REM allocate the next entry
|
||||
SZ%=2:GOSUB ALLOC
|
||||
SZ=2:GOSUB ALLOC
|
||||
|
||||
REM update previous sequence entry value to point to new entry
|
||||
Z%(ZZ%(ZL%),1)=R%
|
||||
Z%(S%(X),1)=R
|
||||
REM update previous ptr to current entry
|
||||
ZZ%(ZL%)=R%
|
||||
S%(X)=R
|
||||
|
||||
REM process the next sequence entry from source list
|
||||
A%=Z%(A%,1)
|
||||
A=Z%(A,1)
|
||||
|
||||
GOTO EVAL_AST_SEQ_LOOP
|
||||
EVAL_AST_SEQ_LOOP_DONE:
|
||||
REM if no error, get return value (new seq)
|
||||
IF ER%=-2 THEN R%=ZZ%(ZL%-1)
|
||||
IF ER=-2 THEN R=S%(X-1)
|
||||
REM otherwise, free the return value and return nil
|
||||
IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
|
||||
IF ER<>-2 THEN R=0:AY=S%(X-1):GOSUB RELEASE
|
||||
|
||||
REM pop previous, return, index and type
|
||||
ZL%=ZL%-4
|
||||
X=X-4
|
||||
GOTO EVAL_AST_RETURN
|
||||
|
||||
EVAL_AST_RETURN:
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
REM pop EVAL AST return label/address
|
||||
RN%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RN%=S%(X):X=X-1
|
||||
ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
|
||||
RETURN
|
||||
|
||||
REM EVAL(A%, E%)) -> R%
|
||||
REM EVAL(A, E)) -> R
|
||||
EVAL:
|
||||
LV%=LV%+1: REM track basic return stack level
|
||||
LV=LV+1: REM track basic return stack level
|
||||
|
||||
REM push A% and E% on the stack
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
|
||||
REM push A and E on the stack
|
||||
X=X+2:S%(X-1)=E:S%(X)=A
|
||||
|
||||
EVAL_TCO_RECUR:
|
||||
|
||||
REM AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
|
||||
REM AZ=A:PR=1:GOSUB PR_STR
|
||||
REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
|
||||
|
||||
GOSUB DEREF_A
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R% THEN GOTO APPLY_LIST
|
||||
IF R THEN GOTO APPLY_LIST
|
||||
EVAL_NOT_LIST:
|
||||
REM ELSE
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=1
|
||||
X=X+1:S%(X)=1
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_1:
|
||||
|
||||
@ -257,17 +257,17 @@ EVAL:
|
||||
GOSUB MACROEXPAND
|
||||
|
||||
GOSUB LIST_Q
|
||||
IF R%<>1 THEN GOTO EVAL_NOT_LIST
|
||||
IF R<>1 THEN GOTO EVAL_NOT_LIST
|
||||
|
||||
GOSUB EMPTY_Q
|
||||
IF R% THEN R%=A%:Z%(R%,0)=Z%(R%,0)+16:GOTO EVAL_RETURN
|
||||
IF R THEN R=A:Z%(R,0)=Z%(R,0)+16:GOTO EVAL_RETURN
|
||||
|
||||
A0%=A%+1
|
||||
R%=A0%:GOSUB DEREF_R:A0%=R%
|
||||
A0%=A+1
|
||||
R=A0%:GOSUB DEREF_R:A0%=R
|
||||
|
||||
REM get symbol in A$
|
||||
IF (Z%(A0%,0)AND15)<>5 THEN A$=""
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=ZS$(Z%(A0%,1))
|
||||
IF (Z%(A0%,0)AND15)=5 THEN A$=S$(Z%(A0%,1))
|
||||
|
||||
IF A$="def!" THEN GOTO EVAL_DEF
|
||||
IF A$="let*" THEN GOTO EVAL_LET
|
||||
@ -282,237 +282,237 @@ EVAL:
|
||||
GOTO EVAL_INVOKE
|
||||
|
||||
EVAL_GET_A3:
|
||||
A3%=Z%(Z%(Z%(A%,1),1),1)+1
|
||||
R%=A3%:GOSUB DEREF_R:A3%=R%
|
||||
A3%=Z%(Z%(Z%(A,1),1),1)+1
|
||||
R=A3%:GOSUB DEREF_R:A3%=R
|
||||
EVAL_GET_A2:
|
||||
A2%=Z%(Z%(A%,1),1)+1
|
||||
R%=A2%:GOSUB DEREF_R:A2%=R%
|
||||
A2%=Z%(Z%(A,1),1)+1
|
||||
R=A2%:GOSUB DEREF_R:A2%=R
|
||||
EVAL_GET_A1:
|
||||
A1%=Z%(A%,1)+1
|
||||
R%=A1%:GOSUB DEREF_R:A1%=R%
|
||||
A1%=Z%(A,1)+1
|
||||
R=A1%:GOSUB DEREF_R:A1%=R
|
||||
RETURN
|
||||
|
||||
EVAL_DEF:
|
||||
REM PRINT "def!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_LET:
|
||||
REM PRINT "let*"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A2%: REM push/save A2%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM push env for for later release
|
||||
X=X+1:S%(X)=A2%: REM push/save A2%
|
||||
X=X+1:S%(X)=E: REM push env for for later release
|
||||
|
||||
REM create new environment with outer as current environment
|
||||
EO%=E%:GOSUB ENV_NEW
|
||||
E%=R%
|
||||
O=E:GOSUB ENV_NEW
|
||||
E=R
|
||||
EVAL_LET_LOOP:
|
||||
IF Z%(A1%,1)=0 THEN GOTO EVAL_LET_LOOP_DONE
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
REM eval current A1 odd element
|
||||
A%=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
A=Z%(A1%,1)+1:GOSUB EVAL
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM set environment: even A1% key to odd A1% eval'd above
|
||||
K%=A1%+1:V%=R%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
K=A1%+1:V=R:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release our use, ENV_SET took ownership
|
||||
|
||||
REM skip to the next pair of A1% elements
|
||||
A1%=Z%(Z%(A1%,1),1)
|
||||
GOTO EVAL_LET_LOOP
|
||||
|
||||
EVAL_LET_LOOP_DONE:
|
||||
E4%=ZZ%(ZL%):ZL%=ZL%-1: REM pop previous env
|
||||
E4%=S%(X):X=X-1: REM pop previous env
|
||||
|
||||
REM release previous environment if not the current EVAL env
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A2%=S%(X):X=X-1: REM pop A2%
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DO:
|
||||
A%=Z%(A%,1): REM rest
|
||||
A=Z%(A,1): REM rest
|
||||
|
||||
REM TODO: TCO
|
||||
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=2
|
||||
X=X+1:S%(X)=2
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_2:
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%: REM push eval'd list
|
||||
A%=R%:GOSUB LAST: REM return the last element
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1: REM pop eval'd list
|
||||
X=X+1:S%(X)=R: REM push eval'd list
|
||||
A=R:GOSUB LAST: REM return the last element
|
||||
AY=S%(X):X=X-1: REM pop eval'd list
|
||||
GOSUB RELEASE: REM release the eval'd list
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_QUASIQUOTE:
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB QUASIQUOTE
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB QUASIQUOTE
|
||||
REM add quasiquote result to pending release queue to free when
|
||||
REM next lower EVAL level returns (LV%)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R%:ZR%(ZM%,1)=LV%
|
||||
REM next lower EVAL level returns (LV)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=R:ZR%(ZM%,1)=LV
|
||||
|
||||
A%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_DEFMACRO:
|
||||
REM PRINT "defmacro!"
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A1%: REM push A1%
|
||||
A%=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
|
||||
X=X+1:S%(X)=A1%: REM push A1%
|
||||
A=A2%:GOSUB EVAL: REM eval a2
|
||||
A1%=S%(X):X=X-1: REM pop A1%
|
||||
|
||||
REM change function to macro
|
||||
Z%(R%,0)=Z%(R%,0)+1
|
||||
Z%(R,0)=Z%(R,0)+1
|
||||
|
||||
REM set a1 in env to a2
|
||||
K%=A1%:V%=R%:GOSUB ENV_SET
|
||||
K=A1%:V=R:GOSUB ENV_SET
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_MACROEXPAND:
|
||||
REM PRINT "macroexpand"
|
||||
R%=Z%(A%,1)+1:GOSUB DEREF_R
|
||||
A%=R%:GOSUB MACROEXPAND:R%=A%
|
||||
R=Z%(A,1)+1:GOSUB DEREF_R
|
||||
A=R:GOSUB MACROEXPAND:R=A
|
||||
|
||||
REM since we are returning it unevaluated, inc the ref cnt
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_TRY:
|
||||
REM PRINT "try*"
|
||||
GOSUB EVAL_GET_A1: REM set a1%, a2%, and a3%
|
||||
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%: REM push/save A%
|
||||
A%=A1%:GOSUB EVAL: REM eval a1
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1: REM pop/restore A%
|
||||
X=X+1:S%(X)=A: REM push/save A
|
||||
A=A1%:GOSUB EVAL: REM eval a1
|
||||
A=S%(X):X=X-1: REM pop/restore A
|
||||
|
||||
REM if there is not error or catch block then return
|
||||
IF ER%=-2 OR Z%(A%,1)=0 THEN GOTO EVAL_RETURN
|
||||
IF ER=-2 OR Z%(A,1)=0 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM create environment for the catch block eval
|
||||
EO%=E%:GOSUB ENV_NEW:E%=R%
|
||||
O=E:GOSUB ENV_NEW:E=R
|
||||
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:GOSUB EVAL_GET_A2: REM set a1% and a2% from catch block
|
||||
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 AS$=ER$:T%=4:GOSUB STRING:ER%=R%:Z%(R%,0)=Z%(R%,0)+16
|
||||
REM create object for ER=-1 type raw string errors
|
||||
IF ER=-1 THEN AS$=ER$:T=4:GOSUB STRING:ER=R:Z%(R,0)=Z%(R,0)+16
|
||||
|
||||
REM bind the catch symbol to the error object
|
||||
K%=A1%:V%=ER%:GOSUB ENV_SET
|
||||
AY%=R%:GOSUB RELEASE: REM release out use, env took ownership
|
||||
K=A1%:V=ER:GOSUB ENV_SET
|
||||
AY=R:GOSUB RELEASE: REM release out use, env took ownership
|
||||
|
||||
REM unset error for catch eval
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
|
||||
A%=A2%:GOSUB EVAL
|
||||
A=A2%:GOSUB EVAL
|
||||
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_IF:
|
||||
GOSUB EVAL_GET_A1: REM set a1%
|
||||
REM push A%
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=A%
|
||||
A%=A1%:GOSUB EVAL
|
||||
REM pop A%
|
||||
A%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
IF (R%=0) OR (R%=1) THEN GOTO EVAL_IF_FALSE
|
||||
REM push A
|
||||
X=X+1:S%(X)=A
|
||||
A=A1%:GOSUB EVAL
|
||||
REM pop A
|
||||
A=S%(X):X=X-1
|
||||
IF (R=0) OR (R=1) THEN GOTO EVAL_IF_FALSE
|
||||
|
||||
EVAL_IF_TRUE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
|
||||
A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
EVAL_IF_FALSE:
|
||||
AY%=R%:GOSUB RELEASE
|
||||
AY=R:GOSUB RELEASE
|
||||
REM if no false case (A3%), return nil
|
||||
IF Z%(Z%(Z%(A%,1),1),1)=0 THEN R%=0:GOTO EVAL_RETURN
|
||||
IF Z%(Z%(Z%(A,1),1),1)=0 THEN R=0:GOTO EVAL_RETURN
|
||||
GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
|
||||
A%=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
A=A3%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_FN:
|
||||
GOSUB EVAL_GET_A2: REM set a1% and a2%
|
||||
A%=A2%:P%=A1%:GOSUB MAL_FUNCTION
|
||||
A=A2%:P=A1%:GOSUB MAL_FUNCTION
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_INVOKE:
|
||||
REM push EVAL_AST return label/address
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=3
|
||||
X=X+1:S%(X)=3
|
||||
GOTO EVAL_AST
|
||||
EVAL_AST_RETURN_3:
|
||||
|
||||
REM if error, return f/args for release by caller
|
||||
IF ER%<>-2 THEN GOTO EVAL_RETURN
|
||||
IF ER<>-2 THEN GOTO EVAL_RETURN
|
||||
|
||||
REM push f/args for release after call
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=R%
|
||||
X=X+1:S%(X)=R
|
||||
|
||||
F%=R%+1
|
||||
F=R+1
|
||||
|
||||
AR%=Z%(R%,1): REM rest
|
||||
R%=F%:GOSUB DEREF_R:F%=R%
|
||||
AR=Z%(R,1): REM rest
|
||||
R=F:GOSUB DEREF_R:F=R
|
||||
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO EVAL_DO_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO EVAL_DO_MAL_FUNCTION
|
||||
|
||||
REM if error, pop and return f/args for release by caller
|
||||
R%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
R=S%(X):X=X-1
|
||||
ER=-1:ER$="apply of non-function":GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
GOTO EVAL_RETURN
|
||||
|
||||
EVAL_DO_MAL_FUNCTION:
|
||||
E4%=E%: REM save the current environment for release
|
||||
E4%=E: REM save the current environment for release
|
||||
|
||||
REM create new environ using env stored with function
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
REM release previous env if it is not the top one on the
|
||||
REM stack (ZZ%(ZL%-2)) because our new env refers to it and
|
||||
REM stack (S%(X-2)) because our new env refers to it and
|
||||
REM we no longer need to track it (since we are TCO recurring)
|
||||
IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
|
||||
IF E4%<>S%(X-2) THEN AY=E4%:GOSUB RELEASE
|
||||
|
||||
REM claim the AST before releasing the list containing it
|
||||
A%=Z%(F%,1):Z%(A%,0)=Z%(A%,0)+16
|
||||
A=Z%(F,1):Z%(A,0)=Z%(A,0)+16
|
||||
REM add AST to pending release queue to free as soon as EVAL
|
||||
REM actually returns (LV%+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%+1
|
||||
REM actually returns (LV+1)
|
||||
ZM%=ZM%+1:ZR%(ZM%,0)=A:ZR%(ZM%,1)=LV+1
|
||||
|
||||
REM pop and release f/args
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
|
||||
AY=S%(X):X=X-1:GOSUB RELEASE
|
||||
|
||||
REM A% set above
|
||||
E%=R%:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
REM A set above
|
||||
E=R:GOTO EVAL_TCO_RECUR: REM TCO loop
|
||||
|
||||
EVAL_RETURN:
|
||||
REM AZ%=R%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%)
|
||||
REM AZ=R: PR=1: GOSUB PR_STR
|
||||
REM PRINT "EVAL_RETURN R: ["+R$+"] ("+STR$(R)+"), LV:"+STR$(LV)+",ER:"+STR$(ER)
|
||||
|
||||
REM release environment if not the top one on the stack
|
||||
IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
|
||||
IF E<>S%(X-1) THEN AY=E:GOSUB RELEASE
|
||||
|
||||
LV%=LV%-1: REM track basic return stack level
|
||||
LV=LV-1: REM track basic return stack level
|
||||
|
||||
REM release everything we couldn't release earlier
|
||||
GOSUB RELEASE_PEND
|
||||
@ -520,51 +520,51 @@ EVAL:
|
||||
REM trigger GC
|
||||
TA%=FRE(0)
|
||||
|
||||
REM pop A% and E% off the stack
|
||||
E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
REM pop A and E off the stack
|
||||
E=S%(X-1):A=S%(X):X=X-2
|
||||
|
||||
RETURN
|
||||
|
||||
REM PRINT(A%) -> R$
|
||||
REM PRINT(A) -> R$
|
||||
MAL_PRINT:
|
||||
AZ%=A%:PR%=1:GOSUB PR_STR
|
||||
AZ=A:PR=1:GOSUB PR_STR
|
||||
RETURN
|
||||
|
||||
REM RE(A$) -> R%
|
||||
REM RE(A$) -> R
|
||||
REM Assume RE% has repl_env
|
||||
REM caller must release result
|
||||
RE:
|
||||
R1%=0
|
||||
R1=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
RETURN: REM caller must release result of EVAL
|
||||
|
||||
REM REP(A$) -> R$
|
||||
REM Assume RE% has repl_env
|
||||
REP:
|
||||
R1%=0:R2%=0
|
||||
R1=0:R2=0
|
||||
GOSUB MAL_READ
|
||||
R1%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
R1=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:E%=RE%:GOSUB EVAL
|
||||
R2%=R%
|
||||
IF ER%<>-2 THEN GOTO REP_DONE
|
||||
A=R:E=RE%:GOSUB EVAL
|
||||
R2=R
|
||||
IF ER<>-2 THEN GOTO REP_DONE
|
||||
|
||||
A%=R%:GOSUB MAL_PRINT
|
||||
A=R:GOSUB MAL_PRINT
|
||||
RT$=R$
|
||||
|
||||
REP_DONE:
|
||||
REM Release memory from MAL_READ and EVAL
|
||||
IF R2%<>0 THEN AY%=R2%:GOSUB RELEASE
|
||||
IF R1%<>0 THEN AY%=R1%:GOSUB RELEASE
|
||||
IF R2<>0 THEN AY=R2:GOSUB RELEASE
|
||||
IF R1<>0 THEN AY=R1:GOSUB RELEASE
|
||||
R$=RT$
|
||||
RETURN
|
||||
|
||||
@ -572,65 +572,65 @@ REM MAIN program
|
||||
MAIN:
|
||||
GOSUB INIT_MEMORY
|
||||
|
||||
LV%=0
|
||||
LV=0
|
||||
|
||||
REM create repl_env
|
||||
EO%=-1:GOSUB ENV_NEW:RE%=R%
|
||||
O=-1:GOSUB ENV_NEW:RE%=R
|
||||
|
||||
REM core.EXT: defined in Basic
|
||||
E%=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
E=RE%:GOSUB INIT_CORE_NS: REM set core functions in repl_env
|
||||
|
||||
ZT%=ZI%: REM top of memory after base repl_env
|
||||
ZT%=ZI: REM top of memory after base repl_env
|
||||
|
||||
REM core.mal: defined using the language itself
|
||||
A$="(def! *host-language* "+CHR$(34)+"C64 Basic"+CHR$(34)+")"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! not (fn* (a) (if a false true)))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(def! load-file (fn* (f) (eval (read-string (str "
|
||||
A$=A$+CHR$(34)+"(do "+CHR$(34)+" (slurp f) "+CHR$(34)+")"+CHR$(34)+")))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs)"
|
||||
A$=A$+" (if (> (count xs) 1) (nth xs 1) (throw "+CHR$(34)+"odd number of"
|
||||
A$=A$+" forms to cond"+CHR$(34)+")) (cons 'cond (rest (rest xs)))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
A$="(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs)"
|
||||
A$=A$+" `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM load the args file
|
||||
A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM set the argument list
|
||||
A$="(def! *ARGV* (rest -*ARGS*-))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REM get the first argument
|
||||
A$="(first -*ARGS*-)"
|
||||
GOSUB RE
|
||||
|
||||
REM if there is an argument, then run it as a program
|
||||
IF R%<>0 THEN AY%=R%:GOSUB RELEASE:GOTO RUN_PROG
|
||||
IF R<>0 THEN AY=R:GOSUB RELEASE:GOTO RUN_PROG
|
||||
REM no arguments, start REPL loop
|
||||
IF R%=0 THEN GOTO REPL
|
||||
IF R=0 THEN GOTO REPL
|
||||
|
||||
RUN_PROG:
|
||||
REM run a single mal program and exit
|
||||
A$="(load-file (first -*ARGS*-))"
|
||||
GOSUB RE
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR
|
||||
END
|
||||
|
||||
REPL:
|
||||
REM print the REPL startup header
|
||||
A$="(println (str "+CHR$(34)+"Mal ["+CHR$(34)+" *host-language* "
|
||||
A$=A$+CHR$(34)+"]"+CHR$(34)+"))"
|
||||
GOSUB RE:AY%=R%:GOSUB RELEASE
|
||||
GOSUB RE:AY=R:GOSUB RELEASE
|
||||
|
||||
REPL_LOOP:
|
||||
A$="user> ":GOSUB READLINE: REM call input parser
|
||||
@ -638,7 +638,7 @@ MAIN:
|
||||
|
||||
A$=R$:GOSUB REP: REM call REP
|
||||
|
||||
IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
IF ER<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
|
||||
PRINT R$
|
||||
GOTO REPL_LOOP
|
||||
|
||||
@ -649,8 +649,8 @@ MAIN:
|
||||
|
||||
PRINT_ERROR:
|
||||
REM if the error is an object, then print and free it
|
||||
IF ER%>=0 THEN AZ%=ER%:PR%=0:GOSUB PR_STR:ER$=R$:AY%=ER%:GOSUB RELEASE
|
||||
IF ER>=0 THEN AZ=ER:PR=0:GOSUB PR_STR:ER$=R$:AY=ER:GOSUB RELEASE
|
||||
PRINT "Error: "+ER$
|
||||
ER%=-2:ER$=""
|
||||
ER=-2:ER$=""
|
||||
RETURN
|
||||
|
||||
|
||||
@ -3,8 +3,8 @@ REM nil 0 -> (unused)
|
||||
REM boolean 1 -> 0: false, 1: true
|
||||
REM integer 2 -> int value
|
||||
REM float 3 -> ???
|
||||
REM string/kw 4 -> ZS$ index
|
||||
REM symbol 5 -> ZS$ index
|
||||
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 vector next/val 7 -> next Z% index (0 for last)
|
||||
@ -23,22 +23,22 @@ REM reference/ptr 14 -> Z% index / or 0
|
||||
REM next free ptr 15 -> Z% index / or 0
|
||||
|
||||
INIT_MEMORY:
|
||||
T%=FRE(0)
|
||||
T=FRE(0)
|
||||
|
||||
S1%=2048+512: REM Z% (boxed memory) size (4 bytes each)
|
||||
S2%=256: REM ZS% (string memory) size (3 bytes each)
|
||||
S3%=256: REM ZZ% (call stack) size (2 bytes each)
|
||||
S4%=64: REM ZR% (release stack) size (4 bytes each)
|
||||
Z1=2048+512: REM Z% (boxed memory) size (4 bytes each)
|
||||
Z2=256: REM S$ (string memory) size (3 bytes each)
|
||||
Z3=256: REM S% (call stack) size (2 bytes each)
|
||||
Z4=64: REM ZR% (release stack) size (4 bytes each)
|
||||
|
||||
REM global error state
|
||||
REM -2 : no error
|
||||
REM -1 : string error in ER$
|
||||
REM >=0 : pointer to error object
|
||||
ER%=-2
|
||||
ER=-2
|
||||
ER$=""
|
||||
|
||||
REM boxed element memory
|
||||
DIM Z%(S1%,1): REM TYPE ARRAY
|
||||
DIM Z%(Z1,1): REM TYPE ARRAY
|
||||
|
||||
REM Predefine nil, false, true, and an empty list
|
||||
Z%(0,0)=0:Z%(0,1)=0
|
||||
@ -48,188 +48,188 @@ INIT_MEMORY:
|
||||
Z%(4,0)=0:Z%(4,1)=0
|
||||
|
||||
REM start of unused memory
|
||||
ZI%=5
|
||||
ZI=5
|
||||
|
||||
REM start of free list
|
||||
ZK%=5
|
||||
ZK=5
|
||||
|
||||
REM string memory storage
|
||||
ZJ%=0:DIM ZS$(S2%)
|
||||
ZJ=0:DIM S$(Z2)
|
||||
|
||||
REM call/logic stack
|
||||
ZL%=-1:DIM ZZ%(S3%): REM stack of Z% indexes
|
||||
X=-1:DIM S%(Z3): REM stack of Z% indexes
|
||||
|
||||
REM pending release stack
|
||||
ZM%=-1:DIM ZR%(S4%,1): REM stack of Z% indexes
|
||||
ZM%=-1:DIM ZR%(Z4,1): REM stack of Z% indexes
|
||||
|
||||
REM PRINT "Lisp data memory: "+STR$(T%-FRE(0))
|
||||
REM PRINT "Lisp data memory: "+STR$(T-FRE(0))
|
||||
REM PRINT "Interpreter working memory: "+STR$(FRE(0))
|
||||
RETURN
|
||||
|
||||
REM memory functions
|
||||
|
||||
REM ALLOC(SZ%) -> R%
|
||||
REM ALLOC(SZ) -> R
|
||||
ALLOC:
|
||||
REM PRINT "ALLOC SZ%: "+STR$(SZ%)+", ZK%: "+STR$(ZK%)
|
||||
U3%=ZK%
|
||||
U4%=ZK%
|
||||
REM PRINT "ALLOC SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
|
||||
U3=ZK
|
||||
U4=ZK
|
||||
ALLOC_LOOP:
|
||||
IF U4%=ZI% THEN GOTO ALLOC_UNUSED
|
||||
IF U4=ZI THEN GOTO ALLOC_UNUSED
|
||||
REM TODO sanity check that type is 15
|
||||
IF ((Z%(U4%,0)AND-16)/16)=SZ% THEN GOTO ALLOC_MIDDLE
|
||||
REM PRINT "ALLOC search: U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
|
||||
U3%=U4%: REM previous set to current
|
||||
U4%=Z%(U4%,1): REM current set to next
|
||||
IF ((Z%(U4,0)AND-16)/16)=SZ THEN GOTO ALLOC_MIDDLE
|
||||
REM PRINT "ALLOC search: U3: "+STR$(U3)+", U4: "+STR$(U4)
|
||||
U3=U4: REM previous set to current
|
||||
U4=Z%(U4,1): REM current set to next
|
||||
GOTO ALLOC_LOOP
|
||||
ALLOC_MIDDLE:
|
||||
REM PRINT "ALLOC_MIDDLE: U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
|
||||
R%=U4%
|
||||
REM set free pointer (ZK%) to next free
|
||||
IF U4%=ZK% THEN ZK%=Z%(U4%,1)
|
||||
REM PRINT "ALLOC_MIDDLE: U3: "+STR$(U3)+", U4: "+STR$(U4)
|
||||
R=U4
|
||||
REM set free pointer (ZK) to next free
|
||||
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)
|
||||
IF U4<>ZK THEN Z%(U3,1)=Z%(U4,1)
|
||||
RETURN
|
||||
ALLOC_UNUSED:
|
||||
REM PRINT "ALLOC_UNUSED ZI%: "+STR$(ZI%)+", U3%: "+STR$(U3%)+", U4%: "+STR$(U4%)
|
||||
R%=U4%
|
||||
ZI%=ZI%+SZ%
|
||||
IF U3%=U4% THEN ZK%=ZI%
|
||||
REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U3: "+STR$(U3)+", U4: "+STR$(U4)
|
||||
R=U4
|
||||
ZI=ZI+SZ
|
||||
IF U3=U4 THEN ZK=ZI
|
||||
REM set previous free to new memory top
|
||||
IF U3%<>U4% THEN Z%(U3%,1)=ZI%
|
||||
IF U3<>U4 THEN Z%(U3,1)=ZI
|
||||
RETURN
|
||||
|
||||
REM FREE(AY%, SZ%) -> nil
|
||||
REM FREE(AY, SZ) -> nil
|
||||
FREE:
|
||||
REM assumes reference count cleanup already (see RELEASE)
|
||||
Z%(AY%,0)=(SZ%*16)+15: REM set type(15) and size
|
||||
Z%(AY%,1)=ZK%
|
||||
ZK%=AY%
|
||||
IF SZ%>=2 THEN Z%(AY%+1,0)=0:Z%(AY%+1,1)=0
|
||||
IF SZ%>=3 THEN Z%(AY%+2,0)=0:Z%(AY%+2,1)=0
|
||||
Z%(AY,0)=(SZ*16)+15: REM set type(15) and size
|
||||
Z%(AY,1)=ZK
|
||||
ZK=AY
|
||||
IF SZ>=2 THEN Z%(AY+1,0)=0:Z%(AY+1,1)=0
|
||||
IF SZ>=3 THEN Z%(AY+2,0)=0:Z%(AY+2,1)=0
|
||||
RETURN
|
||||
|
||||
|
||||
REM RELEASE(AY%) -> nil
|
||||
REM R% should not be affected by this call
|
||||
REM RELEASE(AY) -> nil
|
||||
REM R should not be affected by this call
|
||||
RELEASE:
|
||||
RC%=0
|
||||
RC=0
|
||||
|
||||
GOTO RELEASE_ONE
|
||||
|
||||
RELEASE_TOP:
|
||||
|
||||
IF RC%=0 THEN RETURN
|
||||
IF RC=0 THEN RETURN
|
||||
|
||||
REM pop next object to release, decrease remaining count
|
||||
AY%=ZZ%(ZL%):ZL%=ZL%-1
|
||||
RC%=RC%-1
|
||||
AY=S%(X):X=X-1
|
||||
RC=RC-1
|
||||
|
||||
RELEASE_ONE:
|
||||
|
||||
REM nil, false, true
|
||||
IF AY%<3 THEN GOTO RELEASE_TOP
|
||||
IF AY<3 THEN GOTO RELEASE_TOP
|
||||
|
||||
U6%=Z%(AY%,0)AND15: REM type
|
||||
U6=Z%(AY,0)AND15: REM type
|
||||
|
||||
REM AZ%=AY%: PR%=1: GOSUB PR_STR
|
||||
REM PRINT "RELEASE AY%:"+STR$(AY%)+"["+R$+"] (byte0:"+STR$(Z%(AY%,0))+")"
|
||||
REM AZ=AY: PR=1: GOSUB PR_STR
|
||||
REM PRINT "RELEASE AY:"+STR$(AY)+"["+R$+"] (byte0:"+STR$(Z%(AY,0))+")"
|
||||
|
||||
REM sanity check not already freed
|
||||
IF (U6%)=15 THEN ER%=-1:ER$="Free of free memory: "+STR$(AY%):RETURN
|
||||
IF U6%=14 THEN GOTO RELEASE_REFERENCE
|
||||
IF Z%(AY%,0)<15 THEN ER%=-1:ER$="Free of freed object: "+STR$(AY%):RETURN
|
||||
IF (U6)=15 THEN ER=-1:ER$="Free of free memory: "+STR$(AY):RETURN
|
||||
IF U6=14 THEN GOTO RELEASE_REFERENCE
|
||||
IF Z%(AY,0)<15 THEN ER=-1:ER$="Free of freed object: "+STR$(AY):RETURN
|
||||
|
||||
REM decrease reference count by one
|
||||
Z%(AY%,0)=Z%(AY%,0)-16
|
||||
Z%(AY,0)=Z%(AY,0)-16
|
||||
|
||||
REM our reference count is not 0, so don't release
|
||||
IF Z%(AY%,0)>=16 GOTO RELEASE_TOP
|
||||
IF Z%(AY,0)>=16 GOTO RELEASE_TOP
|
||||
|
||||
REM switch on type
|
||||
IF (U6%<=5) OR (U6%=9) THEN GOTO RELEASE_SIMPLE
|
||||
IF (U6%>=6) AND (U6%<=8) THEN GOTO RELEASE_SEQ
|
||||
IF U6%=10 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6%=11 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6%=12 THEN GOTO RELEASE_ATOM
|
||||
IF U6%=13 THEN GOTO RELEASE_ENV
|
||||
IF U6%=15 THEN ER%=-1:ER$="RELEASE of already freed: "+STR$(AY%):RETURN
|
||||
ER%=-1:ER$="RELEASE not defined for type "+STR$(U6%):RETURN
|
||||
IF (U6<=5) OR (U6=9) THEN GOTO RELEASE_SIMPLE
|
||||
IF (U6>=6) AND (U6<=8) THEN GOTO RELEASE_SEQ
|
||||
IF U6=10 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6=11 THEN GOTO RELEASE_MAL_FUNCTION
|
||||
IF U6=12 THEN GOTO RELEASE_ATOM
|
||||
IF U6=13 THEN GOTO RELEASE_ENV
|
||||
IF U6=15 THEN ER=-1:ER$="RELEASE of already freed: "+STR$(AY):RETURN
|
||||
ER=-1:ER$="RELEASE not defined for type "+STR$(U6):RETURN
|
||||
|
||||
RELEASE_SIMPLE:
|
||||
REM simple type (no recursing), just call FREE on it
|
||||
SZ%=1:GOSUB FREE
|
||||
SZ=1:GOSUB FREE
|
||||
GOTO RELEASE_TOP
|
||||
RELEASE_SIMPLE_2:
|
||||
REM free the current element and continue
|
||||
SZ%=2:GOSUB FREE
|
||||
SZ=2:GOSUB FREE
|
||||
GOTO RELEASE_TOP
|
||||
RELEASE_SEQ:
|
||||
IF Z%(AY%,1)=0 THEN GOTO RELEASE_SIMPLE_2
|
||||
IF Z%(AY%+1,0)<>14 THEN ER%=-1:ER$="invalid list value"+STR$(AY%+1):RETURN
|
||||
IF Z%(AY,1)=0 THEN GOTO RELEASE_SIMPLE_2
|
||||
IF Z%(AY+1,0)<>14 THEN ER=-1:ER$="invalid list value"+STR$(AY+1):RETURN
|
||||
REM add value and next element to stack
|
||||
RC%=RC%+2:ZL%=ZL%+2:ZZ%(ZL%-1)=Z%(AY%+1,1):ZZ%(ZL%)=Z%(AY%,1)
|
||||
RC=RC+2:X=X+2:S%(X-1)=Z%(AY+1,1):S%(X)=Z%(AY,1)
|
||||
GOTO RELEASE_SIMPLE_2
|
||||
RELEASE_ATOM:
|
||||
REM add contained/referred value
|
||||
RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(AY%,1)
|
||||
RC=RC+1:X=X+1:S%(X)=Z%(AY,1)
|
||||
REM free the atom itself
|
||||
GOTO RELEASE_SIMPLE
|
||||
RELEASE_MAL_FUNCTION:
|
||||
REM add ast, params and environment to stack
|
||||
RC%=RC%+3:ZL%=ZL%+3
|
||||
ZZ%(ZL%-2)=Z%(AY%,1):ZZ%(ZL%-1)=Z%(AY%+1,0):ZZ%(ZL%)=Z%(AY%+1,1)
|
||||
RC=RC+3:X=X+3
|
||||
S%(X-2)=Z%(AY,1):S%(X-1)=Z%(AY+1,0):S%(X)=Z%(AY+1,1)
|
||||
REM free the current 2 element mal_function and continue
|
||||
SZ%=2:GOSUB FREE
|
||||
SZ=2:GOSUB FREE
|
||||
GOTO RELEASE_TOP
|
||||
RELEASE_ENV:
|
||||
REM add the hashmap data to the stack
|
||||
RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(AY%,1)
|
||||
RC=RC+1:X=X+1:S%(X)=Z%(AY,1)
|
||||
REM if no outer set
|
||||
IF Z%(AY%+1,1)=-1 THEN GOTO RELEASE_ENV_FREE
|
||||
IF Z%(AY+1,1)=-1 THEN GOTO RELEASE_ENV_FREE
|
||||
REM add outer environment to the stack
|
||||
RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(AY%+1,1)
|
||||
RC=RC+1:X=X+1:S%(X)=Z%(AY+1,1)
|
||||
RELEASE_ENV_FREE:
|
||||
REM free the current 2 element environment and continue
|
||||
SZ%=2:GOSUB FREE
|
||||
SZ=2:GOSUB FREE
|
||||
GOTO RELEASE_TOP
|
||||
RELEASE_REFERENCE:
|
||||
IF Z%(AY%,1)=0 THEN GOTO RELEASE_SIMPLE
|
||||
IF Z%(AY,1)=0 THEN GOTO RELEASE_SIMPLE
|
||||
REM add the referred element to the stack
|
||||
RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=Z%(AY%,1)
|
||||
RC=RC+1:X=X+1:S%(X)=Z%(AY,1)
|
||||
REM free the current element and continue
|
||||
SZ%=1:GOSUB FREE
|
||||
SZ=1:GOSUB FREE
|
||||
GOTO RELEASE_TOP
|
||||
|
||||
REM RELEASE_PEND(LV%) -> nil
|
||||
REM RELEASE_PEND(LV) -> nil
|
||||
RELEASE_PEND:
|
||||
IF ZM%<0 THEN RETURN
|
||||
IF ZR%(ZM%,1)<=LV% THEN RETURN
|
||||
IF ZR%(ZM%,1)<=LV THEN RETURN
|
||||
REM PRINT "RELEASE_PEND releasing:"+STR$(ZR%(ZM%,0))
|
||||
AY%=ZR%(ZM%,0):GOSUB RELEASE
|
||||
AY=ZR%(ZM%,0):GOSUB RELEASE
|
||||
ZM%=ZM%-1
|
||||
GOTO RELEASE_PEND
|
||||
|
||||
REM DEREF_R(R%) -> R%
|
||||
REM DEREF_R(R) -> R
|
||||
DEREF_R:
|
||||
IF (Z%(R%,0)AND15)=14 THEN R%=Z%(R%,1):GOTO DEREF_R
|
||||
IF (Z%(R,0)AND15)=14 THEN R=Z%(R,1):GOTO DEREF_R
|
||||
RETURN
|
||||
|
||||
REM DEREF_A(A%) -> A%
|
||||
REM DEREF_A(A) -> A
|
||||
DEREF_A:
|
||||
IF (Z%(A%,0)AND15)=14 THEN A%=Z%(A%,1):GOTO DEREF_A
|
||||
IF (Z%(A,0)AND15)=14 THEN A=Z%(A,1):GOTO DEREF_A
|
||||
RETURN
|
||||
|
||||
REM DEREF_B(B%) -> B%
|
||||
REM DEREF_B(B) -> B
|
||||
DEREF_B:
|
||||
IF (Z%(B%,0)AND15)=14 THEN B%=Z%(B%,1):GOTO DEREF_B
|
||||
IF (Z%(B,0)AND15)=14 THEN B=Z%(B,1):GOTO DEREF_B
|
||||
RETURN
|
||||
|
||||
CHECK_FREE_LIST:
|
||||
REM start and accumulator
|
||||
P1%=ZK%
|
||||
P1%=ZK
|
||||
P2%=0
|
||||
CHECK_FREE_LIST_LOOP:
|
||||
IF P1%>=ZI% THEN GOTO CHECK_FREE_LIST_DONE
|
||||
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)
|
||||
@ -241,66 +241,66 @@ CHECK_FREE_LIST:
|
||||
|
||||
REM general functions
|
||||
|
||||
REM EQUAL_Q(A%, B%) -> R%
|
||||
REM EQUAL_Q(A, B) -> R
|
||||
EQUAL_Q:
|
||||
GOSUB DEREF_A
|
||||
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
|
||||
IF U1%=6 THEN GOTO EQUAL_Q_SEQ
|
||||
IF U1%=7 THEN GOTO EQUAL_Q_SEQ
|
||||
IF U1%=8 THEN GOTO EQUAL_Q_HM
|
||||
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
|
||||
IF U1=6 THEN GOTO EQUAL_Q_SEQ
|
||||
IF U1=7 THEN GOTO EQUAL_Q_SEQ
|
||||
IF U1=8 THEN GOTO EQUAL_Q_HM
|
||||
|
||||
IF Z%(A%,1)=Z%(B%,1) THEN R%=1
|
||||
IF Z%(A,1)=Z%(B,1) THEN R=1
|
||||
RETURN
|
||||
|
||||
EQUAL_Q_SEQ:
|
||||
IF (Z%(A%,1)=0) AND (Z%(B%,1)=0) THEN R%=1:RETURN
|
||||
IF (Z%(A%,1)=0) OR (Z%(B%,1)=0) THEN R%=0:RETURN
|
||||
IF (Z%(A,1)=0) AND (Z%(B,1)=0) THEN R=1:RETURN
|
||||
IF (Z%(A,1)=0) OR (Z%(B,1)=0) THEN R=0:RETURN
|
||||
|
||||
REM push A% and B%
|
||||
ZL%=ZL%+2:ZZ%(ZL%-1)=A%:ZZ%(ZL%)=B%
|
||||
REM push A and B
|
||||
X=X+2:S%(X-1)=A:S%(X)=B
|
||||
REM compare the elements
|
||||
A%=Z%(A%+1,1):B%=Z%(B%+1,1):GOSUB EQUAL_Q
|
||||
REM pop A% and B%
|
||||
A%=ZZ%(ZL%-1):B%=ZZ%(ZL%):ZL%=ZL%-2
|
||||
IF R%=0 THEN RETURN
|
||||
A=Z%(A+1,1):B=Z%(B+1,1):GOSUB EQUAL_Q
|
||||
REM pop A and B
|
||||
A=S%(X-1):B=S%(X):X=X-2
|
||||
IF R=0 THEN RETURN
|
||||
|
||||
REM next elements of the sequences
|
||||
A%=Z%(A%,1):B%=Z%(B%,1):GOTO EQUAL_Q_SEQ
|
||||
A=Z%(A,1):B=Z%(B,1):GOTO EQUAL_Q_SEQ
|
||||
EQUAL_Q_HM:
|
||||
R%=0
|
||||
R=0
|
||||
RETURN
|
||||
|
||||
REM string functions
|
||||
|
||||
REM STRING_(AS$) -> R%
|
||||
REM STRING_(AS$) -> R
|
||||
REM intern string (returns string index, not Z% index)
|
||||
STRING_:
|
||||
IF ZJ%=0 THEN GOTO STRING_NOT_FOUND
|
||||
IF ZJ=0 THEN GOTO STRING_NOT_FOUND
|
||||
|
||||
REM search for matching string in ZS$
|
||||
FOR I=0 TO ZJ%-1
|
||||
IF AS$=ZS$(I) THEN R%=I:RETURN
|
||||
REM search for matching string in S$
|
||||
FOR I=0 TO ZJ-1
|
||||
IF AS$=S$(I) THEN R=I:RETURN
|
||||
NEXT I
|
||||
|
||||
STRING_NOT_FOUND:
|
||||
ZS$(ZJ%)=AS$
|
||||
R%=ZJ%
|
||||
ZJ%=ZJ%+1
|
||||
S$(ZJ)=AS$
|
||||
R=ZJ
|
||||
ZJ=ZJ+1
|
||||
RETURN
|
||||
|
||||
REM STRING(AS$, T%) -> R%
|
||||
REM STRING(AS$, T) -> R
|
||||
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%
|
||||
TS%=R
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=T
|
||||
Z%(R,1)=TS%
|
||||
RETURN
|
||||
|
||||
REM REPLACE(R$, S1$, S2$) -> R$
|
||||
@ -319,211 +319,211 @@ REPLACE:
|
||||
|
||||
REM list functions
|
||||
|
||||
REM LIST_Q(A%) -> R%
|
||||
REM LIST_Q(A) -> R
|
||||
LIST_Q:
|
||||
R%=0
|
||||
IF (Z%(A%,0)AND15)=6 THEN R%=1
|
||||
R=0
|
||||
IF (Z%(A,0)AND15)=6 THEN R=1
|
||||
RETURN
|
||||
|
||||
REM EMPTY_Q(A%) -> R%
|
||||
REM EMPTY_Q(A) -> R
|
||||
EMPTY_Q:
|
||||
R%=0
|
||||
IF Z%(A%,1)=0 THEN R%=1
|
||||
R=0
|
||||
IF Z%(A,1)=0 THEN R=1
|
||||
RETURN
|
||||
|
||||
REM COUNT(A%) -> R%
|
||||
REM COUNT(A) -> R
|
||||
COUNT:
|
||||
R%=-1
|
||||
R=-1
|
||||
DO_COUNT_LOOP:
|
||||
R%=R%+1
|
||||
IF Z%(A%,1)<>0 THEN A%=Z%(A%,1):GOTO DO_COUNT_LOOP
|
||||
R=R+1
|
||||
IF Z%(A,1)<>0 THEN A=Z%(A,1):GOTO DO_COUNT_LOOP
|
||||
RETURN
|
||||
|
||||
REM LAST(A%) -> R%
|
||||
REM LAST(A) -> R
|
||||
LAST:
|
||||
REM TODO check that actually a list/vector
|
||||
IF Z%(A%,1)=0 THEN R%=0:RETURN: REM empty seq, return nil
|
||||
T6%=0
|
||||
IF Z%(A,1)=0 THEN R=0:RETURN: REM empty seq, return nil
|
||||
T6=0
|
||||
LAST_LOOP:
|
||||
IF Z%(A%,1)=0 THEN GOTO LAST_DONE: REM end, return previous value
|
||||
T6%=A%: REM current becomes previous entry
|
||||
A%=Z%(A%,1): REM next entry
|
||||
IF Z%(A,1)=0 THEN GOTO LAST_DONE: REM end, return previous value
|
||||
T6=A: REM current becomes previous entry
|
||||
A=Z%(A,1): REM next entry
|
||||
GOTO LAST_LOOP
|
||||
LAST_DONE:
|
||||
R%=T6%+1:GOSUB DEREF_R
|
||||
Z%(R%,0)=Z%(R%,0)+16
|
||||
R=T6+1:GOSUB DEREF_R
|
||||
Z%(R,0)=Z%(R,0)+16
|
||||
RETURN
|
||||
|
||||
REM CONS(A%,B%) -> R%
|
||||
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%
|
||||
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
|
||||
Z%(A,0)=Z%(A,0)+16
|
||||
REM inc ref cnt of list we are prepending
|
||||
Z%(B%,0)=Z%(B%,0)+16
|
||||
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
|
||||
REM returns A% as next element following slice (of original)
|
||||
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
|
||||
REM returns A as next element following slice (of original)
|
||||
SLICE:
|
||||
I=0
|
||||
R5%=-1: REM temporary for return as R%
|
||||
R6%=0: REM previous list element
|
||||
R5=-1: REM temporary for return as R
|
||||
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
|
||||
IF R5%=-1 THEN R5%=R%
|
||||
IF R5%<>-1 THEN Z%(R6%,1)=R%
|
||||
REM advance A% to position B%
|
||||
SZ=2:GOSUB ALLOC
|
||||
Z%(R,0)=6+16:Z%(R,1)=0:Z%(R+1,0)=14:Z%(R+1,1)=0
|
||||
IF R5=-1 THEN R5=R
|
||||
IF R5<>-1 THEN Z%(R6,1)=R
|
||||
REM advance A to position B
|
||||
SLICE_FIND_B:
|
||||
IF I<B% AND Z%(A%,1)<>0 THEN A%=Z%(A%,1):I=I+1:GOTO SLICE_FIND_B
|
||||
REM if current position is C%, then return
|
||||
IF C%<>-1 AND I>=C% THEN R%=R5%:RETURN
|
||||
REM if we reached end of A%, then return
|
||||
IF Z%(A%,1)=0 THEN R%=R5%:RETURN
|
||||
R6%=R%: REM save previous list element
|
||||
IF I<B AND Z%(A,1)<>0 THEN A=Z%(A,1):I=I+1:GOTO SLICE_FIND_B
|
||||
REM if current position is C, then return
|
||||
IF C<>-1 AND I>=C THEN R=R5:RETURN
|
||||
REM if we reached end of A, then return
|
||||
IF Z%(A,1)=0 THEN R=R5:RETURN
|
||||
R6=R: REM save previous list element
|
||||
REM copy value and inc ref cnt
|
||||
Z%(R6%+1,1)=Z%(A%+1,1)
|
||||
R%=A%+1:GOSUB DEREF_R:Z%(R%,0)=Z%(R%,0)+16
|
||||
REM advance to next element of A%
|
||||
A%=Z%(A%,1)
|
||||
Z%(R6+1,1)=Z%(A+1,1)
|
||||
R=A+1:GOSUB DEREF_R:Z%(R,0)=Z%(R,0)+16
|
||||
REM advance to next element of A
|
||||
A=Z%(A,1)
|
||||
I=I+1
|
||||
GOTO SLICE_LOOP
|
||||
|
||||
REM LIST2(B2%,B1%) -> R%
|
||||
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
|
||||
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%
|
||||
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 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%
|
||||
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
|
||||
|
||||
RETURN
|
||||
|
||||
REM LIST3(B3%,B2%,B1%) -> R%
|
||||
REM LIST3(B3%,B2%,B1%) -> R
|
||||
LIST3:
|
||||
GOSUB LIST2:TC%=R%
|
||||
GOSUB LIST2:TC%=R
|
||||
|
||||
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%
|
||||
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
|
||||
|
||||
RETURN
|
||||
|
||||
REM hashmap functions
|
||||
|
||||
REM HASHMAP() -> R%
|
||||
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
|
||||
SZ=2:GOSUB ALLOC
|
||||
Z%(R,0)=8+16
|
||||
Z%(R,1)=0
|
||||
Z%(R+1,0)=14
|
||||
Z%(R+1,1)=0
|
||||
RETURN
|
||||
|
||||
REM ASSOC1(HM%, K%, V%) -> R%
|
||||
REM ASSOC1(H, K, V) -> R
|
||||
ASSOC1:
|
||||
REM deref to actual key and value
|
||||
R%=K%:GOSUB DEREF_R:K%=R%
|
||||
R%=V%:GOSUB DEREF_R:V%=R%
|
||||
R=K:GOSUB DEREF_R:K=R
|
||||
R=V:GOSUB DEREF_R:V=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
|
||||
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%
|
||||
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)=HM%: REM hashmap to assoc onto
|
||||
Z%(R%+3,0)=14
|
||||
Z%(R%+3,1)=V%
|
||||
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
|
||||
RETURN
|
||||
|
||||
REM ASSOC1(HM%, K$, V%) -> R%
|
||||
REM ASSOC1(H, K$, V) -> R
|
||||
ASSOC1_S:
|
||||
REM add the key string, then call ASSOC1
|
||||
SZ%=1:GOSUB ALLOC
|
||||
K%=R%
|
||||
ZS$(ZJ%)=K$
|
||||
Z%(R%,0)=4: REM key ref cnt will be inc'd by ASSOC1
|
||||
Z%(R%,1)=ZJ%
|
||||
ZJ%=ZJ%+1
|
||||
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
|
||||
ZJ=ZJ+1
|
||||
GOSUB ASSOC1
|
||||
RETURN
|
||||
|
||||
REM HASHMAP_GET(HM%, K%) -> R%
|
||||
REM HASHMAP_GET(H, K) -> R
|
||||
HASHMAP_GET:
|
||||
H2%=HM%
|
||||
T1$=ZS$(Z%(K%,1)): REM search key string
|
||||
T3%=0: REM whether found or not (for HASHMAP_CONTAINS)
|
||||
R%=0
|
||||
H2%=H
|
||||
T1$=S$(Z%(K,1)): REM search key string
|
||||
T3=0: REM whether found or not (for HASHMAP_CONTAINS)
|
||||
R=0
|
||||
HASHMAP_GET_LOOP:
|
||||
REM no matching key found
|
||||
IF Z%(H2%,1)=0 THEN R%=0:RETURN
|
||||
IF Z%(H2%,1)=0 THEN R=0:RETURN
|
||||
REM follow value ptrs
|
||||
T2%=H2%+1
|
||||
T2=H2%+1
|
||||
HASHMAP_GET_DEREF:
|
||||
IF Z%(T2%,0)=14 THEN T2%=Z%(T2%,1):GOTO HASHMAP_GET_DEREF
|
||||
IF Z%(T2,0)=14 THEN T2=Z%(T2,1):GOTO HASHMAP_GET_DEREF
|
||||
REM get key string
|
||||
T2$=ZS$(Z%(T2%,1))
|
||||
T2$=S$(Z%(T2,1))
|
||||
REM if they are equal, we found it
|
||||
IF T1$=T2$ THEN T3%=1:R%=Z%(H2%,1)+1:RETURN
|
||||
IF T1$=T2$ THEN T3=1:R=Z%(H2%,1)+1:RETURN
|
||||
REM skip to next key
|
||||
H2%=Z%(Z%(H2%,1),1)
|
||||
GOTO HASHMAP_GET_LOOP
|
||||
|
||||
REM HASHMAP_CONTAINS(HM%, K%) -> R%
|
||||
REM HASHMAP_CONTAINS(H, K) -> R
|
||||
HASHMAP_CONTAINS:
|
||||
GOSUB HASHMAP_GET
|
||||
R%=T3%
|
||||
R=T3
|
||||
RETURN
|
||||
|
||||
REM NATIVE_FUNCTION(A%) -> R%
|
||||
REM NATIVE_FUNCTION(A) -> R
|
||||
NATIVE_FUNCTION:
|
||||
SZ%=1:GOSUB ALLOC
|
||||
Z%(R%,0)=9+16
|
||||
Z%(R%,1)=A%
|
||||
SZ=1:GOSUB ALLOC
|
||||
Z%(R,0)=9+16
|
||||
Z%(R,1)=A
|
||||
RETURN
|
||||
|
||||
REM NATIVE_FUNCTION(A%, P%, E%) -> R%
|
||||
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
|
||||
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%
|
||||
Z%(R,0)=10+16
|
||||
Z%(R,1)=A
|
||||
Z%(R+1,0)=P
|
||||
Z%(R+1,1)=E
|
||||
RETURN
|
||||
|
||||
REM APPLY(F%, AR%) -> R%
|
||||
REM restores E%
|
||||
REM APPLY(F, AR) -> R
|
||||
REM restores E
|
||||
APPLY:
|
||||
IF (Z%(F%,0)AND15)=9 THEN GOTO DO_APPLY_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=10 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
IF (Z%(F%,0)AND15)=11 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=9 THEN GOTO DO_APPLY_FUNCTION
|
||||
IF (Z%(F,0)AND15)=10 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
IF (Z%(F,0)AND15)=11 THEN GOTO DO_APPLY_MAL_FUNCTION
|
||||
|
||||
DO_APPLY_FUNCTION:
|
||||
GOSUB DO_FUNCTION
|
||||
@ -531,17 +531,17 @@ APPLY:
|
||||
RETURN
|
||||
|
||||
DO_APPLY_MAL_FUNCTION:
|
||||
ZL%=ZL%+1:ZZ%(ZL%)=E%: REM save the current environment
|
||||
X=X+1:S%(X)=E: REM save the current environment
|
||||
|
||||
REM create new environ using env and params stored in the
|
||||
REM function and bind the params to the apply arguments
|
||||
EO%=Z%(F%+1,1):BI%=Z%(F%+1,0):EX%=AR%:GOSUB ENV_NEW_BINDS
|
||||
O=Z%(F+1,1):BI%=Z%(F+1,0):EX%=AR:GOSUB ENV_NEW_BINDS
|
||||
|
||||
A%=Z%(F%,1):E%=R%:GOSUB EVAL
|
||||
A=Z%(F,1):E=R:GOSUB EVAL
|
||||
|
||||
AY%=E%:GOSUB RELEASE: REM release the new environment
|
||||
AY=E:GOSUB RELEASE: REM release the new environment
|
||||
|
||||
E%=ZZ%(ZL%):ZL%=ZL%-1: REM pop/restore the saved environment
|
||||
E=S%(X):X=X-1: REM pop/restore the saved environment
|
||||
|
||||
RETURN
|
||||
|
||||
|
||||
48
basic/variables.txt
Normal file
48
basic/variables.txt
Normal file
@ -0,0 +1,48 @@
|
||||
Global Unique:
|
||||
|
||||
Z% : boxed memory values
|
||||
ZI : start of unused memory (index into Z%)
|
||||
ZK : start of free list (index into Z%)
|
||||
|
||||
S$ : string memory storage
|
||||
ZJ : next free index in S$
|
||||
|
||||
S% : logic/call stack (Z% indexes)
|
||||
X : top element of S% stack
|
||||
|
||||
ZR% : pending release stack (index into Z%, eval level)
|
||||
ZM% : top element of ZR% stack
|
||||
|
||||
RE% : root repl environment
|
||||
|
||||
ER : error type (-2: none, -1: string, >=0: object)
|
||||
ER$ : error string (ER=-1)
|
||||
|
||||
LV : EVAL stack call level/depth
|
||||
|
||||
Calling arguments/temporaries:
|
||||
|
||||
A : common call arguments (especially EVAL, EVAL_AST)
|
||||
B : common call arguments
|
||||
C : common call arguments
|
||||
E : environment (EVAL, EVAL_AST)
|
||||
F : function
|
||||
H : hash map
|
||||
K : hash map key (Z% index)
|
||||
K$ : hash map key string
|
||||
O : outer environment
|
||||
P : MAL_FUNCTION
|
||||
R : common return value
|
||||
T : common temp, type
|
||||
V : hash map value
|
||||
|
||||
SZ : size argument to ALLOC
|
||||
|
||||
Reused/temporaries:
|
||||
|
||||
I : STRING, REPLACE, SLICE, PR_MEMORY, PR_OBJECT
|
||||
J : REPLACE
|
||||
|
||||
Unused:
|
||||
|
||||
D, G, L, M, N, Q, U, W, Y
|
||||
Loading…
Reference in New Issue
Block a user