X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=7cd5d3692b8409b2455b1093be5e215f45d01c8e;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=a6539ee60258ddedc7a3aac4bd32ed5bff234370;hpb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index a6539ee..7cd5d36 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -66,9 +66,10 @@
    is less than this, then print using ``miser-style'' output. Miser
    style conditional newlines are turned on, and all indentations are
    turned off. If NIL, never use miser mode.")
-(defvar *print-pprint-dispatch* nil
-  #!+sb-doc
-  "the pprint-dispatch-table that controls how to pretty-print objects")
+(defvar *print-pprint-dispatch*)
+#!+sb-doc
+(setf (fdocumentation '*print-pprint-dispatch* 'variable)
+      "the pprint-dispatch-table that controls how to pretty-print objects")
 
 (defmacro with-standard-io-syntax (&body body)
   #!+sb-doc
@@ -596,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)
@@ -975,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)
@@ -1401,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
@@ -1418,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))