From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sat, 21 Feb 2015 19:54:21 +0000 (-0700)
Subject: smp: without-interrupts: geneqht.scm
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=0dd59191;p=mit-scheme.git

smp: without-interrupts: geneqht.scm
---

diff --git a/README.txt b/README.txt
index 1793c126d..c9010798e 100644
--- a/README.txt
+++ b/README.txt
@@ -1118,10 +1118,20 @@ The hits with accompanying analysis:
 	SOS operators like add-method need to be serialized?
 
   geneqht.scm:53:	     (without-interrupts
+	Caller: eqht/put!
   geneqht.scm:86:	    (without-interrupts (lambda () (rehash-table! table)))
+	Caller: compute-key-hash
   geneqht.scm:243:(define-integrable (without-interrupts thunk)
+	Local definition of without-interrupts.
   geneqht.scm:244:  (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
+	Caller: Local without-interrupts.
   geneqht.scm:246:    (set-interrupt-enables! interrupt-mask)
+	Caller: Local without-interrupts.
+
+	OK.  Used to avoid inopportune aborts.  Serial access to a
+	particular table is the responsibility of the luser (e.g. SOS
+	operators?).  Serial access to the list of all address hash
+	tables, however, is now provided via a thread-mutex.
 
   generic.scm:104:    (without-interrupts
   generic.scm:132:  (without-interrupts
diff --git a/src/runtime/geneqht.scm b/src/runtime/geneqht.scm
index 22a32b06e..d3f83e683 100644
--- a/src/runtime/geneqht.scm
+++ b/src/runtime/geneqht.scm
@@ -97,8 +97,18 @@ USA.
 		 modulus))
 
 (define (record-address-hash-table! table)
-  (set! address-hash-tables (weak-cons table address-hash-tables))
-  unspecific)
+  (with-thread-mutex-locked address-hash-tables-mutex
+    (lambda ()
+      (set! address-hash-tables (weak-cons table address-hash-tables))
+      unspecific)))
+
+;; Mark-address-hash-tables! might run during record-address-hash-
+;; table! (in the primitive GC daemon) and thus modify the address-
+;; hash-tables list (splicing out pairs whose weak cars have turned to
+;; #f).  The set! in record-address-hash-table! may then write the old
+;; value, before the splice, restoring the old pairs behind the new
+;; one.  Fortunately no harm is done.  The cars of the restored pairs
+;; are all #f and will be spliced out again eventually.
 
 (define (mark-address-hash-tables!)
   (let loop ((previous #f) (tables address-hash-tables))
@@ -114,8 +124,10 @@ USA.
 	   (loop previous (system-pair-cdr tables))))))
 
 (define address-hash-tables)
+(define address-hash-tables-mutex)
 
 (define (initialize-address-hashing!)
+  (set! address-hash-tables-mutex (make-thread-mutex))
   (set! address-hash-tables '())
   (add-primitive-gc-daemon! mark-address-hash-tables!))