X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=9d2ea8e7482972f459b632c9c405da4748c781e5;hb=ff6f7c4d82e5780cced4900561eaae2af0a24d06;hp=aa060d68030fe6184573d996fa6471c260d19234;hpb=15db88b169f732c8d339047bfad92e0725d7cacc;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index aa060d6..9d2ea8e 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1140,10 +1140,19 @@
         (t
          (multiple-value-bind (e string)
              (if fdigits
-                 (flonum-to-digits x (min (- fdigits) (- (or fmin 0))))
+                 (flonum-to-digits x (min (- (+ fdigits (or scale 0)))
+                                          (- (or fmin 0))))
                  (if (and width (> width 1))
-                     (let ((w (multiple-value-list (flonum-to-digits x (1- width) t)))
-                           (f (multiple-value-list (flonum-to-digits x (- (or fmin 0))))))
+                     (let ((w (multiple-value-list
+                               (flonum-to-digits x
+                                                 (max 1
+                                                      (+ (1- width)
+                                                         (if (and scale (minusp scale))
+                                                             scale 0)))
+                                                 t)))
+                           (f (multiple-value-list
+                               (flonum-to-digits x (- (+ (or fmin 0)
+                                                         (if scale scale 0)))))))
                        (cond
                          ((>= (length (cadr w)) (length (cadr f)))
                           (values-list w))
@@ -1153,11 +1162,13 @@
                  (stream (make-string-output-stream)))
              (if (plusp e)
                  (progn
-                   (write-string string stream :end (min (length string) e))
+                   (write-string string stream :end (min (length string)
+                                                         e))
                    (dotimes (i (- e (length string)))
                      (write-char #\0 stream))
                    (write-char #\. stream)
-                   (write-string string stream :start (min (length string) e))
+                   (write-string string stream :start (min (length
+                                                            string) e))
                    (when fdigits
                      (dotimes (i (- fdigits
                                     (- (length string)
@@ -1375,18 +1386,17 @@
 ;;; Print the appropriate exponent marker for X and the specified exponent.
 (defun print-float-exponent (x exp stream)
   (declare (type float x) (type integer exp) (type stream stream))
-  (let ((*print-radix* nil)
-        (plusp (plusp exp)))
+  (let ((*print-radix* nil))
     (if (typep x *read-default-float-format*)
         (unless (eql exp 0)
-          (format stream "e~:[~;+~]~D" plusp exp))
-        (format stream "~C~:[~;+~]~D"
+          (format stream "e~D" exp))
+        (format stream "~C~D"
                 (etypecase x
                   (single-float #\f)
                   (double-float #\d)
                   (short-float #\s)
                   (long-float #\L))
-                plusp exp))))
+                exp))))
 
 (defun output-float-infinity (x stream)
   (declare (float x) (stream stream))
@@ -1429,6 +1439,7 @@
         (print-float-exponent x 0 stream))
        (t
         (output-float-aux x stream -3 8)))))))
+
 (defun output-float-aux (x stream e-min e-max)
   (multiple-value-bind (e string)
       (flonum-to-digits x)
@@ -1453,8 +1464,6 @@
       (t (write-string string stream :end 1)
          (write-char #\. stream)
          (write-string string stream :start 1)
-         (when (= (length string) 1)
-           (write-char #\0 stream))
          (print-float-exponent x (1- e) stream)))))
 
 ;;;; other leaf objects