Skip to content
Snippets Groups Projects
Commit 74c2544a authored by rtoy's avatar rtoy
Browse files

Merge fix from HEAD to allow hashing of NaNs.

parent 524c7339
Branches
Tags
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.54 2010/04/20 17:57:44 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.54.4.1 2010/08/15 15:00:08 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -1016,13 +1016,19 @@ ...@@ -1016,13 +1016,19 @@
(single-float (single-float
;; CLHS says sxhash must return the same thing for +0.0 and ;; CLHS says sxhash must return the same thing for +0.0 and
;; -0.0. We get the desired result by adding +0.0, which ;; -0.0. We get the desired result by adding +0.0, which
;; converts -0.0 to 0.0. ;; converts -0.0 to 0.0. But if s-expr is NaN, we don't want
(let* ((x (+ s-expr 0f0)) ;; to signal an error from adding 0, so don't do it since it
;; we don't need to anyway.
(let* ((x (if (float-nan-p s-expr)
s-expr
(+ s-expr 0f0)))
(bits (single-float-bits x))) (bits (single-float-bits x)))
(ldb sxhash-bits-byte (ldb sxhash-bits-byte
(logxor (ash bits (- sxmash-rotate-bits)) bits)))) (logxor (ash bits (- sxmash-rotate-bits)) bits))))
(double-float (double-float
(let* ((x (+ s-expr 0d0)) (let* ((x (if (float-nan-p s-expr)
s-expr
(+ s-expr 0d0)))
(lo (double-float-low-bits x)) (lo (double-float-low-bits x))
(hi (double-float-high-bits x))) (hi (double-float-high-bits x)))
(ldb sxhash-bits-byte (ldb sxhash-bits-byte
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment