From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Thu, 23 Jul 2015 16:21:01 +0000 (-0700)
Subject: gdbm: Prepare the GC daemon to run concurrently with other threads.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~63
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1b218c4ceb01500bed3d16346e9c5d3ef4fbcb19;p=mit-scheme.git

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

diff --git a/src/gdbm/gdbm.scm b/src/gdbm/gdbm.scm
index b94adc545..4ce2a21eb 100644
--- 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)