From a71e3e77108d785ed09229887aa0420c2ad17466 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 18 Jun 2004 18:18:12 +0000 Subject: [PATCH] o Fix a misplaced declaration in %unary-ftruncate/single-float o Update %unary-ftruncate and the corresponding deftransform because it was not properly returning the correct sign for signed zeroes. If the number was in a good range, we used truncate, which loses the sign of zero. (Should we have leave it in and add an explicit check for a zero result and adjust the sign appropriately? That would allow us to use the fast builtin instructions at the expense of a test for zero and a fix.) --- code/float.lisp | 16 ++++------------ compiler/float-tran.lisp | 23 +++++------------------ 2 files changed, 9 insertions(+), 30 deletions(-) diff --git a/code/float.lisp b/code/float.lisp index c41b612b3..1078c2816 100644 --- a/code/float.lisp +++ b/code/float.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/float.lisp,v 1.29 2004/06/09 14:46:11 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.30 2004/06/18 18:18:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1077,6 +1077,7 @@ rounding modes & do ieee round-to-integer. (exp (ldb vm:single-float-exponent-byte bits)) (biased (truly-the kernel:single-float-exponent (- exp vm:single-float-bias)))) + (declare (type (signed-byte 32) bits)) ;; At this point, we have the number represented as ;; ;; x = sign * 2^exp * frac @@ -1105,7 +1106,6 @@ rounding modes & do ieee round-to-integer. ;; Somewhere in between. Zap the bits that ;; represent the fraction part. (let ((frac-bits (- (float-digits x) biased))) - (declare (type (signed-byte 32) bits)) (setf bits (logandc2 bits (- (ash 1 frac-bits) 1))) (kernel:make-single-float bits)))))) @@ -1158,23 +1158,15 @@ rounding modes & do ieee round-to-integer. ;;; to be a (signed-byte 32). ;;; (defun %unary-ftruncate (number) - (macrolet ((truncate-float (rtype helper) - `(if (< (float (- (- (ash 1 31)) 1) number) - number - (float (ash 1 31) number)) - (coerce (truly-the (signed-byte 32) - (%unary-truncate number)) - ',rtype) - (,helper number)))) (number-dispatch ((number real)) ((integer) (float number)) ((ratio) (float (truncate (numerator number) (denominator number)))) ((single-float) - (truncate-float single-float %unary-ftruncate/single-float)) + (%unary-ftruncate/single-float number)) ((double-float) - (truncate-float double-float %unary-ftruncate/double-float))))) + (%unary-ftruncate/double-float number)))) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 2e73790d1..ca1aa9d4a 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-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/float-tran.lisp,v 1.97 2004/01/10 05:01:41 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.98 2004/06/18 18:18:12 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -118,26 +118,13 @@ (movable foldable flushable)) ;; Convert %unary-ftruncate to unary-ftruncate/{single,double}-float -;; if x is known to be of the right type. Also, if the result is -;; known to fit in the same range as a (signed-byte 32), convert this -;; to %unary-truncate, which might be a single instruction, and float -;; the result. However, for sparc, we have a vop to do this so call -;; that, and for Sparc V9, we can actually handle a 64-bit integer -;; range. +;; if x is known to be of the right type. Note that we used to do a +;; range-check here to see if we could use the FP conversion +;; instructions, but that loses when we have signed zeroes. (macrolet ((frob (ftype func) `(deftransform %unary-ftruncate ((x) (,ftype)) - (let* ((x-type (continuation-type x)) - (lo (bound-value (numeric-type-low x-type))) - (hi (bound-value (numeric-type-high x-type))) - (limit-lo (- (ash 1 #-sparc-v9 31 #+sparc-v9 63))) - (limit-hi (ash 1 #-sparc-v9 31 #+sparc-v9 63))) - (if (and (numberp lo) (numberp hi) - (< limit-lo lo) - (< hi limit-hi)) - #-sparc '(coerce (%unary-truncate x) ',ftype) - #+sparc '(fast-unary-ftruncate x) - '(,func x)))))) + '(,func x)))) (frob single-float %unary-ftruncate/single-float) (frob double-float %unary-ftruncate/double-float)) -- GitLab