0.8.8.13:

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

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 48889e5..0989d83 100644 (file)
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -597,7 +597,7 @@
 ;;; words, diddle its case according to *PRINT-CASE* and
 ;;; READTABLE-CASE.
 (defun output-symbol-name (name stream &optional (maybe-quote t))
-  (declare (type simple-base-string name))
+  (declare (type simple-string name))
   (setup-printer-state)
   (if (and maybe-quote (symbol-quotep name))
       (output-quoted-symbol-name name stream)
@@ -976,7 +976,7 @@
           (write-char (if (zerop bit) #\0 #\1) stream)))
        (t
         (when (and *print-readably*
-                   (not (array-readably-printable-p array)))
+                   (not (array-readably-printable-p vector)))
           (error 'print-not-readable :object vector))
         (descend-into (stream)
                       (write-string "#(" stream)
@@ -1163,8 +1163,8 @@
       (2 (write-char #\b stream))
       (8 (write-char #\o stream))
       (16 (write-char #\x stream))
-      (t (write *print-base* :stream stream :radix nil :base 10)))
-    (write-char #\r stream))
+      (t (write *print-base* :stream stream :radix nil :base 10)
+        (write-char #\r stream))))
   (let ((*print-radix* nil))
     (output-integer (numerator ratio) stream)
     (write-char #\/ stream)
@@ -1402,7 +1402,9 @@
       (declare (ignore sig))
       (if (= x 0.0e0)
          (values (float 0.0e0 original-x) 1)
-         (let* ((ex (round (* exponent (log 2e0 10))))
+         (let* ((ex (locally (declare (optimize (safety 0)))
+                       (the fixnum
+                         (round (* exponent (log 2e0 10))))))
                 (x (if (minusp ex)
                        (if (float-denormalized-p x)
                            #!-long-float
@@ -1419,7 +1421,9 @@
                      (z y (* y m))
                      (ex ex (1- ex)))
                     ((>= z 0.1e0)
-                     (values (float z original-x) ex))))))))))
+                     (values (float z original-x) ex))
+                   (declare (long-float m) (integer ex))))
+              (declare (long-float d))))))))
 (eval-when (:compile-toplevel :execute)
   (setf *read-default-float-format* 'single-float))
 \f