Basic: more reductions. RELEASE refactor.

Save about 400 bytes.

Increase value Z% array by 100 to 4195.

Reduce string array by 1 (to 199) since in BASIC the value is the last
index not the size.

diff --git a/basic/core.in.bas b/basic/core.in.bas
index 2d0863e..3f4a2e1 100644 (file)
--- a/basic/core.in.bas
+++ b/basic/core.in.bas
@@ -40,15 +40,15 @@ SUB DO_TCO_FUNCTION
   G=Z%(F,1)
 
   REM Get argument values
-  R=AR+1:GOSUB DEREF_R:AA=R
-  R=Z%(AR,1)+1:GOSUB DEREF_R:AB=R
+  R=AR+1:GOSUB DEREF_R:A=R
+  R=Z%(AR,1)+1:GOSUB DEREF_R:B=R
 
   ON G-60 GOTO DO_APPLY,DO_MAP,DO_SWAP_BANG
 
   DO_APPLY:
-    F=AA
+    F=A
     AR=Z%(AR,1)
-    B=AR:GOSUB COUNT:C=R
+    A=AR:GOSUB COUNT:C=R
 
     A=Z%(AR+1,1)
     REM no intermediate args, but not a list, so convert it first
@@ -82,16 +82,16 @@ SUB DO_TCO_FUNCTION
       GOTO DO_TCO_FUNCTION_DONE
 
   DO_MAP:
-    F=AA
+    F=A
 
     REM first result list element
     T=6:L=0:N=0:GOSUB ALLOC
 
-    REM push future return val, prior entry, F and AB
+    REM push future return val, prior entry, F and B
     GOSUB PUSH_R
     Q=0:GOSUB PUSH_Q
     Q=F:GOSUB PUSH_Q
-    Q=AB:GOSUB PUSH_Q
+    Q=B:GOSUB PUSH_Q
 
     DO_MAP_LOOP:
       REM set previous to current if not the first element
@@ -100,12 +100,12 @@ SUB DO_TCO_FUNCTION
       REM update previous reference to current
       Q=R:GOSUB PUT_Q_2
 
-      IF Z%(AB,1)=0 THEN GOTO DO_MAP_DONE
+      IF Z%(B,1)=0 THEN GOTO DO_MAP_DONE
 
       REM create argument list for apply call
       Z%(3,0)=Z%(3,0)+32
       REM inc ref cnt of referred argument
-      T=6:L=3:N=Z%(AB+1,1):GOSUB ALLOC
+      T=6:L=3:N=Z%(B+1,1):GOSUB ALLOC
 
       REM push argument list
       GOSUB PUSH_R
@@ -125,10 +125,10 @@ SUB DO_TCO_FUNCTION
       REM restore F
       GOSUB PEEK_Q_1:F=Q
 
-      REM update AB to next source element
+      REM update B to next source element
       GOSUB PEEK_Q
       Q=Z%(Q,1)
-      AB=Q
+      B=Q
       GOSUB PUT_Q
 
       REM allocate next element
@@ -149,29 +149,29 @@ SUB DO_TCO_FUNCTION
 
 
   DO_SWAP_BANG:
-    F=AB
+    F=B
 
     REM add atom to front of the args list
-    T=6:L=Z%(Z%(AR,1),1):N=Z%(AA,1):GOSUB ALLOC: REM cons
+    T=6:L=Z%(Z%(AR,1),1):N=Z%(A,1):GOSUB ALLOC: REM cons
     AR=R
 
     REM push args for release after
     Q=AR:GOSUB PUSH_Q
 
     REM push atom
-    Q=AA:GOSUB PUSH_Q
+    Q=A:GOSUB PUSH_Q
 
     CALL APPLY
 
     REM pop atom
-    GOSUB POP_Q:AA=Q
+    GOSUB POP_Q:A=Q
 
     REM pop and release args
     GOSUB POP_Q:AY=Q
     GOSUB RELEASE
 
     REM use reset to update the value
-    AB=R:GOSUB DO_RESET_BANG
+    B=R:GOSUB DO_RESET_BANG
 
     REM but decrease ref cnt of return by 1 (not sure why)
     AY=R:GOSUB RELEASE
@@ -188,8 +188,8 @@ DO_FUNCTION:
   G=Z%(F,1)
 
   REM Get argument values
-  R=AR+1:GOSUB DEREF_R:AA=R
-  R=Z%(AR,1)+1:GOSUB DEREF_R:AB=R
+  R=AR+1:GOSUB DEREF_R:A=R
+  R=Z%(AR,1)+1:GOSUB DEREF_R:B=R
 
   REM Switch on the function number
   IF G>59 THEN ER=-1:E$="unknown function"+STR$(G):RETURN
@@ -209,49 +209,49 @@ DO_FUNCTION:
   ON G-49 GOTO DO_META,DO_ATOM,DO_ATOM_Q,DO_DEREF,DO_RESET_BANG,DO_EVAL,DO_READ_FILE,DO_PR_MEMORY_SUMMARY
 
   DO_EQUAL_Q:
-    A=AA:B=AB:GOSUB EQUAL_Q
+    GOSUB EQUAL_Q
     R=R+1
     RETURN
   DO_THROW:
-    ER=AA
+    ER=A
     Z%(ER,0)=Z%(ER,0)+32
     R=0
     RETURN
   DO_NIL_Q:
     R=1
-    IF AA=0 THEN R=2
+    IF A=0 THEN R=2
     RETURN
   DO_TRUE_Q:
     R=1
-    IF AA=2 THEN R=2
+    IF A=2 THEN R=2
     RETURN
   DO_FALSE_Q:
     R=1
-    IF AA=1 THEN R=2
+    IF A=1 THEN R=2
     RETURN
   DO_STRING_Q:
     R=1
-    IF (Z%(AA,0)AND 31)<>4 THEN RETURN
-    IF MID$(S$(Z%(AA,1)),1,1)=CHR$(127) THEN RETURN
+    IF (Z%(A,0)AND 31)<>4 THEN RETURN
+    IF MID$(S$(Z%(A,1)),1,1)=CHR$(127) THEN RETURN
     R=2
     RETURN
   DO_SYMBOL:
-    B$=S$(Z%(AA,1))
+    B$=S$(Z%(A,1))
     T=5:GOSUB STRING
     RETURN
   DO_SYMBOL_Q:
     R=1
-    IF (Z%(AA,0)AND 31)=5 THEN R=2
+    IF (Z%(A,0)AND 31)=5 THEN R=2
     RETURN
   DO_KEYWORD:
-    B$=S$(Z%(AA,1))
+    B$=S$(Z%(A,1))
     IF MID$(B$,1,1)<>CHR$(127) THEN B$=CHR$(127)+B$
     T=4:GOSUB STRING
     RETURN
   DO_KEYWORD_Q:
     R=1
-    IF (Z%(AA,0)AND 31)<>4 THEN RETURN
-    IF MID$(S$(Z%(AA,1)),1,1)<>CHR$(127) THEN RETURN
+    IF (Z%(A,0)AND 31)<>4 THEN RETURN
+    IF MID$(S$(Z%(A,1)),1,1)<>CHR$(127) THEN RETURN
     R=2
     RETURN
 
@@ -274,25 +274,25 @@ DO_FUNCTION:
     R=0
     RETURN
   DO_READ_STRING:
-    A$=S$(Z%(AA,1))
+    A$=S$(Z%(A,1))
     GOSUB READ_STR
     RETURN
   DO_READLINE:
-    A$=S$(Z%(AA,1)):GOSUB READLINE
+    A$=S$(Z%(A,1)):GOSUB READLINE
     IF EZ=1 THEN EZ=0:R=0:RETURN
     B$=R$:T=4:GOSUB STRING
     RETURN
   DO_SLURP:
     R$=""
-    #cbm OPEN 1,8,0,S$(Z%(AA,1))
-    #qbasic A$=S$(Z%(AA,1))
+    #cbm OPEN 1,8,0,S$(Z%(A,1))
+    #qbasic A$=S$(Z%(A,1))
     #qbasic IF NOT _FILEEXISTS(A$) THEN ER=-1:E$="File not found":RETURN
     #qbasic OPEN A$ FOR INPUT AS #1
     DO_SLURP_LOOP:
       A$=""
       #cbm GET#1,A$
       #qbasic A$=INPUT$(1,1)
