From 8fb2433cfcd4477eecf30c86fe6211f1d312f3ae Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Wed, 15 Apr 1998 01:29:59 +0000 Subject: [PATCH] Kahan says (sqrt -0.0) returns -0.0. --- code/irrat.lisp | 5 ++--- compiler/float-tran.lisp | 8 +++----- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/code/irrat.lisp b/code/irrat.lisp index 3feaf8764..1305d5834 100644 --- a/code/irrat.lisp +++ b/code/irrat.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/irrat.lisp,v 1.27 1998/02/24 18:18:17 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/irrat.lisp,v 1.28 1998/04/15 01:29:57 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -379,8 +379,7 @@ (complex-sqrt number) (coerce (%sqrt (coerce number 'double-float)) 'single-float))) (((foreach single-float double-float)) - (if (< (float-sign number) - (coerce 0 '(dispatch-type number))) + (if (minusp number) (complex-sqrt number) (coerce (%sqrt (coerce number 'double-float)) '(dispatch-type number)))) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 5d05c17ba..d43b35962 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.68 1998/03/30 03:05:52 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.69 1998/04/15 01:29:59 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -675,10 +675,8 @@ (frob acos (specifier-type '(real -1d0 1d0)) 0 pi :increasingp nil) (frob acosh (specifier-type '(real 1d0)) nil nil) (frob atanh (specifier-type '(real -1d0 1d0)) -1 1) - (frob sqrt (specifier-type - #-negative-zero-is-not-zero '(or (member 0f0 0d0) - (real (0d0))) - #+negative-zero-is-not-zero '(real 0d0)) + (frob sqrt (specifier-type #-negative-zero-is-not-zero '(real 0d0) + #+negative-zero-is-not-zero '(real -0d0)) 0 nil)) ;;; Compute bounds for (expt x y). This should be easy since (expt x -- GitLab