diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp index 1ee030bd0cd2e14673aa47e0f1f22b437a63c0ff..3df41f4b89f4332f5e9a9a6bb171a0700c71c71d 100644 --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -2031,29 +2031,33 @@ (labels ((calc-exp (x) (when x - (nth-value 1 (decode-float x)))) - (min-exp () - ;; Use decode-float on the least positive float of the - ;; appropriate type to find the min exponent. If we don't - ;; know the actual number format, use double, which has the - ;; widest range (including double-double-float). - (calc-exp (if (eq 'single-float (numeric-type-format arg)) - least-positive-single-float - least-positive-double-float))) - (max-exp () + (bound-func #'(lambda (arg) + (nth-value 1 (decode-float arg))) + x))) + (min-exp (interval) + ;; (decode-float 0d0) returns an exponent of -1022. But + ;; (decode-float least-positive-double-float returns -1073. + ;; Hence, if the low value is less than this, we need to + ;; return the exponent of the least positive number. + (let ((least (if (eq 'single-float (numeric-type-format arg)) + least-positive-single-float + least-positive-double-float))) + (if (or (interval-contains-p 0 interval) + (interval-contains-p least interval)) + (calc-exp least) + (calc-exp (bound-value (interval-low interval)))))) + (max-exp (interval) ;; Use decode-float on the most postive number of the ;; appropriate type to find the max exponent. If we don't ;; know the actual number format, use double, which has the ;; widest range (including double-double-float). - (calc-exp (if (eq 'single-float (numeric-type-format arg)) - most-positive-single-float - most-positive-double-float)))) - (let* ((interval (interval-func #'calc-exp - (interval-abs (numeric-type->interval arg)))) - (lo (or (interval-low interval) - (min-exp))) - (hi (or (interval-high interval) - (max-exp)))) + (or (calc-exp (bound-value (interval-high interval))) + (calc-exp (if (eq 'single-float (numeric-type-format arg)) + most-positive-single-float + most-positive-double-float))))) + (let* ((interval (interval-abs (numeric-type->interval arg))) + (lo (min-exp interval)) + (hi (max-exp interval))) (specifier-type `(integer ,(or lo '*) ,(or hi '*)))))) (defun decode-float-sign-derive-type-aux (arg)