From 323d722fd0b3ec0c0d914810537f615cd357aacf Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Thu, 13 Jan 2000 16:53:33 +0000 Subject: [PATCH] Modify the sxhash double-float and long-float functions to allow them to be compiled to fast native code, and to make use of the sign bit. Fix and update the sxhash double-float transform to be consistent. Add a transform for the sxhash of long-floats. --- code/hash-new.lisp | 35 ++++++++++++++++------------------- code/hash.lisp | 28 +++++++++++++++++++--------- compiler/generic/vm-tran.lisp | 30 ++++++++++++++++++++---------- 3 files changed, 55 insertions(+), 38 deletions(-) diff --git a/code/hash-new.lisp b/code/hash-new.lisp index f19264705..802701570 100644 --- a/code/hash-new.lisp +++ b/code/hash-new.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.5 1999/12/04 16:02:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.6 2000/01/13 16:53:23 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -901,29 +901,26 @@ (single-float (let ((bits (single-float-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash bits (- sxmash-rotate-bits)) - bits)))) + (logxor (ash bits (- sxmash-rotate-bits)) bits)))) (double-float - (let* ((val s-expr) - (lo (double-float-low-bits val)) - (hi (ldb sxhash-bits-byte (double-float-high-bits val)))) + (let ((lo (double-float-low-bits s-expr)) + (hi (double-float-high-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash lo (- sxmash-rotate-bits)) - (ash hi (- sxmash-rotate-bits)) - lo hi)))) + (logxor (ash lo (- sxmash-rotate-bits)) lo + (ldb sxhash-bits-byte + (logxor (ash hi (- sxmash-rotate-bits)) hi)))))) #+long-float (long-float - (let* ((val s-expr) - (lo (long-float-low-bits val)) - #+sparc (mid (long-float-mid-bits val)) - (hi (long-float-high-bits val)) - (exp (long-float-exp-bits val))) + (let ((lo (long-float-low-bits s-expr)) + #+sparc (mid (long-float-mid-bits s-expr)) + (hi (long-float-high-bits s-expr)) + (exp (long-float-exp-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash lo (- sxmash-rotate-bits)) - #+sparc (ash mid (- sxmash-rotate-bits)) - (ash hi (- sxmash-rotate-bits)) - (ash exp (- sxmash-rotate-bits)) - lo hi exp)))) + (logxor (ash lo (- sxmash-rotate-bits)) lo + #+sparc (ash mid (- sxmash-rotate-bits)) #+sparc mid + (ash hi (- sxmash-rotate-bits)) hi + (ldb sxhash-bits-byte + (logxor (ash exp (- sxmash-rotate-bits)) exp)))))) (ratio (logxor (internal-sxhash (numerator s-expr) 0) (internal-sxhash (denominator s-expr) 0))) (complex (logxor (internal-sxhash (realpart s-expr) 0) diff --git a/code/hash.lisp b/code/hash.lisp index c0a544728..37351fd21 100644 --- a/code/hash.lisp +++ b/code/hash.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.29 1994/10/31 04:11:27 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.30 2000/01/13 16:53:24 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -870,16 +870,26 @@ (single-float (let ((bits (single-float-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash bits (- sxmash-rotate-bits)) - bits)))) + (logxor (ash bits (- sxmash-rotate-bits)) bits)))) (double-float - (let* ((val s-expr) - (lo (double-float-low-bits val)) - (hi (ldb sxhash-bits-byte (double-float-high-bits val)))) + (let ((lo (double-float-low-bits s-expr)) + (hi (double-float-high-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash lo (- sxmash-rotate-bits)) - (ash hi (- sxmash-rotate-bits)) - lo hi)))) + (logxor (ash lo (- sxmash-rotate-bits)) lo + (ldb sxhash-bits-byte + (logxor (ash hi (- sxmash-rotate-bits)) hi)))))) + #+long-float + (long-float + (let ((lo (long-float-low-bits s-expr)) + #+sparc (mid (long-float-mid-bits s-expr)) + (hi (long-float-high-bits s-expr)) + (exp (long-float-exp-bits s-expr))) + (ldb sxhash-bits-byte + (logxor (ash lo (- sxmash-rotate-bits)) lo + #+sparc (ash mid (- sxmash-rotate-bits)) #+sparc mid + (ash hi (- sxmash-rotate-bits)) hi + (ldb sxhash-bits-byte + (logxor (ash exp (- sxmash-rotate-bits)) exp)))))) (ratio (logxor (internal-sxhash (numerator s-expr) 0) (internal-sxhash (denominator s-expr) 0))) (complex (logxor (internal-sxhash (realpart s-expr) 0) diff --git a/compiler/generic/vm-tran.lisp b/compiler/generic/vm-tran.lisp index b4cf9d140..2c15eba38 100644 --- a/compiler/generic/vm-tran.lisp +++ b/compiler/generic/vm-tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.37 1999/09/06 06:49:28 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-tran.lisp,v 1.38 2000/01/13 16:53:33 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -331,18 +331,28 @@ (deftransform sxhash ((s-expr) (single-float)) '(let ((bits (single-float-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash bits (- sxmash-rotate-bits)) - bits)))) + (logxor (ash bits (- sxmash-rotate-bits)) bits)))) (deftransform sxhash ((s-expr) (double-float)) - '(let* ((val s-expr) - (lo (double-float-low-bits val)) - (hi (double-float-high-bits val))) + '(let* ((lo (double-float-low-bits s-expr)) + (hi (double-float-high-bits s-expr))) (ldb sxhash-bits-byte - (logxor (ash lo (- sxmash-rotate-bits)) - (ash hi (- sxmash-rotate-bits)) - lo hi)))) - + (logxor (ash lo (- sxmash-rotate-bits)) lo + (ldb sxhash-bits-byte + (logxor (ash hi (- sxmash-rotate-bits)) hi)))))) + +#+long-float +(deftransform sxhash ((s-expr) (long-float)) + '(let* ((lo (long-float-low-bits s-expr)) + #+sparc (mid (long-float-mid-bits s-expr)) + (hi (long-float-high-bits s-expr)) + (exp (long-float-exp-bits s-expr))) + (ldb sxhash-bits-byte + (logxor (ash lo (- sxmash-rotate-bits)) lo + #+sparc (ash mid (- sxmash-rotate-bits)) #+sparc mid + (ash hi (- sxmash-rotate-bits)) hi + (ldb sxhash-bits-byte + (logxor (ash exp (- sxmash-rotate-bits)) exp)))))) ;;;; Float EQL transforms. -- GitLab