From 20b819c42a04c8fa81725178fc9c61a11a0e3979 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Tue, 16 Jun 2015 19:35:31 -0700 Subject: [PATCH] Remove without-interrupts from runtime/sfile.scm. Serialize access to the files-to-delete element of the fixed-objects vector. --- src/runtime/sfile.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/runtime/sfile.scm b/src/runtime/sfile.scm index 4be35f009..f9581d052 100644 --- a/src/runtime/sfile.scm +++ b/src/runtime/sfile.scm @@ -194,12 +194,18 @@ USA. (lambda () (receiver pathname)) (lambda () (deallocate-temporary-file pathname))))) +(define files-to-delete-mutex) + +(define (with-files-to-delete-locked thunk) + (with-thread-mutex-lock files-to-delete-mutex + (lambda () (without-interruption thunk)))) + (define (allocate-temporary-file pathname) (and (not (file-exists? pathname)) (let ((objects (get-fixed-objects-vector)) (slot (fixed-objects-vector-slot 'FILES-TO-DELETE)) (filename (->namestring pathname))) - (without-interrupts + (with-files-to-delete-locked (lambda () (and (file-touch pathname) (begin @@ -213,7 +219,7 @@ USA. (let ((objects (get-fixed-objects-vector)) (slot (fixed-objects-vector-slot 'FILES-TO-DELETE)) (filename (->namestring pathname))) - (without-interrupts + (with-files-to-delete-locked (lambda () (vector-set! objects slot (delete! filename (vector-ref objects slot))) @@ -315,6 +321,7 @@ USA. (define local-type-map) (define (initialize-package!) + (set! files-to-delete-mutex (make-thread-mutex)) (set! interned-mime-types ;; We really want each of these hash tables to be a ;; datum-weak hash table, but the hash table abstraction -- 2.25.1