common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Ensure that hash-table-index-vector stays with the table

Browse source 
This accidental omission of ALLOCATING-FOR-HASH-TABLE had catastrophic
consequences if any system table was involved. I discovered the problem
in particular on SB-DI::*COMPILED-DEBUG-FUNS* which meant that you were
crashing while crashing, because you couldn't extract cached debug funs.

Test case by Gemini
This commit is contained in:
Douglas Katzman 2026-08-12 18:31:36 -04:00
parent f7d9205bfd
commit f9075a0c2a
2 changed files with 24 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/code/target-hash-table.lisp
View file

@ -1976,7 +1976,9 @@ multiple threads accessing the same hash-table without locking."
;; have been cleared already in another thread. ;; have been cleared already in another thread.
(when (or (/= (kv-vector-rehash-stamp old-kv-vector) initial-stamp) (when (or (/= (kv-vector-rehash-stamp old-kv-vector) initial-stamp)
(not (zerop (kv-vector-rehash-stamp new-kv-vector)))) (not (zerop (kv-vector-rehash-stamp new-kv-vector))))
(setq new-index-vector (make-index-vector new-n-buckets)))) (setq new-index-vector
(allocating-for-hash-table (table)
(make-index-vector new-n-buckets)))))
;; Preserve only the 'hashing' bit on the OLD-KV-VECTOR so that ;; Preserve only the 'hashing' bit on the OLD-KV-VECTOR so that
;; its high-water-mark can meaningfully be reduced to 0 when done. ;; its high-water-mark can meaningfully be reduced to 0 when done.

21
tests/ht-affinity.impure.lisp Normal file
View file

@ -0,0 +1,21 @@
#+(or gc-stress ;; c-find-heap->arena is not gc-safe
(not system-tlabs) interpreter) (invoke-restart 'run-tests::skip-file)
(test-util:with-test (:name :puthash-heap-table-addr-hash-realloc)
(let ((a (sb-vm:new-arena 1048576))
(old-threshold (sb-ext:bytes-consed-between-gcs)))
(unwind-protect
(progn
;; Low GC threshold ensures GC occurs during realloc inside grow-hash-table
(setf (sb-ext:bytes-consed-between-gcs) 4096)
(let ((table (make-hash-table :test 'eq :size 128 :rehash-size 2)))
(assert (not (sb-impl::flat-hash-table-p table)))
(sb-vm:with-arena (a)
(dotimes (i 1000)
(let ((k (sb-vm:without-arena (cons i i))))
(setf (gethash k table) i))
(assert (sb-ext:heap-allocated-p
(sb-impl::hash-table-index-vector table))))))
(assert (null (sb-vm:c-find-heap->arena a))))
(setf (sb-ext:bytes-consed-between-gcs) old-threshold)
(sb-vm:destroy-arena a))))