-      #qbasic IF EOF(1) THEN RS=1:A$=A$+CHR$(10)+")":GOTO DO_SLURP_DONE
+      #qbasic IF EOF(1) THEN EZ=1:A$=A$+CHR$(10)+")":GOTO DO_SLURP_DONE
       IF ASC(A$)=10 THEN R$=R$+CHR$(13)
       IF (ASC(A$)<>10) AND (A$<>"") THEN R$=R$+A$
       #cbm IF (ST AND 64) THEN GOTO DO_SLURP_DONE
@@ -305,32 +305,32 @@ DO_FUNCTION:
 
   DO_LT:
     R=1
-    IF Z%(AA,1)<Z%(AB,1) THEN R=2
+    IF Z%(A,1)<Z%(B,1) THEN R=2
     RETURN
   DO_LTE:
     R=1
-    IF Z%(AA,1)<=Z%(AB,1) THEN R=2
+    IF Z%(A,1)<=Z%(B,1) THEN R=2
     RETURN
   DO_GT:
     R=1
-    IF Z%(AA,1)>Z%(AB,1) THEN R=2
+    IF Z%(A,1)>Z%(B,1) THEN R=2
     RETURN
   DO_GTE:
     R=1
-    IF Z%(AA,1)>=Z%(AB,1) THEN R=2
+    IF Z%(A,1)>=Z%(B,1) THEN R=2
     RETURN
 
   DO_ADD:
-    T=2:L=Z%(AA,1)+Z%(AB,1):GOSUB ALLOC
+    T=2:L=Z%(A,1)+Z%(B,1):GOSUB ALLOC
     RETURN
   DO_SUB:
-    T=2:L=Z%(AA,1)-Z%(AB,1):GOSUB ALLOC
+    T=2:L=Z%(A,1)-Z%(B,1):GOSUB ALLOC
     RETURN
   DO_MULT:
-    T=2:L=Z%(AA,1)*Z%(AB,1):GOSUB ALLOC
+    T=2:L=Z%(A,1)*Z%(B,1):GOSUB ALLOC
     RETURN
   DO_DIV:
-    T=2:L=Z%(AA,1)/Z%(AB,1):GOSUB ALLOC
+    T=2:L=Z%(A,1)/Z%(B,1):GOSUB ALLOC
     RETURN
   DO_TIME_MS:
     T=2:L=INT((TI-BT)*16.667):GOSUB ALLOC
@@ -341,7 +341,7 @@ DO_FUNCTION:
     Z%(R,0)=Z%(R,0)+32
     RETURN
   DO_LIST_Q:
-    A=AA:GOSUB LIST_Q
+    GOSUB LIST_Q
     R=R+1: REM map to mal false/true
     RETURN
   DO_VECTOR:
@@ -349,17 +349,17 @@ DO_FUNCTION:
     RETURN
   DO_VECTOR_Q:
     R=1
-    IF (Z%(AA,0)AND 31)=7 THEN R=2
+    IF (Z%(A,0)AND 31)=7 THEN R=2
     RETURN
   DO_HASH_MAP:
     A=AR:T=8:GOSUB FORCE_SEQ_TYPE
     RETURN
   DO_MAP_Q:
     R=1
-    IF (Z%(AA,0)AND 31)=8 THEN R=2
+    IF (Z%(A,0)AND 31)=8 THEN R=2
     RETURN
   DO_ASSOC:
-    H=AA
+    H=A
     AR=Z%(AR,1)
     DO_ASSOC_LOOP:
       R=AR+1:GOSUB DEREF_R:K=R
@@ -370,28 +370,28 @@ DO_FUNCTION:
       IF AR=0 OR Z%(AR,1)=0 THEN RETURN
       GOTO DO_ASSOC_LOOP
   DO_GET:
-    IF AA=0 THEN R=0:RETURN
-    H=AA:K=AB:GOSUB HASHMAP_GET
+    IF A=0 THEN R=0:RETURN
+    H=A:K=B:GOSUB HASHMAP_GET
     GOSUB DEREF_R
     Z%(R,0)=Z%(R,0)+32
     RETURN
   DO_CONTAINS:
-    H=AA:K=AB:GOSUB HASHMAP_CONTAINS
+    H=A:K=B:GOSUB HASHMAP_CONTAINS
     R=R+1
     RETURN
   DO_KEYS:
     GOTO DO_KEYS_VALS
   DO_VALS:
-    AA=Z%(AA,1)
+    A=Z%(A,1)
   DO_KEYS_VALS:
     REM first result list element
     T=6:L=0:N=0:GOSUB ALLOC:T2=R
 
     DO_KEYS_VALS_LOOP:
-      IF AA=0 OR Z%(AA,1)=0 THEN R=T2:RETURN
+      IF A=0 OR Z%(A,1)=0 THEN R=T2:RETURN
 
       REM copy the value
-      T1=Z%(AA+1,1)
+      T1=Z%(A+1,1)
       REM inc ref cnt of referred argument
       Z%(T1,0)=Z%(T1,0)+32
       Z%(R+1,1)=T1
@@ -402,18 +402,18 @@ DO_FUNCTION:
       REM point previous element to this one
       Z%(T1,1)=R
 
-      IF Z%(Z%(AA,1),1)=0 THEN R=T2:RETURN
+      IF Z%(Z%(A,1),1)=0 THEN R=T2:RETURN
 
-      AA=Z%(Z%(AA,1),1)
+      A=Z%(Z%(A,1),1)
 
       GOTO DO_KEYS_VALS_LOOP
 
   DO_SEQUENTIAL_Q:
     R=1
-    IF (Z%(AA,0)AND 31)=6 OR (Z%(AA,0)AND 31)=7 THEN R=2
+    IF (Z%(A,0)AND 31)=6 OR (Z%(A,0)AND 31)=7 THEN R=2
     RETURN
   DO_CONS:
-    T=6:L=AB:N=AA:GOSUB ALLOC
+    T=6:L=B:N=A:GOSUB ALLOC
     RETURN
   DO_CONCAT:
     REM if empty arguments, return empty list
@@ -422,7 +422,7 @@ DO_FUNCTION:
     REM single argument
     IF Z%(Z%(AR,1),1)<>0 THEN GOTO DO_CONCAT_MULT
       REM force to list type
-      A=AA:T=6:GOSUB FORCE_SEQ_TYPE
+      T=6:GOSUB FORCE_SEQ_TYPE
       RETURN
 
     REM multiple arguments
@@ -437,54 +437,55 @@ DO_FUNCTION:
         IF Z%(AR,1)<>0 THEN GOTO DO_CONCAT_STACK
 
     REM pop last argument as our seq to prepend to
-    GOSUB POP_Q:AB=Q
+    GOSUB POP_Q:B=Q
     REM last arg/seq is not copied so we need to inc ref to it
-    Z%(AB,0)=Z%(AB,0)+32
+    Z%(B,0)=Z%(B,0)+32
     DO_CONCAT_LOOP:
