0.8.0.2:

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

diff --git a/src/code/package.lisp b/src/code/package.lisp
index b290abb..c43c5e4 100644 (file)
--- a/src/code/package.lisp
+++ b/src/code/package.lisp
@@ -32,22 +32,22 @@
 
 (sb!xc:deftype hash-vector () '(simple-array (unsigned-byte 8) (*)))
 
-(sb!xc:defstruct (package-hashtable (:constructor %make-package-hashtable ())
-                                   (:copier nil))
+(sb!xc:defstruct (package-hashtable
+                   (:constructor %make-package-hashtable
+                                 (table hash size &aux (free size)))
+                   (:copier nil))
   ;; The g-vector of symbols.
-  ;; FIXME: could just be type SIMPLE-VECTOR, with (MISSING-ARG) default
-  (table nil :type (or simple-vector null))
+  (table (missing-arg) :type simple-vector)
   ;; The i-vector of pname hash values.
-  ;; FIXME: could just be type HASH-VECTOR, with (MISSING-ARG) default
-  (hash nil :type (or hash-vector null))
+  (hash (missing-arg) :type hash-vector)
   ;; The total number of entries allowed before resizing.
   ;;
   ;; FIXME: CAPACITY would be a more descriptive name. (This is
   ;; related to but not quite the same as HASH-TABLE-SIZE, so calling
   ;; it SIZE seems somewhat misleading.)
-  (size 0 :type index)
+  (size (missing-arg) :type index)
   ;; The remaining number of entries that can be made before we have to rehash.
-  (free 0 :type index)
+  (free (missing-arg) :type index)
   ;; The number of deleted entries.
   (deleted 0 :type index))
 \f
@@ -56,8 +56,9 @@
 ;;; KLUDGE: We use DEF!STRUCT to define this not because we need to
 ;;; manipulate target package objects on the cross-compilation host,
 ;;; but only because its MAKE-LOAD-FORM function needs to be hooked
-;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system. The DEF!STRUCT
-;;; side-effect of defining a new PACKAGE type on the
+;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system so that we can
+;;; compile things like IN-PACKAGE in warm init before CLOS is set up.
+;;; The DEF!STRUCT side effect of defining a new PACKAGE type on the
 ;;; cross-compilation host is just a nuisance, and in order to avoid
 ;;; breaking the cross-compilation host, we need to work around it
 ;;; around by putting the new PACKAGE type (and the PACKAGEP predicate
@@ -110,7 +111,7 @@
   "DO-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs at least once for each symbol accessible in the given
    PACKAGE with VAR bound to the current symbol."
-  (multiple-value-bind (body decls) body-decls
+  (multiple-value-bind (body decls) (parse-body body-decls nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
         (flet ((,flet-name (,var)
@@ -121,9 +122,6 @@
             (flet ((iterate-over-hash-table (table ignore)
                      (let ((hash-vec (package-hashtable-hash table))
                            (sym-vec (package-hashtable-table table)))
-                       (declare (type (simple-array (unsigned-byte 8) (*))
-                                      hash-vec)
-                                (type simple-vector sym-vec))
                        (dotimes (i (length sym-vec))
                          (when (>= (aref hash-vec i) 2)
                            (let ((sym (aref sym-vec i)))
@@ -158,9 +156,6 @@
                  (table (package-external-symbols package))
                  (hash-vec (package-hashtable-hash table))
                  (sym-vec (package-hashtable-table table)))
-            (declare (type (simple-array (unsigned-byte 8) (*))
-                           hash-vec)
-                     (type simple-vector sym-vec))
             (dotimes (i (length sym-vec))
               (when (>= (aref hash-vec i) 2)
                 (,flet-name (aref sym-vec i))))))
@@ -186,9 +181,6 @@
             (flet ((iterate-over-hash-table (table)
                      (let ((hash-vec (package-hashtable-hash table))
                            (sym-vec (package-hashtable-table table)))
-                       (declare (type (simple-array (unsigned-byte 8) (*))
-                                      hash-vec)
-                                (type simple-vector sym-vec))
                        (dotimes (i (length sym-vec))
                          (when (>= (aref hash-vec i) 2)
                            (,flet-name (aref sym-vec i)))))))
@@ -230,7 +222,13 @@
            (,packages `,(mapcar (lambda (package)
                                   (if (packagep package)
                                       package
-                                      (find-package package)))
+                                      ;; Maybe FIND-PACKAGE-OR-DIE?
+                                      (or (find-package package)
+                                          (error 'simple-package-error
+                                                 ;; could be a character
+                                                 :name (string package)
+                                                 :format-control "~@<~S does not name a package ~:>"
+                                                 :format-arguments (list package)))))
                                 (if (consp ,these-packages)
                                     ,these-packages
                                     (list ,these-packages))))
@@ -243,6 +241,7 @@
            `(setf ,package-use-list (package-%use-list (car ,packages)))
            `(declare (ignore ,package-use-list)))
        (macrolet ((,init-macro (next-kind)
+        (declare (optimize (inhibit-warnings 3)))
         (let ((symbols (gensym)))
           `(progn
              (setf ,',kind ,next-kind)
@@ -294,6 +293,7 @@
           (flet ((,real-symbol-p (number)
                    (> number 1)))
             (macrolet ((,mname ()
+             (declare (optimize (inhibit-warnings 3)))
              `(block ,',BLOCK
                 (loop
                   (case ,',kind