-REM Z 0 -> 1
-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 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 followed by value (unless empty)
-REM hashmap next/val 8 -> next Z% index (0 for last)
-REM followed by key or value (alternating)
-REM function 9 -> function index
-REM mal function 10 -> body AST Z% index
-REM followed by param and env Z% index
-REM macro (same as 10) 11 -> body AST Z% index
-REM followed by param and env Z% index
-REM atom 12 -> Z% index
-REM environment 13 -> data/hashmap Z% index
-REM followed by 13 and outer Z% index (-1 for none)
-REM reference/ptr 14 -> Z% index / or 0
-REM next free ptr 15 -> Z% index / or 0
-
-INIT_MEMORY:
- 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)
-
- REM global error state
- REM -2 : no error
- REM -1 : string error in ER$
- REM >=0 : pointer to error object
- ER%=-2
- ER$=""
-
- REM boxed element memory
- DIM Z%(S1%,1): REM TYPE ARRAY
-
- REM Predefine nil, false, true, and an empty list
- Z%(0,0)=0:Z%(0,1)=0
- Z%(1,0)=1:Z%(1,1)=0
- Z%(2,0)=1:Z%(2,1)=1
- Z%(3,0)=6+16:Z%(3,1)=0
- Z%(4,0)=0:Z%(4,1)=0
-
- REM start of unused memory
- ZI%=5
-
- REM start of free list
- ZK%=5
-
- REM string memory storage
- ZJ%=0:DIM ZS$(S2%)
-
- REM call/logic stack
- ZL%=-1:DIM ZZ%(S3%): REM stack of Z% indexes
-
- REM pending release stack
- ZM%=-1:DIM ZR%(S4%,1): REM stack of Z% indexes
-
- 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%
-ALLOC:
- REM PRINT "ALLOC SZ%: "+STR$(SZ%)+", ZK%: "+STR$(ZK%)
- U3%=ZK%
- U4%=ZK%
- ALLOC_LOOP:
- 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
- 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 set previous free to next free
- 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 set previous free to new memory top
- IF U3%<>U4% THEN Z%(U3%,1)=ZI%
- RETURN
-
-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
- RETURN
-
-
-REM RELEASE(AY%) -> nil
-REM R% should not be affected by this call
-RELEASE:
- RC%=0
-
- GOTO RELEASE_ONE
-
- RELEASE_TOP:
-
- IF RC%=0 THEN RETURN
-
- REM pop next object to release, decrease remaining count
- AY%=ZZ%(ZL%):ZL%=ZL%-1
- RC%=RC%-1
-
- RELEASE_ONE:
-
- REM nil, false, true
- IF AY%<3 THEN GOTO RELEASE_TOP
-
- 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 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
-
- REM decrease reference count by one
- 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
-
- 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
-
- RELEASE_SIMPLE:
- REM simple type (no recursing), just call FREE on it
- SZ%=1:GOSUB FREE
- GOTO RELEASE_TOP
- RELEASE_SIMPLE_2:
- REM free the current element and continue
- 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
- 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)
- GOTO RELEASE_SIMPLE_2
- RELEASE_ATOM:
- REM add contained/referred value
- RC%=RC%+1:ZL%=ZL%+1:ZZ%(ZL%)=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)
- REM free the current 2 element mal_function and continue
- 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)
- REM if no outer set
- 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)
- RELEASE_ENV_FREE:
- REM free the current 2 element environment and continue
- SZ%=2:GOSUB FREE
- GOTO RELEASE_TOP
- RELEASE_REFERENCE:
- 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)
- REM free the current element and continue
- SZ%=1:GOSUB FREE
- GOTO RELEASE_TOP
-
-REM RELEASE_PEND(LV%) -> nil
-RELEASE_PEND:
- IF ZM%<0 THEN RETURN
- IF ZR%(ZM%,1)<=LV% THEN RETURN
- REM PRINT "RELEASE_PEND releasing:"+STR$(ZR%(ZM%,0))
- AY%=ZR%(ZM%,0):GOSUB RELEASE
- ZM%=ZM%-1
- GOTO RELEASE_PEND
-
-REM DEREF_R(R%) -> R%
-DEREF_R:
- IF (Z%(R%,0)AND15)=14 THEN R%=Z%(R%,1):GOTO DEREF_R
- RETURN
-
-REM DEREF_A(A%) -> A%
-DEREF_A:
- IF (Z%(A%,0)AND15)=14 THEN A%=Z%(A%,1):GOTO DEREF_A
- RETURN
-
-REM DEREF_B(B%) -> B%
-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%
- P2%=0
- CHECK_FREE_LIST_LOOP:
- IF P1%>=ZI% THEN GOTO CHECK_FREE_LIST_DONE
- IF (Z%(P1%,0)AND15)<>15 THEN P2%=-1:GOTO CHECK_FREE_LIST_DONE
- P2%=P2%+(Z%(P1%,0)AND-16)/16
- P1%=Z%(P1%,1)
- GOTO CHECK_FREE_LIST_LOOP
- CHECK_FREE_LIST_DONE:
- IF P2%=-1 THEN PRINT "corrupt free list at "+STR$(P1%)
- RETURN
-
-
-REM general functions
-
-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
-
- 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
-
- REM push A% and B%
- ZL%=ZL%+2:ZZ%(ZL%-1)=A%:ZZ%(ZL%)=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
-
- REM next elements of the sequences
- A%=Z%(A%,1):B%=Z%(B%,1):GOTO EQUAL_Q_SEQ
- EQUAL_Q_HM:
- R%=0
- RETURN
-
-REM string functions
-
-REM STRING_(AS$) -> R%
-REM intern string (returns string index, not Z% index)
-STRING_:
- 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
- NEXT I
-
- STRING_NOT_FOUND:
- ZS$(ZJ%)=AS$
- R%=ZJ%
- ZJ%=ZJ%+1
- RETURN
-
-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%
- RETURN
-
-REM REPLACE(R$, S1$, S2$) -> R$
-REPLACE:
- T3$=R$
- R$=""
- I=1
- J=LEN(T3$)
- REPLACE_LOOP:
- IF I>J THEN RETURN
- CH$=MID$(T3$,I,LEN(S1$))
- IF CH$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$)
- IF CH$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1
- GOTO REPLACE_LOOP
-
-
-REM list functions
-
-REM LIST_Q(A%) -> R%
-LIST_Q:
- R%=0
- IF (Z%(A%,0)AND15)=6 THEN R%=1
- RETURN
-
-REM EMPTY_Q(A%) -> R%
-EMPTY_Q:
- R%=0
- IF Z%(A%,1)=0 THEN R%=1
- RETURN
-
-REM COUNT(A%) -> R%
-COUNT:
- R%=-1
- 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%
-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
- 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
- GOTO LAST_LOOP
- LAST_DONE:
- R%=T6%+1:GOSUB DEREF_R
- Z%(R%,0)=Z%(R%,0)+16
- RETURN
-
-REM CONS(A%,B%) -> R%
-CONS:
- SZ%=2:GOSUB ALLOC
- Z%(R%,0)=6+16
- Z%(R%,1)=B%
- Z%(R%+1,0)=14
- Z%(R%+1,1)=A%
- REM inc ref cnt of item we are including
- Z%(A%,0)=Z%(A%,0)+16
- REM inc ref cnt of list we are prepending
- Z%(B%,0)=Z%(B%,0)+16
- RETURN
-
-REM SLICE(A%,B%,C%) -> R%
-REM make copy of sequence A% from index B% to C%
-REM returns R6% as reference to last element of slice
-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
- 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%
- 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
- 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)
- I=I+1
- GOTO SLICE_LOOP
-
-REM LIST2(B2%,B1%) -> R%
-LIST2:
- REM terminator
- SZ%=2:GOSUB ALLOC:TB%=R%
- Z%(R%,0)=6+16:Z%(R%,1)=0:Z%(R%+1,0)=0:Z%(R%+1,1)=0
-
- REM second element is B1%
- SZ%=2:GOSUB ALLOC:TC%=R%
- Z%(R%,0)=6+16:Z%(R%,1)=TB%:Z%(R%+1,0)=14:Z%(R%+1,1)=B1%
- Z%(B1%,0)=Z%(B1%,0)+16
-
- REM first element is B2%
- SZ%=2:GOSUB ALLOC
- Z%(R%,0)=6+16:Z%(R%,1)=TC%:Z%(R%+1,0)=14:Z%(R%+1,1)=B2%
- Z%(B2%,0)=Z%(B2%,0)+16
-
- RETURN
-
-REM LIST3(B3%,B2%,B1%) -> R%
-LIST3:
- 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%
- Z%(B3%,0)=Z%(B3%,0)+16
-
- RETURN
-
-REM hashmap functions
-
-REM HASHMAP() -> R%
-HASHMAP:
- SZ%=2:GOSUB ALLOC
- Z%(R%,0)=8+16
- Z%(R%,1)=0
- Z%(R%+1,0)=14
- Z%(R%+1,1)=0
- RETURN
-
-REM ASSOC1(HM%, 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%
-
- REM inc ref count of key and value
- Z%(K%,0)=Z%(K%,0)+16
- Z%(V%,0)=Z%(V%,0)+16
- SZ%=4:GOSUB ALLOC
- REM key ptr
- Z%(R%,0)=8+16
- Z%(R%,1)=R%+2: REM point to next element (value)
- Z%(R%+1,0)=14
- Z%(R%+1,1)=K%
- REM value ptr
- Z%(R%+2,0)=8+16
- Z%(R%+2,1)=HM%: REM hashmap to assoc onto
- Z%(R%+3,0)=14
- Z%(R%+3,1)=V%
- RETURN
-
-REM ASSOC1(HM%, 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
- GOSUB ASSOC1
- RETURN
-
-REM HASHMAP_GET(HM%, 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
- HASHMAP_GET_LOOP:
- REM no matching key found
- IF Z%(H2%,1)=0 THEN R%=0:RETURN
- REM follow value ptrs
- T2%=H2%+1
- 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))
- REM if they are equal, we found it
- 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%
-HASHMAP_CONTAINS:
- GOSUB HASHMAP_GET
- R%=T3%
- RETURN
-
-REM NATIVE_FUNCTION(A%) -> R%
-NATIVE_FUNCTION:
- SZ%=1:GOSUB ALLOC
- Z%(R%,0)=9+16
- Z%(R%,1)=A%
- RETURN
-
-REM NATIVE_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%
- RETURN
-
-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
-
- DO_APPLY_FUNCTION:
- GOSUB DO_FUNCTION
-
- RETURN
-
- DO_APPLY_MAL_FUNCTION:
- ZL%=ZL%+1:ZZ%(ZL%)=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
-
- A%=Z%(F%,1):E%=R%:GOSUB EVAL
-
- AY%=E%:GOSUB RELEASE: REM release the new environment
-
- E%=ZZ%(ZL%):ZL%=ZL%-1: REM pop/restore the saved environment
-
- RETURN
-
+REM general functions
+
+REM TYPE_A(A) -> T
+TYPE_A:
+ T=Z%(A)AND 31
+ RETURN
+
+REM TYPE_F(F) -> T
+TYPE_F:
+ T=Z%(F)AND 31
+ RETURN
+
+REM EQUAL_Q(A, B) -> R
+EQUAL_Q:
+ ED=0: REM recursion depth
+ R=-1: REM return value
+
+ EQUAL_Q_RECUR:
+
+ REM push A and B
+ GOSUB PUSH_A
+ Q=B:GOSUB PUSH_Q
+ ED=ED+1
+
+ GOSUB TYPE_A
+ T2=Z%(B)AND 31
+ IF T>5 AND T<8 AND T2>5 AND T2<8 THEN GOTO EQUAL_Q_SEQ
+ IF T=8 AND T2=8 THEN GOTO EQUAL_Q_HM
+
+ IF T<>T2 OR Z%(A+1)<>Z%(B+1) THEN R=0
+ GOTO EQUAL_Q_DONE
+
+ EQUAL_Q_SEQ:
+ IF Z%(A+1)=0 AND Z%(B+1)=0 THEN GOTO EQUAL_Q_DONE
+ IF Z%(A+1)=0 OR Z%(B+1)=0 THEN R=0:GOTO EQUAL_Q_DONE
+
+ REM compare the elements
+ A=Z%(A+2):B=Z%(B+2)
+ GOTO EQUAL_Q_RECUR
+
+ EQUAL_Q_SEQ_CONTINUE:
+ REM next elements of the sequences
+ GOSUB PEEK_Q_1:A=Q
+ GOSUB PEEK_Q:B=Q
+ A=Z%(A+1):B=Z%(B+1)
+ Q=A:GOSUB PUT_Q_1
+ Q=B:GOSUB PUT_Q
+ GOTO EQUAL_Q_SEQ
+
+ EQUAL_Q_HM:
+ R=0
+ GOTO EQUAL_Q_DONE
+
+ EQUAL_Q_DONE:
+ REM pop current A and B
+ GOSUB POP_Q
+ GOSUB POP_Q
+ ED=ED-1
+ IF R>-1 AND ED>0 THEN GOTO EQUAL_Q_DONE: REM unwind
+ IF ED=0 AND R=-1 THEN R=1
+ IF ED=0 THEN RETURN
+ GOTO EQUAL_Q_SEQ_CONTINUE
+
+REM string functions
+
+REM STRING(B$, T) -> R
+REM intern string and allocate reference (return Z% index)
+STRING:
+ IF S=0 THEN GOTO STRING_NOT_FOUND
+
+ REM search for matching string in S$
+ I=0
+ STRING_FIND_LOOP:
+ IF I>S-1 THEN GOTO STRING_NOT_FOUND
+ IF S%(I)>0 AND B$=S$(I) THEN GOTO STRING_DONE
+ I=I+1
+ GOTO STRING_FIND_LOOP
+
+ STRING_NOT_FOUND:
+ I=S-1
+ STRING_FIND_GAP_LOOP:
+ REM TODO: don't search core function names (store position)
+ IF I=-1 THEN GOTO STRING_NEW
+ IF S%(I)=0 THEN GOTO STRING_SET
+ I=I-1
+ GOTO STRING_FIND_GAP_LOOP
+
+ STRING_NEW:
+ I=S
+ S=S+1
+ REM fallthrough
+
+ STRING_SET:
+ S$(I)=B$
+ REM fallthrough
+
+ STRING_DONE:
+ S%(I)=S%(I)+1
+ L=I:GOSUB ALLOC
+ RETURN
+
+REM REPLACE(R$, S1$, S2$) -> R$
+REPLACE:
+ T3$=R$
+ R$=""
+ I=1
+ J=LEN(T3$)
+ REPLACE_LOOP:
+ IF I>J THEN RETURN
+ C$=MID$(T3$,I,LEN(S1$))
+ IF C$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$)
+ IF C$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1
+ GOTO REPLACE_LOOP
+
+
+REM sequence functions
+
+REM FORCE_SEQ_TYPE(A,T) -> R
+FORCE_SEQ_TYPE:
+ REM if it's already the right type, inc ref cnt and return it
+ IF (Z%(A)AND 31)=T THEN R=A:GOTO INC_REF_R
+ REM if it's empty, return the empty sequence match T
+ IF A<16 THEN R=(T-4)*3:GOTO INC_REF_R
+ REM otherwise, copy first element to turn it into correct type
+ B=Z%(A+2): REM value to copy
+ L=Z%(A+1):M=B:GOSUB ALLOC: REM T already set
+ IF Z%(A+1)=0 THEN RETURN
+ RETURN
+
+REM MAP_LOOP_START(T):
+REM - setup stack for map loop
+MAP_LOOP_START:
+ REM point to empty sequence to start off
+ R=(T-4)*3: REM calculate location of empty seq
+
+ GOSUB PUSH_R: REM push return ptr
+ GOSUB PUSH_R: REM push empty ptr
+ GOSUB PUSH_R: REM push current ptr
+ GOTO INC_REF_R
+
+REM MAP_LOOP_UPDATE(C,M):
+REM MAP_LOOP_UPDATE(C,M,N):
+REM - called after M (and N if T=8) are set
+REM - C indicates whether to free M (and N if T=8)
+REM - update the structure of the return sequence
+MAP_LOOP_UPDATE:
+ GOSUB PEEK_Q_1:L=Q: REM empty ptr
+
+ GOSUB ALLOC: REM allocate new sequence element
+
+ REM sequence took ownership
+ AY=L:GOSUB RELEASE
+ IF C THEN AY=M:GOSUB RELEASE
+ IF C AND T=8 THEN AY=N:GOSUB RELEASE
+
+ REM if not first element, set current next to point to new element
+ GOSUB PEEK_Q
+ IF Q>14 THEN Z%(Q+1)=R
+ REM if first element, set return to new element
+ IF Q<15 THEN Q=R:GOSUB PUT_Q_2
+ Q=R:GOSUB PUT_Q: REM update current ptr to new element
+
+ RETURN
+
+REM MAP_LOOP_DONE() -> R
+REM - cleanup stack and set return value
+MAP_LOOP_DONE:
+ GOSUB POP_Q: REM pop current ptr
+ GOSUB POP_Q: REM pop empty ptr
+ GOSUB POP_R: REM pop return ptr
+ RETURN
+
+
+REM LIST_Q(A) -> R
+LIST_Q:
+ R=0
+ GOSUB TYPE_A
+ IF T=6 THEN R=1
+ RETURN
+
+REM EMPTY_Q(A) -> R
+EMPTY_Q:
+ R=0
+ IF Z%(A+1)=0 THEN R=1
+ RETURN
+
+REM COUNT(A) -> R
+REM - returns length of list, not a Z% index
+COUNT:
+ GOSUB PUSH_A
+ R=-1
+ DO_COUNT_LOOP:
+ R=R+1
+ IF Z%(A+1)<>0 THEN A=Z%(A+1):GOTO DO_COUNT_LOOP
+ GOSUB POP_A
+ RETURN
+
+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
+ W=0
+ LAST_LOOP:
+ IF Z%(A+1)=0 THEN GOTO LAST_DONE: REM end, return previous value
+ W=A: REM current becomes previous entry
+ A=Z%(A+1): REM next entry
+ GOTO LAST_LOOP
+ LAST_DONE:
+ R=Z%(W+2)
+ GOTO INC_REF_R
+
+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 before empty
+REM returns A as next element following slice (of original)
+SLICE:
+ I=0
+ R=6: REM always a list
+ GOSUB INC_REF_R
+ R6=-1: REM last list element before empty
+ W=R: REM temporary for return as R
+ REM advance A to position B
+ SLICE_FIND_B:
+ IF I<B AND Z%(A+1)<>0 THEN A=Z%(A+1):I=I+1:GOTO SLICE_FIND_B
+ SLICE_LOOP:
+ REM if current position is C, then return
+ IF C<>-1 AND I>=C THEN R=W:RETURN
+ REM if we reached end of A, then return
+ IF Z%(A+1)=0 THEN R=W:RETURN
+ REM allocate new list element with copied value
+ T=6:L=6:M=Z%(A+2):GOSUB ALLOC
+ REM sequence took ownership
+ AY=L:GOSUB RELEASE
+ REM if not first element, set last to point to new element
+ IF R6>-1 THEN Z%(R6+1)=R
+ REM if first element, set return value to new element
+ IF R6=-1 THEN W=R
+ R6=R: REM update last list element
+ REM advance to next element of A
+ A=Z%(A+1)
+ I=I+1
+ GOTO SLICE_LOOP
+
+REM LIST2(B,A) -> R
+LIST2:
+ REM last element is 3 (empty list), second element is A
+ T=6:L=6:M=A:GOSUB ALLOC
+
+ REM first element is B
+ T=6:L=R:M=B:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM new list takes ownership of previous
+
+ RETURN
+
+REM LIST3(C,B,A) -> R
+LIST3:
+ GOSUB LIST2
+
+ REM first element is C
+ T=6:L=R:M=C:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM new list takes ownership of previous
+
+ RETURN
+
+
+REM hashmap functions
+
+REM HASHMAP() -> R
+HASHMAP:
+ REM just point to static empty hash-map
+ R=12
+ GOTO INC_REF_R
+
+REM ASSOC1(H, K, C) -> R
+ASSOC1:
+ REM create key/value entry
+ T=8:L=H:M=K:N=C:GOSUB ALLOC
+ AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap
+ RETURN
+
+REM ASSOC1_S(H, B$, C) -> R
+ASSOC1_S:
+ REM add the key string
+ T=4:GOSUB STRING
+ K=R:GOSUB ASSOC1
+ AY=K:GOSUB RELEASE: REM map took ownership of key
+ RETURN
+
+REM HASHMAP_GET(H, K) -> R
+REM - returns R3 with whether we found it or not
+HASHMAP_GET:
+ B$=S$(Z%(K+1)): REM search key string
+ R3=0: REM whether found or not (for HASHMAP_CONTAINS)
+ R=0
+ HASHMAP_GET_LOOP:
+ REM no matching key found
+ IF Z%(H+1)=0 THEN R=0:RETURN
+ REM get search string is equal to key string we found it
+ IF B$=S$(Z%(Z%(H+2)+1)) THEN R3=1:R=Z%(H+3):RETURN
+ REM skip to next key/value
+ H=Z%(H+1)
+ GOTO HASHMAP_GET_LOOP
+
+REM HASHMAP_CONTAINS(H, K) -> R
+HASHMAP_CONTAINS:
+ GOSUB HASHMAP_GET
+ R=R3
+ RETURN
+
HCoop / jackhill / mal.git / blobdiff