-      IF X=CZ THEN R=AB:RETURN
-      GOSUB POP_Q:AA=Q: REM pop off next seq to prepend
-      IF Z%(AA,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
-      A=AA:B=0:C=-1:GOSUB SLICE
+      IF X=CZ THEN R=B:RETURN
+      GOSUB POP_A: REM pop off next seq to prepend
+      IF Z%(A,1)=0 THEN GOTO DO_CONCAT_LOOP: REM skip empty seqs
+      Q=B:GOSUB PUSH_Q
+      B=0:C=-1:GOSUB SLICE
+      GOSUB POP_Q:B=Q
 
       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
+      Z%(R6,1)=B
 
-      AB=R
+      B=R
       GOTO DO_CONCAT_LOOP
   DO_NTH:
-    B=AA:GOSUB COUNT
-    B=Z%(AB,1)
+    GOSUB COUNT
+    B=Z%(B,1)
     IF R<=B THEN R=0:ER=-1:E$="nth: index out of range":RETURN
     DO_NTH_LOOP:
       IF B=0 THEN GOTO DO_NTH_DONE
       B=B-1
-      AA=Z%(AA,1)
+      A=Z%(A,1)
       GOTO DO_NTH_LOOP
     DO_NTH_DONE:
-      R=Z%(AA+1,1)
+      R=Z%(A+1,1)
       Z%(R,0)=Z%(R,0)+32
       RETURN
   DO_FIRST:
-    IF AA=0 THEN R=0:RETURN
-    IF Z%(AA,1)=0 THEN R=0
-    IF Z%(AA,1)<>0 THEN R=AA+1:GOSUB DEREF_R
+    IF A=0 THEN R=0:RETURN
+    IF Z%(A,1)=0 THEN R=0
+    IF Z%(A,1)<>0 THEN R=A+1:GOSUB DEREF_R
     IF R<>0 THEN Z%(R,0)=Z%(R,0)+32
     RETURN
   DO_REST:
-    IF AA=0 THEN R=3:Z%(R,0)=Z%(R,0)+32:RETURN
-    IF Z%(AA,1)=0 THEN A=AA
-    IF Z%(AA,1)<>0 THEN A=Z%(AA,1)
+    IF A=0 THEN R=3:Z%(R,0)=Z%(R,0)+32:RETURN
+    IF Z%(A,1)<>0 THEN A=Z%(A,1)
     T=6:GOSUB FORCE_SEQ_TYPE
     RETURN
   DO_EMPTY_Q:
     R=1
-    IF Z%(AA,1)=0 THEN R=2
+    IF Z%(A,1)=0 THEN R=2
     RETURN
   DO_COUNT:
-    B=AA:GOSUB COUNT
+    GOSUB COUNT
     T=2:L=R:GOSUB ALLOC
     RETURN
   DO_CONJ:
@@ -495,35 +496,35 @@ DO_FUNCTION:
     RETURN
 
   DO_WITH_META:
-    T=Z%(AA,0)AND 31
+    T=Z%(A,0)AND 31
     REM remove existing metadata first
-    IF T>=16 THEN AA=Z%(AA,1):GOTO DO_WITH_META
-    T=T+16:L=AA:N=AB:GOSUB ALLOC
+    IF T>=16 THEN A=Z%(A,1):GOTO DO_WITH_META
+    T=T+16:L=A:N=B:GOSUB ALLOC
     RETURN
   DO_META:
-    IF (Z%(AA,0)AND 31)<16 THEN R=0:RETURN
-    R=Z%(AA+1,1)
+    IF (Z%(A,0)AND 31)<16 THEN R=0:RETURN
+    R=Z%(A+1,1)
     Z%(R,0)=Z%(R,0)+32
     RETURN
   DO_ATOM:
-    T=12:L=AA:GOSUB ALLOC
+    T=12:L=A:GOSUB ALLOC
     RETURN
   DO_ATOM_Q:
     R=1
-    IF (Z%(AA,0)AND 31)=12 THEN R=2
+    IF (Z%(A,0)AND 31)=12 THEN R=2
     RETURN
   DO_DEREF:
-    R=Z%(AA,1):GOSUB DEREF_R
+    R=Z%(A,1):GOSUB DEREF_R
     Z%(R,0)=Z%(R,0)+32
     RETURN
   DO_RESET_BANG:
-    R=AB
+    R=B
     REM release current value
-    AY=Z%(AA,1):GOSUB RELEASE
+    AY=Z%(A,1):GOSUB RELEASE
     REM inc ref by 2 for atom ownership and since we are returning it
     Z%(R,0)=Z%(R,0)+64
     REM update value
-    Z%(AA,1)=R
+    Z%(A,1)=R
     RETURN
 
   REM DO_PR_MEMORY:
@@ -535,12 +536,12 @@ DO_FUNCTION:
 
   DO_EVAL:
     Q=E:GOSUB PUSH_Q: REM push/save environment
-    A=AA:E=D:CALL EVAL
+    E=D:CALL EVAL
     GOSUB POP_Q:E=Q
     RETURN
 
   DO_READ_FILE:
-    A$=S$(Z%(AA,1))
+    A$=S$(Z%(A,1))
     GOSUB READ_FILE
     RETURN
 
@@ -556,75 +557,75 @@ INIT_CORE_NS:
   REM must match DO_FUNCTION mappings
 
   A=1
-  K$="=":GOSUB INIT_CORE_SET_FUNCTION: REM A=1
-  K$="throw":GOSUB INIT_CORE_SET_FUNCTION: REM A=2
-  K$="nil?":GOSUB INIT_CORE_SET_FUNCTION: REM A=3
-  K$="true?":GOSUB INIT_CORE_SET_FUNCTION: REM A=4
-  K$="false?":GOSUB INIT_CORE_SET_FUNCTION: REM A=5
-  K$="string?":GOSUB INIT_CORE_SET_FUNCTION: REM A=6
-  K$="symbol":GOSUB INIT_CORE_SET_FUNCTION: REM A=7
-  K$="symbol?":GOSUB INIT_CORE_SET_FUNCTION: REM A=8
-  K$="keyword":GOSUB INIT_CORE_SET_FUNCTION: REM A=9
-  K$="keyword?":GOSUB INIT_CORE_SET_FUNCTION: REM A=10
-
-  K$="pr-str":GOSUB INIT_CORE_SET_FUNCTION: REM A=11
-  K$="str":GOSUB INIT_CORE_SET_FUNCTION: REM A=12
-  K$="prn":GOSUB INIT_CORE_SET_FUNCTION: REM A=13
-  K$="println":GOSUB INIT_CORE_SET_FUNCTION: REM A=14
-  K$="read-string":GOSUB INIT_CORE_SET_FUNCTION: REM A=15
-  K$="readline":GOSUB INIT_CORE_SET_FUNCTION: REM A=16
-  K$="slurp":GOSUB INIT_CORE_SET_FUNCTION: REM A=17
-
-  K$="<":GOSUB INIT_CORE_SET_FUNCTION: REM A=18
-  K$="<=":GOSUB INIT_CORE_SET_FUNCTION: REM A=19
-  K$=">":GOSUB INIT_CORE_SET_FUNCTION: REM A=20
-  K$=">=":GOSUB INIT_CORE_SET_FUNCTION: REM A=21
-  K$="+":GOSUB INIT_CORE_SET_FUNCTION: REM A=22
-  K$="-":GOSUB INIT_CORE_SET_FUNCTION: REM A=23
-  K$="*":GOSUB INIT_CORE_SET_FUNCTION: REM A=24
-  K$="/":GOSUB INIT_CORE_SET_FUNCTION: REM A=25
-  K$="time-ms":GOSUB INIT_CORE_SET_FUNCTION: REM A=26
-
-  K$="list":GOSUB INIT_CORE_SET_FUNCTION: REM A=27
-  K$="list?":GOSUB INIT_CORE_SET_FUNCTION: REM A=28
-  K$="vector":GOSUB INIT_CORE_SET_FUNCTION: REM A=29
-  K$="vector?":GOSUB INIT_CORE_SET_FUNCTION: REM A=30
-  K$="hash-map":GOSUB INIT_CORE_SET_FUNCTION: REM A=31
-  K$="map?":GOSUB INIT_CORE_SET_FUNCTION: REM A=32
-  K$="assoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=33
-  K$="dissoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=34
-  K$="get":GOSUB INIT_CORE_SET_FUNCTION: REM A=35
-  K$="contains?":GOSUB INIT_CORE_SET_FUNCTION: REM A=36
-  K$="keys":GOSUB INIT_CORE_SET_FUNCTION: REM A=37
-  K$="vals":GOSUB INIT_CORE_SET_FUNCTION: REM A=38
-
-  K$="sequential?":GOSUB INIT_CORE_SET_FUNCTION: REM A=39
-  K$="cons":GOSUB INIT_CORE_SET_FUNCTION: REM A=40
-  K$="concat":GOSUB INIT_CORE_SET_FUNCTION: REM A=41
-  K$="nth":GOSUB INIT_CORE_SET_FUNCTION: REM A=42
-  K$="first":GOSUB INIT_CORE_SET_FUNCTION: REM A=43
-  K$="rest":GOSUB INIT_CORE_SET_FUNCTION: REM A=44
-  K$="empty?":GOSUB INIT_CORE_SET_FUNCTION: REM A=45
-  K$="count":GOSUB INIT_CORE_SET_FUNCTION: REM A=46
-
-  K$="conj":GOSUB INIT_CORE_SET_FUNCTION: REM A=47
-  K$="seq":GOSUB INIT_CORE_SET_FUNCTION: REM A=48
-
-  K$="with-meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=49
-  K$="meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=50
-  K$="atom":GOSUB INIT_CORE_SET_FUNCTION: REM A=51
-  K$="atom?":GOSUB INIT_CORE_SET_FUNCTION: REM A=52
-  K$="deref":GOSUB INIT_CORE_SET_FUNCTION: REM A=53
-  K$="reset!":GOSUB INIT_CORE_SET_FUNCTION: REM A=54
-
-  K$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=55
-  K$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=56
-  K$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=57
+  B$="=":GOSUB INIT_CORE_SET_FUNCTION: REM A=1
+  B$="throw":GOSUB INIT_CORE_SET_FUNCTION: REM A=2
+  B$="nil?":GOSUB INIT_CORE_SET_FUNCTION: REM A=3
+  B$="true?":GOSUB INIT_CORE_SET_FUNCTION: REM A=4
+  B$="false?":GOSUB INIT_CORE_SET_FUNCTION: REM A=5
+  B$="string?":GOSUB INIT_CORE_SET_FUNCTION: REM A=6
+  B$="symbol":GOSUB INIT_CORE_SET_FUNCTION: REM A=7
+  B$="symbol?":GOSUB INIT_CORE_SET_FUNCTION: REM A=8
+  B$="keyword":GOSUB INIT_CORE_SET_FUNCTION: REM A=9
+  B$="keyword?":GOSUB INIT_CORE_SET_FUNCTION: REM A=10
+
+  B$="pr-str":GOSUB INIT_CORE_SET_FUNCTION: REM A=11
+  B$="str":GOSUB INIT_CORE_SET_FUNCTION: REM A=12
+  B$="prn":GOSUB INIT_CORE_SET_FUNCTION: REM A=13
+  B$="println":GOSUB INIT_CORE_SET_FUNCTION: REM A=14
+  B$="read-string":GOSUB INIT_CORE_SET_FUNCTION: REM A=15
+  B$="readline":GOSUB INIT_CORE_SET_FUNCTION: REM A=16
+  B$="slurp":GOSUB INIT_CORE_SET_FUNCTION: REM A=17
+
+  B$="<":GOSUB INIT_CORE_SET_FUNCTION: REM A=18
+  B$="<=":GOSUB INIT_CORE_SET_FUNCTION: REM A=19
+  B$=">":GOSUB INIT_CORE_SET_FUNCTION: REM A=20
+  B$=">=":GOSUB INIT_CORE_SET_FUNCTION: REM A=21
+  B$="+":GOSUB INIT_CORE_SET_FUNCTION: REM A=22
+  B$="-":GOSUB INIT_CORE_SET_FUNCTION: REM A=23
+  B$="*":GOSUB INIT_CORE_SET_FUNCTION: REM A=24
+  B$="/":GOSUB INIT_CORE_SET_FUNCTION: REM A=25
+  B$="time-ms":GOSUB INIT_CORE_SET_FUNCTION: REM A=26
+
+  B$="list":GOSUB INIT_CORE_SET_FUNCTION: REM A=27
+  B$="list?":GOSUB INIT_CORE_SET_FUNCTION: REM A=28
+  B$="vector":GOSUB INIT_CORE_SET_FUNCTION: REM A=29
+  B$="vector?":GOSUB INIT_CORE_SET_FUNCTION: REM A=30
+  B$="hash-map":GOSUB INIT_CORE_SET_FUNCTION: REM A=31
+  B$="map?":GOSUB INIT_CORE_SET_FUNCTION: REM A=32
+  B$="assoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=33
+  B$="dissoc":GOSUB INIT_CORE_SET_FUNCTION: REM A=34
+  B$="get":GOSUB INIT_CORE_SET_FUNCTION: REM A=35
+  B$="contains?":GOSUB INIT_CORE_SET_FUNCTION: REM A=36
+  B$="keys":GOSUB INIT_CORE_SET_FUNCTION: REM A=37
+  B$="vals":GOSUB INIT_CORE_SET_FUNCTION: REM A=38
+
+  B$="sequential?":GOSUB INIT_CORE_SET_FUNCTION: REM A=39
+  B$="cons":GOSUB INIT_CORE_SET_FUNCTION: REM A=40
+  B$="concat":GOSUB INIT_CORE_SET_FUNCTION: REM A=41
+  B$="nth":GOSUB INIT_CORE_SET_FUNCTION: REM A=42
+  B$="first":GOSUB INIT_CORE_SET_FUNCTION: REM A=43
+  B$="rest":GOSUB INIT_CORE_SET_FUNCTION: REM A=44
+  B$="empty?":GOSUB INIT_CORE_SET_FUNCTION: REM A=45
+  B$="count":GOSUB INIT_CORE_SET_FUNCTION: REM A=46
+
+  B$="conj":GOSUB INIT_CORE_SET_FUNCTION: REM A=47
+  B$="seq":GOSUB INIT_CORE_SET_FUNCTION: REM A=48
+
+  B$="with-meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=49
+  B$="meta":GOSUB INIT_CORE_SET_FUNCTION: REM A=50
+  B$="atom":GOSUB INIT_CORE_SET_FUNCTION: REM A=51
+  B$="atom?":GOSUB INIT_CORE_SET_FUNCTION: REM A=52
+  B$="deref":GOSUB INIT_CORE_SET_FUNCTION: REM A=53
+  B$="reset!":GOSUB INIT_CORE_SET_FUNCTION: REM A=54
+
+  B$="eval":GOSUB INIT_CORE_SET_FUNCTION: REM A=55
+  B$="read-file":GOSUB INIT_CORE_SET_FUNCTION: REM A=56
+  B$="pr-memory-summary":GOSUB INIT_CORE_SET_FUNCTION: REM A=57
 
   REM these are in DO_TCO_FUNCTION
   A=61
-  K$="apply":GOSUB INIT_CORE_SET_FUNCTION: REM A=61
-  K$="map":GOSUB INIT_CORE_SET_FUNCTION: REM A=62
-  K$="swap!":GOSUB INIT_CORE_SET_FUNCTION: REM A=63
+  B$="apply":GOSUB INIT_CORE_SET_FUNCTION: REM A=61
+  B$="map":GOSUB INIT_CORE_SET_FUNCTION: REM A=62
+  B$="swap!":GOSUB INIT_CORE_SET_FUNCTION: REM A=63
 
   RETURN

diff --git a/basic/env.in.bas b/basic/env.in.bas
index 6c280f3..cab37f3 100644 (file)
--- a/basic/env.in.bas
+++ b/basic/env.in.bas
@@ -58,7 +58,7 @@ ENV_SET:
   R=C
   RETURN
 
-REM ENV_SET_S(E, K$, C) -> R
+REM ENV_SET_S(E, B$, C) -> R
 ENV_SET_S:
   H=Z%(E,1)
   GOSUB ASSOC1_S

diff --git a/basic/reader.in.bas b/basic/reader.in.bas
index 0d536bc..8e1e522 100644 (file)
--- a/basic/reader.in.bas
+++ b/basic/reader.in.bas
@@ -29,16 +29,16 @@ READ_TOKEN:
     GOTO READ_TOKEN_LOOP
 
 READ_FILE_CHUNK:
-  IF RS=1 THEN RETURN
+  IF EZ=1 THEN RETURN
   IF RI>1 THEN A$=MID$(A$,RI,LEN(A$)-RI+1):RI=1:RJ=RJ-RI+1
   READ_FILE_CHUNK_LOOP:
     IF LEN(A$)>RJ+9 THEN RETURN
     #cbm GET#2,C$
     #qbasic C$=INPUT$(1,2)
-    #qbasic IF EOF(2) THEN RS=1:A$=A$+CHR$(10)+")":RETURN
+    #qbasic IF EOF(2) THEN EZ=1:A$=A$+CHR$(10)+")":RETURN
     A$=A$+C$
-    #cbm IF (ST AND 64) THEN RS=1:A$=A$+CHR$(10)+")":RETURN
-    #cbm IF (ST AND 255) THEN RS=1:ER=-1:E$="File read error "+STR$(ST):RETURN
+    #cbm IF (ST AND 64) THEN EZ=1:A$=A$+CHR$(10)+")":RETURN
+    #cbm IF (ST AND 255) THEN EZ=1:ER=-1:E$="File read error "+STR$(ST):RETURN
     GOTO READ_FILE_CHUNK_LOOP
 
 SKIP_SPACES:
@@ -148,8 +148,8 @@ READ_FORM:
       GOTO READ_FORM_DONE
   READ_STRING:
     REM PRINT "READ_STRING"
-    T7$=MID$(T$,LEN(T$),1)
-    IF T7$<>CHR$(34) THEN E$="expected '"+CHR$(34)+"'":GOTO READ_FORM_ABORT
+    C=ASC(MID$(T$,LEN(T$),1))
+    IF C<>34 THEN E$="expected '"+CHR$(34)+"'":GOTO READ_FORM_ABORT
     R$=MID$(T$,2,LEN(T$)-2)
     S1$=CHR$(92)+CHR$(34):S2$=CHR$(34):GOSUB REPLACE: REM unescape quotes
     S1$=CHR$(92)+"n":S2$=CHR$(13):GOSUB REPLACE: REM unescape newlines
@@ -258,7 +258,7 @@ READ_FILE:
   RI=1: REM index into A$
   RJ=1: REM READ_TOKEN sub-index
   RF=1: REM reading from file
-  RS=0: REM file read state (1: EOF)
+  EZ=0: REM file read state (1: EOF)
   SD=0: REM sequence read depth
   #cbm OPEN 2,8,0,A$
   #qbasic IF NOT _FILEEXISTS(A$) THEN ER=-1:E$="File not found":RETURN
@@ -266,4 +266,5 @@ READ_FILE:
   REM READ_FILE_CHUNK adds terminating ")"
   A$="(do ":GOSUB READ_FORM
   CLOSE 2
+  EZ=0
   RETURN

diff --git a/basic/step2_eval.in.bas b/basic/step2_eval.in.bas
index 5ea5bc5..eeba70c 100755 (executable)
--- a/basic/step2_eval.in.bas
+++ b/basic/step2_eval.in.bas
@@ -142,7 +142,7 @@ SUB EVAL
 
     EVAL_INVOKE:
       CALL EVAL_AST
-      T6=R
+      W=R
 
       REM if error, return f/args for release by caller
       IF ER<>-2 THEN GOTO EVAL_RETURN
@@ -152,7 +152,7 @@ SUB EVAL
       R=F:GOSUB DEREF_R:F=R
       IF (Z%(F,0)AND 31)<>9 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
       GOSUB DO_FUNCTION
-      AY=T6:GOSUB RELEASE
+      AY=W:GOSUB RELEASE
       GOTO EVAL_RETURN
 
   EVAL_RETURN:
@@ -180,8 +180,8 @@ DO_FUNCTION:
   G=Z%(F,1)
 
   REM Get argument values
-  R=AR+1:GOSUB DEREF_R:AA=Z%(R,1)
-  R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1)
+  R=AR+1:GOSUB DEREF_R:A=Z%(R,1)
+  R=Z%(AR,1)+1:GOSUB DEREF_R:B=Z%(R,1)
 
   REM Switch on the function number
   IF G=1 THEN GOTO DO_ADD
