fix Darwin/PPC build

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index a52648a..924000b 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1333,7 +1333,9 @@
                    (values-list w))
                   (t (values-list f))))
               (flonum-to-digits x)))
-    (let ((e (+ e (or scale 0)))
+    (let ((e (if (zerop x)
+                 e
+                 (+ e (or scale 0))))
           (stream (make-string-output-stream)))
       (if (plusp e)
           (progn
@@ -1351,7 +1353,10 @@
             (write-string "." stream)
             (dotimes (i (- e))
               (write-char #\0 stream))
-            (write-string string stream)
+            (write-string string stream :end (when fdigits
+                                               (min (length string)
+                                                    (max (or fmin 0)
+                                                         (+ fdigits e)))))
             (when fdigits
               (dotimes (i (+ fdigits e (- (length string))))
                 (write-char #\0 stream)))))
@@ -1729,15 +1734,15 @@
   nil)
 
 (defun output-fun (object stream)
-    (let* ((*print-length* 3)  ; in case we have to..
-           (*print-level* 3)  ; ..print an interpreted function definition
-           (name (%fun-name object))
-           (proper-name-p (and (legal-fun-name-p name) (fboundp name)
-                               (eq (fdefinition name) object))))
-      (print-unreadable-object (object stream :identity (not proper-name-p))
-        (format stream "~:[FUNCTION~;CLOSURE~]~@[ ~S~]"
-                (closurep object)
-                name))))
+  (let* ((*print-length* 4)  ; in case we have to..
+         (*print-level* 3)  ; ..print an interpreted function definition
+         (name (%fun-name object))
+         (proper-name-p (and (legal-fun-name-p name) (fboundp name)
+                             (eq (fdefinition name) object))))
+    (print-unreadable-object (object stream :identity (not proper-name-p))
+      (format stream "~:[FUNCTION~;CLOSURE~]~@[ ~S~]"
+              (closurep object)
+              name))))
 \f
 ;;;; catch-all for unknown things