From 6e131f5fa6e97cdc94fdb2ad29ad50f9ebd96f62 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 12 Jul 2005 18:23:26 +0000
Subject: [PATCH] The FTRUNCATE derive-type optimizer was not correctly
 deriving the result if -0.0 could be returned.  This causes the misc.558
 ansi-test to fail.

We should do something better than this fix.
---
 compiler/srctran.lisp | 40 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 35 insertions(+), 5 deletions(-)

diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index f0340e059..08ace655d 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.156 2005/04/23 15:04:09 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.157 2005/07/12 18:23:26 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1681,6 +1681,11 @@
   ;; The bounds are the same as for truncate.  However, the first
   ;; result is a float of some type.  We need to determine what that
   ;; type is.  Basically it's the more contagious of the two types.
+  ;;
+  ;; FIXME: Now that ftruncate returns signed zeroes, we should do
+  ;; something better than calling truncate-derive-type-quot to figure
+  ;; out the result and massaging that to get the correct float
+  ;; result.
   (let* ((q-type (truncate-derive-type-quot number-type divisor-type))
 	 (res-type (numeric-contagion number-type divisor-type))
 	 (res-format (numeric-type-format res-type)))
@@ -1693,10 +1698,35 @@
 	     (if (numberp x)
 		 (coerce x (or res-format 'float))
 		 x)))
-      (make-numeric-type :class 'float
-			 :format res-format
-			 :low (floatify-bound (numeric-type-low q-type))
-			 :high (floatify-bound (numeric-type-high q-type))))))
+      (let ((q-lo (floatify-bound (numeric-type-low q-type)))
+	    (q-hi (floatify-bound (numeric-type-high q-type))))
+	;; We need to be careful if q-type contains zero.  Why?
+	;; Because ftruncate returns signed zeroes.  See GCL
+	;; ansi-tests misc.558 for an example:
+	;;
+	;; (defun misc-558 (p1)
+	;;   (declare (optimize (speed 1) (safety 2) (debug 2)
+	;;                      (space 3))
+	;; 	   (type (eql -39466.56) p1))
+	;;   (ffloor p1 305598613))
+	;; 
+	(when (csubtypep (specifier-type '(integer 0 0)) q-type)
+	  ;; The quotient contains 0.  We really only have a problem
+	  ;; if one of the end points is zero.  
+	  (cond ((and q-lo (zerop q-lo))
+		 ;; We should only include -0.0 if the result really
+		 ;; could be -0.0, but we're lazy right now and just
+		 ;; force it.  The interval is very slightly larger
+		 ;; than the true interval.
+		 (setq q-lo (float -0d0 q-lo)))
+		((and q-hi (zerop q-hi))
+		 ;; This probably isn't needed because 0 is converted
+		 ;; to +0.0, which is the upper bound we want.
+		 (setq q-hi (float 0d0 q-hi)))))
+	(make-numeric-type :class 'float
+			   :format res-format
+			   :low q-lo
+			   :high q-hi)))))
 
 (defun ftruncate-derive-type-quot-aux (n d same-arg)
   (declare (ignore same-arg))
-- 
GitLab