diff --git a/src/code/defpackage.lisp b/src/code/defpackage.lisp index 414dd51c6..7a774b223 100644 --- a/src/code/defpackage.lisp +++ b/src/code/defpackage.lisp @@ -43,8 +43,8 @@ implementation it is ~S." *!default-package-use-list*) ;; a "resolved" package is not in the global name->package mapping yet, ;; which is why the FIND-PACKAGE / CERROR below does not signal. (or (resolve-deferred-package name) - (%make-package (make-symbol-hashset internal-symbols) - (make-symbol-hashset external-symbols)))) + (%make-package (make-symbol-table internal-symbols) + (make-symbol-table external-symbols)))) (existing-pkg) (namelist (cons name nicks)) (conflict)) @@ -202,7 +202,7 @@ implementation it is ~S." *!default-package-use-list*) ;; Setting PACKAGE-%NAME to NIL is required in order to ;; make PACKAGE-NAME return NIL for a deleted package as ;; ANSI requires. Setting the other slots to NIL - ;; and blowing away the SYMBOL-HASHSETs is just done + ;; and blowing away the SYMBOL-TABLEs is just done ;; for tidiness and to help the GC. (package-keys package) #())) (atomic-incf *package-names-cookie*) @@ -210,8 +210,8 @@ implementation it is ~S." *!default-package-use-list*) (setf (sb-c::package-environment-changed sb-c::*compilation*) t)) (setf (package-tables package) #() (package-%shadowing-symbols package) nil - (package-internal-symbols package) (make-symbol-hashset 0) - (package-external-symbols package) (make-symbol-hashset 0))) + (package-internal-symbols package) (make-symbol-table 0) + (package-external-symbols package) (make-symbol-table 0))) (return-from delete-package t))))))) ;;; Possible FIXME: diff --git a/src/code/package.lisp b/src/code/package.lisp index 506c8c3db..f515d4110 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -12,7 +12,7 @@ (in-package "SB-IMPL") -;;;; the SYMBOL-HASHSET structure +;;;; the SYMBOL-TABLE structure ;;; Packages are implemented using a special kind of hashtable - ;;; the storage is a single vector in which each cell is both key and value. @@ -52,15 +52,27 @@ (defconstant +package-id-user+ 3) (defconstant +package-id-kernel+ 4) -(sb-xc:defstruct (symbol-hashset +(sb-xc:defstruct (symtbl-magic (:conc-name "SYMTBL-") + (:copier nil) + (:predicate nil) + (:constructor make-symtbl-magic (hash1-mask hash1-c hash2-mask))) + (hash1-mask 0 :type (unsigned-byte 32)) + (hash1-c 0 :type (unsigned-byte 32)) + ;; These values were both needed for the secondary hash but they aren't now + ;; because the secondary hash is not computed by taking a remainder. It's just a mask. + (hash2-mask 0 :type (unsigned-byte 32)) + ;(hash2-c 0 :type (unsigned-byte 32)) + ) + +(sb-xc:defstruct (symbol-table (:conc-name "SYMTBL-") (:predicate nil) - (:constructor %make-symbol-hashset + (:constructor %make-symbol-table (%cells size &aux (free size))) (:copier nil)) ;; An extra indirection to the symbol vector allows atomically changing the symbols ;; and the division magic parameters. - (%cells (missing-arg) :type (cons t simple-vector)) + (%cells (missing-arg) :type (cons symtbl-magic simple-vector)) (modified nil :type boolean) (package nil :type (or null package)) ; backpointer, only if externals ;; SIZE is roughly related to the number of symbols the client code asked to be @@ -100,11 +112,11 @@ (mru-table-index 0 :type index) ;; packages that use this package (%used-by nil :type (or null weak-pointer)) - ;; SYMBOL-HASHSETs of internal & external symbols - (internal-symbols nil :type symbol-hashset) - (external-symbols nil :type symbol-hashset) + ;; SYMBOL-TABLEs of internal & external symbols + (internal-symbols nil :type symbol-table) + (external-symbols nil :type symbol-table) ;; shadowing symbols - ;; Todo: dynamically changeover to a SYMBOL-HASHSET if list gets long + ;; Todo: dynamically changeover to a SYMBOL-TABLE if list gets long (%shadowing-symbols () :type list) ;; documentation string for this package (doc-string nil :type (or simple-string null)) @@ -125,7 +137,7 @@ (%local-nicknames nil :type (or null (cons simple-vector weak-vector))) ;; Definition source location (source-location nil :type (or null sb-c:definition-source-location))) -(proclaim '(freeze-type symbol-hashset package)) +(proclaim '(freeze-type symbol-table package)) (defconstant +initial-package-bits+ 2) ; for genesis diff --git a/src/code/shaketree.lisp b/src/code/shaketree.lisp index a95fbbdbd..7b6b95949 100644 --- a/src/code/shaketree.lisp +++ b/src/code/shaketree.lisp @@ -16,7 +16,7 @@ (push x result) ; keep a strong reference to this symbol (push (cons (string x) (make-weak-pointer x)) result)))) (fill cells 0) - (resize-symbol-hashset table 0 t) + (resize-symbol-table table 0 t) result))) (dolist (package (list-all-packages)) ;; Never discard standard symbols diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp index 5f9003b59..403b1a6e9 100644 --- a/src/code/target-package.lisp +++ b/src/code/target-package.lisp @@ -374,17 +374,7 @@ of :INHERITED :EXTERNAL :INTERNAL." (expand-pkg-iterator '((list-all-packages) :internal :external) var body-decls result-form)) -;;;; SYMBOL-HASHSET stuff - -(defstruct (symtbl-magic (:conc-name "SYMTBL-") - (:copier nil) - (:predicate nil) - (:constructor make-symtbl-magic (hash1-mask hash1-c - hash2-mask hash2-c))) - (hash1-mask 0 :type (unsigned-byte 32)) - (hash1-c 0 :type (unsigned-byte 32)) - (hash2-mask 0 :type (unsigned-byte 32)) - (hash2-c 0 :type (unsigned-byte 32))) +;;;; SYMBOL-TABLE stuff (declaim (inline symtbl-cells)) (defun symtbl-cells (table) (truly-the simple-vector (cdr (symtbl-%cells table)))) @@ -394,7 +384,7 @@ of :INHERITED :EXTERNAL :INTERNAL." (the fixnum (+ (symtbl-deleted table) (symtbl-free table)))))) -(defmethod print-object ((table symbol-hashset) stream) +(defmethod print-object ((table symbol-table) stream) (declare (type stream stream)) (print-unreadable-object (table stream :type t :identity t) (let* ((n-live (%symtbl-count table)) @@ -437,10 +427,10 @@ of :INHERITED :EXTERNAL :INTERNAL." ;;; The smallest table built here has three entries. This ;;; is necessary because the double hashing step size is calculated ;;; using a division by the table size minus two. -(defun make-symbol-hashset (size &optional (load-factor 3/4)) +(defun make-symbol-table (size &optional (load-factor 3/4)) (declare (sb-c::tlab :system) (inline make-symtbl-magic) ; to allow system-TLAB allocation - (inline %make-symbol-hashset)) + (inline %make-symbol-table)) (flet ((choose-good-size (size) (loop for n of-type fixnum from (logior (ceiling size load-factor) 1) @@ -456,11 +446,10 @@ of :INHERITED :EXTERNAL :INTERNAL." (size (truncate (* n load-factor))) (reciprocals (if (= n 3) ; minimal table - (make-symtbl-magic 0 0 0 0) ; <-- should be LTV but can't be. + (make-symtbl-magic 0 0 0) ; <-- should be LTV but can't be. ; (package-cold-init called before LTV fixups) - (make-symtbl-magic h1-mask h1-c h2-mask 0)))) - (%make-symbol-hashset (cons reciprocals (make-array n :initial-element 0)) - size)))) + (make-symtbl-magic h1-mask h1-c h2-mask)))) + (%make-symbol-table (cons reciprocals (make-array n :initial-element 0)) size)))) (declaim (inline pkg-symbol-valid-p)) (defun pkg-symbol-valid-p (x) (not (fixnump x))) @@ -512,17 +501,17 @@ of :INHERITED :EXTERNAL :INTERNAL." ;;; calls to ADD-SYMBOL make no attempt to preserve Robinhood's minimization ;;; of the maximum probe sequence length. We can do it now because the ;;; entire vector will be swapped, which is concurrent reader safe. -(defun resize-symbol-hashset (table size splat &optional (load-factor 3/4)) +(defun resize-symbol-table (table size splat &optional (load-factor 3/4)) (when (zerop size) - (return-from resize-symbol-hashset + (return-from resize-symbol-table ;; Don't need a barrier here. Suppose a reader finished probing with a miss. ;; Whether it re-probes again or not, it will surely result in a miss. (setf (symtbl-%cells table) - (load-time-value (cons (make-symtbl-magic 0 0 0 0) #(0 0 0)) t) + (load-time-value (cons (make-symtbl-magic 0 0 0) #(0 0 0)) t) (symtbl-free table) 0 (symtbl-size table) 0 (symtbl-deleted table) 0))) - (let* ((temp-table (make-symbol-hashset size load-factor)) + (let* ((temp-table (make-symbol-table size load-factor)) (cells (symtbl-%cells temp-table)) (reciprocals (car cells)) (vec (truly-the simple-vector (cdr cells))) @@ -1093,7 +1082,7 @@ Experimental: interface subject to change." ;; N.B.: Never pass 0 for the new size, as that will assign the ;; constant read-only vector #(0 0 0) into the cells. (let ((new-size (max 1 (* (- (symtbl-size table) (symtbl-deleted table)) 2)))) - (resize-symbol-hashset table new-size t))) + (resize-symbol-table table new-size t))) (let* ((cells (symtbl-%cells table)) (reciprocals (car cells)) (vec (truly-the simple-vector (cdr cells))) @@ -1185,7 +1174,7 @@ Experimental: interface subject to change." ;;; that can't ever be freed. (defun tune-hashset-sizes-of-all-packages () (flet ((tune-table-size (desired-lf table) - (resize-symbol-hashset table (%symtbl-count table) t desired-lf) + (resize-symbol-table table (%symtbl-count table) t desired-lf) ;; The APROPOS-LIST R/O scan optimization is inadmissible if no R/O space #-darwin-jit (setf (symtbl-modified table) nil))) (dolist (package (list-all-packages)) @@ -1220,7 +1209,7 @@ Experimental: interface subject to change." (defun %lookup-symbol (table string name-length name-hash) (declare (optimize (sb-c::verify-arg-count 0) (sb-c::insert-array-bounds-checks 0))) - (declare (symbol-hashset table) (simple-string string) (index name-length)) + (declare (symbol-table table) (simple-string string) (index name-length)) #+nil (atomic-incf *sym-lookups*) (macrolet ((probe (metric) @@ -1292,7 +1281,7 @@ Experimental: interface subject to change." ;;; Delete SYMBOL from TABLE, storing -1 in its place. SYMBOL must exist. ;;; -;;; NOTE: It's possible that NUKE-SYMBOL should never 0-fill the old symbol-hashset if downsizing. +;;; NOTE: It's possible that NUKE-SYMBOL should never 0-fill the old symbol-table if downsizing. ;;; CLHS nowhere implies that altering accessability of a symbol already _present_ in a package ;;; counts as INTERNing. Iterating over directly present symbols of a package permits UNINTERN on ;;; the current symbol, which might rehash the storage vector, creating a new one. To allow it, @@ -1323,7 +1312,7 @@ Experimental: interface subject to change." (let ((size (symtbl-size table)) (used (%symtbl-count table))) (when (< used (truncate size 4)) - (resize-symbol-hashset table (* used 2) splat)))) + (resize-symbol-table table (* used 2) splat)))) (defun list-all-packages () "Return a list of all existing packages." @@ -1947,7 +1936,7 @@ PACKAGE." ;;;; final initialization ;;;; Due to the relative difficulty - but not impossibility - of manipulating -;;;; symbol-hashsets in the cross-compilation host, all interning operations +;;;; symbol-tables in the cross-compilation host, all interning operations ;;;; are delayed until cold-init. ;;;; The cold loader (GENESIS) set *!INITIAL-SYMBOLS* to the target ;;;; representation of the hosts's *COLD-PACKAGE-SYMBOLS*. @@ -1991,8 +1980,7 @@ PACKAGE." ;; though its only use be to name an FLET in a function ;; hanging on an otherwise uninternable symbol. strange but true :-( (flet ((!make-table (input) - (let ((table (make-symbol-hashset - (length (the simple-vector input))))) + (let ((table (make-symbol-table (length (the simple-vector input))))) (dovector (symbol input table) (add-symbol table symbol))))) (let ((externals (!make-table external-v))) @@ -2226,8 +2214,8 @@ PACKAGE." (setq table (make-hash-table :test 'equal) *deferred-package-names* table)) (or (gethash name table) - (let ((package (%make-package (make-symbol-hashset 0) - (make-symbol-hashset 0)))) + (let ((package (%make-package (make-symbol-table 0) + (make-symbol-table 0)))) (setf (symtbl-package (package-external-symbols package)) package) (with-package-names () (setf (package-%name package) name) diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp index c1270f67c..be79a705c 100644 --- a/src/compiler/generic/genesis.lisp +++ b/src/compiler/generic/genesis.lisp @@ -4379,7 +4379,7 @@ static inline uword_t word_has_stickymark(uword_t word) { (let ((child (case class (sb-c::compiled-debug-info 'sb-c::compiled-debug-fun) (defstruct-description 'defstruct-slot-description) - (package 'sb-impl::symbol-hashset)))) + (package 'sb-impl::symbol-table)))) (when child (write-structure-object (layout-info (find-layout child)) stream))) (write-structure-object (layout-info (find-layout class)) diff --git a/src/runtime/search.c b/src/runtime/search.c index 45cf2e701..42b63eb8a 100644 --- a/src/runtime/search.c +++ b/src/runtime/search.c @@ -221,7 +221,7 @@ static lispobj* search_package_symbols(lispobj package, char* symbol_name) struct package* pkg = (void*)INSTANCE(package); int pass; for (pass = 0; pass <= 1; ++pass) { - struct symbol_hashset* table = (void*) + struct symbol_table* table = (void*) INSTANCE(barrier_load(pass ? &pkg->external_symbols : &pkg->internal_symbols)); gc_assert(widetag_of(&table->header) == INSTANCE_WIDETAG); lispobj cells = barrier_load(&table->_cells); diff --git a/tests/traceroot.impure.lisp b/tests/traceroot.impure.lisp index 1a3c8b39e..cb1f60142 100644 --- a/tests/traceroot.impure.lisp +++ b/tests/traceroot.impure.lisp @@ -93,7 +93,7 @@ ;;; Sample output: ;;; Path to "hi": -;;; 6 1000209AB3 [ 1] a symbol-hashset +;;; 6 1000209AB3 [ 1] a symbol-table ;;; 1 10048F145F [ 29] a (simple-vector 37) ;;; 1 503B403F [ 2] COMMON-LISP-USER::*TOP* ;;; 0 1004B885B7 [ 6] a cons = (P Q R ...) ; = (NTHCDR 6 object) diff --git a/tools-for-build/editcore.lisp b/tools-for-build/editcore.lisp index 77c2d3532..8f0121590 100644 --- a/tools-for-build/editcore.lisp +++ b/tools-for-build/editcore.lisp @@ -39,7 +39,7 @@ #:near-cond-jump-displacement #:mov #:call #:jmp #:get-gpr #:reg-name #:machine-ea #:machine-ea-base #:machine-ea-index #:machine-ea-disp) - (:import-from "SB-IMPL" #:symbol-hashset #:package-%name + (:import-from "SB-IMPL" #:symbol-table #:package-%name #:symtbl-%cells #:hash-table-pairs #:hash-table-%count)) @@ -216,10 +216,10 @@ (dolist (string contents hs) (sb-int:hashset-insert hs string)))) -(defun scan-symbol-hashset (function table core) +(defun scan-symbol-table (function table core) (let* ((spacemap (core-spacemap core)) (nil-object (core-nil-object core)) - (cells (translate (symtbl-%cells (truly-the symbol-hashset + (cells (translate (symtbl-%cells (truly-the symbol-table (translate table spacemap))) spacemap))) (dovector (x (translate (cdr cells) spacemap)) @@ -275,7 +275,7 @@ (let ((externals (gethash package-name packages)) (n 0)) (unless externals - (scan-symbol-hashset + (scan-symbol-table (lambda (string symbol) (declare (ignore symbol)) (incf n) @@ -490,7 +490,7 @@ (package-alist) (symbols (make-hash-table :test 'equal))) (labels ((scan-symtbl (table) - (scan-symbol-hashset + (scan-symbol-table (lambda (str sym) (pushnew (get-lisp-obj-address sym) (gethash str symbols))) table core))