From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Wed, 17 Jun 2015 02:35:31 +0000 (-0700)
Subject: Remove without-interrupts from runtime/sfile.scm.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~49
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=20b819c42a04c8fa81725178fc9c61a11a0e3979;p=mit-scheme.git

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 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