Add something like a garbage collector

Split heap into temporary "little heap" and permanent "big heap".
Defined symbols get copied into big heap, and little heap is
reset after each REPL iteration.

3 files changed, 172 insertions, 6 deletions

diff --git a/eval.s b/eval.s
index 71286b5..9b2e37f 100644
--- a/eval.s
+++ b/eval.s
@@ -40,10 +40,9 @@ not_atom:
 003054 000002
 ; R2 = rest
 ; R3 = rest'
-; push entry l[second, hd] onto symbol table a
-; a <- cons(l[second, hd], a)
+; push entry l[second, third] onto symbol table a
 003056 011225 MOV @R2, (R5)+        ; push second (=car(rest)) onto symbol table column 0
-003060 011425 MOV @R4, (R5)+        ; push hd onto symbol table column 1
+003060 011325 MOV @R3, (R5)+        ; push third (=car(rest')) onto symbol table column 1
 ; evaluate cons(third, tl) in extended environment
 ; R0 <- cons(third, tl)
 003062 011300 MOV @R3, R0           ; arg1 <- third (=car(rest'))
@@ -64,7 +63,7 @@ not_label:
 003112 005110
 003114 004737 JSR PC, #eq           ; test eq(first, at"LAMBDA")
 003116 004600
-003120 001043 BNE error             ; branch if not lambda
+003120 001043 BNE not_lambda        ; branch if not lambda
 ; if is lambda
 ; push onto a               ; a <- append(pair(second, evlis(tl)), a)
 003122 010546 MOV R5, -(SP)               ; push old symbol table pointer to stack
@@ -111,8 +110,31 @@ done:
 ; pop off argument entries
 003224 012605 MOV (SP)+, R5               ; restore symbol table pointer
 003226 000207 RTS PC
-error:
-003230 000777 BR -2                       ; infinite loop
+
+not_lambda:
+; R2 = hd
+003230 011200 MOV @R2, R0           ; arg1 <- car(hd) = first
+003232 012701 MOV "DEFINE", R1      ; arg2 <- at"DEFINE"
+003234 005122
+003236 004737 JSR PC, #eq           ; test eq(first, at"DEFINE")
+003240 004600
+003242 001377 BNE error             ; infinite loop if not define
+; if is define
+; push entry l[cp(second), cp(third)] onto symbol table
+003244 016203 MOV 2(R2), R3         ; rest <- cdr(hd)
+003246 000002
+003250 011300 MOV @R3, R0           ; arg1 <- second (=car(rest))
+003252 004737 JSR PC, @copy         ; copy second to big heap
+003254 005400
+003256 010025 MOV R0, (R5)+         ; push cp(second) onto symbol table column 0
+003260 017300 MOV @2(R3), R0        ; arg1 <- third (=car(cdr(rest)))
+003262 000002
+003264 004737 JSR PC, @copy         ; copy third to big heap
+003266 005400
+003270 010025 MOV R0, (R5)+         ; push cp(third) onto symbol table column 1
+003272 012700 MOV "NIL", R0         ; result <- at"NIL"
+003274 005000
+003276 000207 RTS PC                ; return result
 
 head_is_atom:
 ; R2 = hd
diff --git a/heap.s b/heap.s
new file mode 100644
index 0000000..00f47e2
--- /dev/null
+++ b/heap.s
@@ -0,0 +1,55 @@
+; copy s-exp into big (permanent) heap
+; R0 = arg1
+; big heap at 11000
+; touches R0, R1, R2
+copy:
+005400 032710 BIT #1, (R0)          ; test if cons or atom
+005402 000001
+005404 001016 BNE is_atom           ; branch if atom
+; otherwise it's cons:
+005406 011046 MOV @R0, -(SP)        ; save car to stack
+005410 016000 MOV 2(R0), R0         ; arg1 <- cdr
+005412 000002
+005414 004737 JSR PC, @copy         ; result <- copy(cdr)
+005416 005400
+005420 010001 MOV R0, R1            ; arg2 <- result
+005422 012600 MOV (SP)+, R0         ; arg1 <- car from stack
+005424 010146 MOV R1, -(SP)         ; save arg2
+005426 004737 JSR PC, @copy         ; arg1 <- copy(car)
+005430 005400
+005432 012601 MOV (SP)+, R1         ; restore arg2
+005434 004737 JSR PC, @big_cons     ; allocate cons cell
+005436 005600
+005440 000207 RTS PC
+is_atom:
+005442 013702 MOV @#11000, R2       ; get free pointer
+005444 011000
+005446 010246 MOV R2, -(SP)         ; save new atom start address
+005450 010201 MOV R2, R1
+005452 062701 ADD #3, R1
+005454 000003
+005456 010122 MOV R1, (R2)+         ; allocate atom tag and increment free pointer
+005460 011000 MOV @R0, R0
+005462 005300 DEC R0                ; get string address
+005464 112022 MOVB (R0)+, (R2)+     ; copy one byte
+005466 001376 BNE -4                ; if not null continue copying chars
+005470 005202 INC R2                ; align free pointer
+005472 042702 BIC #1, R2
+005574 000001
+005576 010237 MOV R2, @#11000       ; store new free pointer
+005500 011000
+005502 012600 MOV (SP)+, R0         ; result <- address of new atom
+005504 000207 RTS PC
+
+big_cons:
+005600 013702 MOV @#11000, R2       ; get free pointer
+005602 011000
+005604 010012 MOV R0, @R2           ; move arg1 to car of new cons cell
+005606 010162 MOV R1, 2(R2)         ; move arg2 to cdr of new cons cell
+005610 000002
+005612 010200 MOV R2, R0            ; result <- new cons cell
+005614 062702 ADD 4, R2             ; advance free pointer
+005616 000004
+005620 010237 MOV R2, @#11000       ; store new free pointer
+005622 011000
+005624 000207 RTS PC
diff --git a/layout.s b/layout.s
new file mode 100644
index 0000000..04a768c
--- /dev/null
+++ b/layout.s
@@ -0,0 +1,89 @@
+^- stack
+1000:
+  init
+2000:
+  read
+3000:
+  eval
+4000:
+  print
+  4400:
+    cons
+  4500:
+    assoc
+  4600:
+    eq
+5000:
+  atom "NIL\0"
+    005000 005003
+    005002 044516 ; "NI"
+    005004 000114 ; "L\0"
+  atom "T\0"
+    005006 005011
+    005010 000124 ; "T\0"
+  atom "F\0"
+    005012 005015
+    005014 000106 ; "F\0"
+  atom "QUOTE\0"
+    005016 005021
+    005020 052521 ; "QU"
+    005022 052117 ; "OT"
+    005024 000105 ; "E\0"
+  atom "ATOM\0"
+    005026 005031
+    005030 052101 ; "AT"
+    005032 046517 ; "OM"
+    005034 000000 ; "\0"
+  atom "EQ\0"
+    005036 005041
+    005040 050505 ; "EQ"
+    005042 000000 ; "\0"
+  atom "COND\0"
+    005044 005047
+    005046 047503 ; "CO"
+    005050 042116 ; "ND"
+    005052 000000 ; "\0"
+  atom "CAR\0"
+    005054 005057
+    005056 040503 ; "CA"
+    005060 000122 ; "R\0"
+  atom "CDR\0"
+    005062 005065
+    005064 042103 ; "CD"
+    005066 000122 ; "R\0"
+  atom "CONS\0"
+    005070 005073
+    005072 047503 ; "CO"
+    005074 051516 ; "NS"
+    005076 000000 ; "\0"
+  atom "LABEL\0"
+    005100 005103
+    005102 040514 ; "LA"
+    005104 042502 ; "BE"
+    005106 000114 ; "L\0"
+  atom "LAMBDA\0"
+    005110 005113
+    005112 040514 ; "LA"
+    005114 041115 ; "MB"
+    005116 040504 ; "DA"
+    005120 000000 ; "\0"
+  atom "DEFINE\0"
+    005122 005125
+    005124 042504 ; "DE"
+    005126 044506 ; "FI"
+    005130 042516 ; "NE"
+    005132 000000 ; "\0"
+  5400:
+    copy
+  5600:
+    big_cons
+6000:
+  symbol table
+7000:
+  print buffer
+10000:
+  little_heap
+    010000 010002 ; free pointer
+11000:
+  big_heap
+    011000 011002 ; free pointer