From 81f1bd8cc103aa2ab73cfea76ffa18288aaec96f Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Thu, 9 Jul 2015 19:18:17 -0700 Subject: [PATCH] ffi: Assume GC daemon must lock out other threads. --- src/runtime/ffi.scm | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) 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)) -- 2.25.1