X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpackage.lisp;h=80455aceafceb2095d4bfdff1bff0405a60f11d8;hb=dc33d6a6b84f8338e603759cec8e25da29055d50;hp=e376b9d7d55af56749a9e2552d161bbee56176b2;hpb=ea1fd7753b7dc1277a7d250fed317300fe1e5772;p=sbcl.git

diff --git a/src/code/package.lisp b/src/code/package.lisp
index e376b9d..80455ac 100644
--- a/src/code/package.lisp
+++ b/src/code/package.lisp
@@ -30,24 +30,24 @@
 ;;;   the entry is unused. If it is one, then it is deleted.
 ;;;   Double-hashing is used for collision resolution.
 
-(sb!xc:deftype hash-vector () '(simple-array (unsigned-byte 8) (*)))
+(def!type hash-vector () '(simple-array (unsigned-byte 8) (*)))
 
-(sb!xc:defstruct (package-hashtable (:constructor %make-package-hashtable ())
-				    (:copier nil))
+(def!struct (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))
 
@@ -99,7 +99,12 @@
   ;; shadowing symbols
   (%shadowing-symbols () :type list)
   ;; documentation string for this package
-  (doc-string nil :type (or simple-string null)))
+  (doc-string nil :type (or simple-string null))
+  ;; package locking
+  #!+sb-package-locks
+  (lock nil :type boolean)
+  #!+sb-package-locks
+  (%implementation-packages nil :type list))
 
 ;;;; iteration macros
 
@@ -111,7 +116,8 @@
   "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) (parse-body body-decls nil)
+  (multiple-value-bind (body decls)
+      (parse-body body-decls :doc-string-allowed nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
 	 (flet ((,flet-name (,var)
@@ -122,9 +128,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)))
@@ -149,7 +152,8 @@
   "DO-EXTERNAL-SYMBOLS (VAR [PACKAGE [RESULT-FORM]]) {DECL}* {TAG | FORM}*
    Executes the FORMs once for each external symbol in the given PACKAGE with
    VAR bound to the current symbol."
-  (multiple-value-bind (body decls) (parse-body body-decls nil)
+  (multiple-value-bind (body decls)
+      (parse-body body-decls :doc-string-allowed nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
 	 (flet ((,flet-name (,var)
@@ -159,9 +163,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))))))
@@ -177,7 +178,8 @@
   "DO-ALL-SYMBOLS (VAR [RESULT-FORM]) {DECLARATION}* {TAG | FORM}*
    Executes the FORMs once for each symbol in every package with VAR bound
    to the current symbol."
-  (multiple-value-bind (body decls) (parse-body body-decls nil)
+  (multiple-value-bind (body decls)
+      (parse-body body-decls :doc-string-allowed nil)
     (let ((flet-name (gensym "DO-SYMBOLS-")))
       `(block nil
 	 (flet ((,flet-name (,var)
@@ -187,9 +189,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)))))))
@@ -231,7 +230,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))))
@@ -244,6 +249,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)
@@ -284,7 +290,7 @@
 	      (error 'simple-program-error
 		     :format-control
 		     "At least one of :INTERNAL, :EXTERNAL, or ~
-		      :INHERITED must be supplied."))
+                      :INHERITED must be supplied."))
 	   ,(dolist (symbol symbol-types)
 	      (unless (member symbol '(:internal :external :inherited))
 		(error 'program-error
@@ -295,6 +301,7 @@
 	   (flet ((,real-symbol-p (number)
 		    (> number 1)))
 	     (macrolet ((,mname ()
+	      (declare (optimize (inhibit-warnings 3)))
 	      `(block ,',BLOCK
 		 (loop
 		   (case ,',kind
@@ -302,7 +309,7 @@
 			 `((:internal
 			    (setf ,',counter
 				  (position-if #',',real-symbol-p
-					       ,',hash-vector
+					       (the hash-vector ,',hash-vector)
 					       :start (if ,',counter
 							  (1+ ,',counter)
 							  0)))
@@ -315,7 +322,7 @@
 			 `((:external
 			    (setf ,',counter
 				  (position-if #',',real-symbol-p
-					       ,',hash-vector
+					       (the hash-vector ,',hash-vector)
 					       :start (if ,',counter
 							  (1+ ,',counter)
 							  0)))
@@ -329,7 +336,9 @@
 			    (flet ((,',inherited-symbol-p (number)
 				     (when (,',real-symbol-p number)
 				       (let* ((p (position
-						  number ,',hash-vector
+						  number
+						  (the hash-vector
+						    ,',hash-vector)
 						  :start (if ,',counter
 							     (1+ ,',counter)
 							     0)))
@@ -340,11 +349,13 @@
 						  (car ,',packages)))
 					      :inherited)))))
 			      (setf ,',counter
-				    (position-if #',',inherited-symbol-p
-						 ,',hash-vector
-						 :start (if ,',counter
-							    (1+ ,',counter)
-							    0))))
+				    (when ,',hash-vector
+				      (position-if #',',inherited-symbol-p
+						   (the hash-vector
+						     ,',hash-vector)
+						   :start (if ,',counter
+							      (1+ ,',counter)
+							      0)))))
 			    (cond (,',counter
 				   (return-from
 				    ,',BLOCK