X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpackage.lisp;h=7f67aa633d90e1c0e59fdf063d2a6a8f552fd385;hb=e92a2f8844d9125e76a4b96dc27b56632bfd85b6;hp=7c6fc3be700e218ff7e24f2e9d39dd64fb7a8293;hpb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;p=sbcl.git diff --git a/src/code/package.lisp b/src/code/package.lisp index 7c6fc3b..7f67aa6 100644 --- 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 REQUIRED-ARG - (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 REQUIRED-ARG - (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)) @@ -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))))))) @@ -227,10 +219,16 @@ (inherited-symbol-p (gensym)) (BLOCK (gensym))) `(let* ((,these-packages ,package-list) - (,packages `,(mapcar #'(lambda (package) - (if (packagep package) - package - (find-package package))) + (,packages `,(mapcar (lambda (package) + (if (packagep 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) @@ -253,7 +252,8 @@ (car ,',packages)))) (when ,symbols (setf ,',vector (package-hashtable-table ,symbols)) - (setf ,',hash-vector (package-hashtable-hash ,symbols))))) + (setf ,',hash-vector + (package-hashtable-hash ,symbols))))) (:external `(let ((,symbols (package-external-symbols (car ,',packages)))) @@ -293,6 +293,7 @@ (flet ((,real-symbol-p (number) (> number 1))) (macrolet ((,mname () + (declare (optimize (inhibit-warnings 3))) `(block ,',BLOCK (loop (case ,',kind @@ -300,7 +301,7 @@ `((:internal (setf ,',counter (position-if #',',real-symbol-p - ,',hash-vector + (the hash-vector ,',hash-vector) :start (if ,',counter (1+ ,',counter) 0))) @@ -313,7 +314,7 @@ `((:external (setf ,',counter (position-if #',',real-symbol-p - ,',hash-vector + (the hash-vector ,',hash-vector) :start (if ,',counter (1+ ,',counter) 0))) @@ -327,7 +328,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))) @@ -339,7 +342,8 @@ :inherited))))) (setf ,',counter (position-if #',',inherited-symbol-p - ,',hash-vector + (the hash-vector + ,',hash-vector) :start (if ,',counter (1+ ,',counter) 0))))