1.0.3.11: Fix deportation gc safety bug

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 9da5da1..d3096e8 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -358,10 +358,14 @@
             (default-structure-print object stream *current-level-in-print*))
            (t
             (write-string "#<INSTANCE but not STRUCTURE-OBJECT>" stream))))
+    (funcallable-instance
+     (cond
+       ((not (and (boundp '*print-object-is-disabled-p*)
+                  *print-object-is-disabled-p*))
+        (print-object object stream))
+       (t (output-fun object stream))))
     (function
-     (unless (and (funcallable-instance-p object)
-                  (printed-as-funcallable-standard-class object stream))
-       (output-fun object stream)))
+     (output-fun object stream))
     (symbol
      (output-symbol object stream))
     (number
@@ -1140,10 +1144,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 +1166,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 +1390,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 +1443,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 +1468,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)))))
 \f
 ;;;; other leaf objects
@@ -1463,7 +1476,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 +1531,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)