X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-package.lisp;h=9689b16d3a6311b6b157f64cde3aa78e948681bc;hb=1596e9fdeb2265c4a00e441bc8a1dbdc5364afa7;hp=074e43d2a8d163ab18bb611271f1548c663c33d2;hpb=ff92598854bf7cae8d57fe49cef4d9a98e1ab345;p=sbcl.git

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 074e43d..9689b16 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -34,29 +34,36 @@
   (declare (type stream stream))
   (print-unreadable-object (table stream :type t)
     (format stream
-	    ":SIZE ~S :FREE ~S :DELETED ~S"
-	    (package-hashtable-size table)
-	    (package-hashtable-free table)
-	    (package-hashtable-deleted table))))
+            ":SIZE ~S :FREE ~S :DELETED ~S"
+            (package-hashtable-size table)
+            (package-hashtable-free table)
+            (package-hashtable-deleted table))))
 
-;;; the maximum density we allow in a package hashtable
-(defconstant package-rehash-threshold 0.75)
+;;; the maximum load factor we allow in a package hashtable
+(defconstant +package-rehash-threshold+ 0.75)
+
+;;; the load factor desired for a package hashtable when writing a
+;;; core image
+(defconstant +package-hashtable-image-load-factor+ 0.5)
 
 ;;; Make a package hashtable having a prime number of entries at least
-;;; as great as (/ SIZE PACKAGE-REHASH-THRESHOLD). If RES is supplied,
+;;; as great as (/ SIZE +PACKAGE-REHASH-THRESHOLD+). If RES is supplied,
 ;;; then it is destructively modified to produce the result. This is
 ;;; useful when changing the size, since there are many pointers to
 ;;; the hashtable.
