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