smp: Use make-serial-population. Squash into 7f0c85a.
authorMatt Birkholz <puck@birchwood-abbey.net>
Wed, 25 Feb 2015 15:29:01 +0000 (08:29 -0700)
committerMatt Birkholz <puck@birchwood-abbey.net>
Wed, 25 Feb 2015 15:29:01 +0000 (08:29 -0700)
src/runtime/hashtb.scm

index ebcfa88b89a28d4dc20a133a77baef5c7feaa49e..ac3bb79eb7957d90c6997040351717f8cdd6b9a5 100644 (file)
@@ -107,7 +107,7 @@ USA.
            (set-table-initial-size-in-effect?! table #t)))
       (reset-table! table)
       (if (table-type-rehash-after-gc? type)
-         (record-address-hash-table! table)))
+         (record-address-hash-table! table))
       table)))
 
 (define (hash-table/type table)
@@ -1352,40 +1352,19 @@ USA.
 ;;;; Miscellany
 
 (define address-hash-tables)
-(define address-hash-tables-mutex)
 
 (define (initialize-address-hash-tables!)
-  (set! address-hash-tables '())
-  (set! address-hash-tables-mutex (make-thread-mutex))
+  (set! address-hash-tables (make-serial-population))
   (add-primitive-gc-daemon! mark-address-hash-tables!)
   unspecific)
 
 (define (record-address-hash-table! table)
-  (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.
+  (add-to-population! address-hash-tables table))
 
 (define (mark-address-hash-tables!)
-  (let loop ((previous #f) (tables address-hash-tables))
-    (if (system-pair? tables)
-       (if (system-pair-car tables)
-           (begin
-             (set-table-needs-rehash?! (system-pair-car tables) #t)
-             (loop tables (system-pair-cdr tables)))
-           (begin
-             (if previous
-                 (system-pair-set-cdr! previous (system-pair-cdr tables))
-                 (set! address-hash-tables (system-pair-cdr tables)))        
-             (loop previous (system-pair-cdr tables)))))))
+  (for-each-inhabitant address-hash-tables
+                      (lambda (table)
+                        (set-table-needs-rehash?! table #t))))
 
 (define (check-arg object default predicate description procedure)
   (cond ((predicate object) object)
@@ -1403,4 +1382,4 @@ USA.
   ;; Must come before any hash table types are constructed or used.
   ;; This constructs an address hash table, however.
   (initialize-memoized-hash-table-types!)
-  (initialize-hash-table-type-constructors!))
+  (initialize-hash-table-type-constructors!))
\ No newline at end of file