Remove without-interrupts from runtime/sfile.scm.

Serialize access to the files-to-delete element of the fixed-objects
vector.

diff --git a/src/runtime/sfile.scm b/src/runtime/sfile.scm
index 4be35f009b0992ef5724007d37a47d1be8c31254..f9581d052385fb77de4843f5420684ab5ecaf1f2 100644 (file)
--- 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