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

Disable perfectly hashed packages except for "CL"

Browse source 
This is an emergency stopgap. There are (at least) two problems with the code:

1. %LOOKUP-SYMBOL is carefully designed to be threadsafe using something like a
   fast-read lock (i.e. no mutex, only a post-check that consistent state was
   seen), but perfect hashing seems to break that design.

2. It might adversely impact DO-SYMBOLS. It is permitted to UNINTERN
   ("... the current symbol may be uninterned from the package being traversed")
   but doing so re-scrambles the whole vector rather than just depositing a 0.
This commit is contained in:
Douglas Katzman 2024-03-21 10:37:43 -04:00
parent 8e4f6812ef
commit c34e397585
2 changed files with 19 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/code/defpackage.lisp
View file

@ -748,10 +748,14 @@ specifies to signal a warning if SWANK package is in variance, and an error othe
(briefly-describe-symbol symbol))
(values))
(defun perfectly-hash-package (designator)
;;; TODO: I think the original idea was to place all symbols into a single
;;; vector, with an bit-vector to record internal/external per symbol.
(defun perfectly-hash-package (package)
(flet ((rehash (table &aux (cells (symtbl-%cells table)))
(when (functionp (car cells))
(return-from rehash)) ; already hashed
;; The APROPOS-LIST R/O scan optimization is inadmissible if no R/O space
#-darwin-jit (setf (symtbl-modified table) nil)
(let* ((cells (cdr cells))
(hashes (map '(simple-array (unsigned-byte 32) (*))
#'symbol-name-hash
@ -770,9 +774,8 @@ specifies to signal a warning if SWANK package is in variance, and an error othe
(symtbl-size table) (length hashes)
(symtbl-free table) 0
(symtbl-deleted table) 0)))))
(let ((package (find-package designator)))
(rehash (package-internal-symbols package))
(rehash (package-external-symbols package)))))
(rehash (package-internal-symbols package))
(rehash (package-external-symbols package))))
;;; Reorganize both hashsets of all packages, called by SAVE-LISP-AND-DIE.
;;; With a few exceptions, tables are saved at 100% load factor and a perfect hash.
@ -800,9 +803,13 @@ specifies to signal a warning if SWANK package is in variance, and an error othe
#-darwin-jit (setf (symtbl-modified table) nil)))
(dolist (package (list-all-packages))
;; Choose load factor based on whether INTERN is expected at runtime
;; FIXME: because changing a package from perfectly hashed back to
;; an open-addressing table is not thread-safe, _only_ the CL package can
;; become perfectly hashed.
(let ((lf (cond ((eq (the package package) *keyword-package*) 60/100)
((eq (package-id package) +package-id-user+) 8/10)
(t 1))))
((eq package *cl-package*) 1)
(t 8/10))))
(cond ((= lf 1)
(perfectly-hash-package package))
(t

9
tests/perfecthash.impure.lisp
View file

@ -19,8 +19,13 @@
|#
(with-test (:name :minimal-vs-non-minimal)
(let* ((symbols (sb-impl::symtbl-cells (sb-impl::package-internal-symbols
(find-package "SB-WALKER"))))
(let* ((symbols
;; Not sure why INTERN would randomly occur in SB-WALKER but it did,
;; thereby undoing the perfect hash and creating empty cells.
;; It's moot, now that I've temporarily disabled perfect hashing of packages.
(remove-if-not #'symbolp
(sb-impl::symtbl-cells (sb-impl::package-internal-symbols
(find-package "SB-WALKER")))))
(hashes (map '(simple-array (unsigned-byte 32) (*))
#'sb-kernel::symbol-name-hash
symbols))