@@ -191,16 +191,16 @@ DO_FUNCTION:
   ER=-1:E$="unknown function"+STR$(G):RETURN
 
   DO_ADD:
-    T=2:L=AA+AB:GOSUB ALLOC
+    T=2:L=A+B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_SUB:
-    T=2:L=AA-AB:GOSUB ALLOC
+    T=2:L=A-B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_MULT:
-    T=2:L=AA*AB:GOSUB ALLOC
+    T=2:L=A*B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_DIV:
-    T=2:L=AA/AB:GOSUB ALLOC
+    T=2:L=A/B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
 
   DO_FUNCTION_DONE:
@@ -244,19 +244,19 @@ MAIN:
 
   REM + function
   A=1:GOSUB NATIVE_FUNCTION
-  H=D:K$="+":C=R:GOSUB ASSOC1_S:D=R
+  H=D:B$="+":C=R:GOSUB ASSOC1_S:D=R
 
   REM - function
   A=2:GOSUB NATIVE_FUNCTION
-  H=D:K$="-":C=R:GOSUB ASSOC1_S:D=R
+  H=D:B$="-":C=R:GOSUB ASSOC1_S:D=R
 
   REM * function
   A=3:GOSUB NATIVE_FUNCTION
-  H=D:K$="*":C=R:GOSUB ASSOC1_S:D=R
+  H=D:B$="*":C=R:GOSUB ASSOC1_S:D=R
 
   REM / function
   A=4:GOSUB NATIVE_FUNCTION
