Add #+salted-symbol-hash to 32-bit x86 config

Only 3 bits available for randomness without robbing from the name hash bits,
reducing SXHASH range and messing up xperfecthash30. Better than nothing.

crossbuild-runner/backends/x86/features

@@ -6,3 +6,4 @@
 :alien-callbacks
 :cycle-counter
 :fp-and-pc-standard-save
+:salted-symbol-hash

src/code/cross-sxhash.lisp

@@ -58,8 +58,9 @@
              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))
+  #-salted-symbol-hash `(symbol-hash ,s)
+  #+(and salted-symbol-hash 64-bit) `(let ((h (symbol-name-hash ,s))) (sb-int:mix h h))
+  #+(and salted-symbol-hash (not 64-bit)) `(symbol-name-hash ,s))
 ) ; end EVAL-WHEN
 
 (defun calc-symbol-name-hash (string length)

src/code/symbol.lisp

@@ -412,14 +412,21 @@ 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)))))
+    #-salted-symbol-hash (%set-symbol-hash symbol name-hash)
     #+salted-symbol-hash
-    (let* ((salt (murmur-hash-word/fixnum
-                  (word-mix name-hash (get-lisp-obj-address symbol))))
-           (hash (logior (ash name-hash 32) (mask-field symbol-hash-prng-byte salt))))
+    (let ((salt (murmur-hash-word/fixnum
+                 (word-mix name-hash (get-lisp-obj-address symbol)))))
+      #+64-bit
+      (let ((hash (logior (ash name-hash 32) (mask-field symbol-hash-prng-byte 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)
+      #-64-bit
+      (with-pinned-objects (symbol) ; no vop sets the raw slot
+        (setf (sap-ref-32 (int-sap (get-lisp-obj-address symbol))
+                          (- (ash sb-vm:symbol-hash-slot sb-vm:word-shift)
+                             sb-vm:other-pointer-lowtag))
+              (logior (ash name-hash 3) (ldb (byte 3 0) salt)))))
     ;; 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)

src/compiler/generic/genesis.lisp

@@ -1145,15 +1145,17 @@ core and return a descriptor to it."
 (defun assign-symbol-hash (descriptor wordindex name)
   ;; "why not just call sb-c::symbol-name-hash?" you ask? because: no symbol.
   (let ((name-hash (sb-c::calc-symbol-name-hash name (length name))))
-    #+64-bit
-    ;; Low 4 bytes to high 4 bytes of slot, plus salt the hash any way you want
-    ;; as long as the build is reproducible.
+    #-salted-symbol-hash
+    (write-wordindexed descriptor wordindex (make-fixnum-descriptor name-hash))
+    #+salted-symbol-hash
     (let* ((salt (sb-impl::murmur3-fmix-word (descriptor-bits descriptor)))
-           (hash (logior (ash name-hash 32)
-                         (mask-field sb-impl::symbol-hash-prng-byte salt))))
-      (write-wordindexed/raw descriptor wordindex hash))
-    #-64-bit
-    (write-wordindexed descriptor wordindex (make-fixnum-descriptor name-hash))))
+           (prng-byte sb-impl::symbol-hash-prng-byte)
+           ;; 64-bit: Low 4 bytes to high 4 bytes of slot
+           ;; 32-bit: name-hash to high 29 bits
+           ;; plus salt the hash any way you want as long as the build is reproducible.
+           (name-hash-pos (+ (byte-size prng-byte) (byte-position prng-byte)))
+           (hash (logior (ash name-hash name-hash-pos) (mask-field prng-byte salt))))
+      (write-wordindexed/raw descriptor wordindex hash))))
 
 ;;; Allocate (and initialize) a symbol.
 ;;; Even though all symbols are the same size now, I still envision the possibility

src/compiler/generic/objdef.lisp

@@ -442,7 +442,8 @@ during backtrace.
         :init :null)
   (name :init :arg :ref-trans symbol-name)
   ;; The remaining slots can be ignored by GC
-  (hash :set-trans %set-symbol-hash :ref-trans symbol-hash)
+  #+salted-symbol-hash (hash)
+  #-salted-symbol-hash (hash :set-trans %set-symbol-hash :ref-trans symbol-hash)
   (package-id :type index ; actually 16 bits. (Could go in the header)
               :ref-trans symbol-package-id
               :set-trans sb-impl::set-symbol-package-id :set-known ())

src/compiler/generic/parms.lisp

@@ -426,6 +426,7 @@
        (defconstant-eqx sb-impl::symbol-hash-prng-byte
          (byte n-symbol-hash-prng-bits (- 32 n-symbol-hash-prng-bits))
          #'equal))
+#-64-bit (defconstant-eqx sb-impl::symbol-hash-prng-byte (byte 3 0) #'equal)
 
 (push '("SB-VM" +c-callable-fdefns+ +common-static-symbols+)
       *!removable-symbols*)

src/compiler/x86/cell.lisp

@@ -204,6 +204,24 @@
     (inst cmp (object-slot-ea object symbol-value-slot
                                        other-pointer-lowtag)
           unbound-marker-widetag)))
+
+(define-vop (symbol-hash)
+  (:policy :fast-safe)
+  (:translate symbol-hash)
+  (:args (symbol :scs (descriptor-reg)))
+  (:results (res :scs (unsigned-reg)))
+  (:result-types positive-fixnum)
+  (:generator 2
+    (loadw res symbol symbol-hash-slot other-pointer-lowtag)
+    ;; include the low 3 random bits but ensure res is a HASH-CODE
+    (inst and res (ldb (byte sb-vm:n-positive-fixnum-bits 0) -1))))
+
+(define-vop (symbol-name-hash symbol-hash)
+  (:translate symbol-name-hash)
+  (:generator 1
+    (loadw res symbol symbol-hash-slot other-pointer-lowtag)
+    ;; shift out the low 3 random bits
+    (inst shr res 3)))
 
 ;;;; fdefinition (FDEFN) objects
 

tests/symbol.pure.lisp

@@ -117,8 +117,13 @@
     (values (/ n-well-hashed-sets n-homograph-sets)
             result)))
 
-(with-test (:name :hashing-improvements :skipped-on (not :64-bit))
-  (assert (> (summarize-colliding-hashes nil) .95)))
+(with-test (:name :hashing-improvements :skipped-on (not :salted-symbol-hash))
+  ;; Roughly: For each set of symbols colliding on SXHASH at all, what fraction
+  ;; of those sets do NOT have any collisions on SYMBOL-HASH.
+  (let ((expectation
+         #+64-bit .95
+         #+x86 .70))
+    (assert (> (summarize-colliding-hashes nil) expectation))))
 
 (with-test (:name :fast-slot-name-mapper-small)
   ;; The XSET type has only2 slots, does not get a compiled function
@@ -130,7 +135,7 @@
 
 (with-test (:name :fast-slot-name-mapper-big)
   (let ((collision-sets
-         #+salted-symbol-hash ; equivalently #+64-bit
+         #+salted-symbol-hash
           (nth-value 1 (summarize-colliding-hashes nil))
          ;; Require at least 4 different sets of colliding symbols,
          ;; Needless to say, this hashes horribly, with some sets