cs: fix weak equal? hash tables

The pruning step was wrong, causing lists of cleared weak boxes to
accumulate. This leak particularly affected `datum-intern-literal`.
This commit is contained in:
Matthew Flatt 2019-05-27 08:23:52 -06:00
parent 9d3a49f265
commit 0bffb7035d
2 changed files with 27 additions and 12 deletions

View File

@ -0,0 +1,18 @@
#lang racket/base
(define (check label mk)
(let loop ([tries 0])
(printf "~a ~a\n" label tries)
(collect-garbage)
(define pre (current-memory-use))
(for ([j 100])
(for ([i (in-range 10000)])
(datum-intern-literal (mk i j))))
(collect-garbage)
(when ((current-memory-use) . > . pre)
(when (= tries 10)
(error 'check "didn't find non-growing iteration"))
(loop (add1 tries)))))
(check "strings" (lambda (i j) (format "string-~a-~a" i j)))
(check "flonums" (lambda (i j) (random)))

View File

@ -950,11 +950,11 @@
(define (prune-table! t)
(let ([ht (weak-equal-hash-keys-ht t)])
(let-values ([(new-ht count)
(let loop ([ht ht]
(let loop ([new-ht empty-hasheqv]
[i (intmap-iterate-first ht)]
[count 0])
(cond
[(not i) (values ht count)]
[(not i) (values new-ht count)]
[else
(let-values ([(key l) (intmap-iterate-key+value ht i #f)])
(let ([l (let loop ([l l])
@ -963,8 +963,8 @@
[(bwp-object? (car l)) (loop (cdr l))]
[else (weak/fl-cons (car l) (loop (cdr l)))]))])
(loop (if (null? l)
ht
(hash-set ht key l))
new-ht
(intmap-set new-ht key l))
(intmap-iterate-next ht i)
(+ count (length l)))))]))])
(set-weak-equal-hash-keys-ht! t new-ht)
@ -972,18 +972,15 @@
(set-weak-equal-hash-prune-at! t (max 128 (* 2 count))))))
;; ----------------------------------------
;; When `eq?`ness of flonums is not preserved by
;; the GC, then we need special handling for flonums.
;; But the GC now does preserve `eq?`ness.
(define (weak/fl-cons key d)
;; Special case for flonums, which are never retained in weak pairs,
;; but we want to treat them like fixnums and other immediates:
(if (flonum? key)
(cons key d)
(weak-cons key d)))
(weak-cons key d))
(define (ephemeron/fl-cons key d)
(if (flonum? key)
(cons key d)
(ephemeron-cons key d)))
(ephemeron-cons key d))
;; ----------------------------------------