Basic: fix errors, reader, if form. Self-host 0-3

- Stop let binding eval on error. Also don't continue into EVAL if
  error.
- if without a false position was freeing up too much when it
  finished.
- fix reader so that it doesn't keep incrementing ref cnt of static
  empty sequences.

diff --git a/basic/core.in.bas b/basic/core.in.bas
index 0f59cd5..490aae1 100644 (file)
--- a/basic/core.in.bas
+++ b/basic/core.in.bas
@@ -50,7 +50,7 @@ SUB DO_TCO_FUNCTION
   DO_APPLY:
     F=AA
     AR=Z%(AR,1)
-    A=AR:GOSUB COUNT:R4=R
+    B=AR:GOSUB COUNT:R4=R
 
     A=Z%(AR+1,1)
     REM no intermediate args, but not a list, so convert it first
@@ -108,12 +108,14 @@ SUB DO_TCO_FUNCTION
 
       AR=R:CALL APPLY
 
-      REM pop apply args are release them
+      REM pop apply args and release them
       AY=X%(X):X=X-1:GOSUB RELEASE
 
       REM set the result value
       Z%(X%(X-2)+1,1)=R
 
+      IF ER<>-2 THEN GOTO DO_MAP_DONE
+
       REM restore F
       F=X%(X-1)
 
@@ -127,8 +129,11 @@ SUB DO_TCO_FUNCTION
       GOTO DO_MAP_LOOP
 
     DO_MAP_DONE:
-      REM get return val
-      R=X%(X-3)
+      REM if no error, get return val
+      IF ER=-2 THEN R=X%(X-3)
+      REM otherwise, free the return value and return nil
+      IF ER<>-2 THEN R=0:AY=X%(X-3):GOSUB RELEASE
+
       REM pop everything off stack
       X=X-4
       GOTO DO_TCO_FUNCTION_DONE
@@ -178,7 +183,7 @@ DO_FUNCTION:
 
   REM Switch on the function number
   IF FF>59 THEN ER=-1:ER$="unknown function"+STR$(FF):RETURN
-  ON FF/10+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_56
+  ON FF/10+1 GOTO DO_1_9,DO_10_19,DO_20_29,DO_30_39,DO_40_49,DO_50_59
 
   DO_1_9:
   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_KEYWORD
@@ -190,8 +195,9 @@ DO_FUNCTION:
   ON FF-29 GOTO DO_VECTOR_Q,DO_HASH_MAP,DO_MAP_Q,DO_ASSOC,DO_THROW,DO_GET,DO_CONTAINS,DO_KEYS,DO_VALS,DO_SEQUENTIAL_Q
   DO_40_49:
   ON FF-39 GOTO DO_CONS,DO_CONCAT,DO_NTH,DO_FIRST,DO_REST,DO_EMPTY_Q,DO_COUNT,DO_THROW,DO_THROW,DO_WITH_META
-  DO_50_56:
+  DO_50_59:
   ON FF-49 GOTO DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE
+  REM ,DO_PR_MEMORY_SUMMARY
 
   DO_EQUAL_Q:
     A=AA:B=AB:GOSUB EQUAL_Q
@@ -437,8 +443,8 @@ DO_FUNCTION:
       AB=R
       GOTO DO_CONCAT_LOOP
   DO_NTH:
+    B=AA:GOSUB COUNT
     B=Z%(AB,1)
-    A=AA:GOSUB COUNT
     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
@@ -466,7 +472,7 @@ DO_FUNCTION:
     IF Z%(AA,1)=0 THEN R=2
     RETURN
   DO_COUNT:
-    A=AA:GOSUB COUNT
+    B=AA:GOSUB COUNT
     T=2:L=R:GOSUB ALLOC
     RETURN
 
@@ -591,6 +597,7 @@ INIT_CORE_NS:
 
   K$="eval":A=55:GOSUB INIT_CORE_SET_FUNCTION
   K$="read-file":A=56:GOSUB INIT_CORE_SET_FUNCTION
+  REM K$="pr-memory-summary":A=57:GOSUB INIT_CORE_SET_FUNCTION
 
   REM these are in DO_TCO_FUNCTION
   K$="apply":A=61:GOSUB INIT_CORE_SET_FUNCTION

diff --git a/basic/reader.in.bas b/basic/reader.in.bas
index 0bc1674..5b50aee 100644 (file)
--- a/basic/reader.in.bas
+++ b/basic/reader.in.bas
@@ -199,7 +199,9 @@ READ_FORM:
     IF T7<9 THEN L=T7
     T8=R: REM save previous value for release
     T=X%(X-1):N=R:GOSUB ALLOC
-    AY=T8:GOSUB RELEASE: REM list takes ownership
+    REM list takes ownership
+    IF L<9 THEN AY=L:GOSUB RELEASE
+    AY=T8:GOSUB RELEASE
 
     REM if previous element is the first element then set
     REM the first to the new element

diff --git a/basic/step2_eval.in.bas b/basic/step2_eval.in.bas
index 7f39912..d637bf9 100755 (executable)
--- a/basic/step2_eval.in.bas
+++ b/basic/step2_eval.in.bas
@@ -62,7 +62,7 @@ SUB EVAL_AST
       IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -117,6 +117,8 @@ SUB EVAL
   REM push A and E on the stack
   X=X+2:X%(X-1)=E:X%(X)=A
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 

