Skip to content
Snippets Groups Projects
Commit ceea5508 authored by ram's avatar ram
Browse files

Changed SXHASH to use the float-bits primitives instead of integer-decode-

float for hashing float, so that SXHASH don't gag on NaNs and infinities.
Also, fixed it to not EQ hash random objects, as that is illegal.
parent 90a2d4ce
No related branches found
No related tags found
No related merge requests found
...@@ -362,7 +362,7 @@ ...@@ -362,7 +362,7 @@
(eval-when (compile eval) (eval-when (compile eval)
(defconstant sxhash-bits-byte (byte 23 0))
(defconstant sxmash-total-bits 26) (defconstant sxmash-total-bits 26)
(defconstant sxmash-rotate-bits 7) (defconstant sxmash-rotate-bits 7)
...@@ -418,7 +418,7 @@ ...@@ -418,7 +418,7 @@
;; The pointers and immediate types. ;; The pointers and immediate types.
(list (sxhash-list s-expr depth)) (list (sxhash-list s-expr depth))
(fixnum (fixnum
(ldb (byte 23 0) s-expr)) (ldb sxhash-bits-byte s-expr))
#+nil #+nil
(structure ???) (structure ???)
;; Other-pointer types. ;; Other-pointer types.
...@@ -426,11 +426,20 @@ ...@@ -426,11 +426,20 @@
(symbol (sxhash-simple-string (symbol-name s-expr))) (symbol (sxhash-simple-string (symbol-name s-expr)))
(number (number
(etypecase s-expr (etypecase s-expr
(integer (ldb (byte 23 0) s-expr)) (integer (ldb sxhash-bits-byte s-expr))
(float (multiple-value-bind (significand exponent) (single-float
(integer-decode-float s-expr) (let ((bits (vm:single-float-bits s-expr)))
(logxor (the fixnum (ldb (byte 23 0) significand)) (ldb sxhash-bits-byte
(the fixnum (ldb (byte 23 0) exponent))))) (logxor (ash bits (- sxmash-rotate-bits))
bits))))
(double-float
(let* ((val s-expr)
(lo (vm:double-float-low-bits val))
(hi (vm:double-float-high-bits val)))
(ldb sxhash-bits-byte
(logxor (ash lo (- sxmash-rotate-bits))
(ash hi (- sxmash-rotate-bits))
lo hi))))
(ratio (the fixnum (+ (internal-sxhash (numerator s-expr) 0) (ratio (the fixnum (+ (internal-sxhash (numerator s-expr) 0)
(internal-sxhash (denominator s-expr) 0)))) (internal-sxhash (denominator s-expr) 0))))
(complex (the fixnum (+ (internal-sxhash (realpart s-expr) 0) (complex (the fixnum (+ (internal-sxhash (realpart s-expr) 0)
...@@ -442,4 +451,4 @@ ...@@ -442,4 +451,4 @@
#+nil #+nil
(compiled-function (%primitive header-length s-expr)) (compiled-function (%primitive header-length s-expr))
;; Everything else. ;; Everything else.
(t (%primitive make-fixnum s-expr)))) (t 42)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment