mirror of
https://github.com/kanaka/mal.git
synced 2024-09-20 01:57:09 +03:00
70f29a2b3c
- Move apply logic in swap! to APPLY function in types and use that for macroexpand - Abort def! if error before updating the environment - let* wasn't properly saving A2% for the final eval. Also, the environment release check should be against the top-level EVAL env, not the root repl env. - (concat (list) ...) was broken so fix it to ignore empty lists that aren't in the trailing position. - nil, false and true in the reader were always being returned as references (with an ref cnt) but we have the assumption that references (14) are not ref cnt'd and are always part of a compound type so fix the reader to just return the interned addresses.
543 lines
13 KiB
QBasic
543 lines
13 KiB
QBasic
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
|
|
ER%=0: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:
|
|
REM REM IF ER%<>0 THEN RETURN
|
|
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%
|
|
SLICE:
|
|
I=0
|
|
R5%=-1: REM temporary for return as R%
|
|
R6%=0: REM previous list element
|
|
SLICE_LOOP:
|
|
REM always allocate at list 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
|
|
|