gdbm: Prepare the GC daemon to run concurrently with other threads.

diff --git a/src/gdbm/gdbm.scm b/src/gdbm/gdbm.scm
index b94adc545a11df2862194d7db01b19c862cc874f..4ce2a21ebaf7bf3cb86dae1e1bbcfe485459cdd5 100644 (file)
--- a/src/gdbm/gdbm.scm
+++ b/src/gdbm/gdbm.scm
@@ -345,23 +345,27 @@ USA.
              (loop (cdr alist)))))))
 
 (define (cleanup-open-gdbfs)
-  (if (not (thread-mutex-owner open-gdbfs-mutex))
-      (let loop ((entries open-gdbfs)
-                (prev #f))
-       (if (pair? entries)
-           (let ((entry (car entries))
-                 (next (cdr entries)))
-             (if (weak-pair/car? entry)
-                 (loop next entries)
-                 (let ((args (weak-cdr entry)))
-                   (if prev
-                       (set-cdr! prev next)
-                       (set! open-gdbfs next))
-                   (if (not (alien-null? args))
-                       (begin
-                         (C-call "do_gdbm_close" args)
-                         (alien-null! args)))
-                   (loop next prev))))))))
+  (with-thread-mutex-try-lock
+   open-gdbfs-mutex
+   (lambda ()
+     (let loop ((entries open-gdbfs)
+               (prev #f))
+       (if (pair? entries)
+          (let ((entry (car entries))
+                (next (cdr entries)))
+            (if (weak-pair/car? entry)
+                (loop next entries)
+                (let ((args (weak-cdr entry)))
+                  (if prev
+                      (set-cdr! prev next)
+                      (set! open-gdbfs next))
+                  (if (not (alien-null? args))
+                      (begin
+                        (C-call "do_gdbm_close" args)
+                        (alien-null! args)))
+                  (loop next prev)))))))
+   (lambda ()
+     unspecific)))
 
 (define (reset-open-gdbfs)
   (for-each (lambda (weak) (alien-null! (weak-cdr weak))) open-gdbfs)