X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprint.lisp;h=7b4d3fe1f754a3428584ebaff51e960f8e693323;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=4f3c28a1b97e6411e2a89aa6ad783891e1cd449b;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/print.lisp b/src/code/print.lisp
index 4f3c28a..7b4d3fe 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!IMPL")
-
-(file-comment
-  "$Header$")
 
 ;;;; exported printer control variables
 
@@ -559,13 +556,14 @@
 	  (write-char #\: stream))
 	 ;; Otherwise, if the symbol's home package is the current
 	 ;; one, then a prefix is never necessary.
-	 ((eq package *package*))
+	 ((eq package (sane-package)))
 	 ;; Uninterned symbols print with a leading #:.
 	 ((null package)
 	  (when (or *print-gensym* *print-readably*)
 	    (write-string "#:" stream)))
 	 (t
-	  (multiple-value-bind (symbol accessible) (find-symbol name *package*)
+	  (multiple-value-bind (symbol accessible)
+	      (find-symbol name (sane-package))
 	    ;; If we can find the symbol by looking it up, it need not
 	    ;; be qualified. This can happen if the symbol has been
 	    ;; inherited from a package other than its home package.
@@ -605,8 +603,6 @@
 (declaim (type (simple-array (unsigned-byte 16) (#.char-code-limit))
 	       *character-attributes*))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-
 ;;; Constants which are a bit-mask for each interesting character attribute.
 (defconstant other-attribute		(ash 1 0)) ; Anything else legal.
 (defconstant number-attribute		(ash 1 1)) ; A numeric digit.
@@ -618,9 +614,11 @@
 (defconstant slash-attribute		(ash 1 7)) ; /
 (defconstant funny-attribute		(ash 1 8)) ; Anything illegal.
 
-;;; LETTER-ATTRIBUTE is a local of SYMBOL-QUOTEP. It matches letters that
-;;; don't need to be escaped (according to READTABLE-CASE.)
-(defconstant attribute-names
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+;;; LETTER-ATTRIBUTE is a local of SYMBOL-QUOTEP. It matches letters
+;;; that don't need to be escaped (according to READTABLE-CASE.)
+(defparameter *attribute-names*
   `((number . number-attribute) (lowercase . lowercase-attribute)
     (uppercase . uppercase-attribute) (letter . letter-attribute)
     (sign . sign-attribute) (extension . extension-attribute)
@@ -691,9 +689,10 @@
 		       (the fixnum
 			    (logand
 			     (logior ,@(mapcar
-					#'(lambda (x)
-					    (or (cdr (assoc x attribute-names))
-						(error "Blast!")))
+					(lambda (x)
+					  (or (cdr (assoc x
+							  *attribute-names*))
+					      (error "Blast!")))
 					attributes))
 			     bits)))))
 	     (digitp ()
@@ -1036,8 +1035,8 @@
 
 (defun output-integer (integer stream)
   ;; FIXME: This UNLESS form should be pulled out into something like
-  ;; GET-REASONABLE-PRINT-BASE, along the lines of GET-REASONABLE-PACKAGE
-  ;; for the *PACKAGE* variable.
+  ;; (SANE-PRINT-BASE), along the lines of (SANE-PACKAGE) for the
+  ;; *PACKAGE* variable.
   (unless (and (fixnump *print-base*)
 	       (< 1 *print-base* 37))
     (let ((obase *print-base*))