0.pre7.49:

[sbcl.git] / src / code / target-package.lisp

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index ebac39b..40a9576 100644 (file)
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -91,21 +91,22 @@
   (def-frob package-used-by-list package-%used-by-list)
   (def-frob package-shadowing-symbols package-%shadowing-symbols))
 
-(flet ((stuff (table)
-        (let ((size (the fixnum
-                         (- (the fixnum (package-hashtable-size table))
-                            (the fixnum
-                                 (package-hashtable-deleted table))))))
-          (declare (fixnum size))
-          (values (the fixnum
-                       (- size
-                          (the fixnum
-                               (package-hashtable-free table))))
-                  size))))
-  (defun package-internal-symbol-count (package)
-    (stuff (package-internal-symbols package)))
-  (defun package-external-symbol-count (package)
-    (stuff (package-external-symbols package))))
+(defun %package-hashtable-symbol-count (table)
+  (let ((size (the fixnum
+               (- (the fixnum (package-hashtable-size table))
+                  (the fixnum
+                    (package-hashtable-deleted table))))))
+    (declare (fixnum size))
+    (the fixnum
+      (- size
+        (the fixnum
+          (package-hashtable-free table))))))
+
+(defun package-internal-symbol-count (package)
+  (%package-hashtable-symbol-count (package-internal-symbols package)))
+
+(defun package-external-symbol-count (package)
+  (%package-hashtable-symbol-count (package-external-symbols package)))
 \f
 (defvar *package* (error "*PACKAGE* should be initialized in cold load!") 
   #!+sb-doc "the current package")
@@ -261,7 +262,7 @@
         DOIT
         (return (progn ,@forms))))))
 
-;;; Delete the entry for String in Table. The entry must exist.
+;;; Delete the entry for STRING in TABLE. The entry must exist.
 (defun nuke-symbol (table string)
   (declare (simple-string string))
   (let* ((length (length string))
@@ -273,11 +274,11 @@
       (setf (aref (package-hashtable-table table) index) nil)
       (incf (package-hashtable-deleted table)))))
 \f
-;;; Enter any new Nicknames for Package into *package-names*.
+;;; Enter any new NICKNAMES for PACKAGE into *PACKAGE-NAMES*.
 ;;; If there is a conflict then give the user a chance to do
 ;;; something about it.
 (defun enter-new-nicknames (package nicknames)
-  (check-type nicknames list)
+  (declare (type list nicknames))
   (dolist (n nicknames)
     (let* ((n (package-namify n))
           (found (gethash n *package-names*)))
@@ -859,9 +860,6 @@
 \f
 ;;;; APROPOS and APROPOS-LIST
 
-;;; KLUDGE: All the APROPOS stuff should probably be byte-compiled, since it's
-;;; only likely to be used interactively. -- WHN 19990827
-
 (defun briefly-describe-symbol (symbol)
   (fresh-line)
   (prin1 symbol)
@@ -921,8 +919,8 @@
     (let* ((pkg (apply #'make-package (first spec)))
           (internal (package-internal-symbols pkg))
           (external (package-external-symbols pkg)))
-      (/show0 "back from MAKE-PACKAGE")
-      #!+sb-show (sb!sys:%primitive print (package-name 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))
@@ -959,7 +957,7 @@
   ;; nicknames that we don't want in our target SBCL. For that reason,
   ;; we handle it specially, not dumping the host Lisp version at
   ;; genesis time..
-  (assert (not (find-package "COMMON-LISP-USER")))
+  (aver (not (find-package "COMMON-LISP-USER")))
   ;; ..but instead making our own from scratch here.
   (/show0 "about to MAKE-PACKAGE COMMON-LISP-USER")
   (make-package "COMMON-LISP-USER"