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)
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
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)
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$
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
-
- Z%(R%,0)=10+16
- Z%(R%,1)=A%
- Z%(R%+1,0)=P%
- Z%(R%+1,1)=E%
+ 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
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
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
HCoop / jackhill / mal.git / blobdiff