From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sun, 11 Mar 2018 17:09:53 +0000 (-0700)
Subject: glib: Residual fixes.  Less integration for easier debugging.
X-Git-Tag: mit-scheme-pucked-x11-0.2.2~57
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6ee3b4ee11e80345a10951fd5aab8b55d3faa689;p=mit-scheme.git

glib: Residual fixes.  Less integration for easier debugging.
---

diff --git a/src/glib/glib.pkg b/src/glib/glib.pkg
index c320bb1d7..0776325be 100644
--- a/src/glib/glib.pkg
+++ b/src/glib/glib.pkg
@@ -114,8 +114,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (export ()
 	  stop-glib-thread)
   (import (glib)
-	  glib-mutex			;exposed by with-glib-lock, run-glib,...
+	  glib-mutex			;exposed by integrated with-glib-lock
 	  with-glib-lock
+	  assert-glib-locked
 	  run-glib-cleanups
 	  run-glib-daemons)
   (import (glib main)
diff --git a/src/glib/glib.scm b/src/glib/glib.scm
index 0adc5a85b..6dd371982 100644
--- a/src/glib/glib.scm
+++ b/src/glib/glib.scm
@@ -122,28 +122,20 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (reset-glib-mutex!)
   (set! glib-mutex (make-thread-mutex)))
 
-(define-integrable (with-glib-lock thunk)
+(define (with-glib-lock thunk)
   (with-thread-mutex-lock glib-mutex thunk))
 
-(define-integrable-operator (without-glib-lock thunk)
-  ;; Temporarily use thread-mutex-owner to (try to) avoid signaling an
-  ;; error when glib is not locked.  This should actually avoid the
-  ;; error in single threaded worlds.
-  (let ((owner (thread-mutex-owner glib-mutex)))
-    (if (eq? #f owner)
-	(begin
-	  (outf-error ";glib already unlocked\n")
-	  (thunk)
-	  ;; Lock it *now*?
-	  )
-	(without-thread-mutex-lock glib-mutex thunk))))
+(define (without-glib-lock thunk)
+  (without-thread-mutex-lock glib-mutex thunk))
 
-(define-integrable (assert-glib-locked operator)
+#;(define-integrable (assert-glib-locked operator) #f)
+(define (assert-glib-locked operator)
   ;; Useful at least when debugging single threaded worlds.
   (if (not (eq? (current-thread) (thread-mutex-owner glib-mutex)))
       (outf-error ";glib not locked: "operator"\n")))
 
-(define-integrable (assert-without-interruption operator)
+#;(define-integrable (assert-without-interruption operator) #f)
+(define (assert-without-interruption operator)
   (if (not (get-thread-event-block))
       (outf-error ";not without-interruption: "operator"\n")))
 
@@ -167,6 +159,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	      (loop next prev))))))
 
 (define (run-glib-daemons)
+  (assert-glib-locked 'run-glib-daemons)
   (with-glib-error-handler "the secondary GC daemons"
 			   trigger-secondary-gc-daemons!))
 
@@ -193,7 +186,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     weak-pair))
 
 (define (execute-glib-cleanup object)
-  (assert-glib-locked 'execute-glib-cleanup) ; and without-interruption
+  (assert-without-interruption 'execute-glib-cleanup)
+  (assert-glib-locked 'execute-glib-cleanup)
   (let ((entry (weak-assq object glib-cleanups)))
     (if entry
 	(begin