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

x86-64: store SYMBOL-NAME-HASH in the high 4 bytes of hash slot

Browse source 
So now NIL's name-hash is 0 given that static space is below 4GB
and the SYMBOL-NAME-HASH accessor is simply a 32-bit MOV.
Also put 1 random byte in the hash slot so that SYMBOL-HASH is a
slightly better hash function for EQL,EQUAL,EQUALP tables.
This commit is contained in:
Douglas Katzman 2024-03-03 11:05:12 -05:00
parent bfe7a29fac
commit 25eb5adb96
11 changed files with 149 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
crossbuild-runner/backends/x86-64/features
View file

@ -15,3 +15,4 @@
:executable-funinstances
:unbind-in-unwind
:no-continue-unwind
:salted-symbol-hash

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

@ -56,19 +56,24 @@
;; hash.impure.lisp)
#.(logandc1 1193941380939624010 most-positive-fixnum))
most-positive-fixnum)))
(defun sxhash-symbol-xform (s)
#+salted-symbol-hash `(let ((h (symbol-name-hash ,s))) (sb-int:mix h h))
#-salted-symbol-hash `(symbol-hash ,s))
) ; end EVAL-WHEN
(defun calc-symbol-name-hash (string length)
;; 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
((string= string "NIL") ; :NIL must hash the same as NIL
;; out-of-order with defconstant nil-value
(ash (sb-vm::get-nil-taggedptr) (- sb-vm:n-fixnum-tag-bits)))
(t
(logxor (%sxhash-simple-string string) most-positive-fixnum))))
(cond #+64-bit
((string= string "NIL") ; :NIL must hash the same as NIL
#+x86-64 0 ; return the high 4 bytes in NIL's car slot
#-x86-64
;; out-of-order with defconstant nil-value
(ash (sb-vm::get-nil-taggedptr) (- sb-vm:n-fixnum-tag-bits)))
(t
(logxor (%sxhash-simple-string string) most-positive-fixnum))))
;;; This is merely a slot-reader in real life, but since cross-compiling
;;; doesn't have a slot, simply recompute the answer as if it were stored.
@ -100,7 +105,6 @@
;; one way or another based on the type of the dimension.
;; 2. Exactly the same thing occurs with alien-type :BITS and :ALIGNMENT
;; which are either NIL or int, as is alien-fun-type :VARARGS
;; which
;; But in stark contrast, XSET-ELTS-HASH avoids calling SXHASH on symbols
;; because SXHASH is not the best hasher for that purpose, like say an XSET
;; that contains 100 symbols all of whose print names are the same.
@ -108,7 +112,7 @@
(unless (member s '("*" "NIL" "UNSPECIFIED") :test 'string=)
(error "don't call SB-XC:SXHASH on ~S" obj))
;; !PACKAGE-COLD-INIT will cross-check this hash
(return-from sb-xc:sxhash (calc-symbol-name-hash s (length s)))))
(return-from sb-xc:sxhash #.(sxhash-symbol-xform 'obj))))
(let ((answer
(etypecase obj ; croak on anything but these
(sb-xc:fixnum #.(sxhash-fixnum-xform 'obj))

2
src/code/defpackage.lisp
View file

@ -821,7 +821,7 @@ specifies to signal a warning if SWANK package is in variance, and an error othe
(when (functionp reciprocals)
(return-from metrics (values 1 1 1))) ; 1 probe max+avg, 100% load
(flet ((probe-seq-len (symbol)
(let* ((name-hash (sxhash symbol))
(let* ((name-hash (symbol-name-hash symbol))
(index (symbol-table-hash 1 name-hash nslots))
(h2 (symbol-table-hash 2 name-hash nslots))
(nprobes 1))

12
src/code/symbol.lisp
View file

@ -87,7 +87,7 @@ distinct from the global value. Can also be SETF."
(and (char= (schar string 0) #\N)
(char= (schar string 1) #\I)
(char= (schar string 2) #\L)))))
(sxhash nil)) ; transformed
#.(symbol-hash 'nil)) ; utilize the host's function
(t
;; flip the bits so that a symbol hashes differently from its print name
(logxor (%sxhash-simple-substring string 0 length)
@ -390,6 +390,7 @@ distinct from the global value. Can also be SETF."
;; Readonly space is physically unwritable. Don't touch it.
(not (read-only-space-obj-p name)))
(logior-array-flags name sb-vm:+vector-shareable+))) ; Set "logically read-only" bit
(name-hash (calc-symbol-name-hash name (length name)))
(symbol
(truly-the symbol
;; If no immobile-space, easy: all symbols go in dynamic-space
@ -408,7 +409,14 @@ distinct from the global value. Can also be SETF."
(char= (char name (1- (length name))) #\*)))
(sb-vm::%alloc-immobile-symbol name)
(sb-vm::%alloc-symbol name)))))
(%set-symbol-hash symbol (calc-symbol-name-hash name (length name)))
#+salted-symbol-hash
(let* ((salt (murmur3-fmix-word (mix (get-lisp-obj-address symbol) name-hash)))
(hash (logior (logand (ash name-hash 32) most-positive-word)
(mask-field (byte 8 24) salt))))
;; %SET-SYMBOL-HASH wants a unsigned fixnum, which HASH is not.
(%primitive sb-vm::set-slot symbol (%make-lisp-obj hash)
'make-symbol sb-vm:symbol-hash-slot sb-vm:other-pointer-lowtag))
#-salted-symbol-hash (%set-symbol-hash symbol name-hash)
;; Compact-symbol (which is equivalent to #+64-bit) has the package already NIL
;; because the PACKAGE-ID-BITS field defaults to 0.
#-compact-symbol (%set-symbol-package symbol nil)

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

@ -1997,10 +1997,13 @@ PACKAGE."
;; type decl is critical here - can't invoke a hairy aref routine yet
(dovector (symbol (the simple-vector symbols))
(when symbol ; skip NIL because of its magic-ness
(let* ((stored-hash (symbol-hash symbol))
(name (symbol-name symbol))
(let* ((name (symbol-name symbol))
(computed-hash (calc-symbol-name-hash name (length name))))
(aver (= stored-hash computed-hash)))))))
#+salted-symbol-hash
(aver (= (symbol-name-hash symbol)
(logand computed-hash +symname-hash-mask+)))
#-salted-symbol-hash
(aver (= (symbol-hash symbol) computed-hash)))))))
(check-hash-slot (car *!initial-symbols*)) ; uninterned symbols
(dolist (spec specs)
(check-hash-slot (second spec))

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

@ -1154,10 +1154,14 @@ core and return a descriptor to it."
(pkg-id (if cold-package
(descriptor-fixnum (read-slot cold-package :id))
sb-impl::+package-id-none+))
(hash (make-fixnum-descriptor
(sb-c::calc-symbol-name-hash name (length name)))))
(hash (sb-c::calc-symbol-name-hash name (length name))))
(write-wordindexed symbol sb-vm:symbol-value-slot *unbound-marker*)
(write-wordindexed symbol sb-vm:symbol-hash-slot hash)
(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*)
#+compact-symbol
(write-wordindexed/raw symbol sb-vm:symbol-name-slot

9
src/compiler/generic/vm-fndb.lisp
View file

@ -117,13 +117,8 @@
(defknown (symbol-hash) (symbol) hash-code (flushable movable))
(defknown (symbol-name-hash) (symbol) symbol-name-hash (flushable movable))
;;; This accessor will read the word at SYMBOL-HASH-SLOT in any object, not only symbols.
;;; The value is predictable only if the object is a symbol. The trick is to either:
;;; 1) Access taggedptr - lowtag + offset using a few registers, OR
;;; 2) Compute the untagged base pointer, while also holding the tagged pointer
;;; in a register (implicitly pinned), and then access via the untagged pointer.
;;; x86-64 implements this as a vop, though arm64 probably could too, unless compiled
;;; with #+relocatable-static-space.
;;; This accessor will read the half-lispword at SYMBOL-HASH-SLOT in any object,
;;; not only symbols. The value is reliable only if the object is a symbol.
(defknown hash-as-if-symbol-name (t) symbol-name-hash (flushable movable always-translatable))
(defknown %set-symbol-hash (symbol hash-code)

3
src/compiler/sxhash.lisp
View file

@ -162,11 +162,12 @@
;;; - SXHASH is required by the language to have behavior that precludes randomizing the
;;; hash, and encourages using all the range of positive fixnums.
;;;
(deftransform sxhash ((x) (symbol)) `(symbol-hash x))
(deftransform sxhash ((x) (symbol)) '#.(sxhash-symbol-xform 'x))
(deftransform hash-as-if-symbol-name ((object) (symbol) * :important nil)
`(symbol-name-hash object))
#-salted-symbol-hash
(define-source-transform symbol-name-hash (s) `(ldb (byte 32 0) (symbol-hash ,s)))
(intern "SCRAMBLE" "SB-C")

44
src/compiler/x86-64/cell.lisp
View file

@ -420,42 +420,32 @@
(:policy :fast-safe)
(:translate symbol-hash)
(:args (symbol :scs (descriptor-reg)))
(:results (res :scs (any-reg)))
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:arg-refs args)
(:generator 2
(loadw res symbol symbol-hash-slot other-pointer-lowtag)
;; The symbol-hash slot of NIL holds NIL because it is also the
;; car slot, so we have to zero the fixnum tag bit(s) 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
(unless (not-nil-tn-ref-p args)
(inst and res (lognot fixnum-tag-mask)))))
(inst shr res 24))) ; shift out 3 bytes
(eval-when (:compile-toplevel)
;; assumption: any object can be read 1 word past its base pointer
(assert (= sb-vm:symbol-hash-slot 1)))
(assert (= sb-vm:symbol-hash-slot 1))
;; also: whatever pointer tag a non-immediate object has, we can subtract
;; 3 without reading any byte outside of the object.
(aver (= (- (+ 4 (ash symbol-hash-slot word-shift)) other-pointer-lowtag)
-3))) ; 3 is the smallest pointer tag
(define-vop (hash-as-if-symbol-name)
(define-vop (symbol-name-hash)
(:policy :fast-safe)
(:translate hash-as-if-symbol-name)
(:args (object :scs (descriptor-reg)))
;; arg can not target the temp because they both have to be live
;; in order that the tagged pointer not disappear.
;; But temp and output could be in the same register.
(:temporary (:sc unsigned-reg :to (:result 0)) base-ptr)
(:results (res :scs (any-reg)))
;; identical translations believe it or not
(:translate symbol-name-hash hash-as-if-symbol-name)
(:args (symbol :scs (descriptor-reg)))
(:results (res :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 4
(inst mov base-ptr object)
(inst and base-ptr (lognot lowtag-mask))
(inst mov res (ea n-word-bytes base-ptr)) ; 1 word beyond the header
;; This will be more efficient after I align the 32 bits that we want to grab
;; for the name hash into the upper 4 bytes so that we don't have to refer
;; to a mask that isn't expressible in an immediate operand.
(inst and res
(register-inline-constant
:qword (ash #xFFFFFFFF n-fixnum-tag-bits)))))
(:generator 1
;; NIL gets 0 for its name hash since its upper 4 address bytes are 0
(inst mov :dword res
(ea (- (+ 4 (ash symbol-hash-slot word-shift)) other-pointer-lowtag)
symbol))))
(aver (= sb-impl::package-id-bits 16))
(define-vop ()

10
tests/x86-64-codegen.impure.lisp
View file

@ -560,9 +560,13 @@
(disassemble f :stream string))
#\newline)))
(with-test (:name :peephole-optimizations-1)
(with-test (:name :peephole-optimizations-1 :skipped-on :sbcl)
;; The test does not check that both the load and the shift
;; have been sized as :dword instead of :qword, but it should.
;; have been sized as :dword instead of :qword, but it should
;; FIXME: this test was supposed to assert that
;; "AND r, -2 ; AND r, n" combines the two ANDs into one,
;; but there is no longer an AND in the symbol-hash vop
;; so I need to find a different test case.
(let ((f '(lambda (x)
;; eliminate arg count check, type check
(declare (optimize speed (safety 0)))
@ -573,6 +577,8 @@
(assert (= (count-assembly-lines instcombined)
(- (count-assembly-lines unoptimized) 1)))))
;; Likewise this was "AND RDX, -2 ; SAR RDX, 2 ; AND RDX, -2 ; AND RDX, 62"
;; becoming "SHR EDX, 2 ; AND EDX, 62"
(let ((f '(lambda (x)
;; eliminate arg count check, type check
(declare (optimize speed (safety 0)))

82
xperfecthash63.lisp-expr
View file

@ -2627,5 +2627,87 @@
(#(D5E7BDB 4499E855 61F4228E 76DB0CD0 922F453B)
"(SB-C::T0 SB-C::T1 SB-C::T2 SB-C::T3 SB-C::T4)"
"( (& (^ val (>> val 11)) 7))")
(#(0 7980B71D 7C678985 CD22F006)
"(NIL BASE-CHAR CHARACTER *)"
"( (& (+ val (>> val 6)) 3) )")
(#(0 10ACE44E 74748736 971A1DF1)
"(NIL FLOAT RATIONAL INTEGER)"
"( (& (>> val 5) 3) )")
(#(0 E022967D FB685091 FF5AE652)
"(NIL :HEAD :TAIL :BOTH)"
"( (& (>> val 14) 3) )")
(#(0 905F66AC 92586CF4 9D5025AF)
"(:SPECIAL-FORM :MACRO :FUNCTION NIL)"
"( (& (+ val (>> val 2)) 3) )")
(#(0 19627350 3932B57B C3C1E2DD)
"(NIL NOTINLINE MAYBE-INLINE INLINE)"
"( (& (>> val 8) 3) )")
(#(0 12D85B02 47ED28C7 568510D9 EC8EB822)
"(NIL :FORTHCOMING-DEFCLASS-TYPE :INSTANCE :DEFINED :PRIMITIVE)"
"( (& (^ (>> val 1) (>> val 8)) 7))")
(#(0 55E45869 62971997 8F406FFB)
"(:AUTO :IMMOBILE :DYNAMIC NIL)"
"( (& (>> val 3) 3) )")
(#(0 3C28E423 6610551C A1DFDD0E A55DBD6F)
"(:DELETED :INITIAL :COMPLEX-TOPLEVEL :TOPLEVEL NIL)"
"( (& (^ val (>> val 16)) 7))")
(#(0 8D87477C C8A25DB2 F987A176)
"(SB-C::INITIAL-UNUSED T SET NIL)"
"( (& (>> val 1) 3) )")
(#(0 83A45D5A 90B78E0C C8A25DB2)
"(:COMPUTE-ONLY :FORCE-TO-STACK NIL T)"
"( (& (>> val 3) 3) )")
(#(0 519DD3CE 55B0F9E6 70E7C178 92E00046)
"(:FIXED :KNOWN-RETURN :LOCAL-CALL :FULL-CALL NIL)"
"( (& (+ (>> val 1) (>> val 11)) 7))")
(#(0 60574E06 7BC3707A 7F9752D2)
"(:UNSPECIFIC :WILD :NEWEST NIL)"
"( (& (>> val 22) 3) )")
(#(0 60574E06 7F9752D2 ED8B5226)
"(:UNC :WILD :UNSPECIFIC NIL)"
"( (& (+ val (>> val 24)) 3) )")
(#(0 7A03BEDF 8E8B60F0 9D81B113 D8C1EE02 FBADBE01)
"(:NAMED :PREDICATE :COPIER :CONSTRUCTOR :CONC-NAME NIL)"
"( (& (^ (>> val 1) (>> val 7)) 7))")
(#(0 3E421619 42F9EC4F 52ECC4FA 53C6AF8C 546D436A D9F0FE17 E77DD8CF)
"(NIL :SUPERSEDE :APPEND :OVERWRITE :RENAME-AND-DELETE :RENAME :NEW-VERSION :ERROR)"
"( (& (- (>> val 2) (>> val 18)) 7))")
(#(0 B414EE0 3B3832EC A256D8C6 E3479BD2)
"(:KEY-OR-VALUE :KEY-AND-VALUE :VALUE :KEY NIL)"
"( (& (+ (>> val 1) (>> val 26)) 7))")
(#(0 C07E71ED E022967D E41ED3F1)
"(NIL :STRINGS :BOTH :SYMBOLS)"
"( (& (>> val 3) 3) )")
(#(0 90EDB7B 1FDE90F6 25164A63 50F5AB12 B800E558 C3EABF48)
"(:VERSION :TYPE :NAME :DIRECTORY :DEVICE :HOST NIL)"
"( (& (>> val 12) 7))")
(#(0 64688A38 B690AE2E D1146057 E0A39FB8)
"(:BYTE :WORD :DWORD :QWORD NIL)"
"( (& (^ val (>> val 22)) 7))")
(#(0 10ACE44E 2CFE05E6 3539E037 372E43BC 652FED0C 7C31AE8F 7C678985 965CD62A A0FAB3A5 B64902BB B6EC8FEB C8A25DB2 CD22F006
FF5C21D6)
"(T BASE-CHAR STANDARD-CHAR CHARACTER EXTENDED-CHAR BIT FIXNUM UNSIGNED-BYTE SIGNED-BYTE DOUBLE-FLOAT SINGLE-FLOAT MOD INTEGER COMPLEX NIL)"
"((let ((tab #a((8) (unsigned-byte 8) 13 2 0 5 12 0 5 14)))
(let ((b (& (>> val 19) #x7)))
(let ((a (>> (<< val 5) 29)))
(^ a (aref tab b))))))")
(#(0 70CB34EE A74C4D40 E29480A8 FF414202)
"(NIL LIST CONS VECTOR SIMPLE-VECTOR)"
"( (& (- (>> val 1) (>> val 6)) 7))")
(#(0 47ED28C7 7980B71D A4323F41 AE780BE9 C8A25DB2)
"(T * INSTANCE FUNCALLABLE-INSTANCE EXTENDED-SEQUENCE NIL)"
"( (& (+ (>> val 1) (>> val 27)) 7))")
(#(0 42F9EC4F 52ECC4FA 53C6AF8C 546D436A D9F0FE17 E77DD8CF)
"(:NEW-VERSION :ERROR NIL :RENAME :RENAME-AND-DELETE :SUPERSEDE :APPEND)"
"( (& (^ (>> val 4) (>> val 13)) 7))")
(#(0 50EDFBF1 6C16ABD3 AC25889A E8DC3557)
"(EQ EQL EQUAL EQUALP NIL)"
"( (& (^ (>> val 2) (>> val 13)) 7))")
(#(0 3D6EC19 326CF299 3A1DA026 8CD5B89F 92586CF4 A048B3D2 B7DA6CE4 EB29C836 F987A176)
"(EVAL FUNCTION SB-WALKER::TEST SB-WALKER::EFFECT RETURN QUOTE NIL SET LAMBDA SB-WALKER::CALL)"
"((let ((tab #a((8) (unsigned-byte 8) 8 5 4 0 2 0 0 13)))
(let ((b (& val #x7)))
(let ((a (>> (<< val 5) 29)))
(^ a (aref tab b))))))")
)
;; EOF