X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=c17846b9e0b1f5828c0a61be02c8d9de9c8ee881;hb=22e18896b53b0af44b1e18f885c943f6c3e50d01;hp=9da5da1238815ce297ebf852c0c875038d951910;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 9da5da1..c17846b 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
@@ -1463,7 +1472,8 @@
 ;;; the character name or the character in the #\char format.
 (defun output-character (char stream)
   (if (or *print-escape* *print-readably*)
-      (let ((graphicp (graphic-char-p char))
+      (let ((graphicp (and (graphic-char-p char)
+                           (standard-char-p char)))
             (name (char-name char)))
         (write-string "#\\" stream)
         (if (and name (not graphicp))
@@ -1517,7 +1527,7 @@
 ;;; The definition here is a simple temporary placeholder. It will be
 ;;; overwritten by a smarter version (capable of calling generic
 ;;; PRINT-OBJECT when appropriate) when CLOS is installed.
-(defun printed-as-clos-funcallable-standard-class (object stream)
+(defun printed-as-funcallable-standard-class (object stream)
   (declare (ignore object stream))
   nil)