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

arm64: enable #+salted-symbol-hash

Browse source 
The problem of xperfecthash files being sensitive to STATIC-SPACE-START
is hereby largely mitigated.

- 64-bit arm needs 3 choices for NIL's hash: one for #+darwin, one for all
  other POSIX OSes, and one if #+relocatable-static-space. The former 2 see
  a non-zero byte in the hash due to the high address of NIL. Relocatable
  uses an ordinary name-based hash, and no longer needs 8-word symbols.

- All other 64-bit architectures use a static-space address below 4GB.
  Since the high half of NIL's address is 0, its symbol-name-hash is 0.

- 32-bit architectures use a slot for symbol-hash that does not overlap
  with CAR or CDR of NIL, same as for relocatable-static
This commit is contained in:
Douglas Katzman 2024-03-04 16:59:23 -05:00
parent 1fe98b3b17
commit 790bca746e
7 changed files with 62 additions and 57 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
src/code/cross-sxhash.lisp
View file

@ -66,12 +66,11 @@
;; The reader passes a string buffer and length to avoid consing a new string
;; for each symbol read. That does not occur in cross-compilation.
(assert (= length (length string)))
(cond #+64-bit
(cond #+(and 64-bit (not relocatable-static-space))
((string= string "NIL") ; :NIL must hash the same as NIL
#+salted-symbol-hash 0 ; return the high 4 bytes in NIL's car slot
#-salted-symbol-hash
;; Return the high 4 bytes in NIL's car slot.
;; out-of-order with defconstant nil-value
(ash (sb-vm::get-nil-taggedptr) (- sb-vm:n-fixnum-tag-bits)))
(ldb (byte 32 32) (sb-vm::get-nil-taggedptr)))
(t
(logxor (%sxhash-simple-string string) most-positive-fixnum))))

2
src/cold/shared.lisp
View file

