smp: without-interrupts: geneqht.scm

diff --git a/README.txt b/README.txt
index 1793c126d65dadced58236e0ba94d354ad63220d..c9010798e498163c3284308aa9bc5fb41cbdb7ef 100644 (file)
--- 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 22a32b06e1cb93831376540c325ce943cb802dc2..d3f83e683851752a835f0d65e2d496631cf75fba 100644 (file)
--- 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!))
 \f