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