From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Fri, 10 Jul 2015 02:18:17 +0000 (-0700)
Subject: ffi: Assume GC daemon must lock out other threads.
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=81f1bd8cc103aa2ab73cfea76ffa18288aaec96f;p=mit-scheme.git

ffi: Assume GC daemon must lock out other threads.
---

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 31a38ba12..a89582f22 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -338,23 +338,26 @@ USA.
 (define malloced-aliens-mutex)
 
 (define (free-malloced-aliens)
-  (with-thread-mutex-lock malloced-aliens-mutex
-    (lambda ()
-      (let loop ((aliens malloced-aliens)
-		 (prev #f))
-	(if (pair? aliens)
-	    (if (weak-pair/car? (car aliens))
-		(loop (cdr aliens) aliens)
-		(let ((copy (weak-cdr (car aliens)))
-		      (next (cdr aliens)))
-		  (if prev
-		      (set-cdr! prev next)
-		      (set! malloced-aliens next))
-		  (if (not (alien-null? copy))
-		      (begin
-			((ucode-primitive c-free 1) copy)
-			(alien-null! copy)))
-		  (loop next prev))))))))
+  (with-thread-mutex-try-lock
+   malloced-aliens-mutex
+   (lambda ()
+     (let loop ((aliens malloced-aliens)
+		(prev #f))
+       (if (pair? aliens)
+	   (if (weak-pair/car? (car aliens))
+	       (loop (cdr aliens) aliens)
+	       (let ((copy (weak-cdr (car aliens)))
+		     (next (cdr aliens)))
+		 (if prev
+		     (set-cdr! prev next)
+		     (set! malloced-aliens next))
+		 (if (not (alien-null? copy))
+		     (begin
+		       ((ucode-primitive c-free 1) copy)
+		       (alien-null! copy)))
+		 (loop next prev))))))
+   (lambda ()
+     unspecific)))
 
 (define (reset-malloced-aliens!)
   (set! malloced-aliens-mutex (make-thread-mutex))