diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index b6297a054d0c1f5cd84cdfed773e0d8fe3794820..b826ab06d2aff5580c0e39acfddc2508060a0be1 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.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/srctran.lisp,v 1.127 2003/08/25 19:37:46 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.128 2003/08/31 19:03:46 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -356,13 +356,6 @@ (make-interval :low (bound-value (interval-low x)) :high (bound-value (interval-high x)))) -(defun signed-zero->= (x y) - (declare (real x y)) - (or (> x y) - (and (= x y) - (>= (float-sign (float x)) - (float-sign (float y)))))) - ;;; INTERVAL-RANGE-INFO ;;; ;;; For an interval X, if X >= POINT, return '+. If X <= POINT, return @@ -398,34 +391,44 @@ ('both (and (interval-low x) (interval-high x))))) -;;; Signed zero comparison functions. Use these functions if we need to -;;; distinguish between signed zeroes. +;;; Return the sign of the number, taking into account the sign of +;;; signed-zeros. An integer 0 has a positive sign here. +(declaim (inline number-sign)) +(defun number-sign (x) + (declare (real x)) + (cond ((integerp x) + (if (minusp x) -1.0 1.0)) + ((floatp x) + (float-sign x)))) -(defun signed-zero-< (x y) - (declare (real x y)) - (or (< x y) - (and (= x y) - (< (float-sign (float x)) - (float-sign (float y)))))) -(defun signed-zero-> (x y) - (declare (real x y)) - (or (> x y) - (and (= x y) - (> (float-sign (float x)) - (float-sign (float y)))))) +;;; Signed zero comparison functions. Use these functions if we need +;;; to distinguish between signed zeroes. Thus -0.0 < 0.0, which not +;;; true with normal Lisp comparison functions. (defun signed-zero-= (x y) (declare (real x y)) (and (= x y) - (= (float-sign (float x)) - (float-sign (float y))))) - -(defun signed-zero-<= (x y) - (declare (real x y)) - (or (< x y) - (and (= x y) - (<= (float-sign (float x)) - (float-sign (float y)))))) + (= (number-sign x) + (number-sign y)))) + + +(macrolet ((frob (name op1 op2) + `(defun ,name (x y) + (declare (real x y)) + ;; Comparison (op1) is true, or the numbers are EQUAL + ;; so we need to compare the signs of the numbers + ;; appropriately. + (or (,op1 x y) + (and (= x y) + ;; Convert the numbers to long-floats so we + ;; don't get problems converting to + ;; shorter floats from longer. + (,op2 (number-sign x) + (number-sign y))))))) + (frob signed-zero-< < <) + (frob signed-zero-> > >) + (frob signed-zero-<= < <=) + (frob signed-zero->= > >=)) ;;; INTERVAL-CONTAINS-P ;;;