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