From 9e8f521118e65199b07f050f495337e42ae72a72 Mon Sep 17 00:00:00 2001 From: Joel Martin Date: Wed, 21 Sep 2016 23:27:12 -0500 Subject: [PATCH] Basic: step7 basics, reader macros. step1,3 tests. Also: - Add some step1 and step3 tests that were discovered during Basic development. - Move PR_MEMORY* to debug.in.bas - Simplify Makefile deps - Fix freeing in steps4-7 when error at deeper level i.e. (prn (abc)) - add SLICE function to support concat implementation. --- basic/Makefile | 24 +- basic/core.in.bas | 54 +++- basic/debug.in.bas | 79 +++++ basic/reader.in.bas | 41 ++- basic/step0_repl.in.bas | 17 +- basic/step1_read_print.in.bas | 8 +- basic/step2_eval.in.bas | 32 +- basic/step3_env.in.bas | 22 +- basic/step4_if_fn_do.in.bas | 37 +-- basic/step5_tco.in.bas | 37 +-- basic/step6_file.in.bas | 50 ++-- basic/step7_quote.in.bas | 534 ++++++++++++++++++++++++++++++++++ basic/types.in.bas | 107 +++---- tests/step1_read_print.mal | 4 + tests/step3_env.mal | 7 + tests/step5_tco.mal | 2 + 16 files changed, 869 insertions(+), 186 deletions(-) create mode 100644 basic/debug.in.bas create mode 100755 basic/step7_quote.in.bas diff --git a/basic/Makefile b/basic/Makefile index 68bbe224..2ba285b6 100644 --- a/basic/Makefile +++ b/basic/Makefile @@ -9,13 +9,19 @@ step%.prg: step%.bas petcat -text -w2 -o $@ $<.tmp #rm $<.tmp -step0_repl.bas: readline.in.bas -step1_read_print.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas -step2_eval.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas -step3_env.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas -step4_if_fn_do.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas -step5_tco.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas -step6_file.bas: readline.in.bas types.in.bas reader.in.bas printer.in.bas env.in.bas core.in.bas +STEP0_DEPS = readline.in.bas +STEP1_DEPS = $(STEP0_DEPS) debug.in.bas types.in.bas reader.in.bas printer.in.bas +STEP3_DEPS = $(STEP1_DEPS) env.in.bas +STEP4_DEPS = $(STEP3_DEPS) core.in.bas + +step0_repl.bas: $(STEP0_DEPS) +step1_read_print.bas: $(STEP1_DEPS) +step2_eval.bas: $(STEP1_DEPS) +step3_env.bas: $(STEP3_DEPS) +step4_if_fn_do.bas: $(STEP4_DEPS) +step5_tco.bas: $(STEP4_DEPS) +step6_file.bas: $(STEP4_DEPS) +step7_quote.bas: $(STEP4_DEPS) tests/%.bas: tests/%.in.bas ./qb2cbm.sh $< > $@ @@ -25,8 +31,10 @@ tests/%.prg: tests/%.bas petcat -text -w2 -o $@ $<.tmp rm $<.tmp +mal.prg: step7_quote.prg + cp $< $@ -SOURCES_LISP = env.in.bas core.in.bas step6_file.in.bas +SOURCES_LISP = env.in.bas core.in.bas step7_quote.in.bas SOURCES = readline.in.bas types.in.bas reader.in.bas printer.in.bas $(SOURCES_LISP) .PHONY: stats diff --git a/basic/core.in.bas b/basic/core.in.bas index 58ef902d..1628cc75 100644 --- a/basic/core.in.bas +++ b/basic/core.in.bas @@ -31,6 +31,7 @@ DO_FUNCTION: IF FF%=28 THEN DO_LIST_Q IF FF%=39 THEN DO_CONS + IF FF%=40 THEN DO_CONCAT IF FF%=43 THEN DO_FIRST IF FF%=44 THEN DO_REST IF FF%=45 THEN DO_EMPTY_Q @@ -54,11 +55,11 @@ DO_FUNCTION: DO_PR_STR: AZ%=AR%: PR%=1: SE$=" ": GOSUB PR_STR_SEQ - AS$=R$: T%=4: GOSUB STRING + AS$=R$: T%=4+16: GOSUB STRING RETURN DO_STR: AZ%=AR%: PR%=0: SE$="": GOSUB PR_STR_SEQ - AS$=R$: T%=4: GOSUB STRING + AS$=R$: T%=4+16: GOSUB STRING RETURN DO_PRN: AZ%=AR%: PR%=1: SE$=" ": GOSUB PR_STR_SEQ @@ -89,7 +90,7 @@ DO_FUNCTION: GOTO DO_SLURP_LOOP DO_SLURP_DONE: CLOSE 1 - AS$=R$: T%=4: GOSUB STRING + AS$=R$: T%=4+16: GOSUB STRING RETURN DO_LT: @@ -142,6 +143,51 @@ DO_FUNCTION: DO_CONS: A%=AA%: B%=AB%: GOSUB CONS RETURN + DO_CONCAT: + REM if empty arguments, return empty list + IF Z%(AR%,1)=0 THEN R%=3: Z%(R%,0)=Z%(R%,0)+16: RETURN + + REM single argument + IF Z%(Z%(AR%,1),1)<>0 THEN GOTO DO_CONCAT_MULT + REM if single argument and it's a list, return it + IF (Z%(AA%,0)AND15)=6 THEN R%=AA%: Z%(R%,0)=Z%(R%,0)+16: RETURN + REM otherwise, copy first element to turn it into a list + B%=AA%+1: GOSUB DEREF_B: REM value to copy + SZ%=2: GOSUB ALLOC + Z%(R%,0)=6+16: Z%(R%,1)=Z%(AA%,1) + Z%(R%+1,0)=14: Z%(R%+1,1)=B% + REM inc ref count of trailing list part and of copied value + Z%(Z%(AA%,1),0)=Z%(Z%(AA%,1),0)+16 + Z%(B%,0)=Z%(B%,0)+16 + RETURN + + REM multiple arguments + DO_CONCAT_MULT: + CZ%=ZL%: REM save current stack position + REM push arguments onto the stack + DO_CONCAT_STACK: + R%=AR%+1: GOSUB DEREF_R + ZL%=ZL%+1: ZZ%(ZL%)=R%: REM push sequence + AR%=Z%(AR%,1) + IF Z%(AR%,1)<>0 THEN GOTO DO_CONCAT_STACK + + REM pop last argument as our seq to prepend to + AB%=ZZ%(ZL%): ZL%=ZL%-1 + REM last arg/seq is not copied so we need to inc ref to it + Z%(AB%,0)=Z%(AB%,0)+16 + DO_CONCAT_LOOP: + IF ZL%=CZ% THEN R%=AB%: RETURN + AA%=ZZ%(ZL%): ZL%=ZL%-1: REM pop off next seq to prepend + A%=AA%: B%=0: C%=-1: GOSUB SLICE + + REM release the terminator of new list (we skip over it) + AY%=Z%(R6%,1): GOSUB RELEASE + REM attach new list element before terminator (last actual + REM element to the next sequence + Z%(R6%,1)=AB% + + AB%=R% + GOTO DO_CONCAT_LOOP DO_FIRST: IF Z%(AA%,1)=0 THEN R%=0 IF Z%(AA%,1)<>0 THEN R%=AA%+1: GOSUB DEREF_R @@ -253,7 +299,6 @@ DO_FUNCTION: RETURN DO_EVAL: - AZ%=AA%: PR%=1: GOSUB PR_STR A%=AA%: E%=RE%: GOSUB EVAL RETURN @@ -289,6 +334,7 @@ INIT_CORE_NS: K$="list?": A%=28: GOSUB INIT_CORE_SET_FUNCTION K$="cons": A%=39: GOSUB INIT_CORE_SET_FUNCTION + K$="concat": A%=40: GOSUB INIT_CORE_SET_FUNCTION K$="first": A%=43: GOSUB INIT_CORE_SET_FUNCTION K$="rest": A%=44: GOSUB INIT_CORE_SET_FUNCTION K$="empty?": A%=45: GOSUB INIT_CORE_SET_FUNCTION diff --git a/basic/debug.in.bas b/basic/debug.in.bas new file mode 100644 index 00000000..3a385be8 --- /dev/null +++ b/basic/debug.in.bas @@ -0,0 +1,79 @@ +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 " "; + 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%) + RETURN + +REM REM PR_MEMORY(P1%, P2%) -> nil +REM PR_MEMORY: +REM IF P2%"+STR$(P2%); +REM PRINT " (ZI%: "+STR$(ZI%)+", ZK%: "+STR$(ZK%)+"):" +REM IF P2%P2% THEN GOTO PR_MEMORY_AFTER_VALUES +REM PRINT " "+STR$(I); +REM IF (Z%(I,0)AND15)=15 THEN GOTO PR_MEMORY_FREE +REM PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16); +REM PRINT ", type: "+STR$(Z%(I,0)AND15)+", value: "+STR$(Z%(I,1)); +REM IF (Z%(I,0)AND15)=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'"; +REM IF (Z%(I,0)AND15)=5 THEN PRINT " "+ZS$(Z%(I,1))+""; +REM PRINT +REM I=I+1 +REM IF (Z%(I-1,0)AND15)<>10 THEN GOTO PR_MEMORY_VALUE_LOOP +REM PRINT " "+STR$(I)+": "; +REM PRINT "params: "+STR$(Z%(I+1,0))+", env:"+STR$(Z%(I+1,1)) +REM I=I+1 +REM GOTO PR_MEMORY_VALUE_LOOP +REM PR_MEMORY_FREE: +REM PRINT ": FREE size: "+STR$((Z%(I,0)AND-16)/16)+", next: "+STR$(Z%(I,1)); +REM IF I=ZK% THEN PRINT " (free list start)"; +REM PRINT +REM IF (Z%(I,0)AND-16)=32 THEN I=I+1: PRINT " "+STR$(I)+": ---" +REM I=I+1 +REM GOTO PR_MEMORY_VALUE_LOOP +REM PR_MEMORY_AFTER_VALUES: +REM PRINT "ZS% String Memory (ZJ%: "+STR$(ZJ%)+"):" +REM IF ZJ%<=0 THEN PRINT " ---": GOTO PR_MEMORY_SKIP_STRINGS +REM FOR I=0 TO ZJ%-1 +REM PRINT " "+STR$(I)+": '"+ZS$(I)+"'" +REM NEXT I +REM PR_MEMORY_SKIP_STRINGS: +REM PRINT "ZZ% Stack Memory (ZL%: "+STR$(ZL%)+"):" +REM IF ZL%<0 THEN PRINT " ---": GOTO PR_MEMORY_SKIP_STACK +REM FOR I=0 TO ZL% +REM PRINT " "+STR$(I)+": "+STR$(ZZ%(I)) +REM NEXT I +REM PR_MEMORY_SKIP_STACK: +REM PRINT "^^^^^^" +REM RETURN + +REM PR_OBJECT(P1%) -> nil +PR_OBJECT: + RC%=0 + + RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=P1% + + PR_OBJ_LOOP: + IF RC%=0 THEN RETURN + I=ZZ%(ZL%): RC%=RC%-1: ZL%=ZL%-1 + + P2%=Z%(I,0)AND15 + PRINT " "+STR$(I); + PRINT ": ref cnt: "+STR$((Z%(I,0)AND-16)/16); + PRINT ", type: "+STR$(P2%)+", value: "+STR$(Z%(I,1)); + IF P2%=4 THEN PRINT " '"+ZS$(Z%(I,1))+"'"; + IF P2%=5 THEN PRINT " "+ZS$(Z%(I,1))+""; + PRINT + IF P2%<=5 OR P2%=9 THEN GOTO PR_OBJ_LOOP + IF Z%(I,1)<>0 THEN RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=Z%(I,1) + IF P2%>=6 AND P2%<=8 THEN RC%=RC%+1: ZL%=ZL%+1: ZZ%(ZL%)=I+1 + GOTO PR_OBJ_LOOP diff --git a/basic/reader.in.bas b/basic/reader.in.bas index dd452ee1..03cf5b51 100644 --- a/basic/reader.in.bas +++ b/basic/reader.in.bas @@ -6,6 +6,8 @@ READ_TOKEN: IF T$="(" OR T$=")" THEN RETURN IF T$="[" OR T$="]" THEN RETURN IF T$="{" OR T$="}" THEN RETURN + IF (T$="'") OR (T$="`") OR (T$="@") THEN RETURN + IF (T$="~") AND NOT MID$(A$,CUR%+1,1)="@" THEN RETURN S1=0: S2=0: REM S1: INSTRING?, S2: ESCAPED? IF T$=CHR$(34) THEN S1=1 CUR%=CUR%+1 @@ -20,6 +22,7 @@ READ_TOKEN: IF CH$="{" OR CH$="}" THEN RETURN READ_TOKEN_CONT: T$=T$+CH$ + IF T$="~@" THEN RETURN CUR%=CUR%+1 IF S1 AND S2 THEN S2=0: GOTO READ_TOKEN_LOOP IF S1 AND (S2=0) AND (CH$=CHR$(92)) THEN S2=1: GOTO READ_TOKEN_LOOP @@ -42,13 +45,20 @@ READ_FORM: IF ER% THEN RETURN GOSUB SKIP_SPACES GOSUB READ_TOKEN + IF T$="" AND SD%>0 THEN ER$="unexpected EOF": GOTO READ_FORM_ABORT 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 + IF T$="'" THEN AS$="quote": GOTO READ_MACRO + IF T$="`" THEN AS$="quasiquote": GOTO READ_MACRO + IF T$="~" THEN AS$="unquote": GOTO READ_MACRO + IF T$="~@" THEN AS$="splice-unquote": GOTO READ_MACRO + IF T$="@" THEN AS$="deref": GOTO READ_MACRO CH$=MID$(T$,1,1) REM PRINT "CH$: ["+CH$+"]("+STR$(ASC(CH$))+")" + IF (CH$=";") THEN R%=0: GOTO READ_TO_EOL IF CH$>="0" AND CH$ <= "9" THEN READ_NUMBER IF CH$="-" THEN READ_SYMBOL_MAYBE @@ -61,6 +71,11 @@ READ_FORM: IF CH$="}" THEN T%=8: GOTO READ_SEQ_END GOTO READ_SYMBOL + READ_TO_EOL: + CH$=MID$(A$,IDX%+1,1) + IDX%=IDX%+1 + IF CH$="" OR CH$=CHR$(13) OR CH$=CHR$(10) THEN GOTO READ_FORM + GOTO READ_TO_EOL READ_NIL_BOOL: REM PRINT "READ_NIL_BOOL" SZ%=1: GOSUB ALLOC @@ -73,6 +88,27 @@ READ_FORM: Z%(R%,0)=2+16 Z%(R%,1)=VAL(T$) GOTO READ_FORM_DONE + READ_MACRO: + IDX%=IDX%+LEN(T$) + T%=5: GOSUB STRING: REM AS$ set above + + REM to call READ_FORM recursively, SD% needs to be saved, set to + REM 0 for the call and then restored afterwards. + ZL%=ZL%+2: ZZ%(ZL%-1)=SD%: ZZ%(ZL%)=R%: REM push SD% and symbol + SD%=0: GOSUB READ_FORM: B1%=R% + SD%=ZZ%(ZL%-1): B2%=ZZ%(ZL%): ZL%=ZL%-2: REM pop SD%, pop symbol into B2% + +REM AZ%=R%: PR%=1: GOSUB PR_STR +REM PRINT "obj: ["+R$+"] ("+STR$(R%)+")" + + GOSUB LIST2 + AY%=B1%: GOSUB RELEASE: REM release value, list has ownership +REM +REM AZ%=R%: PR%=1: GOSUB PR_STR +REM PRINT "list: ["+R$+"] ("+STR$(R%)+")" + + T$="" + GOTO READ_FORM_DONE READ_STRING: REM PRINT "READ_STRING" T7$=MID$(T$,LEN(T$),1) @@ -82,14 +118,14 @@ READ_FORM: 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$: T%=4: GOSUB STRING + AS$=R$: T%=4+16: GOSUB STRING GOTO READ_FORM_DONE READ_SYMBOL_MAYBE: CH$=MID$(T$,2,1) IF CH$>="0" AND CH$<="9" THEN READ_NUMBER READ_SYMBOL: REM PRINT "READ_SYMBOL" - AS$=T$: T%=5: GOSUB STRING + AS$=T$: T%=5+16: GOSUB STRING GOTO READ_FORM_DONE READ_SEQ: @@ -139,7 +175,6 @@ READ_FORM: REM check read sequence depth IF SD%=0 THEN RETURN - IF T$="" THEN ER$="unexpected EOF": GOTO READ_FORM_ABORT REM PRINT "READ_FORM_DONE next list entry" REM allocate new sequence entry and space for value diff --git a/basic/step0_repl.in.bas b/basic/step0_repl.in.bas index 032f0cb5..82c4bca1 100755 --- a/basic/step0_repl.in.bas +++ b/basic/step0_repl.in.bas @@ -2,6 +2,8 @@ GOTO MAIN REM $INCLUDE: 'readline.in.bas' +REM $INCLUDE: 'debug.in.bas' + REM READ(A$) -> R$ MAL_READ: R$=A$ @@ -26,15 +28,16 @@ REP: REM MAIN program MAIN: - MAIN_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ - IF EOF=1 THEN GOTO MAIN_DONE - A$=R$: GOSUB REP: REM /* call REP */ + REPL_LOOP: + A$="user> ": GOSUB READLINE: REM call input parser + IF EOF=1 THEN GOTO QUIT + + A$=R$: GOSUB REP: REM call REP + PRINT R$ - GOTO MAIN_LOOP + GOTO REPL_LOOP - MAIN_DONE: + QUIT: PRINT "Free: "+STR$(FRE(0)) END diff --git a/basic/step1_read_print.in.bas b/basic/step1_read_print.in.bas index 9df83f9e..240013b2 100755 --- a/basic/step1_read_print.in.bas +++ b/basic/step1_read_print.in.bas @@ -5,6 +5,8 @@ REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'debug.in.bas' + REM READ(A$) -> R% MAL_READ: GOSUB READ_STR @@ -44,8 +46,7 @@ MAIN: ZT%=ZI%: REM top of memory after base repl_env REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT A$=R$: GOSUB REP: REM call REP @@ -61,7 +62,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step2_eval.in.bas b/basic/step2_eval.in.bas index a1d596de..d05fd4e4 100755 --- a/basic/step2_eval.in.bas +++ b/basic/step2_eval.in.bas @@ -5,6 +5,8 @@ REM $INCLUDE: 'types.in.bas' REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' +REM $INCLUDE: 'debug.in.bas' + REM READ(A$) -> R% MAL_READ: GOSUB READ_STR @@ -19,10 +21,6 @@ EVAL_AST: 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%) - GOSUB DEREF_A T%=Z%(A%,0)AND15 @@ -161,14 +159,15 @@ EVAL: 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 + + REM trigger GC TA%=FRE(0) REM pop A% and E% off the stack E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 - LV%=LV%-1: REM track basic return stack level - RETURN REM DO_FUNCTION(F%, AR%) @@ -249,34 +248,28 @@ MAIN: LV%=0 REM create repl_env - GOSUB HASHMAP - RE%=R% + GOSUB HASHMAP: RE%=R% REM + function A%=1: GOSUB NATIVE_FUNCTION - HM%=RE%: K$="+": V%=R%: GOSUB ASSOC1_S - RE%=R% + HM%=RE%: K$="+": V%=R%: GOSUB ASSOC1_S: RE%=R% REM - function A%=2: GOSUB NATIVE_FUNCTION - HM%=RE%: K$="-": V%=R%: GOSUB ASSOC1_S - RE%=R% + HM%=RE%: K$="-": V%=R%: GOSUB ASSOC1_S: RE%=R% REM * function A%=3: GOSUB NATIVE_FUNCTION - HM%=RE%: K$="*": V%=R%: GOSUB ASSOC1_S - RE%=R% + HM%=RE%: K$="*": V%=R%: GOSUB ASSOC1_S: RE%=R% REM / function A%=4: GOSUB NATIVE_FUNCTION - HM%=RE%: K$="/": V%=R%: GOSUB ASSOC1_S - RE%=R% + HM%=RE%: K$="/": V%=R%: GOSUB ASSOC1_S: RE%=R% ZT%=ZI%: REM top of memory after base repl_env REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT A$=R$: GOSUB REP: REM call REP @@ -292,7 +285,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step3_env.in.bas b/basic/step3_env.in.bas index b5f605cb..a0f73955 100755 --- a/basic/step3_env.in.bas +++ b/basic/step3_env.in.bas @@ -6,6 +6,8 @@ REM $INCLUDE: 'reader.in.bas' REM $INCLUDE: 'printer.in.bas' REM $INCLUDE: 'env.in.bas' +REM $INCLUDE: 'debug.in.bas' + REM READ(A$) -> R% MAL_READ: GOSUB READ_STR @@ -20,10 +22,6 @@ EVAL_AST: 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%) - GOSUB DEREF_A T%=Z%(A%,0)AND15 @@ -219,9 +217,14 @@ EVAL: GOTO EVAL_RETURN 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 trigger GC TA%=FRE(0) @@ -229,8 +232,6 @@ EVAL: REM pop A% and E% off the stack E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 - LV%=LV%-1: REM track basic return stack level - RETURN REM DO_FUNCTION(F%, AR%) @@ -311,8 +312,7 @@ MAIN: LV%=0 REM create repl_env - EO%=-1: GOSUB ENV_NEW - RE%=R% + EO%=-1: GOSUB ENV_NEW: RE%=R% E%=RE% REM + function @@ -334,8 +334,7 @@ MAIN: ZT%=ZI%: REM top of memory after base repl_env REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT A$=R$: GOSUB REP: REM call REP @@ -351,7 +350,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step4_if_fn_do.in.bas b/basic/step4_if_fn_do.in.bas index 5950ea4c..28b53704 100755 --- a/basic/step4_if_fn_do.in.bas +++ b/basic/step4_if_fn_do.in.bas @@ -7,6 +7,8 @@ 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 @@ -102,8 +104,10 @@ EVAL_AST: GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: - REM get return value (new seq) - R%=ZZ%(ZL%-1) + REM if no error, get return value (new seq) + IF ER%=0 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 REM pop previous, return, index and type ZL%=ZL%-4 @@ -294,8 +298,9 @@ EVAL: 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 later - ZM%=ZM%+1: ZR%(ZM%)=A% + 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 @@ -304,23 +309,23 @@ EVAL: 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 AZ%=R%: PR%=1: GOSUB PR_STR - REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%) - REM trigger GC TA%=FRE(0) REM pop A% and E% off the stack E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 - LV%=LV%-1: REM track basic return stack level - RETURN REM PRINT(A%) -> R$ @@ -373,8 +378,7 @@ MAIN: LV%=0 REM create repl_env - EO%=-1: GOSUB ENV_NEW - RE%=R% + 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 @@ -382,15 +386,13 @@ MAIN: 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! not (fn* (a) (if a false true)))": GOSUB RE: AY%=R%: GOSUB RELEASE REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT - A$=R$: GOSUB REP: REM /* call REP */ + A$=R$: GOSUB REP: REM call REP IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP PRINT R$ @@ -403,7 +405,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step5_tco.in.bas b/basic/step5_tco.in.bas index 63d3a794..79757564 100755 --- a/basic/step5_tco.in.bas +++ b/basic/step5_tco.in.bas @@ -7,6 +7,8 @@ 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 @@ -102,8 +104,10 @@ EVAL_AST: GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: - REM get return value (new seq) - R%=ZZ%(ZL%-1) + REM if no error, get return value (new seq) + IF ER%=0 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 REM pop previous, return, index and type ZL%=ZL%-4 @@ -304,8 +308,9 @@ EVAL: 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 later - ZM%=ZM%+1: ZR%(ZM%)=A% + 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 @@ -314,23 +319,23 @@ EVAL: 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 AZ%=R%: PR%=1: GOSUB PR_STR - REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%) - REM trigger GC TA%=FRE(0) REM pop A% and E% off the stack E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 - LV%=LV%-1: REM track basic return stack level - RETURN REM PRINT(A%) -> R$ @@ -383,8 +388,7 @@ MAIN: LV%=0 REM create repl_env - EO%=-1: GOSUB ENV_NEW - RE%=R% + 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 @@ -392,15 +396,13 @@ MAIN: 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! not (fn* (a) (if a false true)))": GOSUB RE: AY%=R%: GOSUB RELEASE REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT - A$=R$: GOSUB REP: REM /* call REP */ + A$=R$: GOSUB REP: REM call REP IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP PRINT R$ @@ -413,7 +415,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step6_file.in.bas b/basic/step6_file.in.bas index 3eeaf07d..7eecce33 100755 --- a/basic/step6_file.in.bas +++ b/basic/step6_file.in.bas @@ -9,6 +9,8 @@ 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 @@ -104,8 +106,10 @@ EVAL_AST: GOTO EVAL_AST_SEQ_LOOP EVAL_AST_SEQ_LOOP_DONE: - REM get return value (new seq) - R%=ZZ%(ZL%-1) + REM if no error, get return value (new seq) + IF ER%=0 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 REM pop previous, return, index and type ZL%=ZL%-4 @@ -306,8 +310,9 @@ EVAL: 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 later - ZM%=ZM%+1: ZR%(ZM%)=A% + 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 @@ -316,23 +321,23 @@ EVAL: 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 AZ%=R%: PR%=1: GOSUB PR_STR - REM PRINT "EVAL_RETURN R%: ["+R$+"] ("+STR$(R%)+"), LV%:"+STR$(LV%)+",ER%:"+STR$(ER%) - REM trigger GC TA%=FRE(0) REM pop A% and E% off the stack E%=ZZ%(ZL%-1): A%=ZZ%(ZL%): ZL%=ZL%-2 - LV%=LV%-1: REM track basic return stack level - RETURN REM PRINT(A%) -> R$ @@ -385,8 +390,7 @@ MAIN: LV%=0 REM create repl_env - EO%=-1: GOSUB ENV_NEW - RE%=R% + 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 @@ -394,8 +398,7 @@ MAIN: 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! 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) " @@ -407,12 +410,10 @@ MAIN: GOSUB RE: AY%=R%: GOSUB RELEASE REM set the argument list - A$="(def! *ARGV* (rest -*ARGS*-))" - GOSUB RE: AY%=R%: GOSUB RELEASE + A$="(def! *ARGV* (rest -*ARGS*-))": GOSUB RE: AY%=R%: GOSUB RELEASE REM get the first argument - A$="(first -*ARGS*-)" - GOSUB RE + 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 @@ -421,17 +422,15 @@ MAIN: RUN_PROG: REM run a single mal program and exit - A$="(load-file (first -*ARGS*-))" - GOSUB REP - IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO QUIT - IF ER%=0 THEN PRINT R$: GOTO QUIT + A$="(load-file (first -*ARGS*-))": GOSUB RE + IF ER%<>0 THEN GOSUB PRINT_ERROR + END REPL_LOOP: - A$="user> " - GOSUB READLINE: REM /* call input parser */ + A$="user> ": GOSUB READLINE: REM call input parser IF EOF=1 THEN GOTO QUIT - A$=R$: GOSUB REP: REM /* call REP */ + A$=R$: GOSUB REP: REM call REP IF ER%<>0 THEN GOSUB PRINT_ERROR: GOTO REPL_LOOP PRINT R$ @@ -444,7 +443,6 @@ MAIN: PRINT_ERROR: PRINT "Error: "+ER$ - ER%=0 - ER$="" + ER%=0: ER$="" RETURN diff --git a/basic/step7_quote.in.bas b/basic/step7_quote.in.bas new file mode 100755 index 00000000..b7b975a9 --- /dev/null +++ b/basic/step7_quote.in.bas @@ -0,0 +1,534 @@ +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 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%<>0 THEN GOTO EVAL_AST_RETURN + + GOSUB DEREF_A + + T%=Z%(A%,0)AND15 + IF T%=5 THEN EVAL_AST_SYMBOL + IF T%=6 THEN EVAL_AST_SEQ + IF T%=7 THEN EVAL_AST_SEQ + IF T%=8 THEN 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%<>0 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%=0 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 + + 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 + IF RN%=1 GOTO EVAL_AST_RETURN_1 + IF RN%=2 GOTO EVAL_AST_RETURN_2 + IF RN%=3 GOTO 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%: GOSUB PR_STR + REM PRINT "EVAL: "+R$+"("+STR$(A%)+"), LV%:"+STR$(LV%) + + GOSUB DEREF_A + + GOSUB LIST_Q + IF R% THEN GOTO APPLY_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 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$="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% + + 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% + + E4%=E%: REM save the current environment for 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 + + REM push A1% + ZL%=ZL%+1: ZZ%(ZL%)=A1% + REM eval current A1 odd element + A%=Z%(A1%,1)+1: GOSUB EVAL + REM pop A1% + A1%=ZZ%(ZL%): ZL%=ZL%-1 + + 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: + REM release previous env (if not root repl_env) because our + REM new env refers to it and we no longer need to track it + REM (since we are TCO recurring) + IF E4%<>RE% THEN AY%=E4%: GOSUB RELEASE + + 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_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%<>0 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%<>0 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%<>0 THEN GOTO REP_DONE + + A%=R%: E%=RE%: GOSUB EVAL + R2%=R% + IF ER%<>0 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) " + A$=A$+CHR$(34)+")"+CHR$(34)+")))))" + 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%<>0 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%<>0 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: + PRINT "Error: "+ER$ + ER%=0: ER$="" + RETURN + diff --git a/basic/types.in.bas b/basic/types.in.bas index 68674452..ffa720ab 100644 --- a/basic/types.in.bas +++ b/basic/types.in.bas @@ -26,7 +26,7 @@ INIT_MEMORY: 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) + S4%=64: REM ZR% (release stack) size (4 bytes each) REM global error state ER%=0: ER$="" @@ -34,16 +34,17 @@ INIT_MEMORY: REM boxed element memory DIM Z%(S1%,1): REM TYPE ARRAY - REM Predefine nil, false, true + 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%=3 + ZI%=5 REM start of free list - ZK%=3 + ZK%=5 REM string memory storage ZJ%=0: DIM ZS$(S2%) @@ -52,7 +53,7 @@ INIT_MEMORY: 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%,1): REM stack of Z% indexes REM PRINT "Lisp data memory: "+STR$(T%-FRE(0)) REM PRINT "Interpreter working memory: "+STR$(FRE(0)) @@ -189,12 +190,13 @@ RELEASE: SZ%=1: GOSUB FREE GOTO RELEASE_TOP -REM RELEASE_PEND() -> nil +REM RELEASE_PEND(LV%) -> nil RELEASE_PEND: REM REM IF ER%<>0 THEN RETURN IF ZM%<0 THEN RETURN - REM PRINT "RELEASE_PEND releasing:"+STR$(ZR%(ZM%)) - AY%=ZR%(ZM%): GOSUB RELEASE + 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 @@ -225,61 +227,6 @@ CHECK_FREE_LIST: IF P2%=-1 THEN PRINT "corrupt free list at "+STR$(P1%) RETURN -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 " "; - 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%) - RETURN - -REM PR_MEMORY(P1%, P2%) -> nil -PR_MEMORY: - IF P2%"+STR$(P2%); - PRINT " (ZI%: "+STR$(ZI%)+", ZK%: "+STR$(ZK%)+"):" - IF P2%P2% THEN GOTO PR_MEMORY_AFTER_VALUES - 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)) - I=I+1 - IF (Z%(I-1,0)AND15)<>10 THEN GOTO PR_MEMORY_VALUE_LOOP - PRINT " "+STR$(I)+": "; - PRINT "params: "+STR$(Z%(I+1,0))+", env:"+STR$(Z%(I+1,1)) - I=I+1 - GOTO PR_MEMORY_VALUE_LOOP - PR_MEMORY_FREE: - PRINT ": FREE size: "+STR$((Z%(I,0)AND-16)/16)+", next: "+STR$(Z%(I,1)); - IF I=ZK% THEN PRINT " (free list start)"; - PRINT - IF (Z%(I,0)AND-16)=32 THEN I=I+1: PRINT " "+STR$(I)+": ---" - I=I+1 - GOTO PR_MEMORY_VALUE_LOOP - PR_MEMORY_AFTER_VALUES: - 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)+"'" - NEXT I - PR_MEMORY_SKIP_STRINGS: - 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)) - NEXT I - PR_MEMORY_SKIP_STACK: - PRINT "^^^^^^" - RETURN - REM general functions @@ -336,10 +283,10 @@ REM STRING(AS$, T%) -> R% REM intern string and allocate reference (return Z% index) STRING: GOSUB STRING_ - T7%=R% + TS%=R% SZ%=1: GOSUB ALLOC - Z%(R%,0)=T%+16 - Z%(R%,1)=T7% + Z%(R%,0)=T% + Z%(R%,1)=TS% RETURN REM REPLACE(R$, S1$, S2$) -> R$ @@ -405,6 +352,34 @@ CONS: 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 I0 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 diff --git a/tests/step1_read_print.mal b/tests/step1_read_print.mal index 94d84f52..a4d40a05 100644 --- a/tests/step1_read_print.mal +++ b/tests/step1_read_print.mal @@ -27,6 +27,8 @@ abc-def ;=>(+ 1 2) () ;=>() +(nil) +;=>(nil) ((3 4)) ;=>((3 4)) (+ 1 (+ 2 3)) @@ -96,6 +98,8 @@ false ;=>(unquote 1) ~(1 2 3) ;=>(unquote (1 2 3)) +`(1 ~a 3) +;=>(quasiquote (1 (unquote a) 3)) ~@(1 2 3) ;=>(splice-unquote (1 2 3)) diff --git a/tests/step3_env.mal b/tests/step3_env.mal index ab2aa575..9487a958 100644 --- a/tests/step3_env.mal +++ b/tests/step3_env.mal @@ -29,6 +29,10 @@ mynum MYNUM ;=>222 +;; Check env lookup non-fatal error +(abc 1 2 3) +; .*\'abc\' not found.* + ;; Testing let* (let* (z 9) z) @@ -41,6 +45,9 @@ x ;=>6 (let* (p (+ 2 3) q (+ 2 p)) (+ p q)) ;=>12 +(def! y (let* (z 7) z)) +y +;=>7 ;; Testing outer environment (def! a 4) diff --git a/tests/step5_tco.mal b/tests/step5_tco.mal index 42c7fa42..0e87b5ba 100644 --- a/tests/step5_tco.mal +++ b/tests/step5_tco.mal @@ -2,6 +2,8 @@ (def! sum2 (fn* (n acc) (if (= n 0) acc (sum2 (- n 1) (+ n acc))))) +;; TODO: test let*, and do for TCO + (sum2 10 0) ;=>55 -- 2.20.1