From 07f76f2c02a64cc7ca6221111534772f1298bc0a Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Wed, 1 Feb 2023 05:05:45 -0500 Subject: [PATCH] Change *all-packages* to use power-of-2 sizing Now it definitely outperforms lfhash. And skip part of a test if #+win32 --- src/code/target-package.lisp | 35 ++++++++++------------------------- tests/package-id.impure.lisp | 10 +--------- tests/packages.impure.lisp | 10 ++++++++-- 3 files changed, 19 insertions(+), 36 deletions(-) diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 41a6fcfc5..0eed70241 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -214,29 +214,19 @@ (define-load-time-global *package-names-cookie* most-negative-fixnum) (declaim (fixnum *package-names-cookie*)) -;;; *ALL-PACKAGES* is a prime-number-sized vector (physically with extra cells) +;;; *ALL-PACKAGES* is a power-of-2-sized table (physically with 1 extra cell of metadata) ;;; as the backing storage of a closed-addressing hash-set with a peculiar aspect ;;; of allowing one key to appear in multiple buckets. This aspect allows each global name ;;; ("nickname" and "name" being synonymous in this usage) to appear in its respective ;;; hash bucket. By pure coincidence, names for one package could hash to the same bucket, ;;; so removal has to account for that - removal occurs only when the package does not ;;; belong in a bucket via any of its names. -(defconstant pkgtable-fixed-cells 3) -(defmacro pkgtable-magic (table) `(truly-the (unsigned-byte 32) (svref ,table 0))) -(defmacro pkgtable-mask (table) `(truly-the (unsigned-byte 32) (svref ,table 1))) -(defmacro pkgtable-count (table) `(truly-the fixnum (svref ,table 2))) +(defconstant pkgtable-fixed-cells 1) +(defmacro pkgtable-count (table) + `(truly-the fixnum (svref ,table (1- (length ,table))))) (defmacro pkgtable-bucket-index (vector hash) - `(let ((h ,hash) - (divisor (- (length ,vector) pkgtable-fixed-cells))) - (+ pkgtable-fixed-cells - ,(sb-c::if-vop-existsp (:translate sb-vm::fastrem-32) - `(let ((c (pkgtable-magic ,vector))) - (if (/= c 0) - (sb-vm::fastrem-32 (logand h (pkgtable-mask ,vector)) c - (truly-the (unsigned-byte 32) divisor)) - (rem h divisor))) ; don't have a fastrem coeffficient - `(rem h divisor))))) + `(logand ,hash (- (length ,vector) ,(1+ pkgtable-fixed-cells)))) (defmacro do-pkg-table (((package-var &optional (keys-var '#:keys)) table-var) &body body @@ -245,7 +235,7 @@ (cell (list nil))) (declare (truly-dynamic-extent cell)) (loop for ,index-var of-type index - from pkgtable-fixed-cells below (length .tbl.) + from 0 below (1- (length .tbl.)) do (let ((data (svref .tbl. ,index-var))) (setf (car cell) data) ; in case DATA is a non-null atom (dolist (,package-var (if (%instancep data) cell data)) @@ -268,19 +258,14 @@ (t (list package data)))) (incf (pkgtable-count vector)))))) ; count once for each insertion (new-table (size) - (let* ((n (loop for n of-type fixnum - from (logior (ceiling size 87/100) 1) by 2 ; target LF=87% - when (positive-primep n) return n)) + (let* ((n (power-of-two-ceiling size)) (vector (make-array (+ n pkgtable-fixed-cells) :initial-element nil))) - (multiple-value-bind (mask c) (optimized-symtbl-remainder-params n) - (setf (pkgtable-mask vector) mask - (pkgtable-magic vector) c - (pkgtable-count vector) 0)) + (setf (pkgtable-count vector) 0) vector))) ;; First maybe rehash, assuming all names need to be added to the table. ;; The rehash threshold is 1 item or more per bucket (let ((new-count (+ (pkgtable-count vector) (floor (length keys) 2)))) - (when (>= new-count (- (length vector) pkgtable-fixed-cells)) + (when (> new-count (- (length vector) pkgtable-fixed-cells)) (let ((new-table (new-table new-count))) (do-pkg-table ((package keys) vector) (insert new-table package keys)) @@ -1943,7 +1928,7 @@ PACKAGE." ;; (setq *sym-lookups* 0 *sym-hit-1st-try* 0) (setf *package-graph-lock* (sb-thread:make-mutex :name "Package Graph Lock")) (setf *package-table-lock* (sb-thread:make-mutex :name "Package Table Lock")) - (setf *all-packages* #(0 0 0)) + (setf *all-packages* #(0)) (setf *package-nickname-ids* (cons (make-info-hashtable :comparator #'pkg-name= :hash-function #'sxhash) 1)) diff --git a/tests/package-id.impure.lisp b/tests/package-id.impure.lisp index 271b44bee..4bed51ba1 100644 --- a/tests/package-id.impure.lisp +++ b/tests/package-id.impure.lisp @@ -8,16 +8,8 @@ ;;; the addition of nicknames. (It assumes that every name increases the table load) (mapc 'delete-package (mapcar 'make-package '("AA" "BB" "CC" "DD"))) (defvar *tp* (make-package "SOMETESTPACKAGE")) -(defconstant cell-offset 3) (defun compute-name-bucket (str) - (let ((hash (sxhash str)) - (divisor (- (length *all-packages*) cell-offset))) - (+ cell-offset - (if (find-symbol "FASTREM-32" "SB-VM") - ;; mask required by fastrem vop to constrain the bits of precision - (rem (logand hash (aref *all-packages* 1)) divisor) - ;; if no fastrem vop then we just take the remainder - (rem hash divisor))))) + (mod (sxhash str) (1- (length *all-packages*)))) (defvar *tp-bucket* (compute-name-bucket "SOMETESTPACKAGE")) ;;; Generate a random nicknames for SOMETESTPACKAGE that hashes to diff --git a/tests/packages.impure.lisp b/tests/packages.impure.lisp index 3d0f9814b..60b487a5e 100644 --- a/tests/packages.impure.lisp +++ b/tests/packages.impure.lisp @@ -1053,7 +1053,7 @@ if a restart was invoked." ;; Check that SP is a local nickname (assert (let ((*package* (find-package "MYPKG"))) (find-symbol "ZOOK" "SP"))) ;;; But not a global name of any package - (assert-error (find-symbol "ZOOK" "SP")) + (assert-error (find-symbol "ZOOK" "SP")) (delete-package "SOMEPACKAGE") ;; Assert that the local nickname vector has not yet removed the ;; deleted package. DELETE-PACKAGE does not scan all packages to adjust @@ -1067,7 +1067,13 @@ if a restart was invoked." 2)) (sb-sys:scrub-control-stack) (gc :full t) - (assert (not (weak-pointer-value *the-weak-ptr*))) + ;; Asserting that the weak pointer gets splatted _before_ doing the next FIND-SYMBOL + ;; confirms that the nickname representation did not store a strong reference + ;; to #. Package-local nicknames are necessarily purged of any deleted + ;; packages just-in-time, so the assertion would not demonstrate anything if run + ;; _after_ calling FIND-SYMBOL. I don't know why this fails on #+win32, SEARCH-ROOTS + ;; did not return a path, so there must also be a deficiency in that. + #-win32 (assert (not (weak-pointer-value *the-weak-ptr*))) (assert-error (let ((*package* (find-package "MYPKG"))) ;; the nickname magically went away! (find-symbol "ZOOK" "SP"))))