(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)
;;;; 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)
;; 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