-  H=D:K$="/":C=R:GOSUB ASSOC1_S:D=R
+  H=D:B$="/":C=R:GOSUB ASSOC1_S:D=R
 
   ZT=ZI: REM top of memory after base repl_env
 

diff --git a/basic/step3_env.in.bas b/basic/step3_env.in.bas
index 22a234f..b23fc0e 100755 (executable)
--- a/basic/step3_env.in.bas
+++ b/basic/step3_env.in.bas
@@ -210,7 +210,7 @@ SUB EVAL
         GOTO EVAL_RETURN
     EVAL_INVOKE:
       CALL EVAL_AST
-      T6=R
+      W=R
 
       REM if error, return f/args for release by caller
       IF ER<>-2 THEN GOTO EVAL_RETURN
@@ -220,7 +220,7 @@ SUB EVAL
       R=F:GOSUB DEREF_R:F=R
       IF (Z%(F,0)AND 31)<>9 THEN ER=-1:E$="apply of non-function":GOTO EVAL_RETURN
       GOSUB DO_FUNCTION
-      AY=T6:GOSUB RELEASE
+      AY=W:GOSUB RELEASE
       GOTO EVAL_RETURN
 
   EVAL_RETURN:
@@ -254,8 +254,8 @@ DO_FUNCTION:
   G=Z%(F,1)
 
   REM Get argument values
-  R=AR+1:GOSUB DEREF_R:AA=Z%(R,1)
-  R=Z%(AR,1)+1:GOSUB DEREF_R:AB=Z%(R,1)
+  R=AR+1:GOSUB DEREF_R:A=Z%(R,1)
+  R=Z%(AR,1)+1:GOSUB DEREF_R:B=Z%(R,1)
 
   REM Switch on the function number
   IF G=1 THEN GOTO DO_ADD
@@ -265,16 +265,16 @@ DO_FUNCTION:
   ER=-1:E$="unknown function"+STR$(G):RETURN
 
   DO_ADD:
-    T=2:L=AA+AB:GOSUB ALLOC
+    T=2:L=A+B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_SUB:
-    T=2:L=AA-AB:GOSUB ALLOC
+    T=2:L=A-B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_MULT:
-    T=2:L=AA*AB:GOSUB ALLOC
+    T=2:L=A*B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
   DO_DIV:
-    T=2:L=AA/AB:GOSUB ALLOC
+    T=2:L=A/B:GOSUB ALLOC
     GOTO DO_FUNCTION_DONE
 
   DO_FUNCTION_DONE:
@@ -319,19 +319,19 @@ MAIN:
   E=D
   REM + function
   A=1:GOSUB NATIVE_FUNCTION
-  K$="+":C=R:GOSUB ENV_SET_S
+  B$="+":C=R:GOSUB ENV_SET_S
 
   REM - function
   A=2:GOSUB NATIVE_FUNCTION
-  K$="-":C=R:GOSUB ENV_SET_S
+  B$="-":C=R:GOSUB ENV_SET_S
 
   REM * function
   A=3:GOSUB NATIVE_FUNCTION
