step1_read_print.bas step2_eval.bas: $(STEP1_DEPS)
step3_env.bas: $(STEP3_DEPS)
step4_if_fn_do.bas step5_tco.bas step6_file.bas step7_quote.bas: $(STEP4_DEPS)
-step8_macros.bas: $(STEP4_DEPS)
+step8_macros.bas step9_try.bas: $(STEP4_DEPS)
tests/%.bas: tests/%.in.bas
./basicpp.py $(BASICPP_OPTS) $< > $@
petcat -text -w2 -o $@ $<.tmp
rm $<.tmp
-mal.prg: step8_macros.prg
+mal.prg: step9_try.prg
cp $< $@
-SOURCES_LISP = env.in.bas core.in.bas step8_macros.in.bas
+SOURCES_LISP = env.in.bas core.in.bas step9_try.in.bas
SOURCES = readline.in.bas types.in.bas reader.in.bas printer.in.bas $(SOURCES_LISP)
.PHONY: stats
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%>=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
- REM IF FF%=1 THEN DO_EQUAL_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_READLINE,DO_READ_STRING,DO_SLURP
- REM IF FF%=11 THEN DO_PR_STR
- REM IF FF%=12 THEN DO_STR
- REM IF FF%=13 THEN DO_PRN
- REM IF FF%=14 THEN DO_PRINTLN
- REM IF FF%=15 THEN DO_READLINE
- REM IF FF%=16 THEN DO_READ_STRING
- REM IF FF%=17 THEN 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
- REM IF FF%=18 THEN DO_LT
- REM IF FF%=19 THEN DO_LTE
- REM IF FF%=20 THEN DO_GT
- REM IF FF%=21 THEN DO_GTE
- REM IF FF%=22 THEN DO_ADD
- REM IF FF%=23 THEN DO_SUB
- REM IF FF%=24 THEN DO_MULT
- REM IF FF%=25 THEN DO_DIV
- REM IF FF%=26 THEN DO_TIME_MS
-
DO_27:
- ON FF%-26 GOTO DO_LIST,DO_LIST_Q
- REM IF FF%=27 THEN DO_LIST
- REM IF FF%=28 THEN DO_LIST_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%-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT
- REM IF FF%=40 THEN DO_CONS
- REM IF FF%=41 THEN DO_CONCAT
- REM IF FF%=42 THEN DO_NTH
- REM IF FF%=43 THEN DO_FIRST
- REM IF FF%=44 THEN DO_REST
- REM IF FF%=45 THEN DO_EMPTY_Q
- REM IF FF%=46 THEN DO_COUNT
-
+ 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
- REM IF FF%=53 THEN DO_ATOM
- REM IF FF%=54 THEN DO_ATOM_Q
- REM IF FF%=55 THEN DO_DEREF
- REM IF FF%=56 THEN DO_RESET_BANG
- REM IF FF%=57 THEN DO_SWAP_BANG
-
- REM IF FF%=58 THEN DO_PR_MEMORY
- REM IF FF%=59 THEN DO_PR_MEMORY_SUMMARY
- REM IF FF%=60 THEN DO_EVAL
DO_EQUAL_Q:
A%=AA%:B%=AB%:GOSUB EQUAL_Q
R%=R%+1
RETURN
+ DO_THROW:
+ ER%=AA%
+ Z%(ER%,0)=Z%(ER%,0)+16
+ R%=0
+ RETURN
+ DO_NIL_Q:
+ R%=1
+ IF AA%=0 THEN R%=2
+ RETURN
+ DO_TRUE_Q:
+ R%=1
+ IF AA%=2 THEN R%=2
+ RETURN
+ DO_FALSE_Q:
+ R%=1
+ IF AA%=1 THEN R%=2
+ RETURN
+ DO_STRING_Q:
+ R%=1
+ IF (Z%(AA%,0)AND15)=4 THEN R%=2
+ RETURN
+ DO_SYMBOL:
+ R%=0
+ RETURN
+ DO_SYMBOL_Q:
+ R%=1
+ IF (Z%(AA%,0)AND15)=5 THEN R%=2
+ RETURN
DO_PR_STR:
AZ%=AR%:PR%=1:SE$=" ":GOSUB PR_STR_SEQ
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
A%=AA%:GOSUB LIST_Q
R%=R%+1: REM map to mal false/true
RETURN
+ DO_VECTOR:
+ R%=0
+ RETURN
+ DO_VECTOR_Q:
+ R%=1
+ IF (Z%(AA%,0)AND15)=7 THEN R%=2
+ RETURN
+ DO_HASH_MAP:
+ R%=0
+ RETURN
+ DO_MAP_Q:
+ 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
+ RETURN
DO_CONS:
A%=AA%:B%=AB%:GOSUB CONS
RETURN
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
+ 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
Z%(R%,0)=2+16
Z%(R%,1)=R4%
RETURN
+ DO_APPLY:
+ 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
+
+ REM prepend intermediate args to final args element
+ 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
+ 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
+
+ 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
+ RETURN
+ DO_MAP:
+ F%=AA%
+
+ REM first result list element
+ 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%
+
+ 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
+
+ REM set previous to current if not the first element
+ IF ZZ%(ZL%-2)<>0 THEN Z%(ZZ%(ZL%-2),1)=R%
+ REM update previous reference to current
+ ZZ%(ZL%-2)=R%
+
+ 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%
+ 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%
+
+ REM push argument list
+ ZL%=ZL%+1:ZZ%(ZL%)=R%
+
+ AR%=R%:GOSUB APPLY
+
+ REM pop apply args are release them
+ AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
+
+ REM set the result value
+ Z%(ZZ%(ZL%-2)+1,1)=R%
+
+ REM restore F%
+ F%=ZZ%(ZL%-1)
+
+ REM update AB% to next source element
+ ZZ%(ZL%)=Z%(ZZ%(ZL%),1)
+ AB%=ZZ%(ZL%)
+
+ REM allocate next element
+ SZ%=2:GOSUB ALLOC
+
+ GOTO DO_MAP_LOOP
+
+ DO_MAP_DONE:
+ REM get return val
+ R%=ZZ%(ZL%-3)
+ REM pop everything off stack
+ ZL%=ZL%-4
+ RETURN
DO_ATOM:
SZ%=1:GOSUB ALLOC
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$="pr-str":A%=11:GOSUB INIT_CORE_SET_FUNCTION
K$="str":A%=12: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$="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
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
REM READ_FORM(A$, IDX%) -> R%
READ_FORM:
- IF ER% 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
GOTO READ_FORM
READ_FORM_ABORT:
- ER%=1
+ ER%=-1
R%=0
READ_FORM_ABORT_UNWIND:
IF SD%=0 THEN RETURN
REM REP(A$) -> R$
REP:
GOSUB MAL_READ
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB EVAL
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
EVAL_AST_SYMBOL:
HM%=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
+ IF T3%=0 THEN ER%=-1:ER$="'"+ZS$(Z%(A%,1))+"' not found":GOTO EVAL_AST_RETURN
Z%(R%,0)=Z%(R%,0)+16
GOTO EVAL_AST_RETURN
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
REM push A% and E% on the stack
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 AZ%=A%:PR%=1:GOSUB PR_STR
+ REM PRINT "EVAL: "+R$+" [A%:"+STR$(A%)+", LV%:"+STR$(LV%)+"]"
GOSUB DEREF_A
R3%=R%
REM if error, return f/args for release by caller
- IF ER%<>0 THEN GOTO EVAL_RETURN
+ 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
+ IF (Z%(F%,0)AND15)<>9 THEN ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
GOSUB DO_FUNCTION
AY%=R3%:GOSUB RELEASE
GOTO EVAL_RETURN
EVAL_RETURN:
- REM an error occured, free up any new value
- IF ER%=1 THEN AY%=R%:GOSUB RELEASE
LV%=LV%-1: REM track basic return stack level
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
+ ER%=-1:ER$="unknown function"+STR$(FF%):RETURN
DO_ADD:
Z%(R%,0)=2+16
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
R3%=R%
REM if error, return f/args for release by caller
- IF ER%<>0 THEN GOTO EVAL_RETURN
+ 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
+ IF (Z%(F%,0)AND15)<>9 THEN ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
GOSUB DO_FUNCTION
AY%=R3%:GOSUB RELEASE
GOTO EVAL_RETURN
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
+ ER%=-1:ER$="unknown function"+STR$(FF%):RETURN
DO_ADD:
Z%(R%,0)=2+16
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
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
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
EVAL_AST_RETURN_3:
REM if error, return f/args for release by caller
- IF ER%<>0 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%
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
+ ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
GOSUB DO_FUNCTION
R1%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
EVAL_AST_RETURN_3:
REM if error, return f/args for release by caller
- IF ER%<>0 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%
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
+ ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
GOSUB DO_FUNCTION
R1%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
EVAL_AST_RETURN_3:
REM if error, return f/args for release by caller
- IF ER%<>0 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%
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
+ ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
GOSUB DO_FUNCTION
R1%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
REM run a single mal program and exit
A$="(load-file (first -*ARGS*-))"
GOSUB RE
- IF ER%<>0 THEN GOSUB PRINT_ERROR
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR
END
REPL_LOOP:
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
EVAL_AST_RETURN_3:
REM if error, return f/args for release by caller
- IF ER%<>0 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%
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
+ ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
GOSUB DO_FUNCTION
R1%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
REM run a single mal program and exit
A$="(load-file (first -*ARGS*-))"
GOSUB RE
- IF ER%<>0 THEN GOSUB PRINT_ERROR
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR
END
REPL_LOOP:
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
REM intermediate form) then free it
IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
- IF ER%<>0 THEN GOTO MACROEXPAND_DONE
+ IF ER%<>-2 THEN GOTO MACROEXPAND_DONE
GOTO MACROEXPAND_LOOP
MACROEXPAND_DONE:
REM push A% and E% on the stack
ZL%=ZL%+2:ZZ%(ZL%-1)=E%:ZZ%(ZL%)=A%
- IF ER%<>0 THEN GOTO EVAL_AST_RETURN
+ IF ER%<>-2 THEN GOTO EVAL_AST_RETURN
GOSUB DEREF_A
REM update previous value pointer to evaluated entry
Z%(ZZ%(ZL%)+1,1)=R%
- IF ER%<>0 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
GOTO EVAL_AST_SEQ_LOOP
EVAL_AST_SEQ_LOOP_DONE:
REM if no error, get return value (new seq)
- IF ER%=0 THEN R%=ZZ%(ZL%-1)
+ IF ER%=-2 THEN R%=ZZ%(ZL%-1)
REM otherwise, free the return value and return nil
- IF ER%<>0 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
REM pop previous, return, index and type
ZL%=ZL%-4
A%=A2%:GOSUB EVAL: REM eval a2
A1%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A1%
- IF ER%<>0 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
EVAL_AST_RETURN_3:
REM if error, return f/args for release by caller
- IF ER%<>0 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%
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
+ ER%=-1:ER$="apply of non-function":GOTO EVAL_RETURN
EVAL_DO_FUNCTION:
GOSUB DO_FUNCTION
R1%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R1%=0:R2%=0
GOSUB MAL_READ
R1%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:E%=RE%:GOSUB EVAL
R2%=R%
- IF ER%<>0 THEN GOTO REP_DONE
+ IF ER%<>-2 THEN GOTO REP_DONE
A%=R%:GOSUB MAL_PRINT
RT$=R$
REM run a single mal program and exit
A$="(load-file (first -*ARGS*-))"
GOSUB RE
- IF ER%<>0 THEN GOSUB PRINT_ERROR
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR
END
REPL_LOOP:
A$=R$:GOSUB REP: REM call REP
- IF ER%<>0 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
PRINT R$
GOTO REPL_LOOP
PRINT_ERROR:
PRINT "Error: "+ER$
- ER%=0:ER$=""
+ ER%=-2:ER$=""
RETURN
--- /dev/null
+REM POKE 1, PEEK(1)AND248: REM enable all ROM areas as RAM
+REM POKE 55,0: POKE 56,192: CLR: REM move BASIC end from $A000 to $C000
+GOTO MAIN
+
+REM $INCLUDE: 'readline.in.bas'
+REM $INCLUDE: 'types.in.bas'
+REM $INCLUDE: 'reader.in.bas'
+REM $INCLUDE: 'printer.in.bas'
+REM $INCLUDE: 'env.in.bas'
+REM $INCLUDE: 'core.in.bas'
+
+REM $INCLUDE: 'debug.in.bas'
+
+REM READ(A$) -> R%
+MAL_READ:
+ GOSUB READ_STR
+ RETURN
+
+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
+ RETURN
+
+REM QUASIQUOTE(A%) -> R%
+QUASIQUOTE:
+ 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
+
+ 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
+ REM [ast[1]]
+ 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 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
+
+ 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
+ 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
+ REM release inner quasiquoted since outer list takes ownership
+ 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
+
+ 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
+ RETURN
+
+REM MACROEXPAND(A%, E%) -> A%:
+MACROEXPAND:
+ REM push original A%
+ ZL%=ZL%+1:ZZ%(ZL%)=A%
+
+ MACROEXPAND_LOOP:
+ REM list?
+ 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
+ REM symbol? in first position
+ 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
+ REM macro?
+ IF (Z%(B%,0)AND15)<>11 THEN GOTO MACROEXPAND_DONE
+
+ REM apply
+ 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
+ REM intermediate form) then free it
+ IF A%<>AY% THEN ZM%=ZM%+1:ZR%(ZM%,0)=A%:ZR%(ZM%,1)=LV%
+
+ IF ER%<>-2 THEN GOTO MACROEXPAND_DONE
+ GOTO MACROEXPAND_LOOP
+
+ MACROEXPAND_DONE:
+ ZL%=ZL%-1: REM pop original A%
+ RETURN
+
+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%
+
+ 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
+
+ REM scalar: deref to actual value and inc ref cnt
+ R%=A%:GOSUB DEREF_R
+ Z%(R%,0)=Z%(R%,0)+16
+ GOTO EVAL_AST_RETURN
+
+ EVAL_AST_SYMBOL:
+ K%=A%:GOSUB ENV_GET
+ GOTO EVAL_AST_RETURN
+
+ EVAL_AST_SEQ:
+ REM allocate the first entry
+ SZ%=2:GOSUB ALLOC
+
+ REM make space on the stack
+ ZL%=ZL%+4
+ REM push type of sequence
+ ZZ%(ZL%-3)=T%
+ REM push sequence index
+ ZZ%(ZL%-2)=-1
+ REM push future return value (new sequence)
+ ZZ%(ZL%-1)=R%
+ REM push previous new sequence entry
+ ZZ%(ZL%)=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
+ REM create value ptr placeholder
+ Z%(R%+1,0)=14
+ Z%(R%+1,1)=0
+
+ REM update index
+ ZZ%(ZL%-2)=ZZ%(ZL%-2)+1
+
+ REM check if we are done evaluating the source sequence
+ 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
+ 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
+ GOTO EVAL_AST_ADD_VALUE
+
+ EVAL_AST_DO_EVAL:
+ REM call EVAL for each entry
+ 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%
+
+ IF ER%<>-2 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
+
+ REM allocate the next entry
+ SZ%=2:GOSUB ALLOC
+
+ REM update previous sequence entry value to point to new entry
+ Z%(ZZ%(ZL%),1)=R%
+ REM update previous ptr to current entry
+ ZZ%(ZL%)=R%
+
+ REM process the next sequence entry from source list
+ 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)
+ REM otherwise, free the return value and return nil
+ IF ER%<>-2 THEN R%=0:AY%=ZZ%(ZL%-1):GOSUB RELEASE
+
+ REM pop previous, return, index and type
+ ZL%=ZL%-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 EVAL AST return label/address
+ RN%=ZZ%(ZL%):ZL%=ZL%-1
+ ON RN% GOTO EVAL_AST_RETURN_1,EVAL_AST_RETURN_2,EVAL_AST_RETURN_3
+ RETURN
+
+REM EVAL(A%, E%)) -> R%
+EVAL:
+ 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%
+
+ EVAL_TCO_RECUR:
+
+ 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
+ EVAL_NOT_LIST:
+ REM ELSE
+ REM push EVAL_AST return label/address
+ ZL%=ZL%+1:ZZ%(ZL%)=1
+ GOTO EVAL_AST
+ EVAL_AST_RETURN_1:
+
+ GOTO EVAL_RETURN
+
+ APPLY_LIST:
+ GOSUB MACROEXPAND
+
+ GOSUB LIST_Q
+ 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
+
+ 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 A$="def!" THEN GOTO EVAL_DEF
+ IF A$="let*" THEN GOTO EVAL_LET
+ IF A$="quote" THEN GOTO EVAL_QUOTE
+ IF A$="quasiquote" THEN GOTO EVAL_QUASIQUOTE
+ IF A$="defmacro!" THEN GOTO EVAL_DEFMACRO
+ IF A$="macroexpand" THEN GOTO EVAL_MACROEXPAND
+ IF A$="try*" THEN GOTO EVAL_TRY
+ IF A$="do" THEN GOTO EVAL_DO
+ IF A$="if" THEN GOTO EVAL_IF
+ IF A$="fn*" THEN GOTO EVAL_FN
+ GOTO EVAL_INVOKE
+
+ EVAL_GET_A3:
+ 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%
+ EVAL_GET_A1:
+ 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%
+
+ IF ER%<>-2 THEN GOTO EVAL_RETURN
+
+ REM set a1 in env to a2
+ 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
+
+ REM create new environment with outer as current environment
+ EO%=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%
+ REM eval current A1 odd element
+ A%=Z%(A1%,1)+1:GOSUB EVAL
+ A1%=ZZ%(ZL%):ZL%=ZL%-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
+
+ 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
+
+ REM release previous environment if not the current EVAL env
+ IF E4%<>ZZ%(ZL%-2) THEN AY%=E4%:GOSUB RELEASE
+
+ A2%=ZZ%(ZL%):ZL%=ZL%-1: REM pop A2%
+ A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
+
+ EVAL_DO:
+ A%=Z%(A%,1): REM rest
+
+ REM TODO: TCO
+
+ REM push EVAL_AST return label/address
+ ZL%=ZL%+1:ZZ%(ZL%)=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
+ 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
+ GOTO EVAL_RETURN
+
+ EVAL_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%
+
+ 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%
+
+ REM change function to macro
+ Z%(R%,0)=Z%(R%,0)+1
+
+ REM set a1 in env to a2
+ 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%
+
+ REM since we are returning it unevaluated, inc the ref cnt
+ 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%
+
+ REM if there is not error or catch block then 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%
+
+ GOSUB EVAL_GET_A2: REM set a1% and a2%
+ 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 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
+
+ REM unset error for catch eval
+ ER%=-2:ER$=""
+
+ 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
+
+ EVAL_IF_TRUE:
+ AY%=R%:GOSUB RELEASE
+ GOSUB EVAL_GET_A2: REM set a1% and a2% after EVAL
+ A%=A2%:GOTO EVAL_TCO_RECUR: REM TCO loop
+ EVAL_IF_FALSE:
+ 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
+ GOSUB EVAL_GET_A3: REM set a1% - a3% after EVAL
+ 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
+ GOTO EVAL_RETURN
+
+ EVAL_INVOKE:
+ REM push EVAL_AST return label/address
+ ZL%=ZL%+1:ZZ%(ZL%)=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
+
+ REM push f/args for release after call
+ ZL%=ZL%+1:ZZ%(ZL%)=R%
+
+ F%=R%+1
+
+ 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
+
+ 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
+
+ EVAL_DO_FUNCTION:
+ GOSUB DO_FUNCTION
+
+ REM pop and release f/args
+ AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
+ GOTO EVAL_RETURN
+
+ EVAL_DO_MAL_FUNCTION:
+ 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
+
+ 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 we no longer need to track it (since we are TCO recurring)
+ IF E4%<>ZZ%(ZL%-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
+ 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 pop and release f/args
+ AY%=ZZ%(ZL%):ZL%=ZL%-1:GOSUB RELEASE
+
+ 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 release environment if not the top one on the stack
+ IF E%<>ZZ%(ZL%-1) THEN AY%=E%:GOSUB RELEASE
+
+ LV%=LV%-1: REM track basic return stack level
+
+ REM release everything we couldn't release earlier
+ GOSUB RELEASE_PEND
+
+ REM trigger GC
+ TA%=FRE(0)
+
+ REM pop A% and E% off the stack
+ E%=ZZ%(ZL%-1):A%=ZZ%(ZL%):ZL%=ZL%-2
+
+ RETURN
+
+REM PRINT(A%) -> R$
+MAL_PRINT:
+ AZ%=A%:PR%=1:GOSUB PR_STR
+ RETURN
+
+REM RE(A$) -> R%
+REM Assume RE% has repl_env
+REM caller must release result
+RE:
+ R1%=0
+ GOSUB MAL_READ
+ R1%=R%
+ IF ER%<>-2 THEN GOTO REP_DONE
+
+ A%=R%:E%=RE%:GOSUB EVAL
+
+ REP_DONE:
+ REM Release memory from MAL_READ
+ 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
+ GOSUB MAL_READ
+ 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%: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
+ R$=RT$
+ RETURN
+
+REM MAIN program
+MAIN:
+ GOSUB INIT_MEMORY
+
+ LV%=0
+
+ REM create repl_env
+ EO%=-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
+
+ 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
+
+ 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
+
+ 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
+
+ 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
+
+ REM load the args file
+ A$="(def! -*ARGS*- (load-file "+CHR$(34)+".args.mal"+CHR$(34)+"))"
+ GOSUB RE:AY%=R%:GOSUB RELEASE
+
+ REM set the argument list
+ A$="(def! *ARGV* (rest -*ARGS*-))"
+ 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
+ REM no arguments, start 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
+ END
+
+ REPL_LOOP:
+ A$="user> ":GOSUB READLINE: REM call input parser
+ IF EOF=1 THEN GOTO QUIT
+
+ A$=R$:GOSUB REP: REM call REP
+
+ IF ER%<>-2 THEN GOSUB PRINT_ERROR:GOTO REPL_LOOP
+ PRINT R$
+ GOTO REPL_LOOP
+
+ QUIT:
+ REM P1%=ZT%: P2%=-1: GOSUB PR_MEMORY
+ GOSUB PR_MEMORY_SUMMARY
+ END
+
+ 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
+ PRINT "Error: "+ER$
+ ER%=-2:ER$=""
+ RETURN
+
S4%=64: REM ZR% (release stack) size (4 bytes each)
REM global error state
- ER%=0:ER$=""
+ 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 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%)=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 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%=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%=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
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)<>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
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))
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 list one list element
+ 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%
HCoop / jackhill / mal.git / commitdiff