0.8alpha.0.13:

[sbcl.git] / src / code / print.lisp

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 0acd176..a6539ee 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1391,30 +1391,36 @@
 ;;; part of the computation to avoid over/under flow. When
 ;;; denormalized, we must pull out a large factor, since there is more
 ;;; negative exponent range than positive range.
+
+(eval-when (:compile-toplevel :execute)
+  (setf *read-default-float-format*
+       #!+long-float 'long-float #!-long-float 'double-float))
 (defun scale-exponent (original-x)
   (let* ((x (coerce original-x 'long-float)))
     (multiple-value-bind (sig exponent) (decode-float x)
       (declare (ignore sig))
-      (if (= x 0.0l0)
-         (values (float 0.0l0 original-x) 1)
-         (let* ((ex (round (* exponent (log 2l0 10))))
+      (if (= x 0.0e0)
+         (values (float 0.0e0 original-x) 1)
+         (let* ((ex (round (* exponent (log 2e0 10))))
                 (x (if (minusp ex)
                        (if (float-denormalized-p x)
                            #!-long-float
-                           (* x 1.0l16 (expt 10.0l0 (- (- ex) 16)))
+                           (* x 1.0e16 (expt 10.0e0 (- (- ex) 16)))
                            #!+long-float
-                           (* x 1.0l18 (expt 10.0l0 (- (- ex) 18)))
-                           (* x 10.0l0 (expt 10.0l0 (- (- ex) 1))))
-                       (/ x 10.0l0 (expt 10.0l0 (1- ex))))))
-           (do ((d 10.0l0 (* d 10.0l0))
+                           (* x 1.0e18 (expt 10.0e0 (- (- ex) 18)))
+                           (* x 10.0e0 (expt 10.0e0 (- (- ex) 1))))
+                       (/ x 10.0e0 (expt 10.0e0 (1- ex))))))
+           (do ((d 10.0e0 (* d 10.0e0))
                 (y x (/ x d))
                 (ex ex (1+ ex)))
-               ((< y 1.0l0)
-                (do ((m 10.0l0 (* m 10.0l0))
+               ((< y 1.0e0)
+                (do ((m 10.0e0 (* m 10.0e0))
                      (z y (* y m))
                      (ex ex (1- ex)))
-                    ((>= z 0.1l0)
+                    ((>= z 0.1e0)
                      (values (float z original-x) ex))))))))))
+(eval-when (:compile-toplevel :execute)
+  (setf *read-default-float-format* 'single-float))
 \f
 ;;;; entry point for the float printer