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)