gdbm: Assume other threads may run concurrently with the GC daemons.
authorMatt Birkholz <puck@birchwood-abbey.net>
Fri, 10 Jul 2015 02:15:07 +0000 (19:15 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Fri, 10 Jul 2015 02:15:07 +0000 (19:15 -0700)
src/gdbm/gdbm.scm

index b94adc545a11df2862194d7db01b19c862cc874f..f4566096e58abdd9aa924ec35a4feed933b023ca 100644 (file)
@@ -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-lock-try
+   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)