From 6146fa3d75b793ceb21112bfcdbee1471b2722c4 Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Sat, 24 Jan 1998 14:49:23 +0000 Subject: [PATCH] Fix for elfun-derive-type-simple which was incorrectly deriving a single-float result for a real argument whereas the result type should have been a float in this case; only for a rational argument can will the result type be a single-float. This in turn fixes the mis-compiling of some maths functions, for example (exp #C(0d0 1d0)) was returning garbage. Fix a similar problem in the cis derive-type optimizer, however the fix doesn't special case rational arguments, always defaulting to a float. --- compiler/float-tran.lisp | 45 +++++++++++++++++++++++++++++++--------- 1 file changed, 35 insertions(+), 10 deletions(-) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 163465a19..91ecdf4bc 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.59 1998/01/05 05:54:55 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.60 1998/01/24 14:49:23 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -615,14 +615,39 @@ (let ((lo (numeric-type-low arg)) (hi (numeric-type-high arg))) (if (csubtypep arg cspec) - (let ((f-type (or (numeric-type-format arg) 'single-float))) - (make-numeric-type - :class 'float - :format f-type - :low (or (bound-func fcn lo) - (and default-lo (coerce default-lo f-type))) - :high (or (bound-func fcn hi) - (and default-hi (coerce default-hi f-type))))) + (let ((res-lo (bound-func fcn lo)) + (res-hi (bound-func fcn hi))) + (if (csubtypep arg (specifier-type 'rational)) + ;; For a rational argument the default result + ;; type is a single-float. + (let ((f-type (or (numeric-type-format arg) + 'single-float))) + (make-numeric-type + :class 'float + :format f-type + :low (or res-lo + (and default-lo + (coerce default-lo f-type))) + :high (or res-hi + (and default-hi + (coerce default-hi f-type))))) + ;; However for a real argument the default + ;; result type is a float. + (make-numeric-type + :class 'float + :format (numeric-type-format arg) + :low (or res-lo + (when default-lo + (if (numeric-type-format arg) + (coerce default-lo + (numeric-type-format arg)) + default-lo))) + :high (or res-hi + (when default-hi + (if (numeric-type-format arg) + (coerce default-hi + (numeric-type-format arg)) + default-hi)))))) (float-or-complex-type arg)))) (t (float-or-complex-type arg default-lo default-hi)))))) @@ -1265,7 +1290,7 @@ (one-arg-derive-type num #'(lambda (arg) (c::specifier-type - `(complex ,(or (numeric-type-format arg) 'single-float)))) + `(complex ,(or (numeric-type-format arg) 'float)))) #'cis)) ) ; end progn -- GitLab