From e2e8c8f6d1d43e1044b91080f4cd3922fcd99472 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Mon, 24 Oct 2016 16:40:52 +1300
Subject: [PATCH] GC working when invoked between evaluations.

Now need to deal with root objects on the parameter stack.
---
 README.md  |  2 +-
 scheme.4th | 64 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 63 insertions(+), 3 deletions(-)

diff --git a/README.md b/README.md
index 4ebeb7e..1dcb17d 100644
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 scheme.forth.jl
 ---------------
 
-A hobby scheme implementation for FORTH 83. Specifically it is targeted at 
+A hobby scheme interpreter for FORTH 83. Specifically it is targeted at 
 [forth.jl](http://github.com/tgvaughan/forth.jl) which is an implementation
 of FORTH on top of [Julia](http://www.julialang.org), hence the name.
 At the moment it is a fairly direct port of Peter Micheaux's [Bootstrap
diff --git a/scheme.4th b/scheme.4th
index 3c5c6a9..8d28269 100644
--- a/scheme.4th
+++ b/scheme.4th
@@ -157,15 +157,24 @@ false gc-enabled !
 ;
 
 : pairlike-marked? ( obj -- obj bool )
-    over nextfrees + 0=
+    over nextfrees + @ 0=
 ;
 
 : mark-pairlike ( obj -- obj )
         over nextfrees + 0 swap !
 ;
 
+: gc-unmark ( -- )
+    scheme-memsize 0 do
+        1 nextfrees i + !
+    loop
+;
+
+defer gc-mark-trace
 : gc-mark-obj ( obj -- )
 
+    gc-mark-trace
+
     pairlike? invert if 2drop exit then
     pairlike-marked? if 2drop exit then
 
@@ -184,10 +193,13 @@ false gc-enabled !
             nextfree @ nextfrees i + !
             i nextfree !
         then
-    -1 +loop ;
+    -1 +loop
+;
 
 \ }}}
 
+   
+
 \ ---- Pre-defined symbols ---- {{{
 
 objvar symbol-table
@@ -1291,6 +1303,54 @@ parse-idx-stack parse-idx-sp !
 
 \ }}}
 
+\ ---- DEBUGGING ---- {{{
+
+false value debug-mode
+
+:noname
+    debug-mode if
+        ." Object: " 2dup cr print cr
+        ." Pairlike: " pairlike? if
+            ." TRUE"
+            pairlike-marked? if
+                ."  (Marked)"
+            else
+                ."  (Unmarked)"
+            then
+        else
+            ." FALSE"
+        then
+        cr ." [paused]"
+        key drop cr
+    then
+; is gc-mark-trace
+
+: gc-mark-sweep
+    gc-unmark
+    symbol-table obj@ gc-mark-obj
+    global-env obj@ gc-mark-obj
+    gc-sweep
+;
+
+: gc-count-marked
+    0
+    scheme-memsize 0 do
+        nextfrees i + @ 0= if 1+ then
+    loop
+;
+
+: gc-zero-unmarked
+    scheme-memsize 0 do
+        nextfrees i + @ 0<> if
+            0 car-cells i + !
+            0 cdr-cells i + !
+        then
+    loop
+;
+
+\ }}}
+
+
 \ ---- REPL ----
 
 : repl
-- 
2.20.1