-  K$="*":C=R:GOSUB ENV_SET_S
+  B$="*":C=R:GOSUB ENV_SET_S
 
   REM / function
   A=4:GOSUB NATIVE_FUNCTION
-  K$="/":C=R:GOSUB ENV_SET_S
+  B$="/":C=R:GOSUB ENV_SET_S
 
   ZT=ZI: REM top of memory after base repl_env
 

diff --git a/basic/step4_if_fn_do.in.bas b/basic/step4_if_fn_do.in.bas
index e32ab16..08dfb6f 100755 (executable)
--- a/basic/step4_if_fn_do.in.bas
+++ b/basic/step4_if_fn_do.in.bas
@@ -237,7 +237,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 daba262..b2b6ad4 100755 (executable)
--- a/basic/step5_tco.in.bas
+++ b/basic/step5_tco.in.bas
@@ -257,7 +257,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 07b3020..f30c6d9 100755 (executable)
--- a/basic/step6_file.in.bas
+++ b/basic/step6_file.in.bas
@@ -257,7 +257,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 2d9e221..477ee6e 100755 (executable)
--- a/basic/step7_quote.in.bas
+++ b/basic/step7_quote.in.bas
@@ -43,7 +43,7 @@ SUB QUASIQUOTE
     GOSUB PUSH_A
     REM rest of cases call quasiquote on ast[1..]
     A=Z%(A,1):CALL QUASIQUOTE
-    T6=R
+    W=R
     GOSUB POP_A
 
     REM set A to ast[0] for last two cases
@@ -60,7 +60,7 @@ SUB QUASIQUOTE
 
       B=Z%(A,1)+1:GOSUB DEREF_B:B=B
       B$="concat":T=5:GOSUB STRING:C=R
-      A=T6:GOSUB LIST3
+      A=W:GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
@@ -69,14 +69,14 @@ SUB QUASIQUOTE
   QQ_DEFAULT:
     REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
 
-    Q=T6:GOSUB PUSH_Q
+    Q=W:GOSUB PUSH_Q
     REM A set above to ast[0]
     CALL QUASIQUOTE
     B=R
-    GOSUB POP_Q:T6=Q
+    GOSUB POP_Q:W=Q
 
     B$="cons":T=5:GOSUB STRING:C=R
-    A=T6:GOSUB LIST3
+    A=W:GOSUB LIST3
     REM release inner quasiquoted since outer list takes ownership
     AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
@@ -345,7 +345,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 44cfd10..cbfe05f 100755 (executable)
--- a/basic/step8_macros.in.bas
+++ b/basic/step8_macros.in.bas
@@ -43,7 +43,7 @@ SUB QUASIQUOTE
     GOSUB PUSH_A
     REM rest of cases call quasiquote on ast[1..]
     A=Z%(A,1):CALL QUASIQUOTE
-    T6=R
+    W=R
     GOSUB POP_A
 
     REM set A to ast[0] for last two cases
@@ -60,7 +60,7 @@ SUB QUASIQUOTE
 
       B=Z%(A,1)+1:GOSUB DEREF_B:B=B
       B$="concat":T=5:GOSUB STRING:C=R
-      A=T6:GOSUB LIST3
+      A=W:GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
@@ -69,14 +69,14 @@ SUB QUASIQUOTE
   QQ_DEFAULT:
     REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
 
-    Q=T6:GOSUB PUSH_Q
+    Q=W:GOSUB PUSH_Q
     REM A set above to ast[0]
     CALL QUASIQUOTE
     B=R
-    GOSUB POP_Q:T6=Q
+    GOSUB POP_Q:W=Q
 
     B$="cons":T=5:GOSUB STRING:C=R
-    A=T6:GOSUB LIST3
+    A=W:GOSUB LIST3
     REM release inner quasiquoted since outer list takes ownership
     AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
@@ -411,7 +411,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 023e519..233c8c0 100755 (executable)
--- a/basic/step9_try.in.bas
+++ b/basic/step9_try.in.bas
@@ -43,7 +43,7 @@ SUB QUASIQUOTE
     GOSUB PUSH_A
     REM rest of cases call quasiquote on ast[1..]
     A=Z%(A,1):CALL QUASIQUOTE
-    T6=R
+    W=R
     GOSUB POP_A
 
     REM set A to ast[0] for last two cases
@@ -60,7 +60,7 @@ SUB QUASIQUOTE
 
       B=Z%(A,1)+1:GOSUB DEREF_B:B=B
       B$="concat":T=5:GOSUB STRING:C=R
-      A=T6:GOSUB LIST3
+      A=W:GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
@@ -69,14 +69,14 @@ SUB QUASIQUOTE
   QQ_DEFAULT:
     REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
 
-    Q=T6:GOSUB PUSH_Q
+    Q=W:GOSUB PUSH_Q
     REM A set above to ast[0]
     CALL QUASIQUOTE
     B=R
-    GOSUB POP_Q:T6=Q
+    GOSUB POP_Q:W=Q
 
     B$="cons":T=5:GOSUB STRING:C=R
-    A=T6:GOSUB LIST3
+    A=W:GOSUB LIST3
     REM release inner quasiquoted since outer list takes ownership
     AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
@@ -443,7 +443,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 e4c3765..7e0d0d2 100755 (executable)
--- a/basic/stepA_mal.in.bas
+++ b/basic/stepA_mal.in.bas
@@ -43,7 +43,7 @@ SUB QUASIQUOTE
     GOSUB PUSH_A
     REM rest of cases call quasiquote on ast[1..]
     A=Z%(A,1):CALL QUASIQUOTE
-    T6=R
+    W=R
     GOSUB POP_A
 
     REM set A to ast[0] for last two cases
@@ -60,7 +60,7 @@ SUB QUASIQUOTE
 
       B=Z%(A,1)+1:GOSUB DEREF_B:B=B
       B$="concat":T=5:GOSUB STRING:C=R
-      A=T6:GOSUB LIST3
+      A=W:GOSUB LIST3
       REM release inner quasiquoted since outer list takes ownership
       AY=A:GOSUB RELEASE
       AY=C:GOSUB RELEASE
