IF FF%=58 THEN DO_PR_MEMORY
IF FF%=59 THEN DO_PR_MEMORY_SUMMARY
IF FF%=60 THEN DO_EVAL
- ER%=1: ER$="unknown function" + STR$(FF%): RETURN
+ ER%=1: ER$="unknown function"+STR$(FF%): RETURN
DO_EQUAL_Q:
A%=AA%: B%=AB%: GOSUB EQUAL_Q
DO_PR_STR:
AZ%=AR%: PR%=1: SE$=" ": GOSUB PR_STR_SEQ
- AS$=R$: GOSUB STRING
- R4%=R%
- SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 4+16
- Z%(R%,1) = R4%
+ AS$=R$: T%=4: GOSUB STRING
RETURN
DO_STR:
AZ%=AR%: PR%=0: SE$="": GOSUB PR_STR_SEQ
- AS$=R$: GOSUB STRING
- R4%=R%
- SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 4+16
- Z%(R%,1) = R4%
+ AS$=R$: T%=4: GOSUB STRING
RETURN
DO_PRN:
AZ%=AR%: PR%=1: SE$=" ": GOSUB PR_STR_SEQ
GOTO DO_SLURP_LOOP
DO_SLURP_DONE:
CLOSE 1
- AS$=R$: GOSUB STRING
- R4%=R%
- SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 4+16
- Z%(R%,1) = R4%
+ AS$=R$: T%=4: GOSUB STRING
RETURN
DO_LT:
A%=AA%: GOSUB COUNT
R4%=R%
SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 2+16
- Z%(R%,1) = R4%
+ Z%(R%,0)=2+16
+ Z%(R%,1)=R4%
RETURN
DO_ATOM:
SZ%=1: GOSUB ALLOC
Z%(AA%,0)=Z%(AA%,0)+16: REM inc ref cnt of contained value
- Z%(R%,0) = 11+16
- Z%(R%,1) = AA%
+ Z%(R%,0)=12+16
+ Z%(R%,1)=AA%
RETURN
DO_ATOM_Q:
R%=1
- IF (Z%(AA%,0)AND15)=11 THEN R%=2
+ IF (Z%(AA%,0)AND15)=12 THEN R%=2
RETURN
DO_DEREF:
R%=Z%(AA%,1): GOSUB DEREF_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%
+ 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
RETURN
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
+ 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
RETURN
RR$=""
PR_STR_RECUR:
T%=Z%(AZ%,0)AND15
- REM PRINT "AZ%: " + STR$(AZ%) + ", T%: " + STR$(T%) + ", V%: " + STR$(Z%(AZ%,1))
+ REM PRINT "AZ%: "+STR$(AZ%)+", T%: "+STR$(T%)+", V%: "+STR$(Z%(AZ%,1))
IF T%=14 THEN AZ%=Z%(AZ%,1): GOTO PR_STR_RECUR
IF T%=0 THEN R$="nil": RETURN
IF (T%=1) AND (Z%(AZ%,1)=0) THEN R$="false": RETURN
IF T%=8 THEN PR_SEQ
IF T%=9 THEN PR_FUNCTION
IF T%=10 THEN PR_MAL_FUNCTION
- IF T%=11 THEN PR_ATOM
+ IF T%=12 THEN PR_ATOM
IF T%=13 THEN PR_ENV
IF T%=15 THEN PR_FREE
R$="#<unknown>"
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)
REM Go to next list element
AZ%=Z%(ZZ%(ZL%),1)
- ZZ%(ZL%) = AZ%
- IF Z%(AZ%,1) <> 0 THEN RR$=RR$+" "
+ ZZ%(ZL%)=AZ%
+ IF Z%(AZ%,1)<>0 THEN RR$=RR$+" "
GOTO PR_SEQ_LOOP
PR_SEQ_DONE:
REM get type
RETURN
PR_FUNCTION:
T1%=Z%(AZ%,1)
- R$="#<function" + STR$(T1%) + ">"
+ R$="#<function"+STR$(T1%)+">"
RETURN
PR_MAL_FUNCTION:
T1%=AZ%
AZ%=Z%(T1%+1,0): GOSUB PR_STR_RECUR
- T7$="(fn* " + R$
+ T7$="(fn* "+R$
AZ%=Z%(T1%,1): GOSUB PR_STR_RECUR
- R$=T7$ + " " + R$ + ")"
+ R$=T7$+" "+R$+")"
RETURN
PR_ATOM:
AZ%=Z%(AZ%,1): GOSUB PR_STR_RECUR
- R$="(atom " + R$ + ")"
+ R$="(atom "+R$+")"
RETURN
PR_ENV:
R$="#<env"+STR$(AZ%)+", data"+STR$(Z%(AZ%,1))+">"
DEBUG=${DEBUG:-}
KEEP_REM=${KEEP_REM:-1}
# 0 - drop all REMs
-# 1 - keep LABEL and INCLUDE REMs
+# 1 - keep LABEL and INCLUDE REMs (and blank lines)
# 2 - keep LABEL, INCLUDE, and GOTO REMs
# 3 - keep LABEL, INCLUDE, GOTO, and whole line REMs
# 4 - keep all REMS (end of line REMs too)
[ "${DEBUG}" ] && echo >&2 "dropping REM comment: ${line}"
continue
elif [[ ${line} =~ ^\ *$ ]]; then
+ if [ "${KEEP_REM}" -ge 1 ]; then
[ "${DEBUG}" ] && echo >&2 "found blank line at $lnum"
data="${data}\n"
- continue
+ else
+ [ "${DEBUG}" ] && echo >&2 "ignoring blank line at $lnum"
+ fi
+ continue
elif [[ ${line} =~ ^[A-Za-z_][A-Za-z0-9_]*:$ ]]; then
label=${line%:}
[ "${DEBUG}" ] && echo >&2 "found label ${label} at $lnum"
REM READ_TOKEN(A$, IDX%) -> T$
READ_TOKEN:
CUR%=IDX%
- REM PRINT "READ_TOKEN: " + STR$(CUR%) + ", " + MID$(A$,CUR%,1)
+ REM PRINT "READ_TOKEN: "+STR$(CUR%)+", "+MID$(A$,CUR%,1)
T$=MID$(A$,CUR%,1)
- IF (T$="(") OR (T$=")") THEN RETURN
- IF (T$="[") OR (T$="]") THEN RETURN
- IF (T$="{") OR (T$="}") THEN RETURN
+ IF T$="(" OR T$=")" THEN RETURN
+ IF T$="[" OR T$="]" THEN RETURN
+ IF T$="{" OR T$="}" THEN RETURN
S1=0: S2=0: REM S1: INSTRING?, S2: ESCAPED?
- IF (T$=CHR$(34)) THEN S1=1
+ IF T$=CHR$(34) THEN S1=1
CUR%=CUR%+1
READ_TOKEN_LOOP:
- IF CUR% > LEN(A$) THEN RETURN
+ IF CUR%>LEN(A$) THEN RETURN
CH$=MID$(A$,CUR%,1)
IF S2 THEN GOTO READ_TOKEN_CONT
IF S1 THEN GOTO READ_TOKEN_CONT
- IF (CH$=" ") OR (CH$=",") THEN RETURN
- IF (CH$="(") OR (CH$=")") THEN RETURN
- IF (CH$="[") OR (CH$="]") THEN RETURN
- IF (CH$="{") OR (CH$="}") THEN RETURN
+ IF CH$=" " OR CH$="," THEN RETURN
+ IF CH$="(" OR CH$=")" THEN RETURN
+ IF CH$="[" OR CH$="]" THEN RETURN
+ IF CH$="{" OR CH$="}" THEN RETURN
READ_TOKEN_CONT:
T$=T$+CH$
CUR%=CUR%+1
IF ER% THEN RETURN
GOSUB SKIP_SPACES
GOSUB READ_TOKEN
- 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
+ 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
CH$=MID$(T$,1,1)
- REM PRINT "CH$: [" + CH$ + "](" + STR$(ASC(CH$)) + ")"
- IF (CH$ >= "0") AND (CH$ <= "9") THEN READ_NUMBER
- IF (CH$ = "-") THEN READ_SYMBOL_MAYBE
-
- IF (CH$ = CHR$(34)) THEN 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
+ REM PRINT "CH$: ["+CH$+"]("+STR$(ASC(CH$))+")"
+ IF CH$>="0" AND CH$ <= "9" THEN READ_NUMBER
+ IF CH$="-" THEN READ_SYMBOL_MAYBE
+
+ IF CH$=CHR$(34) THEN 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
GOTO READ_SYMBOL
READ_NIL_BOOL:
REM PRINT "READ_NIL_BOOL"
SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 14+16
- Z%(R%,1) = T%
+ Z%(R%,0)=14+16
+ Z%(R%,1)=T%
GOTO READ_FORM_DONE
READ_NUMBER:
REM PRINT "READ_NUMBER"
SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 2+16
- Z%(R%,1) = VAL(T$)
+ Z%(R%,0)=2+16
+ Z%(R%,1)=VAL(T$)
GOTO READ_FORM_DONE
READ_STRING:
REM PRINT "READ_STRING"
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$: GOSUB STRING
- T7%=R%
- SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 4+16
- Z%(R%,1) = T7%
+ AS$=R$: T%=4: GOSUB STRING
GOTO READ_FORM_DONE
READ_SYMBOL_MAYBE:
CH$=MID$(T$,2,1)
- IF (CH$ >= "0") AND (CH$ <= "9") THEN READ_NUMBER
+ IF CH$>="0" AND CH$<="9" THEN READ_NUMBER
READ_SYMBOL:
REM PRINT "READ_SYMBOL"
- REM intern string value
- AS$=T$: GOSUB STRING
- T7%=R%
- SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 5+16
- Z%(R%,1) = T7%
+ AS$=T$: T%=5: GOSUB STRING
GOTO READ_FORM_DONE
READ_SEQ:
IF SD%>1 THEN Z%(ZZ%(ZL%)+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%
+ ZZ%(ZL%)=R%
REM push current sequence type
ZL%=ZL%+1
- ZZ%(ZL%) = T%
+ ZZ%(ZL%)=T%
REM push previous ptr on the stack
ZL%=ZL%+1
- ZZ%(ZL%) = R%
+ ZZ%(ZL%)=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 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
REM previous element
T7%=ZZ%(ZL%)
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%
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)=ZZ%(ZL%-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%
+ Z%(T7%,1)=R%
READ_FORM_SKIP_FIRST:
REM update previous pointer to current element
- ZZ%(ZL%) = R%
+ ZZ%(ZL%)=R%
GOTO READ_FORM
READ_FORM_ABORT:
-EOF=0
-
REM READLINE(A$) -> R$
READLINE:
EOF=0
PROMPT$=A$
PRINT PROMPT$;
- CH$="": LINE$="": CH=0
+ CH$="": LI$="": CH=0
READCH:
GET CH$: IF CH$="" THEN READCH
CH=ASC(CH$)
IF (CH=127) OR (CH=20) THEN GOTO READCH
IF (CH<32 OR CH>127) AND CH<>13 THEN READCH
PRINT CH$;
- IF LEN(LINE$)<255 AND CH$<>CHR$(13) THEN LINE$=LINE$+CH$
- IF LEN(LINE$)<255 AND CH$<>CHR$(13) THEN GOTO READCH
+ IF LEN(LI$)<255 AND CH$<>CHR$(13) THEN LI$=LI$+CH$
+ IF LEN(LI$)<255 AND CH$<>CHR$(13) THEN GOTO READCH
RL_DONE:
- R$=LINE$
+ R$=LI$
RETURN
- REM Assumes LINE$ has input buffer
+ REM Assumes LI$ has input buffer
RL_BACKSPACE:
- IF LEN(LINE$)=0 THEN RETURN
- LINE$=LEFT$(LINE$, LEN(LINE$)-1)
- PRINT CHR$(157) + " " + CHR$(157);
+ IF LEN(LI$)=0 THEN RETURN
+ LI$=LEFT$(LI$, LEN(LI$)-1)
+ PRINT CHR$(157)+" "+CHR$(157);
RETURN
GOTO MAIN_LOOP
MAIN_DONE:
- PRINT "Free: " + STR$(FRE(0))
+ PRINT "Free: "+STR$(FRE(0))
END
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
IF ER%<>0 THEN GOTO EVAL_AST_RETURN
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL_AST: " + R$ + "(" + STR$(A%) + ")"
- REM PRINT "EVAL_AST level: " + STR$(LV%)
+ REM PRINT "EVAL_AST: "+R$+"("+STR$(A%)+")"
+ REM PRINT "EVAL_AST level: "+STR$(LV%)
GOSUB DEREF_A
ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
+ REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
GOSUB DEREF_A
IF FF%=2 THEN DO_SUB
IF FF%=3 THEN DO_MULT
IF FF%=4 THEN DO_DIV
- ER%=1: ER$="unknown function" + STR$(FF%): RETURN
+ ER%=1: ER$="unknown function"+STR$(FF%): RETURN
DO_ADD:
Z%(R%,0)=2+16
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
IF ER%<>0 THEN GOTO EVAL_AST_RETURN
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL_AST: " + R$ + "(" + STR$(A%) + ")"
- REM PRINT "EVAL_AST level: " + STR$(LV%)
+ REM PRINT "EVAL_AST: "+R$+"("+STR$(A%)+")"
+ REM PRINT "EVAL_AST level: "+STR$(LV%)
GOSUB DEREF_A
ZL%=ZL%+2: ZZ%(ZL%-1)=E%: ZZ%(ZL%)=A%
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
+ REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
GOSUB DEREF_A
GOTO EVAL_INVOKE
EVAL_GET_A3:
- A3% = Z%(Z%(Z%(A%,1),1),1)+1
+ 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
+ A2%=Z%(Z%(A%,1),1)+1
R%=A2%: GOSUB DEREF_R: A2%=R%
EVAL_GET_A1:
- A1% = Z%(A%,1)+1
+ A1%=Z%(A%,1)+1
R%=A1%: GOSUB DEREF_R: A1%=R%
RETURN
IF FF%=2 THEN DO_SUB
IF FF%=3 THEN DO_MULT
IF FF%=4 THEN DO_DIV
- ER%=1: ER$="unknown function" + STR$(FF%): RETURN
+ ER%=1: ER$="unknown function"+STR$(FF%): RETURN
DO_ADD:
Z%(R%,0)=2+16
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
EVAL_TCO_RECUR:
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
+ REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
GOSUB DEREF_A
GOTO EVAL_INVOKE
EVAL_GET_A3:
- A3% = Z%(Z%(Z%(A%,1),1),1)+1
+ 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
+ A2%=Z%(Z%(A%,1),1)+1
R%=A2%: GOSUB DEREF_R: A2%=R%
EVAL_GET_A1:
- A1% = Z%(A%,1)+1
+ A1%=Z%(A%,1)+1
R%=A1%: GOSUB DEREF_R: A1%=R%
RETURN
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
EVAL_TCO_RECUR:
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
+ REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
GOSUB DEREF_A
GOTO EVAL_INVOKE
EVAL_GET_A3:
- A3% = Z%(Z%(Z%(A%,1),1),1)+1
+ 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
+ A2%=Z%(Z%(A%,1),1)+1
R%=A2%: GOSUB DEREF_R: A2%=R%
EVAL_GET_A1:
- A1% = Z%(A%,1)+1
+ A1%=Z%(A%,1)+1
R%=A1%: GOSUB DEREF_R: A1%=R%
RETURN
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
EVAL_TCO_RECUR:
REM AZ%=A%: GOSUB PR_STR
- REM PRINT "EVAL: " + R$ + "(" + STR$(A%) + "), LV%:"+STR$(LV%)
+ REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%)
GOSUB DEREF_A
GOTO EVAL_INVOKE
EVAL_GET_A3:
- A3% = Z%(Z%(Z%(A%,1),1),1)+1
+ 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
+ A2%=Z%(Z%(A%,1),1)+1
R%=A2%: GOSUB DEREF_R: A2%=R%
EVAL_GET_A1:
- A1% = Z%(A%,1)+1
+ A1%=Z%(A%,1)+1
R%=A1%: GOSUB DEREF_R: A1%=R%
RETURN
END
PRINT_ERROR:
- PRINT "Error: " + ER$
+ PRINT "Error: "+ER$
ER%=0
ER$=""
RETURN
REM function 9 -> function index
REM mal function 10 -> body AST Z% index
REM followed by param and env Z% index
-REM atom 11 -> 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
INIT_MEMORY:
T%=FRE(0)
- S1%=2048+512: REM Z% (boxed memory) size (X2)
- REM S1%=4096: REM Z% (boxed memory) size (X2)
- S2%=256: REM ZS% (string memory) size
- S3%=256: REM ZZ% (call stack) size
- S4%=64: REM ZR% (release stack) size
+ 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 (2 bytes each)
REM global error state
- ER%=0
- ER$=""
+ ER%=0: ER$=""
REM boxed element memory
DIM Z%(S1%,1): REM TYPE ARRAY
REM Predefine nil, false, true
- 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%(0,0)=0: Z%(0,1)=0
+ Z%(1,0)=1: Z%(1,1)=0
+ Z%(2,0)=1: Z%(2,1)=1
REM start of unused memory
ZI%=3
ZK%=3
REM string memory storage
- ZJ%=0
- DIM ZS$(S2%)
+ ZJ%=0: DIM ZS$(S2%)
REM call/logic stack
- ZL%=-1
- DIM ZZ%(S3%): REM stack of Z% indexes
+ ZL%=-1: DIM ZZ%(S3%): REM stack of Z% indexes
REM pending release stack
- ZM%=-1
- DIM ZR%(S4%): REM stack of Z% indexes
+ ZM%=-1: DIM ZR%(S4%): REM stack of Z% indexes
- REM PRINT "Lisp data memory: " + STR$(T%-FRE(0))
- REM PRINT "Interpreter working memory: " + STR$(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%
ALLOC:
REM PRINT "ALLOC SZ%: "+STR$(SZ%)+", ZK%: "+STR$(ZK%)
- U3%=ZK%
- U4%=ZK%
+ U3%=ZK%: U4%=ZK%
ALLOC_LOOP:
IF U4%=ZI% THEN GOTO ALLOC_UNUSED
REM TODO sanity check that type is 15
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%
- IF SZ%>=2 THEN Z%(AY%+1,0)=0
- IF SZ%>=2 THEN Z%(AY%+1,1)=0
- IF SZ%>=3 THEN Z%(AY%+2,0)=0
- IF SZ%>=3 THEN Z%(AY%+2,1)=0
- ZK%=AY%
+ 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 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 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 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
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_ATOM
+ IF U6%=12 THEN GOTO RELEASE_ATOM
IF U6%=13 THEN GOTO RELEASE_ENV
IF U6%=14 THEN GOTO RELEASE_REFERENCE
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
+ ER%=1: ER$="RELEASE not defined for type "+STR$(U6%): RETURN
RELEASE_SIMPLE:
REM simple type (no recursing), just call FREE on it
RELEASE_PEND:
REM REM IF ER%<>0 THEN RETURN
IF ZM%<0 THEN RETURN
- REM PRINT "here2 RELEASE_PEND releasing:"+STR$(ZR%(ZM%))
+ REM PRINT "RELEASE_PEND releasing:"+STR$(ZR%(ZM%))
AY%=ZR%(ZM%): GOSUB RELEASE
ZM%=ZM%-1
GOTO RELEASE_PEND
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 "Free memory (FRE) : "+STR$(FRE(0))
+ PRINT "Value memory (Z%) : "+STR$(ZI%-1)+" /"+STR$(S1%)
PRINT " ";
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 (ZS$) : "+STR$(ZJ%)+" /"+STR$(S2%)
+ PRINT "Call stack size (ZZ%) : "+STR$(ZL%+1)+" /"+STR$(S3%)
RETURN
REM PR_MEMORY(P1%, P2%) -> nil
I=P1%
PR_MEMORY_VALUE_LOOP:
IF I>P2% THEN GOTO PR_MEMORY_AFTER_VALUES
- PRINT " " + STR$(I);
+ PRINT " "+STR$(I);
IF (Z%(I,0)AND15)=15 THEN GOTO PR_MEMORY_FREE
- PRINT ": ref cnt: " + STR$((Z%(I,0)AND-16)/16);
- PRINT ", type: " + STR$(Z%(I,0)AND15) + ", value: " + STR$(Z%(I,1))
+ PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16);
+ PRINT ", type: "+STR$(Z%(I,0)AND15)+", value: "+STR$(Z%(I,1))
I=I+1
IF (Z%(I-1,0)AND15)<>10 THEN GOTO PR_MEMORY_VALUE_LOOP
PRINT " "+STR$(I)+": ";
I=I+1
GOTO PR_MEMORY_VALUE_LOOP
PR_MEMORY_AFTER_VALUES:
- PRINT "ZS% String Memory (ZJ%: " + STR$(ZJ%) + "):"
+ PRINT "ZS% String Memory (ZJ%: "+STR$(ZJ%)+"):"
IF ZJ%<=0 THEN PRINT " ---": GOTO PR_MEMORY_SKIP_STRINGS
FOR I=0 TO ZJ%-1
- PRINT " " + STR$(I) + ": '" + ZS$(I) + "'"
+ PRINT " "+STR$(I)+": '"+ZS$(I)+"'"
NEXT I
PR_MEMORY_SKIP_STRINGS:
- PRINT "ZZ% Stack Memory (ZL%: " + STR$(ZL%) + "):"
+ PRINT "ZZ% Stack Memory (ZL%: "+STR$(ZL%)+"):"
IF ZL%<0 THEN PRINT " ---": GOTO PR_MEMORY_SKIP_STACK
FOR I=0 TO ZL%
PRINT " "+STR$(I)+": "+STR$(ZZ%(I))
REM STRING_(AS$) -> R%
REM intern string (returns string index, not Z% index)
-STRING:
+STRING_:
IF ZJ%=0 THEN GOTO STRING_NOT_FOUND
REM search for matching string in ZS$
NEXT I
STRING_NOT_FOUND:
- ZS$(ZJ%) = AS$
+ 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_
+ T7%=R%
+ SZ%=1: GOSUB ALLOC
+ Z%(R%,0)=T%+16
+ Z%(R%,1)=T7%
+ RETURN
+
REM REPLACE(R$, S1$, S2$) -> R$
REPLACE:
T3$=R$
Z%(B%,0)=Z%(B%,0)+16
RETURN
+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
+ 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%
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)=HM%: REM hashmap to assoc onto
+ Z%(R%+3,0)=14
+ Z%(R%+3,1)=V%
RETURN
REM ASSOC1(HM%, K$, V%) -> R%
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%
+ 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 NATIVE_FUNCTION(A%) -> R%
NATIVE_FUNCTION:
SZ%=1: GOSUB ALLOC
- Z%(R%,0) = 9+16
- Z%(R%,1) = A%
+ Z%(R%,0)=9+16
+ Z%(R%,1)=A%
RETURN
REM NATIVE_FUNCTION(A%, P%, E%) -> R%
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
HCoop / jackhill / mal.git / commitdiff