+;;; Actually, the smallest table built here has three entries. This
+;;; is necessary because the double hashing step size is calculated
+;;; using a division by the table size minus two.
 (defun make-or-remake-package-hashtable (size
-					 &optional
+                                         &optional
                                          res)
   (flet ((actual-package-hashtable-size (size)
            (loop for n of-type fixnum
-              from (logior (truncate size package-rehash-threshold) 1)
+              from (logior (ceiling size +package-rehash-threshold+) 1)
               by 2
               when (positive-primep n) return n)))
     (let* ((n (actual-package-hashtable-size size))
-           (size (truncate (* n package-rehash-threshold)))
+           (size (truncate (* n +package-rehash-threshold+)))
            (table (make-array n))
            (hash (make-array n
                              :element-type '(unsigned-byte 8)
@@ -69,38 +76,49 @@
                 (package-hashtable-deleted res) 0)
           (setf res (%make-package-hashtable table hash size)))
       res)))
+
+;;; Destructively resize TABLE to have room for at least SIZE entries
+;;; and rehash its existing entries.
+(defun resize-package-hashtable (table size)
+  (let* ((vec (package-hashtable-table table))
+         (hash (package-hashtable-hash table))
+         (len (length vec)))
+    (make-or-remake-package-hashtable size table)
+    (dotimes (i len)
+      (when (> (aref hash i) 1)
+        (add-symbol table (svref vec i))))))
 
 ;;;; package locking operations, built conditionally on :sb-package-locks
 
 #!+sb-package-locks
 (progn
-(defun package-locked-p (package) 
-  #!+sb-doc 
+(defun package-locked-p (package)
+  #!+sb-doc
   "Returns T when PACKAGE is locked, NIL otherwise. Signals an error
 if PACKAGE doesn't designate a valid package."
   (package-lock (find-undeleted-package-or-lose package)))
 
 (defun lock-package (package)
-  #!+sb-doc 
+  #!+sb-doc
   "Locks PACKAGE and returns T. Has no effect if PACKAGE was already
 locked. Signals an error if PACKAGE is not a valid package designator"
   (setf (package-lock (find-undeleted-package-or-lose package)) t))
 
 (defun unlock-package (package)
-  #!+sb-doc 
+  #!+sb-doc
   "Unlocks PACKAGE and returns T. Has no effect if PACKAGE was already
 unlocked. Signals an error if PACKAGE is not a valid package designator."
   (setf (package-lock (find-undeleted-package-or-lose package)) nil)
   t)
 
 (defun package-implemented-by-list (package)
-  #!+sb-doc 
+  #!+sb-doc
   "Returns a list containing the implementation packages of
 PACKAGE. Signals an error if PACKAGE is not a valid package designator."
   (package-%implementation-packages (find-undeleted-package-or-lose package)))
 
-(defun package-implements-list (package) 
-  #!+sb-doc 
+(defun package-implements-list (package)
+  #!+sb-doc
   "Returns the packages that PACKAGE is an implementation package
 of. Signals an error if PACKAGE is not a valid package designator."
   (let ((package (find-undeleted-package-or-lose package)))
@@ -108,28 +126,28 @@ of. Signals an error if PACKAGE is not a valid package designator."
           when (member package (package-%implementation-packages x))
           collect x)))
 
-(defun add-implementation-package (packages-to-add 
-				   &optional (package *package*))
-  #!+sb-doc 
+(defun add-implementation-package (packages-to-add
+                                   &optional (package *package*))
+  #!+sb-doc
   "Adds PACKAGES-TO-ADD as implementation packages of PACKAGE. Signals
 an error if PACKAGE or any of the PACKAGES-TO-ADD is not a valid
 package designator."
   (let ((package (find-undeleted-package-or-lose package))
-	(packages-to-add (package-listify packages-to-add)))
+        (packages-to-add (package-listify packages-to-add)))
     (setf (package-%implementation-packages package)
           (union (package-%implementation-packages package)
                  (mapcar #'find-undeleted-package-or-lose packages-to-add)))))
 
-(defun remove-implementation-package (packages-to-remove 
-				      &optional (package *package*)) 
-  #!+sb-doc 
+(defun remove-implementation-package (packages-to-remove
+                                      &optional (package *package*))
+  #!+sb-doc
   "Removes PACKAGES-TO-REMOVE from the implementation packages of
 PACKAGE. Signals an error if PACKAGE or any of the PACKAGES-TO-REMOVE
 is not a valid package designator."
   (let ((package (find-undeleted-package-or-lose package))
-	(packages-to-remove (package-listify packages-to-remove)))
+        (packages-to-remove (package-listify packages-to-remove)))
     (setf (package-%implementation-packages package)
-          (nset-difference 
+          (nset-difference
            (package-%implementation-packages package)
            (mapcar #'find-undeleted-package-or-lose packages-to-remove)))))
 
@@ -140,54 +158,54 @@ error if any of PACKAGES is not a valid package designator."
   (with-unique-names (unlocked-packages)
     `(let (,unlocked-packages)
       (unwind-protect
-           (progn 
+           (progn
              (dolist (p ',packages)
                (when (package-locked-p p)
                  (push p ,unlocked-packages)
                  (unlock-package p)))
              ,@forms)
         (dolist (p ,unlocked-packages)
-	  (when (find-package p)
-	    (lock-package p)))))))
+          (when (find-package p)
+            (lock-package p)))))))
 
 (defun package-lock-violation (package &key (symbol nil symbol-p)
                                format-control format-arguments)
-  (let ((restart :continue)
-        (cl-violation-p (eq package (find-package :common-lisp))))
-    (flet ((error-arguments ()
-             (append (list (if symbol-p
-                               'symbol-package-locked-error
-                               'package-locked-error)
-                           :package package
-                           :format-control format-control
-                             :format-arguments format-arguments)
-                       (when symbol-p (list :symbol symbol))
-                       (list :references
-                             (append '((:sbcl :node "Package Locks"))
-                                     (when cl-violation-p
-                                       '((:ansi-cl :section (11 1 2 1 2)))))))))
-      (restart-case
-          (apply #'cerror "Ignore the package lock." (error-arguments))
-        (:ignore-all ()
-          :report "Ignore all package locks in the context of this operation."
-          (setf restart :ignore-all))
-        (:unlock-package ()
-          :report "Unlock the package."
-          (setf restart :unlock-package)))
-      (ecase restart
-        (:continue
-         (pushnew package *ignored-package-locks*))
-        (:ignore-all
-         (setf *ignored-package-locks* t))
-        (:unlock-package
-         (unlock-package package))))))
+  (let* ((restart :continue)
+         (cl-violation-p (eq package *cl-package*))
+         (error-arguments
+          (append (list (if symbol-p
+                            'symbol-package-locked-error
+                            'package-locked-error)
+                        :package package
+                        :format-control format-control
+                        :format-arguments format-arguments)
+                  (when symbol-p (list :symbol symbol))
+                  (list :references
+                        (append '((:sbcl :node "Package Locks"))
+                                (when cl-violation-p
+                                  '((:ansi-cl :section (11 1 2 1 2)))))))))
+    (restart-case
+        (apply #'cerror "Ignore the package lock." error-arguments)
+      (:ignore-all ()
+        :report "Ignore all package locks in the context of this operation."
+        (setf restart :ignore-all))
+      (:unlock-package ()
+        :report "Unlock the package."
+        (setf restart :unlock-package)))
+    (ecase restart
+      (:continue
+       (pushnew package *ignored-package-locks*))
+      (:ignore-all
+       (setf *ignored-package-locks* t))
+      (:unlock-package
+       (unlock-package package)))))
 
 (defun package-lock-violation-p (package &optional (symbol nil symbolp))
   ;; KLUDGE: (package-lock package) needs to be before
   ;; comparison to *package*, since during cold init this gets
   ;; called before *package* is bound -- but no package should
   ;; be locked at that point.
-  (and package 
+  (and package
        (package-lock package)
        ;; In package or implementation package
        (not (or (eq package *package*)
@@ -214,15 +232,15 @@ error if any of PACKAGES is not a valid package designator."
 ;;;
 ;;; Must be used inside the dynamic contour established by
 ;;; WITH-SINGLE-PACKAGE-LOCKED-ERROR
-(defun assert-package-unlocked (package &optional format-control 
-				&rest format-arguments)
-  #!-sb-package-locks 
+(defun assert-package-unlocked (package &optional format-control
+                                &rest format-arguments)
+  #!-sb-package-locks
   (declare (ignore format-control format-arguments))
   #!+sb-package-locks
   (when (package-lock-violation-p package)
-    (package-lock-violation package 
-			    :format-control format-control 
-			    :format-arguments format-arguments))
+    (package-lock-violation package
+                            :format-control format-control
+                            :format-arguments format-arguments))
   package)
 
 ;;; Must be used inside the dynamic contour established by
@@ -236,21 +254,23 @@ error if any of PACKAGES is not a valid package designator."
   (declare (ignore format))
   #!+sb-package-locks
   (let* ((symbol (etypecase name
-		   (symbol name)
-		   (list (if (eq 'setf (first name))
-			     (second name)
-			     ;; Skip (class-predicate foo), etc.
-			     ;; FIXME: MOP and package-lock
-			     ;; interaction needs to be thought about.
-			     (return-from 
-			      assert-symbol-home-package-unlocked
-			       name)))))
-	 (package (symbol-package symbol)))
+                   (symbol name)
+                   (list (if (and (consp (cdr name))
+                                  (eq 'setf (first name)))
+                             (second name)
+                             ;; Skip lists of length 1, single conses and
+                             ;; (class-predicate foo), etc.
+                             ;; FIXME: MOP and package-lock
+                             ;; interaction needs to be thought about.
+                             (return-from
+                              assert-symbol-home-package-unlocked
+                               name)))))
+         (package (symbol-package symbol)))
     (when (package-lock-violation-p package symbol)
-      (package-lock-violation package 
-			      :symbol symbol
-			      :format-control format
-			      :format-arguments (list name))))
+      (package-lock-violation package
+                              :symbol symbol
+                              :format-control format
+                              :format-arguments (list name))))
   name)
 
 
@@ -259,16 +279,16 @@ error if any of PACKAGES is not a valid package designator."
 (def!method print-object ((package package) stream)
   (let ((name (package-%name package)))
     (if name
-	(print-unreadable-object (package stream :type t)
-	  (prin1 name stream))
-	(print-unreadable-object (package stream :type t :identity t)
-	  (write-string "(deleted)" stream)))))
+        (print-unreadable-object (package stream :type t)
+          (prin1 name stream))
+        (print-unreadable-object (package stream :type t :identity t)
+          (write-string "(deleted)" stream)))))
 
 ;;; ANSI says (in the definition of DELETE-PACKAGE) that these, and
 ;;; most other operations, are unspecified for deleted packages. We
 ;;; just do the easy thing and signal errors in that case.
 (macrolet ((def (ext real)
-	     `(defun ,ext (x) (,real (find-undeleted-package-or-lose x)))))
+             `(defun ,ext (x) (,real (find-undeleted-package-or-lose x)))))
   (def package-nicknames package-%nicknames)
   (def package-use-list package-%use-list)
   (def package-used-by-list package-%used-by-list)
@@ -276,8 +296,8 @@ error if any of PACKAGES is not a valid package designator."
 
 (defun %package-hashtable-symbol-count (table)
   (let ((size (the fixnum
-		(- (package-hashtable-size table)
-		   (package-hashtable-deleted table)))))
+                (- (package-hashtable-size table)
+                   (package-hashtable-deleted table)))))
     (the fixnum
       (- size (package-hashtable-free table)))))
 
@@ -287,7 +307,7 @@ error if any of PACKAGES is not a valid package designator."
 (defun package-external-symbol-count (package)
   (%package-hashtable-symbol-count (package-external-symbols package)))
 
-(defvar *package* (error "*PACKAGE* should be initialized in cold load!") 
+(defvar *package* (error "*PACKAGE* should be initialized in cold load!")
   #!+sb-doc "the current package")
 ;;; FIXME: should be declared of type PACKAGE, with no NIL init form,
 ;;; after I get around to cleaning up DOCUMENTATION
@@ -317,34 +337,34 @@ error if any of PACKAGES is not a valid package designator."
 (define-condition bootstrap-package-not-found (condition)
   ((name :initarg :name :reader bootstrap-package-name)))
 (defun debootstrap-package (&optional condition)
-  (invoke-restart 
+  (invoke-restart
    (find-restart-or-control-error 'debootstrap-package condition)))
-  
+
 (defun find-package (package-designator)
   (flet ((find-package-from-string (string)
-	   (declare (type string string))
-	   (let ((packageoid (gethash string *package-names*)))
-	     (when (and (null packageoid)
-			(not *in-package-init*) ; KLUDGE
-			(let ((mismatch (mismatch "SB!" string)))
-			  (and mismatch (= mismatch 3))))
-	       (restart-case
-		   (signal 'bootstrap-package-not-found :name string)
-		 (debootstrap-package ()
-		   (return-from find-package
-		     (if (string= string "SB!XC")
-			 (find-package "COMMON-LISP")
-			 (find-package 
-			  (substitute #\- #\! string :count 1)))))))
-	     packageoid)))
+           (declare (type string string))
+           (let ((packageoid (gethash string *package-names*)))
+             (when (and (null packageoid)
+                        (not *in-package-init*) ; KLUDGE
+                        (let ((mismatch (mismatch "SB!" string)))
+                          (and mismatch (= mismatch 3))))
+               (restart-case
+                   (signal 'bootstrap-package-not-found :name string)
+                 (debootstrap-package ()
+                   (return-from find-package
+                     (if (string= string "SB!XC")
+                         (find-package "COMMON-LISP")
+                         (find-package
+                          (substitute #\- #\! string :count 1)))))))
+             packageoid)))
     (typecase package-designator
       (package package-designator)
       (symbol (find-package-from-string (symbol-name package-designator)))
       (string (find-package-from-string package-designator))
       (character (find-package-from-string (string package-designator)))
       (t (error 'type-error
-		:datum package-designator
-		:expected-type '(or character package string symbol))))))
+                :datum package-designator
+                :expected-type '(or character package string symbol))))))
 
 ;;; Return a list of packages given a package designator or list of
 ;;; package designators, or die trying.
@@ -355,7 +375,7 @@ error if any of PACKAGES is not a valid package designator."
 
 ;;; Make a package name into a simple-string.
 (defun package-namify (n)
-  (stringify-name n "package"))
+  (stringify-package-designator n))
 
 ;;; ANSI specifies (in the definition of DELETE-PACKAGE) that PACKAGE-NAME
 ;;; returns NIL (not an error) for a deleted package, so this is a special
@@ -370,99 +390,123 @@ error if any of PACKAGES is not a valid package designator."
 ;;; must be between 2 and 255.
 (defmacro entry-hash (length sxhash)
   `(the fixnum
-	(+ (the fixnum
-		(rem (the fixnum
-			  (logxor ,length
-				  ,sxhash
-				  (the fixnum (ash ,sxhash -8))
-				  (the fixnum (ash ,sxhash -16))
-				  (the fixnum (ash ,sxhash -19))))
-		     254))
-	   2)))
+        (+ (the fixnum
+                (rem (the fixnum
+                          (logxor ,length
+                                  ,sxhash
+                                  (the fixnum (ash ,sxhash -8))
+                                  (the fixnum (ash ,sxhash -16))
+                                  (the fixnum (ash ,sxhash -19))))
+                     254))
+           2)))
 ;;; FIXME: should be wrapped in EVAL-WHEN (COMPILE EXECUTE)
 
 ;;; Add a symbol to a package hashtable. The symbol is assumed
 ;;; not to be present.
 (defun add-symbol (table symbol)
+  (when (zerop (package-hashtable-free table))
+    ;; The hashtable is full. Resize it to be able to hold twice the
+    ;; amount of symbols than it currently contains. The actual new size
+    ;; can be smaller than twice the current size if the table contained
+    ;; deleted entries.
+    (resize-package-hashtable table
+                              (* (- (package-hashtable-size table)
+                                    (package-hashtable-deleted table))
+                                 2)))
   (let* ((vec (package-hashtable-table table))
-	 (hash (package-hashtable-hash table))
-	 (len (length vec))
-	 (sxhash (%sxhash-simple-string (symbol-name symbol)))
-	 (h2 (the fixnum (1+ (the fixnum (rem sxhash
-					      (the fixnum (- len 2))))))))
-    (declare (fixnum len sxhash h2))
-    (cond ((zerop (the fixnum (package-hashtable-free table)))
-	   (make-or-remake-package-hashtable (* (package-hashtable-size table)
-						2)
-					     table)
-	   (add-symbol table symbol)
-	   (dotimes (i len)
-	     (declare (fixnum i))
-	     (when (> (the fixnum (aref hash i)) 1)
-	       (add-symbol table (svref vec i)))))
-	  (t
-	   (do ((i (rem sxhash len) (rem (+ i h2) len)))
-	       ((< (the fixnum (aref hash i)) 2)
-		(if (zerop (the fixnum (aref hash i)))
-		    (decf (package-hashtable-free table))
-		    (decf (package-hashtable-deleted table)))
-		(setf (svref vec i) symbol)
-		(setf (aref hash i)
-		      (entry-hash (length (symbol-name symbol))
-				  sxhash)))
-	     (declare (fixnum i)))))))
+         (hash (package-hashtable-hash table))
+         (len (length vec))
+         (sxhash (%sxhash-simple-string (symbol-name symbol)))
+         (h2 (1+ (rem sxhash (- len 2)))))
+    (declare (fixnum sxhash h2))
+    (do ((i (rem sxhash len) (rem (+ i h2) len)))
+        ((< (the fixnum (aref hash i)) 2)
+         (if (zerop (the fixnum (aref hash i)))
+             (decf (package-hashtable-free table))
+             (decf (package-hashtable-deleted table)))
+         (setf (svref vec i) symbol)
+         (setf (aref hash i)
+               (entry-hash (length (symbol-name symbol))
+                           sxhash)))
+      (declare (fixnum i)))))
+
+;;; Resize the package hashtables of all packages so that their load
+;;; factor is +PACKAGE-HASHTABLE-IMAGE-LOAD-FACTOR+. Called from
+;;; SAVE-LISP-AND-DIE to optimize space usage in the image.
+(defun tune-hashtable-sizes-of-all-packages ()
+  (flet ((tune-table-size (table)
+           (resize-package-hashtable
+            table
+            (round (* (/ +package-rehash-threshold+
+                         +package-hashtable-image-load-factor+)
+                      (- (package-hashtable-size table)
+                         (package-hashtable-free table)
+                         (package-hashtable-deleted table)))))))
+    (dolist (package (list-all-packages))
+      (tune-table-size (package-internal-symbols package))
+      (tune-table-size (package-external-symbols package)))))
 
 ;;; Find where the symbol named STRING is stored in TABLE. INDEX-VAR
 ;;; is bound to the index, or NIL if it is not present. SYMBOL-VAR
 ;;; is bound to the symbol. LENGTH and HASH are the length and sxhash
 ;;; of STRING. ENTRY-HASH is the entry-hash of the string and length.
 (defmacro with-symbol ((index-var symbol-var table string length sxhash
-				  entry-hash)
-		       &body forms)
+                                  entry-hash)
+                       &body forms)
   (let ((vec (gensym)) (hash (gensym)) (len (gensym)) (h2 (gensym))
-	(name (gensym)) (name-len (gensym)) (ehash (gensym)))
+        (name (gensym)) (name-len (gensym)) (ehash (gensym)))
     `(let* ((,vec (package-hashtable-table ,table))
-	    (,hash (package-hashtable-hash ,table))
-	    (,len (length ,vec))
-	    (,h2 (1+ (the index (rem (the index ,sxhash)
-				      (the index (- ,len 2)))))))
+            (,hash (package-hashtable-hash ,table))
+            (,len (length ,vec))
+            (,h2 (1+ (the index (rem (the index ,sxhash)
+                                      (the index (- ,len 2)))))))
        (declare (type index ,len ,h2))
        (prog ((,index-var (rem (the index ,sxhash) ,len))
-	      ,symbol-var ,ehash)
-	 (declare (type (or index null) ,index-var))
-	 LOOP
-	 (setq ,ehash (aref ,hash ,index-var))
-	 (cond ((eql ,ehash ,entry-hash)
-		(setq ,symbol-var (svref ,vec ,index-var))
-		(let* ((,name (symbol-name ,symbol-var))
-		       (,name-len (length ,name)))
-		  (declare (type index ,name-len))
-		  (when (and (= ,name-len ,length)
-			     (string= ,string ,name
-				      :end1 ,length
-				      :end2 ,name-len))
-		    (go DOIT))))
-	       ((zerop ,ehash)
-		(setq ,index-var nil)
-		(go DOIT)))
-	 (setq ,index-var (+ ,index-var ,h2))
-	 (when (>= ,index-var ,len)
-	   (setq ,index-var (- ,index-var ,len)))
-	 (go LOOP)
-	 DOIT
-	 (return (progn ,@forms))))))
+              ,symbol-var ,ehash)
+         (declare (type (or index null) ,index-var))
+         LOOP
+         (setq ,ehash (aref ,hash ,index-var))
+         (cond ((eql ,ehash ,entry-hash)
+                (setq ,symbol-var (svref ,vec ,index-var))
+                (let* ((,name (symbol-name ,symbol-var))
+                       (,name-len (length ,name)))
+                  (declare (type index ,name-len))
+                  (when (and (= ,name-len ,length)
+                             (string= ,string ,name
+                                      :end1 ,length
+                                      :end2 ,name-len))
+                    (go DOIT))))
+               ((zerop ,ehash)
+                (setq ,index-var nil)
+                (go DOIT)))
+         (setq ,index-var (+ ,index-var ,h2))
+         (when (>= ,index-var ,len)
+           (setq ,index-var (- ,index-var ,len)))
+         (go LOOP)
+         DOIT
+         (return (progn ,@forms))))))
 
 ;;; Delete the entry for STRING in TABLE. The entry must exist.
 (defun nuke-symbol (table string)
   (declare (simple-string string))
   (let* ((length (length string))
-	 (hash (%sxhash-simple-string string))
-	 (ehash (entry-hash length hash)))
+         (hash (%sxhash-simple-string string))
+         (ehash (entry-hash length hash)))
     (declare (type index length hash))
     (with-symbol (index symbol table string length hash ehash)
       (setf (aref (package-hashtable-hash table) index) 1)
       (setf (aref (package-hashtable-table table) index) nil)
-      (incf (package-hashtable-deleted table)))))
+      (incf (package-hashtable-deleted table))))
+  ;; If the table is less than one quarter full, halve its size and
+  ;; rehash the entries.
+  (let* ((size (package-hashtable-size table))
+         (deleted (package-hashtable-deleted table))
+         (used (- size
+                  (package-hashtable-free table)
+                  deleted)))
+    (declare (type fixnum size deleted used))
+    (when (< used (truncate size 4))
+      (resize-package-hashtable table (* used 2)))))
 
 ;;; Enter any new NICKNAMES for PACKAGE into *PACKAGE-NAMES*.
 ;;; If there is a conflict then give the user a chance to do
@@ -471,35 +515,32 @@ error if any of PACKAGES is not a valid package designator."
   (declare (type list nicknames))
   (dolist (n nicknames)
     (let* ((n (package-namify n))
-	   (found (gethash n *package-names*)))
+           (found (gethash n *package-names*)))
       (cond ((not found)
-	     (setf (gethash n *package-names*) package)
-	     (push n (package-%nicknames package)))
-	    ((eq found package))
-	    ((string= (the string (package-%name found)) n)
-	     ;; FIXME: This and the next error needn't have restarts.
-	     (with-simple-restart (continue "Ignore this nickname.")
-	       (error 'simple-package-error
-		      :package package
-		      :format-control "~S is a package name, so it cannot be a nickname for ~S."
-		      :format-arguments (list n (package-%name package)))))
-	    (t
-	     (with-simple-restart (continue "Redefine this nickname.")
-	       (error 'simple-package-error
-		      :package package
-		      :format-control "~S is already a nickname for ~S."
-		      :format-arguments (list n (package-%name found))))
-	     (setf (gethash n *package-names*) package)
-	     (push n (package-%nicknames package)))))))
+             (setf (gethash n *package-names*) package)
+             (push n (package-%nicknames package)))
+            ((eq found package))
+            ((string= (the string (package-%name found)) n)
+             (cerror "Ignore this nickname."
+                     'simple-package-error
+                     :package package
+                     :format-control "~S is a package name, so it cannot be a nickname for ~S."
+                     :format-arguments (list n (package-%name package))))
+            (t
+             (cerror "Leave this nickname alone."
+                     'simple-package-error
+                     :package package
+                     :format-control "~S is already a nickname for ~S."
+                     :format-arguments (list n (package-%name found))))))))
 
 (defun make-package (name &key
-			  (use '#.*default-package-use-list*)
-			  nicknames
-			  (internal-symbols 10)
-			  (external-symbols 10))
+                          (use '#.*default-package-use-list*)
+                          nicknames
+                          (internal-symbols 10)
+                          (external-symbols 10))
   #!+sb-doc
   #.(format nil
-     "Make a new package having the specified NAME, NICKNAMES, and 
+     "Make a new package having the specified NAME, NICKNAMES, and
   USE list. :INTERNAL-SYMBOLS and :EXTERNAL-SYMBOLS are
   estimates for the number of internal and external symbols which
   will ultimately be present in the package. The default value of
@@ -512,20 +553,20 @@ error if any of PACKAGES is not a valid package designator."
   (when (find-package name)
     ;; ANSI specifies that this error is correctable.
     (cerror "Leave existing package alone."
-	    "A package named ~S already exists" name))
+            "A package named ~S already exists" name))
   (let* ((name (package-namify name))
-	 (package (internal-make-package
-		   :%name name
-		   :internal-symbols (make-or-remake-package-hashtable
-				      internal-symbols)
-		   :external-symbols (make-or-remake-package-hashtable
-				      external-symbols))))
+         (package (internal-make-package
+                   :%name name
+                   :internal-symbols (make-or-remake-package-hashtable
+                                      internal-symbols)
+                   :external-symbols (make-or-remake-package-hashtable
+                                      external-symbols))))
 
     ;; Do a USE-PACKAGE for each thing in the USE list so that checking for
     ;; conflicting exports among used packages is done.
     (if *in-package-init*
-	(push (list use package) *!deferred-use-packages*)
-	(use-package use package))
+        (push (list use package) *!deferred-use-packages*)
+        (use-package use package))
 
     ;; FIXME: ENTER-NEW-NICKNAMES can fail (ERROR) if nicknames are illegal,
     ;; which would leave us with possibly-bad side effects from the earlier
@@ -550,114 +591,120 @@ error if any of PACKAGES is not a valid package designator."
   #!+sb-doc
   "Changes the name and nicknames for a package."
   (let* ((package (find-undeleted-package-or-lose package))
-	 (name (string name))
-	 (found (find-package name))
-	 (nicks (mapcar #'string nicknames)))
+         (name (package-namify name))
+         (found (find-package name))
+         (nicks (mapcar #'string nicknames)))
     (unless (or (not found) (eq found package))
       (error 'simple-package-error
-	     :package name
-	     :format-control "A package named ~S already exists."
-	     :format-arguments (list name)))
+             :package name
+             :format-control "A package named ~S already exists."
+             :format-arguments (list name)))
     (with-single-package-locked-error ()
-	(unless (and (string= name (package-name package))
-		     (null (set-difference nicks (package-nicknames package) 
-				       :test #'string=)))
-	  (assert-package-unlocked package "rename as ~A~@[ with nickname~P ~
-                                           ~{~A~^, ~}~]" 
-				   name (length nicks) nicks))
+        (unless (and (string= name (package-name package))
+                     (null (set-difference nicks (package-nicknames package)
+                                       :test #'string=)))
+          (assert-package-unlocked package "rename as ~A~@[ with nickname~P ~
+                                           ~{~A~^, ~}~]"
+                                   name (length nicks) nicks))
       ;; do the renaming
       (remhash (package-%name package) *package-names*)
       (dolist (n (package-%nicknames package))
-	(remhash n *package-names*))
+        (remhash n *package-names*))
       (setf (package-%name package) name
-	    (gethash name *package-names*) package
-	    (package-%nicknames package) ())
+            (gethash name *package-names*) package
+            (package-%nicknames package) ())
       (enter-new-nicknames package nicknames))
     package))
 
-(defun delete-package (package-or-name)
+(defun delete-package (package-designator)
   #!+sb-doc
-  "Delete the package-or-name from the package system data structures."
-  (let ((package (if (packagep package-or-name)
-		     package-or-name
-		     (find-package package-or-name))))
+  "Delete the package designated by PACKAGE-DESIGNATOR from the package
+  system data structures."
+  (let ((package (if (packagep package-designator)
+                     package-designator
+                     (find-package package-designator))))
     (cond ((not package)
-	   ;; This continuable error is required by ANSI.
-	   (with-simple-restart (continue "Return NIL")
-	     (error 'simple-package-error
-		    :package package-or-name
-		    :format-control "There is no package named ~S."
-		    :format-arguments (list package-or-name))))
-	  ((not (package-name package)) ; already deleted
-	   nil)
-	  (t
-	   (with-single-package-locked-error
-	       (:package package "deleting package ~A" package)
-	     (let ((use-list (package-used-by-list package)))
-	       (when use-list
-		 ;; This continuable error is specified by ANSI.
-		 (with-simple-restart
-		     (continue "Remove dependency in other packages.")
-		   (error 'simple-package-error
-			  :package package
-			  :format-control
-			  "Package ~S is used by package(s):~%  ~S"
-			  :format-arguments
-			  (list (package-name package)
-				(mapcar #'package-name use-list))))
-		 (dolist (p use-list)
-		   (unuse-package package p))))
-	     (dolist (used (package-use-list package))
-	       (unuse-package used package))
-	     (do-symbols (sym package)
-	       (unintern sym package))
-	     (remhash (package-name package) *package-names*)
-	     (dolist (nick (package-nicknames package))
-	       (remhash nick *package-names*))
-	     (setf (package-%name package) nil
-		   ;; Setting PACKAGE-%NAME to NIL is required in order to
-		   ;; make PACKAGE-NAME return NIL for a deleted package as
-		   ;; ANSI requires. Setting the other slots to NIL
-		   ;; and blowing away the PACKAGE-HASHTABLES is just done
-		   ;; for tidiness and to help the GC.
-		   (package-%nicknames package) nil
-		   (package-%use-list package) nil
-		   (package-tables package) nil
-		   (package-%shadowing-symbols package) nil
-		   (package-internal-symbols package)
-		   (make-or-remake-package-hashtable 0)
-		   (package-external-symbols package)
-		   (make-or-remake-package-hashtable 0))
-	     t)))))
+           ;; This continuable error is required by ANSI.
+           (cerror
+            "Return ~S."
+            (make-condition
+             'simple-package-error
+             :package package-designator
+             :format-control "There is no package named ~S."
+             :format-arguments (list package-designator))
+            nil))
+          ((not (package-name package)) ; already deleted
+           nil)
+          (t
+           (with-single-package-locked-error
+               (:package package "deleting package ~A" package)
+             (let ((use-list (package-used-by-list package)))
+               (when use-list
+                 ;; This continuable error is specified by ANSI.
+                 (cerror
+                  "Remove dependency in other packages."
+                  (make-condition
+                   'simple-package-error
+                   :package package
+                   :format-control
+                   "~@<Package ~S is used by package~P:~2I~_~S~@:>"
+                   :format-arguments (list (package-name package)
+                                           (length use-list)
+                                           (mapcar #'package-name use-list))))
+                 (dolist (p use-list)
+                   (unuse-package package p))))
+             (dolist (used (package-use-list package))
+               (unuse-package used package))
+             (do-symbols (sym package)
+               (unintern sym package))
+             (remhash (package-name package) *package-names*)
+             (dolist (nick (package-nicknames package))
+               (remhash nick *package-names*))
+             (setf (package-%name package) nil
+                   ;; Setting PACKAGE-%NAME to NIL is required in order to
+                   ;; make PACKAGE-NAME return NIL for a deleted package as
+                   ;; ANSI requires. Setting the other slots to NIL
+                   ;; and blowing away the PACKAGE-HASHTABLES is just done
+                   ;; for tidiness and to help the GC.
+                   (package-%nicknames package) nil
+                   (package-%use-list package) nil
+                   (package-tables package) nil
+                   (package-%shadowing-symbols package) nil
+                   (package-internal-symbols package)
+                   (make-or-remake-package-hashtable 0)
+                   (package-external-symbols package)
+                   (make-or-remake-package-hashtable 0))
+             t)))))
 
 (defun list-all-packages ()
   #!+sb-doc
   "Return a list of all existing packages."
   (let ((res ()))
     (maphash (lambda (k v)
-	       (declare (ignore k))
-	       (pushnew v res))
-	     *package-names*)
+               (declare (ignore k))
+               (pushnew v res))
+             *package-names*)
     res))
 
 (defun intern (name &optional (package (sane-package)))
   #!+sb-doc
-  "Return a symbol having the specified name, creating it if necessary."
+  "Return a symbol in PACKAGE having the specified NAME, creating it
+  if necessary."
   ;; We just simple-stringify the name and call INTERN*, where the real
   ;; logic is.
   (let ((name (if (simple-string-p name)
-		name
-		(coerce name 'simple-string)))
-	(package (find-undeleted-package-or-lose package)))
+                  name
+                  (coerce name 'simple-string)))
+        (package (find-undeleted-package-or-lose package)))
     (declare (simple-string name))
       (intern* name
-	       (length name)
-	       package)))
+               (length name)
+               package)))
 
 (defun find-symbol (name &optional (package (sane-package)))
   #!+sb-doc
-  "Return the symbol named String in Package. If such a symbol is found
-  then the second value is :internal, :external or :inherited to indicate
+  "Return the symbol named STRING in PACKAGE. If such a symbol is found
+  then the second value is :INTERNAL, :EXTERNAL or :INHERITED to indicate
   how the symbol is accessible. If no symbol is found then both values
   are NIL."
   ;; We just simple-stringify the name and call FIND-SYMBOL*, where the
@@ -665,8 +712,8 @@ error if any of PACKAGES is not a valid package designator."
   (let ((name (if (simple-string-p name) name (coerce name 'simple-string))))
     (declare (simple-string name))
     (find-symbol* name
-		  (length name)
-		  (find-undeleted-package-or-lose package))))
+                  (length name)
+                  (find-undeleted-package-or-lose package))))
 
 ;;; If the symbol named by the first LENGTH characters of NAME doesn't exist,
 ;;; then create it, special-casing the keyword package.
@@ -674,128 +721,274 @@ error if any of PACKAGES is not a valid package designator."
   (declare (simple-string name))
   (multiple-value-bind (symbol where) (find-symbol* name length package)
     (cond (where
-	   (values symbol where))
-	  (t
-	   (let ((symbol-name (subseq name 0 length)))
-	     (with-single-package-locked-error 
-		 (:package package "interning ~A" symbol-name)
-	       (let ((symbol (make-symbol symbol-name)))
-		 (%set-symbol-package symbol package)
-		 (cond ((eq package *keyword-package*)
-			(add-symbol (package-external-symbols package) symbol)
-			(%set-symbol-value symbol symbol))
-		       (t
-			(add-symbol (package-internal-symbols package) symbol)))
-		 (values symbol nil))))))))
+           (values symbol where))
+          (t
+           (let ((symbol-name (subseq name 0 length)))
+             (with-single-package-locked-error
+                 (:package package "interning ~A" symbol-name)
+               (let ((symbol (make-symbol symbol-name)))
+                 (%set-symbol-package symbol package)
+                 (cond ((eq package *keyword-package*)
+                        (add-symbol (package-external-symbols package) symbol)
+                        (%set-symbol-value symbol symbol))
+                       (t
+                        (add-symbol (package-internal-symbols package) symbol)))
+                 (values symbol nil))))))))
 
 ;;; Check internal and external symbols, then scan down the list
-;;; of hashtables for inherited symbols. When an inherited symbol
-;;; is found pull that table to the beginning of the list.
+;;; of hashtables for inherited symbols.
 (defun find-symbol* (string length package)
   (declare (simple-string string)
-	   (type index length))
+           (type index length))
   (let* ((hash (%sxhash-simple-substring string length))
-	 (ehash (entry-hash length hash)))
+         (ehash (entry-hash length hash)))
     (declare (type index hash ehash))
     (with-symbol (found symbol (package-internal-symbols package)
-			string length hash ehash)
+                        string length hash ehash)
       (when found
-	(return-from find-symbol* (values symbol :internal))))
+        (return-from find-symbol* (values symbol :internal))))
     (with-symbol (found symbol (package-external-symbols package)
-			string length hash ehash)
+                        string length hash ehash)
       (when found
-	(return-from find-symbol* (values symbol :external))))
+        (return-from find-symbol* (values symbol :external))))
     (let ((head (package-tables package)))
       (do ((prev head table)
-	   (table (cdr head) (cdr table)))
-	  ((null table) (values nil nil))
-	(with-symbol (found symbol (car table) string length hash ehash)
-	  (when found
-	    (unless (eq prev head)
-	      (shiftf (cdr prev) (cdr table) (cdr head) table))
-	    (return-from find-symbol* (values symbol :inherited))))))))
-
-;;; Similar to Find-Symbol, but only looks for an external symbol.
+           (table (cdr head) (cdr table)))
+          ((null table) (values nil nil))
+        (with-symbol (found symbol (car table) string length hash ehash)
+          (when found
+            ;; At this point we used to move the table to the
+            ;; beginning of the list, probably on the theory that we'd
+            ;; soon be looking up further items there. Unfortunately
+            ;; that was very much non-thread safe. Since the failure
+            ;; mode was nasty (corruption of the package in a way
+            ;; which would make symbol lookups loop infinitely) and it
+            ;; would be triggered just by doing reads to a resource
+            ;; that users can't do their own locking on, that code has
+            ;; been removed. If we ever add locking to packages,
+            ;; resurrecting that code might make sense, even though it
+            ;; didn't seem to have much of an performance effect in
+            ;; normal use.
+            ;;
+            ;; -- JES, 2006-09-13
+            (return-from find-symbol* (values symbol :inherited))))))))
+
+;;; Similar to FIND-SYMBOL, but only looks for an external symbol.
 ;;; This is used for fast name-conflict checking in this file and symbol
 ;;; printing in the printer.
 (defun find-external-symbol (string package)
   (declare (simple-string string))
   (let* ((length (length string))
-	 (hash (%sxhash-simple-string string))
-	 (ehash (entry-hash length hash)))
+         (hash (%sxhash-simple-string string))
+         (ehash (entry-hash length hash)))
     (declare (type index length hash))
     (with-symbol (found symbol (package-external-symbols package)
-			string length hash ehash)
+                        string length hash ehash)
       (values symbol found))))
 
+(defun print-symbol-with-prefix (stream symbol colon at)
+  #!+sb-doc
+  "For use with ~/: Write SYMBOL to STREAM as if it is not accessible from
+  the current package."
+  (declare (ignore colon at))
+  ;; Only keywords should be accessible from the keyword package, and
+  ;; keywords are always printed with colons, so this guarantees that the
+  ;; symbol will not be printed without a prefix.
+  (let ((*package* *keyword-package*))
+    (write symbol :stream stream :escape t)))
+
+(define-condition name-conflict (reference-condition package-error)
+  ((function :initarg :function :reader name-conflict-function)
+   (datum :initarg :datum :reader name-conflict-datum)
+   (symbols :initarg :symbols :reader name-conflict-symbols))
+  (:default-initargs :references (list '(:ansi-cl :section (11 1 1 2 5))))
+  (:report
+   (lambda (c s)
+     (format s "~@<~S ~S causes name-conflicts in ~S between the ~
+                following symbols:~2I~@:_~
+                ~{~/sb-impl::print-symbol-with-prefix/~^, ~}~:@>"
+             (name-conflict-function c)
+             (name-conflict-datum c)
+             (package-error-package c)
+             (name-conflict-symbols c)))))
+
+(defun name-conflict (package function datum &rest symbols)
+  (restart-case
+      (error 'name-conflict :package package :symbols symbols
+             :function function :datum datum)
+    (resolve-conflict (s)
+      :report "Resolve conflict."
+      :interactive
+      (lambda ()
+        (let* ((len (length symbols))
+               (nlen (length (write-to-string len :base 10)))
+               (*print-pretty* t))
+          (format *query-io* "~&~@<Select a symbol to be made accessible in ~
+                              package ~A:~2I~@:_~{~{~V,' D. ~
+                              ~/sb-impl::print-symbol-with-prefix/~}~@:_~}~
+                              ~@:>"
+                (package-name package)
+                (loop for s in symbols
+                      for i upfrom 1
+                      collect (list nlen i s)))
+          (loop
+           (format *query-io* "~&Enter an integer (between 1 and ~D): " len)
+           (finish-output *query-io*)
+           (let ((i (parse-integer (read-line *query-io*) :junk-allowed t)))
+             (when (and i (<= 1 i len))
+               (return (list (nth (1- i) symbols))))))))
+      (multiple-value-bind (symbol status)
+          (find-symbol (symbol-name s) package)
+        (declare (ignore status)) ; FIXME: is that true?
+        (case function
+          ((export)
+           (if (eq symbol s)
+               (shadow symbol package)
+               (unintern symbol package)))
+          ((unintern)
+           (shadowing-import s package))
+          ((import)
+           (if (eq symbol s)
+               nil ; do nothing
+               (shadowing-import s package)))
+          ((use-package)
+           (if (eq symbol s)
+               (shadow s package)
+               (shadowing-import s package))))))))
+
+#+nil ; this solution gives a variable number of restarts instead, but
+      ; no good way of programmatically choosing between them.
+(defun name-conflict (package function datum &rest symbols)
+  (let ((condition (make-condition 'name-conflict
+                                   :package package :symbols symbols
+                                   :function function :datum datum)))
+    ;; this is a gross violation of modularity, but I can't see any
+    ;; other way to have a variable number of restarts.
+    (let ((*restart-clusters*
+           (cons
+            (mapcan
+             (lambda (s)
+               (multiple-value-bind (accessible-symbol status)
+                   (find-symbol (symbol-name s) package)
+                 (cond
+                   ;; difficult case
+                   ((eq s accessible-symbol)
+                    (ecase status
+                      ((:inherited)
+                       (list (make-restart
+                              :name (make-symbol "SHADOWING-IMPORT")
+                              :function (lambda ()
+                                          (shadowing-import s package)
+                                          (return-from name-conflict))
+                              :report-function
+                              (lambda (stream)
+                                (format stream "Shadowing-import ~S into ~A."
+                                        s (package-%name package))))))
+                      ((:internal :external)
+                       (aver (= (length symbols) 2))
+                       ;; ARGH! FIXME: this unintern restart can
+                       ;; _still_ leave the system in an
+                       ;; unsatisfactory state: if the symbol is a
+                       ;; external symbol of a package which is
+                       ;; already used by this package, and has also
+                       ;; been imported, then uninterning it from this
+                       ;; package will still leave it visible!
+                       ;;
+                       ;; (DEFPACKAGE "FOO" (:EXPORT "SYM"))
+                       ;; (DEFPACKAGE "BAR" (:EXPORT "SYM"))
+                       ;; (DEFPACKAGE "BAZ" (:USE "FOO"))
+                       ;; (IMPORT 'FOO:SYM "BAZ")
+                       ;; (USE-PACKAGE "BAR" "BAZ")
+                       ;;
+                       ;; Now (UNINTERN 'FOO:SYM "BAZ") doesn't
+                       ;; resolve the conflict. :-(
+                       ;;
+                       ;; -- CSR, 2004-10-20
+                       (list (make-restart
+                              :name (make-symbol "UNINTERN")
+                              :function (lambda ()
+                                          (unintern s package)
+                                          (import
+                                           (find s symbols :test-not #'eq)
+                                           package)
+                                          (return-from name-conflict))
+                              :report-function
+                              (lambda (stream)
+                                (format stream
+                                        "Unintern ~S from ~A and import ~S."
+                                        s
+                                        (package-%name package)
+                                        (find s symbols :test-not #'eq))))))))
+                   (t (list (make-restart
+                             :name (make-symbol "SHADOWING-IMPORT")
+                             :function (lambda ()
+                                         (shadowing-import s package)
+                                         (return-from name-conflict))
+                             :report-function
+                             (lambda (stream)
+                               (format stream "Shadowing-import ~S into ~A."
+                                       s (package-%name package)))))))))
+             symbols)
+            *restart-clusters*)))
+      (with-condition-restarts condition (car *restart-clusters*)
+        (with-simple-restart (abort "Leave action undone.")
+          (error condition))))))
+
 ;;; If we are uninterning a shadowing symbol, then a name conflict can
 ;;; result, otherwise just nuke the symbol.
 (defun unintern (symbol &optional (package (sane-package)))
   #!+sb-doc
-  "Makes Symbol no longer present in Package. If Symbol was present
-  then T is returned, otherwise NIL. If Package is Symbol's home
+  "Makes SYMBOL no longer present in PACKAGE. If SYMBOL was present
+  then T is returned, otherwise NIL. If PACKAGE is SYMBOL's home
   package, then it is made uninterned."
   (let* ((package (find-undeleted-package-or-lose package))
-	 (name (symbol-name symbol))
-	 (shadowing-symbols (package-%shadowing-symbols package)))
+         (name (symbol-name symbol))
+         (shadowing-symbols (package-%shadowing-symbols package)))
     (declare (list shadowing-symbols))
 
     (with-single-package-locked-error ()
       (when (find-symbol name package)
-	(assert-package-unlocked package "uninterning ~A" name))
-      
-      ;; If a name conflict is revealed, give use a chance to shadowing-import
-      ;; one of the accessible symbols.
+        (assert-package-unlocked package "uninterning ~A" name))
+
+      ;; If a name conflict is revealed, give us a chance to
+      ;; shadowing-import one of the accessible symbols.
       (when (member symbol shadowing-symbols)
-	(let ((cset ()))
-	  (dolist (p (package-%use-list package))
-	    (multiple-value-bind (s w) (find-external-symbol name p)
-	      (when w (pushnew s cset))))
-	  (when (cdr cset)
-	    (loop
-	     (cerror
-	      "Prompt for a symbol to SHADOWING-IMPORT."
-	      "Uninterning symbol ~S causes name conflict among these symbols:~%~S"
-	      symbol cset)
-	     (write-string "Symbol to shadowing-import: " *query-io*)
-	     (let ((sym (read *query-io*)))
-	       (cond
-		 ((not (symbolp sym))
-		  (format *query-io* "~S is not a symbol." sym))
-		 ((not (member sym cset))
-		  (format *query-io* "~S is not one of the conflicting symbols." sym))
-		 (t
-		  (shadowing-import sym package)
-		  (return-from unintern t)))))))
-	(setf (package-%shadowing-symbols package)
-	      (remove symbol shadowing-symbols)))
+        (let ((cset ()))
+          (dolist (p (package-%use-list package))
+            (multiple-value-bind (s w) (find-external-symbol name p)
+              (when w (pushnew s cset))))
+          (when (cdr cset)
+            (apply #'name-conflict package 'unintern symbol cset)
+            (return-from unintern t)))
+        (setf (package-%shadowing-symbols package)
+              (remove symbol shadowing-symbols)))
 
       (multiple-value-bind (s w) (find-symbol name package)
-	(declare (ignore s))
-	(cond ((or (eq w :internal) (eq w :external))
-	       (nuke-symbol (if (eq w :internal)
-				(package-internal-symbols package)
-				(package-external-symbols package))
-			    name)
-	       (if (eq (symbol-package symbol) package)
-		   (%set-symbol-package symbol nil))
-	       t)
-	      (t nil))))))
+        (declare (ignore s))
+        (cond ((or (eq w :internal) (eq w :external))
+               (nuke-symbol (if (eq w :internal)
+                                (package-internal-symbols package)
+                                (package-external-symbols package))
+                            name)
+               (if (eq (symbol-package symbol) package)
+                   (%set-symbol-package symbol nil))
+               t)
+              (t nil))))))
 
 ;;; Take a symbol-or-list-of-symbols and return a list, checking types.
 (defun symbol-listify (thing)
   (cond ((listp thing)
-	 (dolist (s thing)
-	   (unless (symbolp s) (error "~S is not a symbol." s)))
-	 thing)
-	((symbolp thing) (list thing))
-	(t
-	 (error "~S is neither a symbol nor a list of symbols." thing))))
+         (dolist (s thing)
+           (unless (symbolp s) (error "~S is not a symbol." s)))
+         thing)
+        ((symbolp thing) (list thing))
+        (t
+         (error "~S is neither a symbol nor a list of symbols." thing))))
 
 (defun string-listify (thing)
-  (mapcar #'string (if (listp thing) 
-		       thing 
-		       (list thing))))
+  (mapcar #'string (if (listp thing)
+                       thing
+                       (list thing))))
 
 ;;; This is like UNINTERN, except if SYMBOL is inherited, it chases
 ;;; down the package it is inherited from and uninterns it there. Used
@@ -804,320 +997,287 @@ error if any of PACKAGES is not a valid package designator."
 (defun moby-unintern (symbol package)
   (unless (member symbol (package-%shadowing-symbols package))
     (or (unintern symbol package)
-	(let ((name (symbol-name symbol)))
-	  (multiple-value-bind (s w) (find-symbol name package)
-	    (declare (ignore s))
-	    (when (eq w :inherited)
-	      (dolist (q (package-%use-list package))
-		(multiple-value-bind (u x) (find-external-symbol name q)
-		  (declare (ignore u))
-		  (when x
-		    (unintern symbol q)
-		    (return t))))))))))
+        (let ((name (symbol-name symbol)))
+          (multiple-value-bind (s w) (find-symbol name package)
+            (declare (ignore s))
+            (when (eq w :inherited)
+              (dolist (q (package-%use-list package))
+                (multiple-value-bind (u x) (find-external-symbol name q)
+                  (declare (ignore u))
+                  (when x
+                    (unintern symbol q)
+                    (return t))))))))))
 
 (defun export (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Exports Symbols from Package, checking that no name conflicts result."
+  "Exports SYMBOLS from PACKAGE, checking that no name conflicts result."
   (let ((package (find-undeleted-package-or-lose package))
-	(syms ()))
+        (syms ()))
     ;; Punt any symbols that are already external.
     (dolist (sym (symbol-listify symbols))
       (multiple-value-bind (s w)
-	  (find-external-symbol (symbol-name sym) package)
-	(declare (ignore s))
-	(unless (or w (member sym syms))
-	  (push sym syms))))
+          (find-external-symbol (symbol-name sym) package)
+        (declare (ignore s))
+        (unless (or w (member sym syms))
+          (push sym syms))))
     (with-single-package-locked-error ()
       (when syms
-	(assert-package-unlocked package "exporting symbol~P ~{~A~^, ~}"
-				 (length syms) syms))
+        (assert-package-unlocked package "exporting symbol~P ~{~A~^, ~}"
+                                 (length syms) syms))
       ;; Find symbols and packages with conflicts.
       (let ((used-by (package-%used-by-list package))
-	    (cpackages ())
-	    (cset ()))
-	(dolist (sym syms)
-	  (let ((name (symbol-name sym)))
-	    (dolist (p used-by)
-	      (multiple-value-bind (s w) (find-symbol name p)
-		(when (and w (not (eq s sym))
-			   (not (member s (package-%shadowing-symbols p))))
-		  (pushnew sym cset)
-		  (pushnew p cpackages))))))
-	(when cset
-	  (restart-case
-	      (error
-	       'simple-package-error
-	       :package package
-	       :format-control
-	       "Exporting these symbols from the ~A package:~%~S~%~
-	        results in name conflicts with these packages:~%~{~A ~}"
-	       :format-arguments
-	       (list (package-%name package) cset
-		     (mapcar #'package-%name cpackages)))
-	    (unintern-conflicting-symbols ()
-	      :report "Unintern conflicting symbols."
-	      (dolist (p cpackages)
-		(dolist (sym cset)
-		  (moby-unintern sym p))))
-	    (skip-exporting-these-symbols ()
-	      :report "Skip exporting conflicting symbols."
-	      (setq syms (nset-difference syms cset))))))
-
+            (cset ()))
+        (dolist (sym syms)
+          (let ((name (symbol-name sym)))
+            (dolist (p used-by)
+              (multiple-value-bind (s w) (find-symbol name p)
+                (when (and w
+                           (not (eq s sym))
+                           (not (member s (package-%shadowing-symbols p))))
+                  ;; Beware: the name conflict is in package P, not in
+                  ;; PACKAGE.
+                  (name-conflict p 'export sym sym s)
+                  (pushnew sym cset))))))
+        (when cset
+          (setq syms (set-difference syms cset))))
       ;; Check that all symbols are accessible. If not, ask to import them.
       (let ((missing ())
-	    (imports ()))
-	(dolist (sym syms)
-	  (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
-	    (cond ((not (and w (eq s sym)))
-		   (push sym missing))
-		  ((eq w :inherited)
-		   (push sym imports)))))
-	(when missing
-	  (with-simple-restart
-	      (continue "Import these symbols into the ~A package."
-			(package-%name package))
-	    (error 'simple-package-error
-		   :package package
-		   :format-control
-		   "These symbols are not accessible in the ~A package:~%~S"
-		   :format-arguments
-		   (list (package-%name package) missing)))
-	  (import missing package))
-	(import imports package))
+            (imports ()))
+        (dolist (sym syms)
+          (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
+            (cond ((not (and w (eq s sym)))
+                   (push sym missing))
+                  ((eq w :inherited)
+                   (push sym imports)))))
+        (when missing
+          (cerror
+           "~S these symbols into the ~A package."
+           (make-condition
+            'simple-package-error
+            :package package
+            :format-control
+            "~@<These symbols are not accessible in the ~A package:~2I~_~S~@:>"
+            :format-arguments (list (package-%name package) missing))
+           'import (package-%name package))
+          (import missing package))
+        (import imports package))
 
       ;; And now, three pages later, we export the suckers.
       (let ((internal (package-internal-symbols package))
-	    (external (package-external-symbols package)))
-	(dolist (sym syms)
-	  (nuke-symbol internal (symbol-name sym))
-	  (add-symbol external sym))))
+            (external (package-external-symbols package)))
+        (dolist (sym syms)
+          (nuke-symbol internal (symbol-name sym))
+          (add-symbol external sym))))
       t))
 
 ;;; Check that all symbols are accessible, then move from external to internal.
 (defun unexport (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Makes Symbols no longer exported from Package."
+  "Makes SYMBOLS no longer exported from PACKAGE."
   (let ((package (find-undeleted-package-or-lose package))
-	(syms ()))
+        (syms ()))
     (dolist (sym (symbol-listify symbols))
       (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
-	(cond ((or (not w) (not (eq s sym)))
-	       (error 'simple-package-error
-		      :package package
-		      :format-control "~S is not accessible in the ~A package."
-		      :format-arguments (list sym (package-%name package))))
-	      ((eq w :external) (pushnew sym syms)))))
+        (cond ((or (not w) (not (eq s sym)))
+               (error 'simple-package-error
+                      :package package
+                      :format-control "~S is not accessible in the ~A package."
+                      :format-arguments (list sym (package-%name package))))
+              ((eq w :external) (pushnew sym syms)))))
     (with-single-package-locked-error ()
       (when syms
-	(assert-package-unlocked package "unexporting symbol~P ~{~A~^, ~}"
-				 (length syms) syms))
+        (assert-package-unlocked package "unexporting symbol~P ~{~A~^, ~}"
+                                 (length syms) syms))
       (let ((internal (package-internal-symbols package))
-	    (external (package-external-symbols package)))
-	(dolist (sym syms)
-	  (add-symbol internal sym)
-	  (nuke-symbol external (symbol-name sym)))))
+            (external (package-external-symbols package)))
+        (dolist (sym syms)
+          (add-symbol internal sym)
+          (nuke-symbol external (symbol-name sym)))))
     t))
 
 ;;; Check for name conflict caused by the import and let the user
 ;;; shadowing-import if there is.
 (defun import (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Make Symbols accessible as internal symbols in Package. If a symbol
+  "Make SYMBOLS accessible as internal symbols in PACKAGE. If a symbol
   is already accessible then it has no effect. If a name conflict
   would result from the importation, then a correctable error is signalled."
   (let* ((package (find-undeleted-package-or-lose package))
-	 (symbols (symbol-listify symbols))
-	 (homeless (remove-if #'symbol-package symbols))
-	 (syms ())
-	 (cset ()))
-    (dolist (sym symbols)
-      (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
-	(cond ((not w)
-	       (let ((found (member sym syms :test #'string=)))
-		 (if found
-		     (when (not (eq (car found) sym))
-		       (push sym cset))
-		     (push sym syms))))
-	      ((not (eq s sym)) (push sym cset))
-	      ((eq w :inherited) (push sym syms)))))
+         (symbols (symbol-listify symbols))
+         (homeless (remove-if #'symbol-package symbols))
+         (syms ()))
     (with-single-package-locked-error ()
-      (when (or homeless syms cset)
-	(let ((union (delete-duplicates (append homeless syms cset))))
-	  (assert-package-unlocked package "importing symbol~P ~{~A~^, ~}" 
-				   (length union) union)))
-      (when cset
-	;; ANSI specifies that this error is correctable.
-	(with-simple-restart
-	    (continue "Import these symbols with Shadowing-Import.")
-	  (error 'simple-package-error
-		 :package package
-		 :format-control
-		 "Importing these symbols into the ~A package ~
-		causes a name conflict:~%~S"
-		 :format-arguments (list (package-%name package) cset))))
+      (dolist (sym symbols)
+        (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
+          (cond ((not w)
+                 (let ((found (member sym syms :test #'string=)))
+                   (if found
+                       (when (not (eq (car found) sym))
+                         (name-conflict package 'import sym sym (car found)))
+                       (push sym syms))))
+                ((not (eq s sym))
+                 (name-conflict package 'import sym sym s))
+                ((eq w :inherited) (push sym syms)))))
+      (when (or homeless syms)
+        (let ((union (delete-duplicates (append homeless syms))))
+          (assert-package-unlocked package "importing symbol~P ~{~A~^, ~}"
+                                   (length union) union)))
       ;; Add the new symbols to the internal hashtable.
       (let ((internal (package-internal-symbols package)))
-	(dolist (sym syms)
-	  (add-symbol internal sym)))
-      ;; If any of the symbols are uninterned, make them be owned by Package.
+        (dolist (sym syms)
+          (add-symbol internal sym)))
+      ;; If any of the symbols are uninterned, make them be owned by PACKAGE.
       (dolist (sym homeless)
-	(%set-symbol-package sym package))
-      (shadowing-import cset package))))
+        (%set-symbol-package sym package))
+      t)))
 
 ;;; If a conflicting symbol is present, unintern it, otherwise just
 ;;; stick the symbol in.
 (defun shadowing-import (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Import Symbols into package, disregarding any name conflict. If
-  a symbol of the same name is present, then it is uninterned.
-  The symbols are added to the Package-Shadowing-Symbols."
+  "Import SYMBOLS into package, disregarding any name conflict. If
+  a symbol of the same name is present, then it is uninterned."
   (let* ((package (find-undeleted-package-or-lose package))
-	 (internal (package-internal-symbols package))
-	 (symbols (symbol-listify symbols))
-	 (lock-asserted-p nil))
+         (internal (package-internal-symbols package))
+         (symbols (symbol-listify symbols))
+         (lock-asserted-p nil))
     (with-single-package-locked-error ()
       (dolist (sym symbols)
-	(multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
-	  (unless (or lock-asserted-p 
-		      (and (eq s sym) 
-			   (member s (package-shadowing-symbols package))))
-	    (assert-package-unlocked package "shadowing-importing symbol~P ~
+        (multiple-value-bind (s w) (find-symbol (symbol-name sym) package)
+          (unless (or lock-asserted-p
+                      (and (eq s sym)
+                           (member s (package-shadowing-symbols package))))
+            (assert-package-unlocked package "shadowing-importing symbol~P ~
                                            ~{~A~^, ~}" (length symbols) symbols)
-	    (setf lock-asserted-p t))
-	  (unless (and w (not (eq w :inherited)) (eq s sym))
-	    (when (or (eq w :internal) (eq w :external))
-	      ;; If it was shadowed, we don't want UNINTERN to flame out...
-	      (setf (package-%shadowing-symbols package)
-		    (remove s (the list (package-%shadowing-symbols package))))
-	      (unintern s package))
-	    (add-symbol internal sym))
-	  (pushnew sym (package-%shadowing-symbols package))))))
+            (setf lock-asserted-p t))
+          (unless (and w (not (eq w :inherited)) (eq s sym))
+            (when (or (eq w :internal) (eq w :external))
+              ;; If it was shadowed, we don't want UNINTERN to flame out...
+              (setf (package-%shadowing-symbols package)
+                    (remove s (the list (package-%shadowing-symbols package))))
+              (unintern s package))
+            (add-symbol internal sym))
+          (pushnew sym (package-%shadowing-symbols package))))))
   t)
 
 (defun shadow (symbols &optional (package (sane-package)))
   #!+sb-doc
-  "Make an internal symbol in Package with the same name as each of the
-  specified symbols, adding the new symbols to the Package-Shadowing-Symbols.
-  If a symbol with the given name is already present in Package, then
-  the existing symbol is placed in the shadowing symbols list if it is
-  not already present."
+  "Make an internal symbol in PACKAGE with the same name as each of
+  the specified SYMBOLS. If a symbol with the given name is already
+  present in PACKAGE, then the existing symbol is placed in the
+  shadowing symbols list if it is not already present."
   (let* ((package (find-undeleted-package-or-lose package))
-	 (internal (package-internal-symbols package))
-	 (symbols (string-listify symbols))
-	 (lock-asserted-p nil))
+         (internal (package-internal-symbols package))
+         (symbols (string-listify symbols))
+         (lock-asserted-p nil))
     (flet ((present-p (w)
-	     (and w (not (eq w :inherited)))))
+             (and w (not (eq w :inherited)))))
       (with-single-package-locked-error ()
-	(dolist (name symbols)
-	  (multiple-value-bind (s w) (find-symbol name package)
-	    (unless (or lock-asserted-p 
-			(and (present-p w)
-			     (member s (package-shadowing-symbols package))))
-	      (assert-package-unlocked package "shadowing symbol~P ~{~A~^, ~}"
-				       (length symbols) symbols)
-	      (setf lock-asserted-p t))
-	    (unless (present-p w)
-	      (setq s (make-symbol name))
-	      (%set-symbol-package s package)
-	      (add-symbol internal s))
-	    (pushnew s (package-%shadowing-symbols package)))))))
+        (dolist (name symbols)
+          (multiple-value-bind (s w) (find-symbol name package)
+            (unless (or lock-asserted-p
+                        (and (present-p w)
+                             (member s (package-shadowing-symbols package))))
+              (assert-package-unlocked package "shadowing symbol~P ~{~A~^, ~}"
+                                       (length symbols) symbols)
+              (setf lock-asserted-p t))
+            (unless (present-p w)
+              (setq s (make-symbol name))
+              (%set-symbol-package s package)
+              (add-symbol internal s))
+            (pushnew s (package-%shadowing-symbols package)))))))
   t)
 
 ;;; Do stuff to use a package, with all kinds of fun name-conflict checking.
 (defun use-package (packages-to-use &optional (package (sane-package)))
   #!+sb-doc
-  "Add all the Packages-To-Use to the use list for Package so that
+  "Add all the PACKAGES-TO-USE to the use list for PACKAGE so that
   the external symbols of the used packages are accessible as internal
-  symbols in Package."
+  symbols in PACKAGE."
   (let ((packages (package-listify packages-to-use))
-	(package (find-undeleted-package-or-lose package)))
+        (package (find-undeleted-package-or-lose package)))
 
     ;; Loop over each package, USE'ing one at a time...
     (with-single-package-locked-error ()
       (dolist (pkg packages)
-	(unless (member pkg (package-%use-list package))
-	  (assert-package-unlocked package "using package~P ~{~A~^, ~}"
-				   (length packages) packages)
-	  (let ((cset ())
-		(shadowing-symbols (package-%shadowing-symbols package))
-		(use-list (package-%use-list package)))
-	  
-	    ;;   If the number of symbols already accessible is less than the
-	    ;; number to be inherited then it is faster to run the test the
-	    ;; other way. This is particularly valuable in the case of
-	    ;; a new package USEing Lisp.
-	    (cond
-	      ((< (+ (package-internal-symbol-count package)
-		     (package-external-symbol-count package)
-		     (let ((res 0))
-		       (dolist (p use-list res)
-			 (incf res (package-external-symbol-count p)))))
-		  (package-external-symbol-count pkg))
-	       (do-symbols (sym package)
-		 (multiple-value-bind (s w)
-		     (find-external-symbol (symbol-name sym) pkg)
-		   (when (and w (not (eq s sym))
-			      (not (member sym shadowing-symbols)))
-		     (push sym cset))))
-	       (dolist (p use-list)
-		 (do-external-symbols (sym p)
-		   (multiple-value-bind (s w)
-		       (find-external-symbol (symbol-name sym) pkg)
-		     (when (and w (not (eq s sym))
-				(not (member (find-symbol (symbol-name sym)
-							  package)
-					     shadowing-symbols)))
-		       (push sym cset))))))
-	      (t
-	       (do-external-symbols (sym pkg)
-		 (multiple-value-bind (s w)
-		     (find-symbol (symbol-name sym) package)
-		   (when (and w (not (eq s sym))
-			      (not (member s shadowing-symbols)))
-		     (push s cset))))))
-
-	    (when cset
-	      (cerror
-	       "Unintern the conflicting symbols in the ~2*~A package."
-	       "Using package ~A results in name conflicts for these symbols:~%~
-                ~S"
-	       (package-%name pkg) cset (package-%name package))
-	      (dolist (s cset) (moby-unintern s package))))
-
-	  (push pkg (package-%use-list package))
-	  (push (package-external-symbols pkg) (cdr (package-tables package)))
-	  (push package (package-%used-by-list pkg))))))
+        (unless (member pkg (package-%use-list package))
+          (assert-package-unlocked package "using package~P ~{~A~^, ~}"
+                                   (length packages) packages)
+          (let ((shadowing-symbols (package-%shadowing-symbols package))
+                (use-list (package-%use-list package)))
+
+            ;; If the number of symbols already accessible is less
+            ;; than the number to be inherited then it is faster to
+            ;; run the test the other way. This is particularly
+            ;; valuable in the case of a new package USEing
+            ;; COMMON-LISP.
+            (cond
+              ((< (+ (package-internal-symbol-count package)
+                     (package-external-symbol-count package)
+                     (let ((res 0))
+                       (dolist (p use-list res)
+                         (incf res (package-external-symbol-count p)))))
+                  (package-external-symbol-count pkg))
+               (do-symbols (sym package)
+                 (multiple-value-bind (s w)
+                     (find-external-symbol (symbol-name sym) pkg)
+                   (when (and w
+                              (not (eq s sym))
+                              (not (member sym shadowing-symbols)))
+                     (name-conflict package 'use-package pkg sym s))))
+               (dolist (p use-list)
+                 (do-external-symbols (sym p)
+                   (multiple-value-bind (s w)
+                       (find-external-symbol (symbol-name sym) pkg)
+                     (when (and w
+                                (not (eq s sym))
+                                (not (member
+                                      (find-symbol (symbol-name sym) package)
+                                      shadowing-symbols)))
+                       (name-conflict package 'use-package pkg sym s))))))
+              (t
+               (do-external-symbols (sym pkg)
+                 (multiple-value-bind (s w)
+                     (find-symbol (symbol-name sym) package)
+                   (when (and w
+                              (not (eq s sym))
+                              (not (member s shadowing-symbols)))
+                     (name-conflict package 'use-package pkg sym s)))))))
+
+          (push pkg (package-%use-list package))
+          (push (package-external-symbols pkg) (cdr (package-tables package)))
+          (push package (package-%used-by-list pkg))))))
   t)
 
 (defun unuse-package (packages-to-unuse &optional (package (sane-package)))
   #!+sb-doc
   "Remove PACKAGES-TO-UNUSE from the USE list for PACKAGE."
   (let ((package (find-undeleted-package-or-lose package))
-	(packages (package-listify packages-to-unuse)))
+        (packages (package-listify packages-to-unuse)))
     (with-single-package-locked-error ()
       (dolist (p packages)
-	(when (member p (package-use-list package))
-	  (assert-package-unlocked package "unusing package~P ~{~A~^, ~}"
-				   (length packages) packages))
-	(setf (package-%use-list package)
-	      (remove p (the list (package-%use-list package))))
-	(setf (package-tables package)
-	      (delete (package-external-symbols p)
-		      (the list (package-tables package))))
-	(setf (package-%used-by-list p)
-	      (remove package (the list (package-%used-by-list p))))))
+        (when (member p (package-use-list package))
+          (assert-package-unlocked package "unusing package~P ~{~A~^, ~}"
+                                   (length packages) packages))
+        (setf (package-%use-list package)
+              (remove p (the list (package-%use-list package))))
+        (setf (package-tables package)
+              (delete (package-external-symbols p)
+                      (the list (package-tables package))))
+        (setf (package-%used-by-list p)
+              (remove package (the list (package-%used-by-list p))))))
     t))
 
 (defun find-all-symbols (string-or-symbol)
   #!+sb-doc
   "Return a list of all symbols in the system having the specified name."
   (let ((string (string string-or-symbol))
-	(res ()))
+        (res ()))
     (maphash (lambda (k v)
-	       (declare (ignore k))
-	       (multiple-value-bind (s w) (find-symbol string v)
-		 (when w (pushnew s res))))
-	     *package-names*)
+               (declare (ignore k))
+               (multiple-value-bind (s w) (find-symbol string v)
+                 (when w (pushnew s res))))
+             *package-names*)
     res))
 
 ;;;; APROPOS and APROPOS-LIST
@@ -1131,28 +1291,28 @@ error if any of PACKAGES is not a valid package designator."
     (write-string " (fbound)")))
 
 (defun apropos-list (string-designator
-		     &optional
-		     package-designator
-		     external-only)
+                     &optional
+                     package-designator
+                     external-only)
   #!+sb-doc
   "Like APROPOS, except that it returns a list of the symbols found instead
   of describing them."
   (if package-designator
       (let ((package (find-undeleted-package-or-lose package-designator))
-	    (string (stringify-name string-designator "APROPOS search"))
-	    (result nil))
-	(do-symbols (symbol package)
-	  (when (and (eq (symbol-package symbol) package)
-		     (or (not external-only)
-			 (eq (nth-value 1 (find-symbol (symbol-name symbol)
-						       package))
-			     :external))
-		     (search string (symbol-name symbol) :test #'char-equal))
-	    (push symbol result)))
-	result)
+            (string (stringify-string-designator string-designator))
+            (result nil))
+        (do-symbols (symbol package)
+          (when (and (eq (symbol-package symbol) package)
+                     (or (not external-only)
+                         (eq (nth-value 1 (find-symbol (symbol-name symbol)
+                                                       package))
+                             :external))
+                     (search string (symbol-name symbol) :test #'char-equal))
+            (push symbol result)))
+        result)
       (mapcan (lambda (package)
-		(apropos-list string-designator package external-only))
-	      (list-all-packages))))
+                (apropos-list string-designator package external-only))
+              (list-all-packages))))
 
 (defun apropos (string-designator &optional package external-only)
   #!+sb-doc
@@ -1184,26 +1344,26 @@ error if any of PACKAGES is not a valid package designator."
   (/show0 "about to loop over *!INITIAL-SYMBOLS* to make packages")
   (dolist (spec *!initial-symbols*)
     (let* ((pkg (apply #'make-package (first spec)))
-	   (internal (package-internal-symbols pkg))
-	   (external (package-external-symbols pkg)))
+           (internal (package-internal-symbols pkg))
+           (external (package-external-symbols pkg)))
       (/show0 "back from MAKE-PACKAGE, PACKAGE-NAME=..")
       (/primitive-print (package-name pkg))
 
       ;; Put internal symbols in the internal hashtable and set package.
       (dolist (symbol (second spec))
-	(add-symbol internal symbol)
-	(%set-symbol-package symbol pkg))
+        (add-symbol internal symbol)
+        (%set-symbol-package symbol pkg))
 
       ;; External symbols same, only go in external table.
       (dolist (symbol (third spec))
-	(add-symbol external symbol)
-	(%set-symbol-package symbol pkg))
+        (add-symbol external symbol)
+        (%set-symbol-package symbol pkg))
 
       ;; Don't set package for imported symbols.
       (dolist (symbol (fourth spec))
-	(add-symbol internal symbol))
+        (add-symbol internal symbol))
       (dolist (symbol (fifth spec))
-	(add-symbol external symbol))
+        (add-symbol external symbol))
 
       ;; Put shadowing symbols in the shadowing symbols list.
       (setf (package-%shadowing-symbols pkg) (sixth spec))
@@ -1230,12 +1390,12 @@ error if any of PACKAGES is not a valid package designator."
   ;; ..but instead making our own from scratch here.
   (/show0 "about to MAKE-PACKAGE COMMON-LISP-USER")
   (make-package "COMMON-LISP-USER"
-		:nicknames '("CL-USER")
-		:use '("COMMON-LISP"
-		       ;; ANSI encourages us to put extension packages
-		       ;; in the USE list of COMMON-LISP-USER.
-		       "SB!ALIEN" "SB!ALIEN" "SB!DEBUG"
-		       "SB!EXT" "SB!GRAY" "SB!PROFILE"))
+                :nicknames '("CL-USER")
+                :use '("COMMON-LISP"
+                       ;; ANSI encourages us to put extension packages
+                       ;; in the USE list of COMMON-LISP-USER.
+                       "SB!ALIEN" "SB!ALIEN" "SB!DEBUG"
+                       "SB!EXT" "SB!GRAY" "SB!PROFILE"))
 
   ;; Now do the *!DEFERRED-USE-PACKAGES*.
   (/show0 "about to do *!DEFERRED-USE-PACKAGES*")