diff --git a/basic/step3_env.in.bas b/basic/step3_env.in.bas
index 5393eff..28215c8 100755 (executable)
--- a/basic/step3_env.in.bas
+++ b/basic/step3_env.in.bas
@@ -61,7 +61,7 @@ SUB EVAL_AST
       IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -119,6 +119,8 @@ SUB EVAL
   REM push A and E on the stack
   X=X+2:X%(X-1)=E:X%(X)=A
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -186,6 +188,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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

diff --git a/basic/step4_if_fn_do.in.bas b/basic/step4_if_fn_do.in.bas
index ab26bac..a247e1a 100755 (executable)
--- a/basic/step4_if_fn_do.in.bas
+++ b/basic/step4_if_fn_do.in.bas
@@ -60,7 +60,7 @@ SUB EVAL_AST
       IF Z%(A,1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -120,6 +120,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -190,6 +192,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -229,7 +233,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/step5_tco.in.bas b/basic/step5_tco.in.bas
index 1e7e280..668ab3d 100755 (executable)
--- a/basic/step5_tco.in.bas
+++ b/basic/step5_tco.in.bas
@@ -63,7 +63,7 @@ SUB EVAL_AST
       IF X%(X-6)=2 AND Z%(Z%(A,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -123,6 +123,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -195,6 +197,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -247,7 +251,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/step6_file.in.bas b/basic/step6_file.in.bas
index 0c80ae6..bdf31e5 100755 (executable)
--- a/basic/step6_file.in.bas
+++ b/basic/step6_file.in.bas
@@ -63,7 +63,7 @@ SUB EVAL_AST
       IF X%(X-6)=2 AND Z%(Z%(A,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -123,6 +123,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -195,6 +197,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -247,7 +251,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/step7_quote.in.bas b/basic/step7_quote.in.bas
index e72e072..cc5abfd 100755 (executable)
--- a/basic/step7_quote.in.bas
+++ b/basic/step7_quote.in.bas
@@ -138,7 +138,7 @@ SUB EVAL_AST
       IF X%(X-6)=2 AND Z%(Z%(A,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -198,6 +198,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -272,6 +274,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -338,7 +342,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/step8_macros.in.bas b/basic/step8_macros.in.bas
index 225289f..7484a39 100755 (executable)
--- a/basic/step8_macros.in.bas
+++ b/basic/step8_macros.in.bas
@@ -174,7 +174,7 @@ SUB EVAL_AST
       IF X%(X-6)=2 AND Z%(Z%(A,1),1)=0 THEN GOTO EVAL_AST_SEQ_LOOP_DONE
 
       REM if hashmap, skip eval of even entries (keys)
-      IF (X%(X-3)=8) AND ((X%(X-2) AND 1)=0) THEN GOTO EVAL_AST_DO_REF
+      IF (X%(X-3)=8) AND ((X%(X-2)AND1)=0) THEN GOTO EVAL_AST_DO_REF
       GOTO EVAL_AST_DO_EVAL
 
       EVAL_AST_DO_REF:
@@ -234,6 +234,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -316,6 +318,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -407,7 +411,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/step9_try.in.bas b/basic/step9_try.in.bas
index 583beb6..a96bf31 100755 (executable)
--- a/basic/step9_try.in.bas
+++ b/basic/step9_try.in.bas
@@ -234,6 +234,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -317,6 +319,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -414,7 +418,7 @@ SUB EVAL
 
       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
+      AY=R:GOSUB RELEASE: REM release our use, env took ownership
 
       REM unset error for catch eval
       ER=-2:ER$=""
@@ -439,7 +443,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/stepA_mal.in.bas b/basic/stepA_mal.in.bas
index a077327..bbc5503 100755 (executable)
--- a/basic/stepA_mal.in.bas
+++ b/basic/stepA_mal.in.bas
@@ -234,6 +234,8 @@ SUB EVAL
 
   EVAL_TCO_RECUR:
 
+  IF ER<>-2 THEN GOTO EVAL_RETURN
+
   REM AZ=A:PR=1:GOSUB PR_STR
   REM PRINT "EVAL: "+R$+" [A:"+STR$(A)+", LV:"+STR$(LV)+"]"
 
@@ -317,6 +319,8 @@ SUB EVAL
         A=Z%(A1,1)+1:CALL EVAL
         A1=X%(X):X=X-1: REM pop A1
 
+        IF ER<>-2 THEN GOTO EVAL_LET_LOOP_DONE
+
         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
@@ -414,7 +418,7 @@ SUB EVAL
 
       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
+      AY=R:GOSUB RELEASE: REM release our use, env took ownership
 
       REM unset error for catch eval
       ER=-2:ER$=""
@@ -439,7 +443,8 @@ SUB EVAL
       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
+        B=A:GOSUB COUNT
+        IF R<4 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
 

diff --git a/basic/types.in.bas b/basic/types.in.bas
index 6d0bdb8..0ce329d 100644 (file)
--- a/basic/types.in.bas
+++ b/basic/types.in.bas
@@ -380,12 +380,14 @@ EMPTY_Q:
   IF Z%(A,1)=0 THEN R=1
   RETURN
 
-REM COUNT(A) -> R
+REM COUNT(B) -> R
+REM - returns length of list, not a Z% index
+REM - modifies B
 COUNT:
   R=-1
   DO_COUNT_LOOP:
     R=R+1
-    IF Z%(A,1)<>0 THEN A=Z%(A,1):GOTO DO_COUNT_LOOP
+    IF Z%(B,1)<>0 THEN B=Z%(B,1):GOTO DO_COUNT_LOOP
   RETURN
 
 REM LAST(A) -> R