diff --git a/code/format.lisp b/code/format.lisp
index 8f810d1b49f2d9e4da0a70ed4eaaa6a46a303964..7096bd923927deebc02bdde4100cb42b20a782f7 100644
--- a/code/format.lisp
+++ b/code/format.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/code/format.lisp,v 1.73 2007/10/09 16:11:54 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.74 2007/10/09 16:45:07 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1219,19 +1219,17 @@
 	    ;; This scale function is basically the same as the one in
 	    ;; FLONUM-TO-DIGITS, except we don't return the computed
 	    ;; digits.  We only want the exponent.
-	    (labels ((flog (v)
-		       (declare (optimize speed))
-		       ;; Compute (ceiling (- (log v 10d0) 1d-10))
-		       (ceiling (the (double-float -400d0 400d0)
-				  (- (log (the (double-float (0d0))
-					    (etypecase v
-					      (single-float
-					       (coerce v 'double-float))
-					      (double-float
-					       v)
-					      (double-double-float
-					       (double-double-hi v))))
-					  10d0)
+	    (labels ((flog (x)
+		       (declare (type (float (0.0)) x))
+		       (let ((xd (etypecase x
+				   (single-float
+				    (float x 1d0))
+				   (double-float
+				    x)
+				   #+double-double-float
+				   (double-double-float
+				    (double-double-hi x)))))
+			 (ceiling (- (the (double-float -400d0 400d0) (log xd 10d0))
 				     1d-10))))
 		     (fixup (r s m+ k)
 		       (if (if high-ok
@@ -1240,15 +1238,12 @@
 			   (+ k 1)
 			   k))
 		     (scale (r s m+)
-		       (declare (integer r s m+)
-				(optimize speed))
-		       (let ((est (flog v)))
+		       (let* ((est (flog v))
+			      (scale (the integer (aref lisp::*powers-of-ten* (abs est)))))
 			 (if (>= est 0)
-			     (fixup r (* s (the integer (aref lisp::*powers-of-ten* est))) m+ est)
-			     (let ((scale (the integer (aref lisp::*powers-of-ten* (- est)))))
-			       (fixup (* r scale) s (* m+ scale) est))))))
+			     (fixup r (* s scale) m+ est)
+			     (fixup (* r scale) s (* m+ scale) est)))))
 	      (let (r s m+)
-		(declare (optimize speed))
 		(if (>= e 0)
 		    (let* ((be (expt float-radix e))
 			   (be1 (* be float-radix)))
diff --git a/code/print.lisp b/code/print.lisp
index 6d0a2fc765677a2c276917d8ca9dce0f4705b857..4d4225b39d38090def46046c1f03c85a58a4fff8 100644
--- a/code/print.lisp
+++ b/code/print.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/code/print.lisp,v 1.113 2007/10/09 16:11:54 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.114 2007/10/09 16:45:07 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1838,6 +1838,8 @@ radix-R.  If you have a power-list then pass it in as PL."
 #+double-double
 (defconstant double-double-float-min-e double-float-min-e)
 
+;; Exact powers of ten.  Must be large enough to cover the range from
+;; least-positive-double-float to most-positive-double-float
 (declaim (type (simple-array integer (326)) *powers-of-ten*))
 (defparameter *powers-of-ten*
   (make-array 326
@@ -1881,18 +1883,30 @@ radix-R.  If you have a power-list then pass it in as PL."
 	    (low-ok (evenp f))
 	    (result (make-array 50 :element-type 'base-char
 				:fill-pointer 0 :adjustable t)))
-	(labels ((fixup (r s m+ m- k)
+	(labels ((flog (x)
+		   (declare (type (float (0.0)) x))
+		   (let ((xd (etypecase x
+			       (single-float
+				(float x 1d0))
+			       (double-float
+				x)
+			       #+double-double-float
+			       (double-double-float
+				(double-double-hi x)))))
+		     (ceiling (- (the (double-float -400d0 400d0) (log xd 10d0))
+				 1d-10))))
+		 (fixup (r s m+ m- k)
 		   (if (if high-ok
 			   (>= (+ r m+) s)
 			   (> (+ r m+) s))
 		       (values (+ k 1) (generate r (* s print-base) m+ m-))
 		       (values k (generate r s m+ m-))))
 		 (scale (r s m+ m-)
-		   (let ((est (ceiling (- (log v 10d0) 1d-10))))
+		   (let* ((est (flog v))
+			  (scale (the integer (aref lisp::*powers-of-ten* (abs est)))))
 		     (if (>= est 0)
-			 (fixup r (* s (aref *powers-of-ten* est)) m+ m- est)
-			 (let ((scale (aref *powers-of-ten* (- est))))
-			   (fixup (* r scale) s (* m+ scale) (* m- scale) est)))))
+			 (fixup r (* s scale) m+ m- est)
+			 (fixup (* r scale) s (* m+ scale) (* m- scale) est))))
 		 (generate (r s m+ m-)
 		   (multiple-value-bind (d r)
 		       (truncate (* r print-base) s)