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

Remove unused slot from symtbl-magic

Browse source 
And rename symbol-hashset type to SYMBOL-TABLE which is more mnemomic
considering that variable holding the thing is usually named 'table',
and the magic parameters are in a symtbl-magic struct.
This commit is contained in:
Douglas Katzman 2024-01-10 23:05:17 -05:00
parent c922a1d491
commit cd041e5b1c
8 changed files with 55 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/code/defpackage.lisp
View file

@ -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:

30
src/code/package.lisp
View file

@ -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

2
src/code/shaketree.lisp
View file

@ -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

52
src/code/target-package.lisp
View file

@ -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)

2
src/compiler/generic/genesis.lisp
View file

@ -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))

2
src/runtime/search.c
View file

@ -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);

2
tests/traceroot.impure.lisp
View file

@ -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)

10
tools-for-build/editcore.lisp
View file

@ -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))