From 3f60507c407dc22a19b4539d08cc926c54141653 Mon Sep 17 00:00:00 2001
From: Tim Vaughan <tgvaughan@gmail.com>
Date: Fri, 29 Sep 2017 00:52:57 +0200
Subject: [PATCH] Debugging GC issue.

---
 src/scheme-primitives.4th |  7 +++++++
 src/scheme.4th            | 14 +++++++++++---
 2 files changed, 18 insertions(+), 3 deletions(-)

diff --git a/src/scheme-primitives.4th b/src/scheme-primitives.4th
index 21a0440..bce895d 100644
--- a/src/scheme-primitives.4th
+++ b/src/scheme-primitives.4th
@@ -280,6 +280,13 @@
     drop swap drop f> boolean-type
 ; 2 make-fa-primitive flo:>
 
+:noname ( flonum flonum -- bool )
+    drop swap drop f<= boolean-type
+; 2 make-fa-primitive flo:<=
+
+:noname ( flonum flonum -- bool )
+    drop swap drop f>= boolean-type
+; 2 make-fa-primitive flo:>=
 
 :noname ( flonum -- bool )
     drop 0.0 = boolean-type
diff --git a/src/scheme.4th b/src/scheme.4th
index af4157f..d6dccd1 100644
--- a/src/scheme.4th
+++ b/src/scheme.4th
@@ -2018,7 +2018,9 @@ variable gc-stack-depth
 ;
 
 :noname
-    \ ." GC! "
+    ." GC! "
+
+    trace
 
     gc-unmark
 
@@ -2036,7 +2038,7 @@ variable gc-stack-depth
 
     gc-sweep
 
-    \ ." (" gc-count-marked . ." pairs marked as used.)" cr
+    ." (" gc-count-marked . ." pairs marked as used.)" cr
 ; is collect-garbage
 
 \ }}}
@@ -2051,8 +2053,14 @@ variable gc-stack-depth
     ok-symbol ( port res )
 
     begin
+        \ DEBUG
+        bold fg blue ." READ from " 2over drop . ." ==> " reset-term
+
         2over read-port ( port res obj )
 
+        \ DEBUG
+        2dup print cr
+
         2dup EOF character-type objeq? if
             2drop 2swap close-port
             exit
@@ -2101,7 +2109,7 @@ variable gc-stack-depth
     enable-gc
 
     \ Display welcome message
-    welcome-symbol nil cons global-env obj@ eval 2drop
+    \ welcome-symbol nil cons global-env obj@ eval 2drop
 
     begin
         ['] repl-body catch
-- 
2.20.1