glib: Serialize callouts to glib. Banish without-interrupts.

diff --git a/src/glib/gio.scm b/src/glib/gio.scm
index d9f4e8187e47980d7262436031708785bf94e49b..67b91370440b7cdebd3295f59af74e2bb208fff3 100644 (file)
--- a/src/glib/gio.scm
+++ b/src/glib/gio.scm
@@ -28,8 +28,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (open-input-gfile uri)
   (let* ((uri* (->uri* uri 'open-input-gfile))
-        (gfile (make-gfile uri*))
-        (gstream (gfile-read gfile))
+        (gstream
+         (with-glib-lock
+          (lambda ()
+            (let* ((gfile (make-gfile uri*))
+                   (gstream (gfile-read gfile)))
+              (gobject-unref! gfile)
+              gstream))))
         (port (make-generic-i/o-port (make-binary-port
                                       (make-g-stream-source gstream)
                                       #f
@@ -38,7 +43,6 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                                      'open-input-gfile)))
     ;;(port/set-coding port 'ISO-8859-1)
     ;;(port/set-line-ending port 'NEWLINE)
-    (gobject-unref! gfile)
     port))
 
 (define (->uri* object caller)
@@ -66,17 +70,24 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
       (named-lambda (g-stream-source/has-bytes?)
        #t)
       (named-lambda (g-stream-source/read-bytes! buffer start end)
-       (g-input-stream-read gstream buffer start end))
+       (with-glib-lock
+        (lambda () (g-input-stream-read gstream buffer start end))))
       (named-lambda (g-stream-source/close)
        (if open?
-           (let ((value (g-input-stream-close gstream)))
+           (let ((value (with-glib-lock
+                         (lambda () (g-input-stream-close gstream)))))
              (set! open? #f)
              value))))))
 
 (define (open-output-gfile uri)
   (let* ((uri* (->uri* uri 'open-output-gfile))
-        (gfile (make-gfile uri*))
-        (gstream (gfile-replace gfile #f #t 'private))
+        (gstream
+         (with-glib-lock
+          (lambda ()
+            (let* ((gfile (make-gfile uri*))
+                   (gstream (gfile-replace gfile #f #t 'private)))
+              (gobject-unref! gfile)
+              gstream))))
         (port (make-generic-i/o-port (make-binary-port
                                       #f
                                       (make-g-stream-sink gstream)
@@ -85,32 +96,34 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                                      'open-output-gfile)))
     ;;(port/set-coding port 'ISO-8859-1)
     ;;(port/set-line-ending port 'NEWLINE)
-    (gobject-unref! gfile)
     port))
 
 (define (make-g-stream-sink gstream)
   (let ((open? #t))
     (make-non-channel-output-sink
      (named-lambda (g-stream-sink/write-bytes buffer start end)
-       (g-output-stream-write gstream buffer start end))
+       (with-glib-lock
+       (lambda () (g-output-stream-write gstream buffer start end))))
      (named-lambda (g-stream-sink/close)
        (if open?
-          (let ((value (g-output-stream-close gstream)))
+          (let ((value (with-glib-lock
+                        (lambda () (g-output-stream-close gstream)))))
             (set! open? #f)
             value))))))
 
 (define (gdirectory-read uri)
-  (let* ((uri* (->uri* uri 'gdirectory-read))
-        (gfile (make-gfile uri*))
-        (names
-         (map! (lambda (ginfo)
-                 (let ((name (gfile-info-get-attribute-value
-                              ginfo "standard::name")))
-                   (gobject-unref! ginfo)
-                   name))
-               (gfile-children gfile "standard::name"))))
-    (gobject-unref! gfile)
-    names))
+  (let ((uri* (->uri* uri 'gdirectory-read)))
+    (with-glib-lock
+     (lambda ()
+       (let ((gfile (make-gfile uri*)))
+        (map! (lambda (ginfo)
+                (let ((name (gfile-info-get-attribute-value
+                             ginfo "standard::name")))
+                  (gobject-unref! ginfo)
+                  name))
+              (let ((children (gfile-children gfile "standard::name")))
+                (gobject-unref! gfile)
+                children)))))))
 
 (define (gfile-children gfile attributes)
   (let ((genum (gfile-enumerate-children gfile attributes #f)))
@@ -160,6 +173,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (call-next-method object)
   (let* ((gio-info (gio-cleanup-info object))
         (gerror* (gio-cleanup-info-gerror-pointer gio-info)))
+    (assert-glib-locked '(initialize-instance <gio>))
     (C-call "g_try_malloc0" gerror* (C-sizeof "* GError"))
     (error-if-null gerror* "Could not create:" gerror*)))
 
@@ -183,6 +197,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                    (,modifier ,info #F))))))))))
 
 (define-integrable-operator (cleanup-gerror-pointer gerror*)
+  (assert-glib-locked 'cleanup-gerror-pointer)
   (if (not (alien-null? gerror*))
       (let ((gerror (make-alien '|GError|)))
        (C-> gerror* "* GError" gerror)
@@ -192,6 +207,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (alien-null! gerror*))))
 
 (define-integrable-operator (cleanup-gio gio-info)
+  (assert-glib-locked 'cleanup-gio)
   (let ((pending-op (gio-cleanup-info-pending-op gio-info)))
     (if (not (memq pending-op '(#f ERROR CLOSED)))
        (C-call "g_cancellable_cancel"
@@ -239,12 +255,19 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (cleanup-g-input-stream gio-info info)))
 
 (define (cleanup-g-input-stream gio-info info)
-  ;; For glib-cleanups.  Run without-interrupts.
+  (assert-without-interruption 'cleanup-g-input-stream)
+  (assert-glib-locked 'cleanup-g-input-stream)
   (cleanup-gio gio-info)
   (cleanup-callback-id info g-input-stream read-id)
   (cleanup-callback-id info g-input-stream skip-id))
 
+(define-integrable (dequeue! queue)
+  (without-glib-lock
+   (lambda ()
+     (thread-queue/dequeue! queue))))
+
 (define (g-input-stream-read gstream buffer start end)
+  (assert-glib-locked 'g-input-stream-read)
   (let* ((gio-info (gio-cleanup-info gstream))
         (info (g-input-stream-cleanup-info gstream))
         (callback-id (g-input-stream-cleanup-info-read-id info)))
@@ -261,7 +284,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
              (C-callback "async_ready")
              callback-id)
       (let* ((queue (gio-queue gstream))
-            (value (thread-queue/dequeue! queue)))
+            (value (dequeue! queue)))
        (if (string? value)
            (begin
              (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
@@ -286,6 +309,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-read-finish-callback queue gerror*)
   (C-callback
    (named-lambda (read-finish-callback source result)
+     (assert-glib-locked 'read-finish-callback)
      (let ((bytes (C-call "g_input_stream_read_finish" source result gerror*)))
        (if (fix:= bytes -1)
           (let ((message (%gerror-message gerror*)))
@@ -314,6 +338,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (maybe-yield-glib))
 
 (define (g-input-stream-skip gstream count)
+  (assert-glib-locked 'g-input-stream-skip)
   (let* ((gio-info (gio-cleanup-info gstream))
         (info (g-input-stream-cleanup-info gstream))
         (callback-id (g-input-stream-cleanup-info-skip-id info)))
@@ -327,7 +352,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (C-callback "async_ready")
            callback-id)
     (let* ((queue (gio-queue gstream))
-          (value (thread-queue/dequeue! queue)))
+          (value (dequeue! queue)))
       (if (string? value)
          (begin
            (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
@@ -339,6 +364,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-skip-finish-callback queue gerror*)
   (C-callback
    (named-lambda (skip-finish-callback source result)
+     (assert-glib-locked 'skip-finish-callback)
      (let ((bytes (C-call "g_input_stream_skip_finish" source result gerror*)))
        (if (fix:= bytes -1)
           (let ((message (%gerror-message gerror*)))
@@ -349,6 +375,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
             (%queue! queue bytes)))))))
 
 (define (g-input-stream-close gstream)
+  (assert-glib-locked 'g-input-stream-close)
   (gfile-close gstream
               (named-lambda (close-input
                              gstream* priority gcancellable* callback id)
@@ -361,12 +388,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                  gio-info (g-input-stream-cleanup-info gstream)))))
 
 (define (gfile-close gio callout make-callback cleanup)
+  (assert-glib-locked 'gfile-close)
   (let* ((gio-info (gio-cleanup-info gio))
         (queue (gio-queue gio))
         (gerror* (gio-cleanup-info-gerror-pointer gio-info)))
     (guarantee-gio-idle gio)
     (let ((callback-id
-          (without-interrupts          ;don't leak callback IDs
+          (without-interruption        ;don't leak callback IDs
            (lambda ()
              (let ((old (gio-cleanup-info-callback-id gio-info)))
                (if old (de-register-c-callback old)))
@@ -379,11 +407,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
               (gobject-alien (gio-cleanup-info-gcancellable gio-info))
               (C-callback "async_ready")
               callback-id)
-      (let ((value (thread-queue/dequeue! queue)))
+      (let ((value (dequeue! queue)))
        (cond ((eq? value #t)
-              (set-gio-cleanup-info-pending-op! gio-info 'CLOSED)
-              (without-interrupts
+              (without-interruption
                (lambda ()
+                 (set-gio-cleanup-info-pending-op! gio-info 'CLOSED)
                  (cleanup gio-info)))
               unspecific)
              ((string? value)
@@ -395,6 +423,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-input-close-finish-callback queue gerror*)
   (C-callback
    (named-lambda (input-close-finish-callback source result)
+     (assert-glib-locked 'input-close-finish-callback)
      (if (fix:zero?
          (C-call "g_input_stream_close_finish" source result gerror*))
         (let ((message (%gerror-message gerror*)))
@@ -428,12 +457,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (cleanup-g-output-stream gio-info info)))
 
 (define (cleanup-g-output-stream gio-info info)
-  ;; For glib-cleanups.  Run without-interrupts.
+  (assert-without-interruption 'cleanup-g-output-stream)
+  (assert-glib-locked 'cleanup-g-output-stream)
   (cleanup-gio gio-info)
   (cleanup-callback-id info g-output-stream write-id)
   (cleanup-callback-id info g-output-stream flush-id))
 
 (define (g-output-stream-write gstream buffer start end)
+  (assert-glib-locked 'g-output-stream-write)
   (let* ((gio-info (gio-cleanup-info gstream))
         (info (g-output-stream-cleanup-info gstream))
         (callback-id (g-output-stream-cleanup-info-write-id info)))
@@ -451,7 +482,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
              (C-callback "async_ready")
              callback-id)
       (let* ((queue (gio-queue gstream))
-            (value (thread-queue/dequeue! queue)))
+            (value (dequeue! queue)))
        (if (string? value)
            (begin
              (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
@@ -463,6 +494,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-write-finish-callback queue gerror*)
   (C-callback
    (named-lambda (write-finish-callback source result)
+     (assert-glib-locked 'write-finish-callback)
      (let ((bytes
            (C-call "g_output_stream_write_finish" source result gerror*)))
        (if (fix:= bytes -1)
@@ -474,6 +506,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
             (%queue! queue bytes)))))))
 
 (define (g-output-stream-flush gstream)
+  (assert-glib-locked 'g-output-stream-flush)
   (let* ((gio-info (gio-cleanup-info gstream))
         (info (g-output-stream-cleanup-info gstream))
         (callback-id (g-output-stream-cleanup-info-flush-id info)))
@@ -486,7 +519,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (C-callback "async_ready")
            callback-id)
     (let* ((queue (gio-queue gstream))
-          (value (thread-queue/dequeue! queue)))
+          (value (dequeue! queue)))
       (if (string? value)
          (begin
            (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
@@ -498,6 +531,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-flush-finish-callback queue gerror*)
   (C-callback
    (named-lambda (flush-finish-callback source result)
+     (assert-glib-locked 'flush-finish-callback)
      (if (fix:zero?
          (C-call "g_output_stream_flush_finish" source result gerror*))
         (let ((message (%gerror-message gerror*)))
@@ -508,6 +542,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (%queue! queue #t))))))
 
 (define (g-output-stream-close gstream)
+  (assert-glib-locked 'g-output-stream-close)
   (gfile-close gstream
               (named-lambda (close-output
                              gstream* priority gcancellable* callback id)
@@ -522,6 +557,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-output-close-finish-callback queue gerror*)
   (C-callback
    (named-lambda (output-close-finish-callback source result)
+     (assert-glib-locked 'output-close-finish-callback)
      (if (fix:zero?
          (C-call "g_output_stream_close_finish" source result gerror*))
         (let ((message (%gerror-message gerror*)))
@@ -540,6 +576,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-alien/ctype! alien '|GFileInputStream|)))
 
 (define (gfile-read gfile)
+  (assert-glib-locked 'gfile-read)
   (gfile-open gfile 'OPEN
              make-g-input-stream
              (named-lambda (open-callout
@@ -555,7 +592,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
         (queue (gio-queue gstream))
         (gerror* (gio-cleanup-info-gerror-pointer gio-info))
         (callback-id
-         (without-interrupts           ;don't leak callback IDs
+         (without-interruption         ;don't leak callback IDs
           (lambda ()
             (let ((id (make-callback (gobject-alien gstream) queue gerror*)))
               (set-gio-cleanup-info-pending-op! gio-info operation)
@@ -567,10 +604,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
               (gobject-alien (gio-cleanup-info-gcancellable gio-info))
               (C-callback "async_ready")
               callback-id)
-      (let ((value (thread-queue/dequeue! queue)))
+      (let ((value (dequeue! queue)))
        (cond ((eq? value #t)
               (set-gio-cleanup-info-pending-op! gio-info #f)
-              (without-interrupts
+              (without-interruption
                (lambda ()
                  (de-register-c-callback callback-id)
                  (set-gio-cleanup-info-callback-id! gio-info #f)
@@ -588,6 +625,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-open-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (open-finish-callback source result)
+     (assert-glib-locked 'open-finish-callback)
      (C-call "g_file_read_finish" alien source result gerror*)
      (if (alien-null? alien)
         (let ((message (%gerror-message gerror*)))
@@ -613,6 +651,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-alien/ctype! alien '|GFileOutputStream|)))
 
 (define (gfile-append-to gfile . flags)
+  (assert-glib-locked 'gfile-append-to)
   (let ((flags* (->gfile-create-flags flags)))
     (gfile-open gfile 'APPEND-TO
                make-g-output-stream
@@ -636,10 +675,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-append-to-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (append-to-finish-callback source result)
+     (assert-glib-locked 'append-to-finish-callback)
      (C-call "g_file_append_to_finish" alien source result gerror*)
      (g-output-stream-finish alien queue gerror* 'APPEND-TO))))
 
 (define (g-output-stream-finish alien queue gerror* op)
+  (assert-glib-locked 'g-output-stream-finish)
   (if (alien-null? alien)
       (let ((message (%gerror-message gerror*)))
        (%trace ";"op"-finish-callback "message" "queue"\n")
@@ -656,6 +697,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
      info (make-flush-finish-callback queue gerror*))))
 
 (define (gfile-create gfile . flags)
+  (assert-glib-locked 'gfile-create)
   (let ((flags* (->gfile-create-flags flags)))
     (gfile-open gfile 'CREATE
                make-g-output-stream
@@ -669,10 +711,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-create-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (create-finish-callback source result)
+     (assert-glib-locked 'create-finish-callback)
      (C-call "g_file_create_finish" alien source result gerror*)
      (g-output-stream-finish alien queue gerror* 'CREATE))))
 
 (define (gfile-replace gfile etag backup? . flags)
+  (assert-glib-locked 'gfile-replace)
   (let ((etag (->gfile-etag etag))
        (make-backups (if backup? 1 0))
        (flags* (->gfile-create-flags flags)))
@@ -697,6 +741,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-replace-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (replace-finish-callback source result)
+     (assert-glib-locked 'replace-finish-callback)
      (C-call "g_file_replace_finish" alien source result gerror*)
      (g-output-stream-finish alien queue gerror* 'REPLACE))))
 \f
@@ -713,6 +758,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gfile-query-info gfile attributes follow-symlinks?)
   (guarantee string? attributes 'gfile-query-info)
+  (assert-glib-locked 'gfile-query-info)
   (gfile-open gfile 'QUERY
              make-gfile-info
              (named-lambda (query-callout
@@ -734,6 +780,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-query-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (query-finish-callback source result)
+     (assert-glib-locked 'query-finish-callback)
      (C-call "g_file_query_info_finish" alien source result gerror*)
      (if (alien-null? alien)
         (let ((message (%gerror-message gerror*)))
@@ -745,6 +792,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gfile-info-list-attributes ginfo namespace)
   (guarantee string? namespace 'gfile-info-list-attributes)
+  (assert-glib-locked 'gfile-info-list-attributes)
   (map! string->symbol
        (let ((alien (make-cstringv
                      (lambda (copy)
@@ -755,6 +803,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            strings))))
 
 (define (gfile-info-get-attribute-status ginfo name)
+  (assert-glib-locked 'gfile-info-get-attribute-status)
   (let ((code (C-call "g_file_info_get_attribute_status"
                      (gobject-alien ginfo)
                      (string->utf8 name))))
@@ -765,6 +814,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (else (error "Unknown GFileAttributeStatus:" code)))))
 
 (define (gfile-info-get-attribute-value ginfo name)
+  (assert-glib-locked 'gfile-info-get-attribute-value)
   (let* ((alien (gobject-alien ginfo))
         (name-bv (string->utf8 name))
         (type (C-call "g_file_info_get_attribute_type" alien name-bv)))
@@ -815,11 +865,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (cleanup-gfile-enumerator gio-info ginfos)))
 
 (define (cleanup-gfile-enumerator gio-info ginfos)
-  ;; For glib-cleanups.  Run without-interrupts.
+  (assert-without-interruption 'cleanup-gfile-enumerator)
+  (assert-glib-locked 'cleanup-gfile-enumerator)
   (cleanup-gio gio-info)
   (cleanup-ginfos ginfos))
 
 (define (cleanup-ginfos glist)
+  (assert-without-interruption 'cleanup-ginfos)
+  (assert-glib-locked 'cleanup-ginfos)
   (if (not (alien-null? glist))
       (let ((scan (copy-alien glist))
            (ginfo (make-alien '|GFileInfo|)))
@@ -838,6 +891,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gfile-enumerate-children gfile attributes follow-symlinks?)
   (guarantee string? attributes 'gfile-enumerate-children)
+  (assert-glib-locked 'gfile-enumerate-children)
   (gfile-open gfile 'OPEN
              make-gfile-enumerator
              (named-lambda (query-callout
@@ -861,6 +915,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-enumerator-finish-callback alien queue gerror*)
   (C-callback
    (named-lambda (enumerator-finish-callback source result)
+     (assert-glib-locked 'enumerator-finish-callback)
      (C-call "g_file_enumerate_children_finish" alien source result gerror*)
      (if (alien-null? alien)
         (let ((message (%gerror-message gerror*)))
@@ -872,6 +927,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gfile-enumerator-next-files genum nfiles)
   (guarantee fixnum? nfiles 'gfile-enumerator-next-files)
+  (assert-glib-locked 'gfile-enumerator-next-files)
   (let* ((gio-info (gio-cleanup-info genum))
         (callback-id (gio-cleanup-info-callback-id gio-info)))
     (guarantee-gio-idle genum)
@@ -884,7 +940,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (C-callback "async_ready")
            callback-id)
     (let* ((queue (gio-queue genum))
-          (value (thread-queue/dequeue! queue)))
+          (value (dequeue! queue)))
       (if (string? value)
          (begin
            (set-gio-cleanup-info-pending-op! gio-info 'ERROR)
@@ -894,6 +950,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (make-ginfos genum))))))
 
 (define (make-ginfos genum)
+  (assert-glib-locked 'make-ginfos)
   (let* ((glist (gfile-enumerator-ginfos genum))
         (scan (copy-alien glist))
         (ginfo (make-alien '|GFileInfo|))
@@ -905,26 +962,23 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                  (C-> scan "GList data" ginfo)
                  (if (not (alien-null? ginfo))
                      (let ((new (make-gfile-info)))
-                       (without-interrupts
-                        (lambda ()
-                          (copy-alien-address! (gobject-alien new) ginfo)
-                          (C->= scan "GList data" 0)))
+                       (copy-alien-address! (gobject-alien new) ginfo)
+                       (C->= scan "GList data" 0)
                        (C-> scan "GList next" scan)
                        (cons new (loop)))
                      (begin
                        (C-> scan "GList next" scan)
                        (loop))))))))
-    (without-interrupts
-     (lambda ()
-       (if (not (alien-null? glist))
-          (begin
-            (C-call "g_list_free" glist)
-            (alien-null! glist)))))
+    (if (not (alien-null? glist))
+       (begin
+         (C-call "g_list_free" glist)
+         (alien-null! glist)))
     ginfos))
 
 (define (make-next-files-finish-callback ginfos queue gerror*)
   (C-callback
    (named-lambda (next-files-finish-callback source result)
+     (assert-glib-locked 'next-files-finish-callback)
      (C-call "g_file_enumerator_next_files_finish" ginfos source result gerror*)
      (if (and (alien-null? ginfos)
              (not (alien-null? (C-> gerror* "* GError"))))
@@ -936,6 +990,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
           (%queue! queue #t))))))
 
 (define (gfile-enumerator-close genum)
+  (assert-glib-locked 'gfile-enumerator-close)
   (let ((ginfos (gfile-enumerator-ginfos genum)))
     (gfile-close genum
                 (named-lambda (close-enumerator
@@ -949,6 +1004,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-enumerator-close-finish-callback queue gerror*)
   (C-callback
    (named-lambda (enumerator-close-finish-callback source result)
+     (assert-glib-locked 'enumerator-close-finish-callback)
      (if (fix:zero?
          (C-call "g_file_enumerator_close_finish" source result gerror*))
         (let ((message (%gerror-message gerror*)))
@@ -979,13 +1035,14 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (cleanup-gio gio-info)))
 
 (define (gfile-mount gfile)
+  (assert-glib-locked 'gfile-mount)
   (let* ((gmountop (make-g-mount-operation))
         (alien (gobject-alien gmountop))
         (gio-info (gio-cleanup-info gmountop))
         (queue (gio-queue gmountop))
         (gerror* (gio-cleanup-info-gerror-pointer gio-info))
         (callback-id
-         (without-interrupts           ;don't leak callback IDs
+         (without-interruption         ;don't leak callback IDs
           (lambda ()
             (let ((id (make-mount-finish-callback queue gerror*)))
               (set-gio-cleanup-info-pending-op! gio-info 'MOUNT)
@@ -1010,7 +1067,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
              (gobject-alien (gio-cleanup-info-gcancellable gio-info))
              (C-callback "async_ready")
              callback-id)
-      (let ((value (thread-queue/dequeue! queue)))
+      (let ((value (dequeue! queue)))
        (cond ((and (equal? value "Password dialog cancelled")
                    (g-mount-operation-ask-password-flags gmountop))
               (set-gio-cleanup-info-pending-op! gio-info #f)
@@ -1022,7 +1079,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
              ((eq? value #t)
               (set-gio-cleanup-info-pending-op! gio-info #f)
               (gobject-unref! gmountop)
-              (without-interrupts
+              (without-interruption
                (lambda ()
                  (cleanup-gio gio-info)))
               unspecific)
@@ -1031,6 +1088,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (prompt-for-mount-auth gmountop)
   (%trace-auth ";prompt-for-mount-auth "gmountop"\n")
+  (assert-glib-locked 'prompt-for-mount-auth)
   (let ((message (g-mount-operation-message gmountop))
        (domain (g-mount-operation-domain gmountop))
        (username (g-mount-operation-username gmountop))
@@ -1039,7 +1097,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
        (port (interaction-i/o-port)))
     (if message (display message port))
     (if (and (memq 'ANONYMOUS-SUPPORTED flags)
-            (prompt-for-confirmation "Login anonymously" port))
+            (without-glib-lock
+              (lambda ()
+                (prompt-for-confirmation "Login anonymously" port))))
        (begin
          (C-call "g_mount_operation_set_anonymous" alien 1)
          (set-g-mount-operation-username! alien "anonymous")))
@@ -1052,22 +1112,37 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (C-call "g_mount_operation_set_username" alien (string->utf8 u))
          (set-g-mount-operation-username! gmountop u)))
     (if (memq 'NEED-PASSWORD flags)
-       (call-with-pass-phrase
-        "Password"
-        (lambda (phrase)
-          (C-call "g_mount_operation_set_password" alien (string->utf8 phrase)))))
+       (let ((password))
+         (dynamic-wind
+          (lambda () unspecific)
+          (lambda ()
+            (without-glib-lock
+             (lambda ()
+               (call-with-pass-phrase
+                "Password"
+                (lambda (phrase) (set! password (string->utf8 phrase))))))
+            (C-call "g_mount_operation_set_password" alien password))
+          (lambda ()
+            (bytevector-fill! password #x55)))))
     (if (memq 'SAVING-SUPPORTED flags)
-       (if (prompt-for-confirmation "Save password permanently" port)
+       (if (without-glib-lock
+            (lambda ()
+              (prompt-for-confirmation "Save password permanently" port)))
            (C-call "g_mount_operation_set_password_save" alien
                    (C-enum "G_PASSWORD_SAVE_PERMANENTLY"))
-           (if (prompt-for-confirmation "Save password for this session" port)
+           (if (without-glib-lock
+                (lambda ()
+                  (prompt-for-confirmation "Save password for this session"
+                                           port)))
                (C-call "g_mount_operation_set_password_save" alien
                        (C-enum "G_PASSWORD_SAVE_FOR_SESSION"))
                (C-call "g_mount_operation_set_password_save" alien
                        (C-enum "G_PASSWORD_SAVE_NEVER")))))))
 
 (define (prompt-for-string* prompt default port)
-  (let ((s (prompt-for-string prompt port)))
+  (let ((s (without-glib-lock
+           (lambda ()
+             (prompt-for-string prompt port)))))
     (if (not (string-find-next-char-in-set s char-set:not-whitespace))
        default
        s)))
@@ -1075,6 +1150,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (make-mount-finish-callback queue gerror*)
   (C-callback
    (named-lambda (mount-finish-callback source result)
+     (assert-glib-locked 'mount-finish-callback)
      (if (fix:zero? (C-call "g_file_mount_enclosing_volume_finish"
                            source result gerror*))
         (let ((message (%gerror-message gerror*)))
@@ -1100,6 +1176,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                 " "(c-peek-cstring user)
                 " "(c-peek-cstring domain)
                 " "(->ask-password-flags flags)"\n")
+    (assert-glib-locked 'mount-password-callback)
     (let ((old (g-mount-operation-ask-password-flags gmountop))
          (new (->ask-password-flags flags)))
       (set-g-mount-operation-message! gmountop
@@ -1142,7 +1219,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                 " "gmountop
                 " "(c-peek-cstring message)
                 " "(peek-gstrv! choices)"\n")
-    (warn "Unimplemented" 'mount-question-callback)))
+    (warn "Unimplemented" 'mount-question-callback)
+    (assert-glib-locked 'mount-question-callback)))
 
 (define (peek-gstrv! alien)
   (let loop ()
@@ -1167,6 +1245,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define-method initialize-instance ((gfile <gfile>))
   (call-next-method gfile)
+  (assert-glib-locked '(initialize-instance <gfile>))
   (let ((alien (gobject-alien gfile))
        (uri (string->utf8 (uri->string (gfile-uri gfile)))))
     (set-alien/ctype! alien '|GFile|)
@@ -1178,6 +1257,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define-method initialize-instance ((gcancel <gcancellable>))
   (call-next-method gcancel)
+  (assert-glib-locked '(initialize-instance <gcancellable>))
   (let ((alien (gobject-alien gcancel)))
     (set-alien/ctype! alien '|GCancellable|)
     (C-call "g_cancellable_new" alien)))
@@ -1187,6 +1267,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (make-cstringv setter)
   ;; SETTER is applied to an alien that must not escape.
+  (assert-glib-locked 'make-cstringv)
   (let ((alien (make-alien '(* uchar)))
        (copy (make-alien '(* uchar))))
     (add-glib-cleanup alien (make-cstringv-cleanup copy))
@@ -1196,6 +1277,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (make-cstringv-cleanup alien)
   (named-lambda (cstringv-cleanup)
+    (assert-glib-locked 'cstringv-cleanup)
     (if (not (alien-null? alien))
        (let ((scan (copy-alien alien))
              (cstr (make-alien 'uchar)))
@@ -1221,7 +1303,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
            (cons str (loop)))))))
 
 (define (free-cstringv alien)
-  (without-interrupts
+  (without-interruption
    (lambda ()
      (execute-glib-cleanup alien)
      (alien-null! alien))))

diff --git a/src/glib/glib-main.scm b/src/glib/glib-main.scm
index 5dd9dcd03babb04f4c89adefd87868e9efc29979..660db6c3a5214316bbdaf09e5015de3d3196ff8a 100644 (file)
--- a/src/glib/glib-main.scm
+++ b/src/glib/glib-main.scm
@@ -30,27 +30,36 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   ;; Called from glib/make.scm, from a (load-option 'Glib).
   (if (not (plugin-available? "glib"))
       (error "GLIB plugin not found"))
-  (if (fix:zero? (C-call "start_glib"))
+  (if (fix:zero? (with-glib-lock
+                 (lambda ()
+                   (C-call "start_glib"))))
       (error "Could not start Glib main loop."))
   (create-glib-thread))
 
 (define-integrable (run-glib select-registry-handle time)
-  (C-call "run_glib" select-registry-handle time))
+  (assert-glib-locked 'run-glib)
+  (C-call "run_glib" select-registry-handle time)
+  (assert-glib-locked 'run-glib-continue))
 
 (define (maybe-yield-glib)
   ;; Used by callbacks that may have made threads runnable.
+  (assert-glib-locked 'maybe-yield-glib)
   (if (other-running-threads?)
       (C-call "yield_glib")))
 
 (define (stop-glib)
   ;; Sortof does the opposite of glib-start.
-  (without-interrupts
+  (with-glib-lock
    (lambda ()
      (exit-glib-thread)
      (C-call "stop_glib"))))
 
 (define (glib-select-trace?)
-  (C-call "glib_select_trace_p"))
+  (with-glib-lock
+   (lambda ()
+     (C-call "glib_select_trace_p"))))
 
 (define (glib-select-trace! on?)
-  (C-call "glib_select_trace" (if on? 1 0)))
\ No newline at end of file
+  (with-glib-lock
+   (lambda ()
+     (C-call "glib_select_trace" (if on? 1 0)))))
\ No newline at end of file

diff --git a/src/glib/glib-thread.scm b/src/glib/glib-thread.scm
index bb4b9ad700e1982717bde4963ddc17f25d03126f..a274c3b164e05da9bd763431ef22eb647eb6a0aa 100644 (file)
--- a/src/glib/glib-thread.scm
+++ b/src/glib/glib-thread.scm
@@ -52,36 +52,35 @@ 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
+                 (let ((gc-tick (car (gc-timestamp))))
+                   (if (fix:< done-tick gc-tick)
+                       (with-glib-lock
+                        (lambda ()
+                          (%trace ";run-glib cleaning up\n")
+                          (run-glib-cleanups)
+                          (%trace ";run-glib clean up done\n")
+                          (set! done-tick gc-tick))))
+                   (if (fix:< next-secondary-tick gc-tick)
+                       (begin
+                         (%trace ";run-glib secondary-gc daemons\n")
+                         (run-glib-daemons)
+                         (%trace ";run-glib secondary-gc daemons done\n")
+                         (set! next-secondary-tick
+                               (fix:+ gc-tick secondary-gc-rate)))))
+                 (with-glib-lock
                   (lambda ()
-                    (let ((gc-tick (car (gc-timestamp))))
-                      (if (fix:< done-tick gc-tick)
-                          (begin
-                            (%trace ";run-glib cleaning up\n")
-                            (run-glib-cleanups)
-                            (%trace ";run-glib clean up done\n")
-                            (set! done-tick gc-tick)))
-                      (if (fix:< next-secondary-tick gc-tick)
-                          (begin
-                            (%trace ";run-glib secondary-gc daemons\n")
-                            (run-glib-daemons)
-                            (%trace ";run-glib secondary-gc daemons done\n")
-                            (set! next-secondary-tick
-                                  (fix:+ gc-tick secondary-gc-rate)))))))
-                 (with-thread-timer-stopped
-                  (lambda ()
-                    (let ((time (or (and (thread/next self) 0)
-                                    (and timer-records
-                                         (timer-record/time timer-records))
-                                    -1)))
-                      (%trace ";run-glib until "time"\n")
-                      ;;(account-for-times self (get-system-times))
-                      (run-glib (select-registry-handle io-registry) time)
-                      ;;(record-start-times! self)
-                      (%trace ";run-glib done at "(real-time-clock)"\n"))))
+                    (with-thread-timer-stopped
+                     (lambda ()
+                       (let ((time (or (and (thread/next self) 0)
+                                       (and timer-records
+                                            (timer-record/time timer-records))
+                                       -1)))
+                         (%trace ";run-glib until "time"\n")
+                         ;;(account-for-times self (get-system-times))
+                         (run-glib (select-registry-handle io-registry) time)
+                         ;;(record-start-times! self)
+                         (%trace ";run-glib done at "(real-time-clock)"\n")
+                         )))))
                  (%trace ";run-glib yields\n")
                  (yield-current-thread)
                  (%trace ";run-glib loops\n")

diff --git a/src/glib/glib.pkg b/src/glib/glib.pkg
index 66bf005d2b050392094d10bf673aad222e7ad758..c320bb1d726ff10b4395ee189a2edcb0626fb6eb 100644 (file)
--- a/src/glib/glib.pkg
+++ b/src/glib/glib.pkg
@@ -32,7 +32,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define-package (glib)
   (parent ())
-  (files "glib"))
+  (files "glib")
+  (import (runtime thread)
+         get-thread-event-block))
 
 (define-package (gobject)
   (parent (glib))
@@ -112,6 +114,8 @@ 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,...
+         with-glib-lock
          run-glib-cleanups
          run-glib-daemons)
   (import (glib main)

diff --git a/src/glib/glib.scm b/src/glib/glib.scm
index c876d5e5ff24799143d19fbfe938b4b87323928d..0adc5a85be6d6642c4c2cafa4ffd0b6b6de33e08 100644 (file)
--- a/src/glib/glib.scm
+++ b/src/glib/glib.scm
@@ -115,14 +115,44 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (set-color-alpha! color alpha)
     color))
 \f
+;;; GLib Mutex
+
+(define glib-mutex)
+
+(define (reset-glib-mutex!)
+  (set! glib-mutex (make-thread-mutex)))
+
+(define-integrable (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-integrable (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)
+  (if (not (get-thread-event-block))
+      (outf-error ";not without-interruption: "operator"\n")))
+
 ;;; GLib Cleanups
 
 (define glib-cleanups)
 
-(define (initialize-glib-cleanups!)
-  (set! glib-cleanups '()))
-
 (define (run-glib-cleanups)
+  (assert-glib-locked 'run-glib-cleanups)
   (let loop ((alist glib-cleanups)
             (prev #f))
     (if (pair? alist)
@@ -157,13 +187,13 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (set! glib-cleanups '()))
 
 (define (add-glib-cleanup object cleanup-thunk)
+  (assert-glib-locked 'add-glib-cleanup)
   (let ((weak-pair (weak-cons object cleanup-thunk)))
-    (without-interrupts
-     (lambda ()
-       (set! glib-cleanups (cons weak-pair glib-cleanups))))
+    (set! glib-cleanups (cons weak-pair glib-cleanups))
     weak-pair))
 
 (define (execute-glib-cleanup object)
+  (assert-glib-locked 'execute-glib-cleanup) ; and without-interruption
   (let ((entry (weak-assq object glib-cleanups)))
     (if entry
        (begin
@@ -179,8 +209,12 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
          (if (eq? obj key) entry
              (loop (cdr alist)))))))
 
+(define (reset-glib-package!)
+  (reset-glib-mutex!)
+  (reset-glib-cleanups!))
+
 (define (initialize-package!)
-  (initialize-glib-cleanups!)
-  (add-event-receiver! event:after-restore reset-glib-cleanups!))
+  (reset-glib-package!)
+  (add-event-receiver! event:after-restore reset-glib-package!))
 
 (initialize-package!)
\ No newline at end of file

diff --git a/src/glib/gobject.scm b/src/glib/gobject.scm
index 4ded11da6b933859a289823fb9fcc7384d115af3..780f84f1ed4f882bd86bb0c7f4f84c08abfd6c9a 100644 (file)
--- a/src/glib/gobject.scm
+++ b/src/glib/gobject.scm
@@ -62,6 +62,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   ;; the closure.
   (named-lambda (gobject-cleanup)
     (%trace ";gobject-cleanup "alien"\n")
+    (assert-glib-locked 'gobject-cleanup)
     (if (not (alien-null? alien))
        (begin
          (for-each
@@ -72,7 +73,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (%trace ";gobject-cleanup done with "alien"\n")))
 
 (define (gobject-unref! object)
-  (without-interrupts
+  (assert-glib-locked 'gobject-unref!)
+  (without-interruption
    (lambda ()
      (execute-glib-cleanup object))))
 
@@ -81,6 +83,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   ;; Specify SIGNAL-NAME if it is not the same as ALIEN-FUNCTION's name.
   (guarantee-gobject gobject 'g-signal-connect)
   (guarantee-alien-function alien-function 'g-signal-connect)
+  (assert-glib-locked 'g-signal-connect)
   (let ((name (cond ((default-object? signal-name)
                     (string->symbol (alien-function/name alien-function)))
                    ((symbol? signal-name) signal-name)
@@ -88,7 +91,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                    (else
                     (error:wrong-type-argument
                      signal-name "string or symbol" 'g-signal-connect)))))
-    (without-interrupts
+    (without-interruption
      (lambda ()
        (let* ((alien (gobject-alien gobject))
              (signals (gobject-signals gobject))
@@ -125,7 +128,8 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define (g-signal-disconnect gobject name)
   (guarantee-gobject gobject 'g-signal-disconnect)
   (guarantee symbol? name 'g-signal-disconnect)
-  (without-interrupts
+  (assert-glib-locked 'g-signal-disconnect)
+  (without-interruption
    (lambda ()
      (let* ((alien (gobject-alien gobject))
            (signals (gobject-signals gobject))
@@ -149,6 +153,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (gobject-get-property gobject property)
   (guarantee-gobject gobject 'gobject-get-property)
+  (assert-glib-locked 'gobject-get-property)
 
   (let ((name (check-prop-name property))
        (gvalue (malloc (C-sizeof "GValue") '|GValue|)))
@@ -215,6 +220,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
       value)))
 
 (define (gobject-set-properties gobject . property-list)
+  (assert-glib-locked 'gobject-set-properties)
   (let* ((gobject-alien (gobject-alien gobject))
         (gvalue (malloc (C-sizeof "GValue") '|GValue|))
         (pspec (malloc (C-sizeof "GParamSpec") '|GParamSpec|))
@@ -308,17 +314,20 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   unspecific)
 
 (define (gobject-get-gclass alien)
+  (assert-glib-locked 'gobject-get-gclass)
   (let ((ret (make-alien '|GObjectClass|)))
     (C-call "G_OBJECT_GET_CLASS" ret alien)
     ret))
 
 (define (gclass-get-name gclass)
+  (assert-glib-locked 'gclass-get-name)
   ;; GCLASS should be an alien of type GObjectClass.
   (let ((c* (make-alien '(* |gchar|))))
     (C-call "G_OBJECT_CLASS_NAME" c* gclass)
     (c-peek-cstring c*)))
 
 (define (gobject-get-gtype gobject)
+  (assert-glib-locked 'gobject-get-gtype)
   (let ((ret (make-alien '|GType|)))
     (C-call "G_OBJECT_TYPE" ret (gobject-alien gobject))
     ret))
@@ -402,6 +411,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 (define gquark-to-string-cache (make-eqv-hash-table))
 
 (define (gquark-from-string string)
+  (assert-glib-locked 'gquark-from-string)
   (or (hash-table/get gquark-from-string-cache string #f)
       (let ((gq (C-call "g_quark_from_string" (string->utf8 string))))
        (hash-table/put! gquark-from-string-cache string gq)