gcfinal: Assume GC daemon is running concurrently with other threads.

diff --git a/src/runtime/gcfinal.scm b/src/runtime/gcfinal.scm
index a62c04dd68e11bca9ce2b8963923b720c72492e1..5a0325395e187bd4ca3739de27bb781af191e5a5 100644 (file)
--- a/src/runtime/gcfinal.scm
+++ b/src/runtime/gcfinal.scm
@@ -189,43 +189,44 @@ USA.
 (define gc-finalizers-mutex)
 
 (define (reset-gc-finalizers)
-  (walk-gc-finalizers-list
+  (walk-gc-finalizers-list/unsafe
    (lambda (finalizer)
-     (with-thread-mutex-lock (gc-finalizer-mutex finalizer)
-       (lambda ()
-        (set-gc-finalizer-items! finalizer '()))))))
+     (set-gc-finalizer-items! finalizer '()))))
 
 (define (run-gc-finalizers)
-  (walk-gc-finalizers-list
-   (lambda (finalizer)
-     (let ((procedure (gc-finalizer-procedure finalizer)))
-       (let loop ((items (gc-finalizer-items finalizer)) (prev #f))
-        (if (pair? items)
-            (if (weak-pair/car? (car items))
-                (loop (cdr items) items)
-                (let ((context (weak-cdr (car items)))
-                      (next (cdr items)))
-                  (if prev
-                      (set-cdr! prev next)
-                      (set-gc-finalizer-items! finalizer next))
-                  (procedure context)
-                  (loop next prev)))))))))
-
-(define (walk-gc-finalizers-list procedure)
-  (with-thread-mutex-lock gc-finalizers-mutex
-    (lambda ()
-      (let loop ((finalizers gc-finalizers) (prev #f))
-       (if (weak-pair? finalizers)
-           (let ((finalizer (weak-car finalizers)))
-             (if finalizer
-                 (begin
-                   (procedure finalizer)
-                   (loop (weak-cdr finalizers) finalizers))
-                 (let ((next (weak-cdr finalizers)))
-                   (if prev
-                       (weak-set-cdr! prev next)
-                       (set! gc-finalizers next))
-                   (loop next prev)))))))))
+  (with-thread-mutex-try-lock
+   gc-finalizers-mutex
+   (lambda ()
+     (walk-gc-finalizers-list/unsafe
+      (lambda (finalizer)
+       (let ((procedure (gc-finalizer-procedure finalizer)))
+         (let loop ((items (gc-finalizer-items finalizer)) (prev #f))
+           (if (pair? items)
+               (if (weak-pair/car? (car items))
+                   (loop (cdr items) items)
+                   (let ((context (weak-cdr (car items)))
+                         (next (cdr items)))
+                     (if prev
+                         (set-cdr! prev next)
+                         (set-gc-finalizer-items! finalizer next))
+                     (procedure context)
+                     (loop next prev)))))))))
+   (lambda ()
+     unspecific)))
+
+(define (walk-gc-finalizers-list/unsafe procedure)
+  (let loop ((finalizers gc-finalizers) (prev #f))
+    (if (weak-pair? finalizers)
+       (let ((finalizer (weak-car finalizers)))
+         (if finalizer
+             (begin
+               (procedure finalizer)
+               (loop (weak-cdr finalizers) finalizers))
+             (let ((next (weak-cdr finalizers)))
+               (if prev
+                   (weak-set-cdr! prev next)
+                   (set! gc-finalizers next))
+               (loop next prev)))))))
 
 (define (initialize-package!)
   (set! gc-finalizers '())