@@ -69,14 +69,14 @@ SUB QUASIQUOTE
   QQ_DEFAULT:
     REM ['cons, quasiquote(ast[0]), quasiquote(ast[1..])]
 
-    Q=T6:GOSUB PUSH_Q
+    Q=W:GOSUB PUSH_Q
     REM A set above to ast[0]
     CALL QUASIQUOTE
     B=R
-    GOSUB POP_Q:T6=Q
+    GOSUB POP_Q:W=Q
 
     B$="cons":T=5:GOSUB STRING:C=R
-    A=T6:GOSUB LIST3
+    A=W:GOSUB LIST3
     REM release inner quasiquoted since outer list takes ownership
     AY=A:GOSUB RELEASE
     AY=B:GOSUB RELEASE
@@ -443,7 +443,7 @@ SUB EVAL
       EVAL_IF_FALSE:
         AY=R:GOSUB RELEASE
         REM if no false case (A3), return nil
-        B=A:GOSUB COUNT
+        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 af9cdf3..b055c2b 100644 (file)
--- a/basic/types.in.bas
+++ b/basic/types.in.bas
@@ -28,8 +28,8 @@ INIT_MEMORY:
   #cbm T=FRE(0)
   #qbasic T=0
 
-  Z1=4096: REM Z% (boxed memory) size (4 bytes each)
-  Z2=200: REM S$/S% (string memory) size (3+2 bytes each)
+  Z1=4195: REM Z% (boxed memory) size (4 bytes each)
+  Z2=199: REM S$/S% (string memory) size (3+2 bytes each)
   #qbasic Z3=200: REM X% (call stack) size (2 bytes each)
   #cbm Z3=49152: REM X starting point at $C000 (2 bytes each)
   #qbasic Z4=64: REM Y% (release stack) size (4 bytes each)
@@ -50,15 +50,22 @@ INIT_MEMORY:
   DIM Z%(Z1,1): REM TYPE ARRAY
 
   REM Predefine nil, false, true, and an empty list
-  Z%(0,0)=0:Z%(0,1)=0
-  Z%(1,0)=1:Z%(1,1)=0
+  FOR I=0 TO 8:Z%(I,0)=0:Z%(I,1)=0:NEXT I
+  Z%(1,0)=1
   Z%(2,0)=1:Z%(2,1)=1
   Z%(3,0)=6+32:Z%(3,1)=0
-  Z%(4,0)=0:Z%(4,1)=0
   Z%(5,0)=7+32:Z%(5,1)=0
-  Z%(6,0)=0:Z%(6,1)=0
   Z%(7,0)=8+32:Z%(7,1)=0
-  Z%(8,0)=0:Z%(8,1)=0
+
+REM  Z%(0,0)=0:Z%(0,1)=0
+REM  Z%(1,0)=1:Z%(1,1)=0
+REM  Z%(2,0)=1:Z%(2,1)=1
+REM  Z%(3,0)=6+32:Z%(3,1)=0
+REM  Z%(4,0)=0:Z%(4,1)=0
+REM  Z%(5,0)=7+32:Z%(5,1)=0
+REM  Z%(6,0)=0:Z%(6,1)=0
+REM  Z%(7,0)=8+32:Z%(7,1)=0
+REM  Z%(8,0)=0:Z%(8,1)=0
 
   REM start of unused memory
   ZI=9
@@ -155,30 +162,28 @@ ALLOC:
   IF T<6 OR T=9 OR T=12 OR T=14 THEN SZ=1
   REM PRINT "ALLOC T: "+STR$(T)+", SZ: "+STR$(SZ)+", ZK: "+STR$(ZK)
   U=ZK
-  V=ZK
+  R=ZK
   ALLOC_LOOP:
-    IF V=ZI THEN GOTO ALLOC_UNUSED
+    IF R=ZI THEN GOTO ALLOC_UNUSED
     REM TODO sanity check that type is 15
-    IF ((Z%(V,0)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE
-    REM PRINT "ALLOC search: U: "+STR$(U)+", V: "+STR$(V)
-    U=V: REM previous set to current
-    V=Z%(V,1): REM current set to next
+    IF ((Z%(R,0)AND-32)/32)=SZ THEN GOTO ALLOC_MIDDLE
+    REM PRINT "ALLOC search: U: "+STR$(U)+", R: "+STR$(R)
+    U=R: REM previous set to current
+    R=Z%(R,1): REM current set to next
     GOTO ALLOC_LOOP
   ALLOC_MIDDLE:
-    REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", V: "+STR$(V)
-    R=V
+    REM PRINT "ALLOC_MIDDLE: U: "+STR$(U)+", R: "+STR$(R)
     REM set free pointer (ZK) to next free
-    IF V=ZK THEN ZK=Z%(V,1)
+    IF R=ZK THEN ZK=Z%(R,1)
     REM set previous free to next free
-    IF V<>ZK THEN Z%(U,1)=Z%(V,1)
+    IF R<>ZK THEN Z%(U,1)=Z%(R,1)
     GOTO ALLOC_DONE
   ALLOC_UNUSED:
-    REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", V: "+STR$(V)
-    R=V
+    REM PRINT "ALLOC_UNUSED ZI: "+STR$(ZI)+", U: "+STR$(U)+", R: "+STR$(R)
     ZI=ZI+SZ
-    IF U=V THEN ZK=ZI
+    IF U=R THEN ZK=ZI
     REM set previous free to new memory top
-    IF U<>V THEN Z%(U,1)=ZI
+    IF U<>R THEN Z%(U,1)=ZI
     GOTO ALLOC_DONE
   ALLOC_DONE:
     Z%(R,0)=T+32
@@ -236,8 +241,7 @@ RELEASE:
 
   REM sanity check not already freed
   IF (U)=15 THEN ER=-1:E$="RELEASE of free: "+STR$(AY):RETURN
-  IF U=14 THEN GOTO RELEASE_REFERENCE
-  IF Z%(AY,0)<15 THEN ER=-1:E$="Unowned object: "+STR$(AY):RETURN
+  IF Z%(AY,0)<15 THEN ER=-1:E$="Unowned: "+STR$(AY):RETURN
 
   REM decrease reference count by one
   Z%(AY,0)=Z%(AY,0)-32
@@ -246,43 +250,46 @@ RELEASE:
   IF Z%(AY,0)>=32 GOTO RELEASE_TOP
 
   REM switch on type
-  IF U<=3 OR U=9 THEN GOTO RELEASE_SIMPLE
-  IF U=4 OR U=5 THEN GOTO RELEASE_STRING
-  IF U>=6 AND U<=8 THEN GOTO RELEASE_SEQ
-  IF U=10 OR U=11 THEN GOTO RELEASE_MAL_FUNCTION
-  IF U>=16 THEN GOTO RELEASE_METADATA
-  IF U=12 THEN GOTO RELEASE_ATOM
-  IF U=13 THEN GOTO RELEASE_ENV
+  SZ=1: REM default FREE size, adjusted by RELEASE_*
+  IF U>=16 THEN GOSUB RELEASE_METADATA
+
+REM  IF U<=3 OR U=9 THEN GOSUB RELEASE_SIMPLE
+REM  IF U=4 OR U=5 THEN GOSUB RELEASE_STRING
+REM  IF U>=6 AND U<=8 THEN GOSUB RELEASE_SEQ
+REM  IF U=10 OR U=11 THEN GOSUB RELEASE_MAL_FUNCTION
+REM  IF U>=16 THEN GOSUB RELEASE_METADATA
+REM  IF U=12 THEN GOSUB RELEASE_ATOM
+REM  IF U=13 THEN GOSUB RELEASE_ENV
+
+  ON U+1 GOSUB RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_SIMPLE,RELEASE_STRING,RELEASE_STRING,RELEASE_SEQ,RELEASE_SEQ,RELEASE_SEQ,RELEASE_SIMPLE,RELEASE_MAL_FUNCTION,RELEASE_MAL_FUNCTION,RELEASE_ATOM,RELEASE_ENV
+
+  REM free the current element and continue, SZ already set
+  GOSUB FREE
+  GOTO RELEASE_TOP
 
   RELEASE_SIMPLE:
-    REM simple type (no recursing), just call FREE on it
-    SZ=1:GOSUB FREE
-    GOTO RELEASE_TOP
-  RELEASE_SIMPLE_2:
-    REM free the current element and continue
-    SZ=2:GOSUB FREE
-    GOTO RELEASE_TOP
+    RETURN
   RELEASE_STRING:
     REM string type, release interned string, then FREE reference
     IF S%(V)=0 THEN ER=-1:E$="RELEASE of free string:"+STR$(S%(V)):RETURN
     S%(V)=S%(V)-1
     IF S%(V)=0 THEN S$(V)="": REM free BASIC string
     REM free the atom itself
-    GOTO RELEASE_SIMPLE
+    RETURN
   RELEASE_SEQ:
-    IF V=0 THEN GOTO RELEASE_SIMPLE_2
+    IF V=0 THEN SZ=2:RETURN
     IF Z%(AY+1,0)<>14 THEN ER=-1:E$="invalid list value"+STR$(AY+1):RETURN
     REM add value and next element to stack
     RC=RC+2
     Q=Z%(AY+1,1):GOSUB PUSH_Q
     Q=V:GOSUB PUSH_Q
-    GOTO RELEASE_SIMPLE_2
+    SZ=2:RETURN
   RELEASE_ATOM:
     REM add contained/referred value
     RC=RC+1
     Q=V:GOSUB PUSH_Q
     REM free the atom itself
-    GOTO RELEASE_SIMPLE
+    RETURN
   RELEASE_MAL_FUNCTION:
     REM add ast, params and environment to stack
     RC=RC+3
@@ -290,36 +297,21 @@ RELEASE:
     Q=Z%(AY+1,0):GOSUB PUSH_Q
     Q=Z%(AY+1,1):GOSUB PUSH_Q
     REM free the current 2 element mal_function and continue
-    SZ=2:GOSUB FREE
-    GOTO RELEASE_TOP
+    SZ=2:RETURN
   RELEASE_METADATA:
     REM add object and metadata object
     RC=RC+2
     Q=V:GOSUB PUSH_Q
     Q=Z%(AY+1,1):GOSUB PUSH_Q
-    SZ=2:GOSUB FREE
-    GOTO RELEASE_TOP
+    SZ=2:RETURN
   RELEASE_ENV:
     REM add the hashmap data to the stack
     RC=RC+1
     Q=V:GOSUB PUSH_Q
-    REM if no outer set
-    IF Z%(AY+1,1)=-1 THEN GOTO RELEASE_ENV_FREE
+    REM if outer set, add outer env to stack
+    IF Z%(AY+1,1)<>-1 THEN RC=RC+1:Q=Z%(AY+1,1):GOSUB PUSH_Q
     REM add outer environment to the stack
-    RC=RC+1
-    Q=Z%(AY+1,1):GOSUB PUSH_Q
-    RELEASE_ENV_FREE:
-      REM free the current 2 element environment and continue
-      SZ=2:GOSUB FREE
-      GOTO RELEASE_TOP
-  RELEASE_REFERENCE:
-    IF V=0 THEN GOTO RELEASE_SIMPLE
-    REM add the referred element to the stack
-    RC=RC+1
-    Q=V:GOSUB PUSH_Q
-    REM free the current element and continue
-    SZ=1:GOSUB FREE
-    GOTO RELEASE_TOP
+    SZ=2:RETURN
 
 
 REM release stack functions
@@ -391,8 +383,8 @@ EQUAL_Q:
   GOTO EQUAL_Q_DONE
 
   EQUAL_Q_SEQ:
-    IF (Z%(A,1)=0) AND (Z%(B,1)=0) THEN GOTO EQUAL_Q_DONE
-    IF (Z%(A,1)=0) OR (Z%(B,1)=0) THEN R=0:GOTO EQUAL_Q_DONE
+    IF Z%(A,1)=0 AND Z%(B,1)=0 THEN GOTO EQUAL_Q_DONE
+    IF Z%(A,1)=0 OR Z%(B,1)=0 THEN R=0:GOTO EQUAL_Q_DONE
 
     REM compare the elements
     A=Z%(A+1,1):B=Z%(B+1,1)
@@ -463,15 +455,15 @@ REM PRINT "STRING ref: "+S$(I)+" (idx:"+STR$(I)+", ref "+STR$(S%(I))+")"
 
 REM REPLACE(R$, S1$, S2$) -> R$
 REPLACE:
-  R3$=R$
+  T3$=R$
   R$=""
   I=1
-  J=LEN(R3$)
+  J=LEN(T3$)
   REPLACE_LOOP:
     IF I>J THEN RETURN
-    C$=MID$(R3$,I,LEN(S1$))
+    C$=MID$(T3$,I,LEN(S1$))
     IF C$=S1$ THEN R$=R$+S2$:I=I+LEN(S1$)
-    IF C$<>S1$ THEN R$=R$+MID$(R3$,I,1):I=I+1
+    IF C$<>S1$ THEN R$=R$+MID$(T3$,I,1):I=I+1
     GOTO REPLACE_LOOP
 
 
@@ -500,28 +492,29 @@ EMPTY_Q:
   IF Z%(A,1)=0 THEN R=1
   RETURN
 
-REM COUNT(B) -> R
+REM COUNT(A) -> R
 REM - returns length of list, not a Z% index
-REM - modifies B
 COUNT:
+  GOSUB PUSH_A
   R=-1
   DO_COUNT_LOOP:
     R=R+1
-    IF Z%(B,1)<>0 THEN B=Z%(B,1):GOTO DO_COUNT_LOOP
+    IF Z%(A,1)<>0 THEN A=Z%(A,1):GOTO DO_COUNT_LOOP
+  GOSUB POP_A
   RETURN
 
 REM LAST(A) -> R
 LAST:
   REM TODO check that actually a list/vector
   IF Z%(A,1)=0 THEN R=0:RETURN: REM empty seq, return nil
-  T6=0
+  W=0
   LAST_LOOP:
     IF Z%(A,1)=0 THEN GOTO LAST_DONE: REM end, return previous value
-    T6=A: REM current becomes previous entry
+    W=A: REM current becomes previous entry
     A=Z%(A,1): REM next entry
     GOTO LAST_LOOP
   LAST_DONE:
-    R=T6+1:GOSUB DEREF_R
+    R=W+1:GOSUB DEREF_R
     Z%(R,0)=Z%(R,0)+32
     RETURN
 
@@ -599,10 +592,10 @@ ASSOC1:
   AY=L:GOSUB RELEASE: REM we took ownership of previous hashmap
   RETURN
 
-REM ASSOC1(H, K$, C) -> R
+REM ASSOC1_S(H, B$, C) -> R
 ASSOC1_S:
   REM add the key string
-  B$=K$:T=4:GOSUB STRING
+  T=4:GOSUB STRING
   K=R:GOSUB ASSOC1
   AY=K:GOSUB RELEASE: REM map took ownership of key
   RETURN

diff --git a/basic/variables.txt b/basic/variables.txt
index aafa336..c4f84ee 100644 (file)
--- a/basic/variables.txt
+++ b/basic/variables.txt
@@ -23,7 +23,7 @@ D   : root repl environment
 BT  : begin time (TI)
 ER  : error type (-2: none, -1: string, >=0: object)
 E$  : error string (ER=-1)
-EZ  : READLINE EOF
+EZ  : READLINE EOF return, READ_FILE EOF temp
 
 LV  : EVAL stack call level/depth
 
@@ -37,12 +37,12 @@ A   : common call argument (especially EVAL, EVAL_AST)
 A$  : common call argument (READLINE, reader, string temp, key value)
 B   : common call argument
 B$  : STRING arg (HASHMAP_GET temp), PR_STR_SEQ seperator
+    : INIT_CORE_SET_FUNCTION, ENV_SET_S, ASSOC1_S
 C   : common call argument, DO_TCO_FUNCTION temp in DO_APPLY
 E   : environment (EVAL, EVAL_AST)
 F   : function
 H   : hash map
 K   : hash map key (Z% index)
-K$  : INIT_CORE_SET_FUNCTION and ENV_SET_S
 L   : ALLOC* Z%(R,1) default
 M   : ALLOC* Z%(R+1,0) default
 N   : ALLOC* Z%(R+1,1) default
@@ -72,33 +72,27 @@ A0  : EVAL ast elements
 A1  : EVAL ast elements
 A2  : EVAL ast elements
 A3  : EVAL ast elements
-AA  : DO_*_FUNCTION arg1
-AB  : DO_*_FUNCTION arg2
 
 CZ  : DO_CONCAT stack position
 ED  : EQUAL_Q recursion depth counter
 RD  : PR_OBJECT recursion depth
 SD  : READ_STR sequence read recursion depth
 
-
 C$  : READ_TOKEN, SKIP_SPACES, SKIP_TO_EOL current character
 G   : function value ON GOTO switch flag
 I   : STRING, REPLACE, SLICE, PR_MEMORY, PR_OBJECT
 J   : REPLACE
 U   : ALLOC, RELEASE, PR_STR temp
-V   : ALLOC, RELEASE, PR_STR_SEQ temp
-W   : SLICE temp
+V   : RELEASE, PR_STR_SEQ temp
+W   : SLICE, LAST, QUASIQUOTE, step2-3 EVAL temp
 RC  : RELEASE remaining number of elements to release
 RF  : reader reading from file flag
-RS  : reader EOF state (1=EOF)
 S1  : READ_TOKEN in a string?
 S2  : READ_TOKEN escaped?
 T$  : READ_* current token string
-T1  : EQUAL_Q, PR_STR, and core DO_KEYS_VALS temp
+T1  : EQUAL_Q, PR_STR, DO_KEYS_VALS temp
 T2  : EQUAL_Q, DO_KEY_VALS, HASH_MAP_GET
 T3$ : REPLACE temp
-T6  : LAST and QUASIQUOTE temp (step2-3 EVAL temp)
-T7$ : READ_FORM:READ_STRING character temp
 
 
 Unused: