Trigger-secondary-gc-daemons! every 100 GCs or so.

diff --git a/src/gtk/thread.scm b/src/gtk/thread.scm
index 69105932a9c467bdfdb9188adf8097772e2510e6..b492f7bc2e44a10f4c7f3be94bf1f173b67242f4 100644 (file)
--- a/src/gtk/thread.scm
+++ b/src/gtk/thread.scm
@@ -29,6 +29,9 @@ USA.
 
 (define gtk-thread #f)
 
+;; Number of GCs between applications of trigger-secondary-gc-daemons!
+(define secondary-gc-rate 100)
+
 ;;; With the following thread always running, the runtime system
 ;;; should no longer use wait-for-io, nor need to signal
 ;;; condition-type:no-thread!
@@ -44,7 +47,8 @@ USA.
        (create-thread
         #f (lambda ()
              (let ((self (current-thread))
-                   (done-tick 0))
+                   (done-tick 0)
+                   (next-secondary-tick secondary-gc-rate))
                (let gtk-thread-loop ()
                  (without-interrupts
                   (lambda ()
@@ -52,7 +56,12 @@ USA.
                       (if (fix:< done-tick gc-tick)
                           (begin
                             (run-gc-cleanups)
-                            (set! done-tick gc-tick))))))
+                            (set! done-tick gc-tick)))
+                      (if (fix:< next-secondary-tick gc-tick)
+                          (begin
+                            (trigger-secondary-gc-daemons!)
+                            (set! next-secondary-tick
+                                  (fix:+ gc-tick secondary-gc-rate)))))))
                  (without-interrupts
                   (lambda ()
                     (let ((time (if (thread/next self)