glib: Add abort restart for cleanups and secondary-GC-daemons.

diff --git a/src/glib/glib-thread.scm b/src/glib/glib-thread.scm
index 4518bc53146da1963742f5dfb5ff58b50607bd79..a1a52ada095397b52c4d8df7c305a71b0fddc52a 100644 (file)
--- a/src/glib/glib-thread.scm
+++ b/src/glib/glib-thread.scm
@@ -52,6 +52,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                    (done-tick 0)
                    (next-secondary-tick secondary-gc-rate))
                (let glib-thread-loop ()
+                 (if (not (eq? interrupt-mask/all
+                               ((ucode-primitive get-interrupt-enables 0))))
+                     (outf-error "\nglib-thread-loop: already running without-interrupts\n"))
                  (without-interrupts
                   (lambda ()
                     (let ((gc-tick (car (gc-timestamp))))
@@ -64,7 +67,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                       (if (fix:< next-secondary-tick gc-tick)
                           (begin
                             (%trace ";run-glib secondary-gc daemons\n")
-                            (trigger-secondary-gc-daemons!)
+                            (run-glib-daemons)
                             (%trace ";run-glib secondary-gc daemons done\n")
                             (set! next-secondary-tick
                                   (fix:+ gc-tick secondary-gc-rate)))))))

diff --git a/src/glib/glib.pkg b/src/glib/glib.pkg
index 1396c5cc197d40740a316885997918ce7941fa2f..e527d932c2eb2527058db2967a8b036ac8a1b494 100644 (file)
--- a/src/glib/glib.pkg
+++ b/src/glib/glib.pkg
@@ -111,7 +111,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (export ()
          stop-glib-thread)
   (import (glib)
-         run-glib-cleanups)
+         run-glib-cleanups
+         run-glib-daemons)
   (import (glib main)
          run-glib)
   (import (runtime primitive-io)

diff --git a/src/glib/glib.scm b/src/glib/glib.scm
index f363f9a159f73cbaa3b0398d138a4123c35a89db..4bdb865803b030be3bab57757e51164200832f5a 100644 (file)
--- a/src/glib/glib.scm
+++ b/src/glib/glib.scm
@@ -130,12 +130,29 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (loop (cdr alist) alist)
            (let ((thunk (weak-cdr (car alist)))
                  (next (cdr alist)))
-             (thunk)
+             (with-glib-error-handler "this GLib cleanup" thunk)
              (if prev
                  (set-cdr! prev next)
                  (set! glib-cleanups next))
              (loop next prev))))))
 
+(define (run-glib-daemons)
+  (with-glib-error-handler "the secondary GC daemons"
+                          trigger-secondary-gc-daemons!))
+
+(define (with-glib-error-handler what thunk)
+  (call-with-current-continuation
+   (lambda (continue)
+     ;;(with-restart name reporter effector interactor thunk)
+     (with-restart 'ABORT
+        (string-append "Punt "what"; return to the GLib main loop.")
+        (named-lambda (glib-abort-effector . args)
+          (declare (ignore args))
+          (continue unspecific))
+        (named-lambda (glib-abort-interactor . args)
+          (apply values args))
+       thunk))))
+
 (define (reset-glib-cleanups!)
   (set! glib-cleanups '()))