@ -319,7 +319,7 @@
(pushnew :immobile-code sb-xc:*features*))
(when (target-featurep :64-bit)
(push :compact-symbol sb-xc:*features*))
(when (and (target-featurep :64-bit) (not (eq arch :arm64)))
(when (target-featurep :64-bit)
;; Considering that a single config file governs rv32 and rv64, I don't
;; know how to make this properly configurable. In theory, 32-bit builds could
;; have a salted hash (gaining 3 bits by making the hash slot raw), but

15
src/compiler/arm64/cell.lisp
View file

@ -216,17 +216,16 @@
(:policy :fast-safe)
(:translate symbol-hash)
(:args (symbol :scs (descriptor-reg)))
(:arg-refs args)
(:results (res :scs (any-reg)))
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 2
;; The symbol-hash slot of NIL holds NIL because it is also the
;; car slot, so we have to strip off the fixnum-tag-mask to make sure
;; it is a fixnum. The lowtag selection magic that is required to
;; ensure this is explained in the comment in objdef.lisp
(loadw res symbol symbol-hash-slot other-pointer-lowtag)
(unless (not-nil-tn-ref-p args)
(inst and res res (bic-mask fixnum-tag-mask)))))
(inst lsr res res 24))) ; shift out 3 bytes
(define-vop (symbol-name-hash symbol-hash)
(:translate symbol-name-hash)
(:generator 1 ; ASSUMPTION: little-endian
(inst ldr (32-bit-reg res)
(@ symbol (- (+ 4 (ash symbol-hash-slot word-shift)) other-pointer-lowtag)))))
(define-vop ()
(:args (symbol :scs (descriptor-reg)))

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

@ -1144,6 +1144,14 @@ core and return a descriptor to it."
(logior #+compact-symbol (ash package-id sb-impl::symbol-name-bits)
(descriptor-bits name)))
(defun assign-symbol-hash (descriptor wordindex name)
(let ((hash (sb-c::calc-symbol-name-hash name (length name))))
(if (member :64-bit sb-xc:*features*)
;; Low 4 bytes to high 4 bytes of slot, plus maybe randomize 1 byte (not yet)
(write-wordindexed/raw descriptor wordindex
(logand (ash hash 32) most-positive-word))
(write-wordindexed descriptor wordindex (make-fixnum-descriptor hash)))))
;;; Allocate (and initialize) a symbol.
;;; Even though all symbols are the same size now, I still envision the possibility
;;; of reducing gensyms to 4 words, though I'm not sure what to do if information
@ -1155,15 +1163,9 @@ core and return a descriptor to it."
(let* ((cold-name (string-literal-to-core name))
(pkg-id (if cold-package
(descriptor-fixnum (read-slot cold-package :id))
sb-impl::+package-id-none+))
(hash (sb-c::calc-symbol-name-hash name (length name))))
sb-impl::+package-id-none+)))
(assign-symbol-hash symbol sb-vm:symbol-hash-slot name)
(write-wordindexed symbol sb-vm:symbol-value-slot *unbound-marker*)
(if (member :salted-symbol-hash sb-xc:*features*)
;; Store the low 4 bytes of hash into the high 4 bytes of the slot
(write-wordindexed/raw symbol sb-vm:symbol-hash-slot
(logand (ash hash 32) most-positive-word))
(write-wordindexed symbol sb-vm:symbol-hash-slot
(make-fixnum-descriptor hash)))
(write-wordindexed symbol sb-vm:symbol-info-slot *nil-descriptor*)
(write-wordindexed/raw symbol sb-vm:symbol-name-slot
(encode-symbol-name pkg-id cold-name))
@ -1782,17 +1784,15 @@ core and return a descriptor to it."
;; The header-word for NIL "as a symbol" contains a length + widetag.
(write-wordindexed des 1 (make-other-immediate-descriptor (1- sb-vm:symbol-size)
sb-vm:symbol-widetag))
(write-wordindexed des (+ 1 sb-vm:symbol-value-slot) nil-val)
#+relocatable-static-space
(write-wordindexed des (+ 1 sb-vm::symbol-unused-slot) nil-val)
;; write the CAR of nil-as-cons. Also for 32-bit, set the hash to the normal hash
;; for the symbol-name.
#+64-bit (write-wordindexed des (+ 1 sb-vm:symbol-hash-slot) nil-val)
#-64-bit (progn (write-wordindexed des (+ 1 sb-vm:symbol-fdefn-slot) nil-val)
(write-wordindexed des (+ 1 sb-vm:symbol-hash-slot)
(make-fixnum-descriptor
(sb-c::calc-symbol-name-hash "NIL" 3))))
;;
;; Write the CAR and CDR of nil-as-cons
(let* ((nil-cons-base-addr (- sb-vm:nil-value sb-vm:list-pointer-lowtag))
(nil-cons-car-offs (- nil-cons-base-addr (gspace-byte-address *static*)))
(nil-cons-cdr-offs (+ nil-cons-car-offs sb-vm:n-word-bytes)))
(setf (bvref-word (descriptor-mem des) nil-cons-car-offs) sb-vm:nil-value
(bvref-word (descriptor-mem des) nil-cons-cdr-offs) sb-vm:nil-value))
;; Assign HASH if and only if NIL's hash is address-insensitive
#+(or relocatable-static-space (not 64-bit))
(assign-symbol-hash des (+ 1 sb-vm:symbol-hash-slot) "NIL")
(write-wordindexed des (+ 1 sb-vm:symbol-info-slot) initial-info)
(write-wordindexed/raw des (+ 1 sb-vm:symbol-name-slot)
(encode-symbol-name sb-impl::+package-id-lisp+ name))))

47
src/compiler/generic/objdef.lisp
View file

