ffi: Assume GC daemon must lock out other threads.

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 31a38ba129d3032a78934083970c855ae303f6ae..a89582f22bb675f7575373910d93964a6f089f4f 100644 (file)
--- 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))