@ -365,22 +365,20 @@ during backtrace.
;;;; symbols
#+64-bit
(define-primitive-object (symbol :lowtag other-pointer-lowtag
:widetag symbol-widetag
:alloc-trans %alloc-symbol
:type symbol)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *symbol-primobj-defn-properties*
'(:lowtag other-pointer-lowtag
:widetag symbol-widetag
:alloc-trans %alloc-symbol
:type symbol)))
#+(and 64-bit (not relocatable-static-space))
(define-primitive-object (symbol . #.*symbol-primobj-defn-properties*)
;; Beware when changing this definition. NIL-the-symbol is defined
;; using this layout, and NIL-the-end-of-list-marker is the cons
;; ( NIL . NIL ), living in the first two slots of NIL-the-symbol
;; (conses have no header). Careful selection of lowtags ensures
;; that the same pointer can be used for both purposes:
;; OTHER-POINTER-LOWTAG is 7, LIST-POINTER-LOWTAG is 3, so if you
;; subtract 3 from (SB-KERNEL:GET-LISP-OBJ-ADDRESS 'NIL) you get the
;; first data slot, and if you subtract 7 you get a symbol header.
;; (The numbers mentioned pertain to the 32-bit machines, not 64-bit)
;; that the same pointer can be used for both purposes.
;; HASH and VALUE are the first two slots.
;; Traditionally VALUE was the first slot, corresponding to the CAR of
;; NIL-as-end-of-list; and HASH was the second, corresponding to CDR.
@ -389,12 +387,7 @@ during backtrace.
;; using lisp code equivalent to "native_pointer(ptr)[1]".
;; This improves the code for CASE and ECASE over symbols
;; regardless of whether the object being tested is known to be a symbol.
;; Accessing the hash requires masking off bits to yield a fixnum result,
;; all the more so if the object is any random type.
#-relocatable-static-space
(hash :set-trans %set-symbol-hash)
#+relocatable-static-space
unused
(value :init :unbound
:set-trans %set-symbol-global-value
:set-known ())
@ -421,15 +414,23 @@ during backtrace.
:cas-trans sb-impl::cas-symbol-%info
:type (or instance list)
:init :null)
(name :init :arg)
#+relocatable-static-space
(hash :set-trans %set-symbol-hash))
(name :init :arg))
;;; 64-bit relocatable-static is a little like 64-bit, a little like 32-bit.
;;; Refer to comments above for details on each slot.
#+(and 64-bit relocatable-static-space)
(define-primitive-object (symbol . #.*symbol-primobj-defn-properties*)
(fdefn :ref-trans %symbol-fdefn :ref-known () :cas-trans cas-symbol-fdefn)
(value :init :unbound :set-trans %set-symbol-global-value :set-known ())
(info :ref-trans symbol-%info :ref-known (flushable)
:cas-trans sb-impl::cas-symbol-%info
:type (or instance list)
:init :null)
(hash :set-trans %set-symbol-hash)
(name :init :arg))
#-64-bit
(define-primitive-object (symbol :lowtag other-pointer-lowtag
:widetag symbol-widetag
:alloc-trans %alloc-symbol
:type symbol)
(define-primitive-object (symbol . #.*symbol-primobj-defn-properties*)
;; As described in the comments above for #+64-bit, the first two slots of SYMBOL
;; have to work for NIL-as-cons, so they have to be NIL and NIL, which have to
;; also be the correct value when reading the slot of NIL-as-symbol.

2
src/runtime/coreparse.c
View file

@ -432,7 +432,7 @@ static void fix_space(uword_t start, lispobj* end, struct heap_adjust* adj)
{ // Modeled on scav_symbol() in gc-common
struct symbol* s = (void*)where;
#ifdef LISP_FEATURE_64_BIT
adjust_pointers(&s->value, 3, adj); // value, fdefn, info
adjust_pointers(where + 1, 4, adj);
lispobj name = decode_symbol_name(s->name);
lispobj adjusted_name = adjust_word(adj, name);
// writeback the name if it changed

8
src/runtime/gc-common.c
View file

@ -813,7 +813,13 @@ static sword_t scav_symbol(lispobj *where,
__attribute__((unused)) lispobj header) {
struct symbol* s = (void*)where;
#ifdef LISP_FEATURE_64_BIT
scavenge(&s->value, 3); // value, fdefn, info
/* The first 4 slots of a symbol are all boxed words, but vary in meaning
* based on #+relocatable-static-space. Scanning the hash is harmless - though
* unnecessary - at present, since it is of descriptor nature, be it fixnum,
* or NIL in the case of NIL. Though there is little or no benefit to gaining
* 1 bit, we could make hash a raw slot in which case we'd have to use care
* to avoid reading it. trace-object.inc uses three separate operations */
scavenge(where + 1, 4);
lispobj name = decode_symbol_name(s->name);
lispobj new = name;
scavenge(&new, 1);