projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.18.3:
[sbcl.git]
/
src
/
code
/
package.lisp
diff --git
a/src/code/package.lisp
b/src/code/package.lisp
index
b290abb
..
80455ac
100644
(file)
--- 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.
;;; 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.
;; 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.
;; 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.)
;; 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.
;; 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
;; 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
;;; 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
;;; 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
@@
-98,7
+99,12
@@
;; shadowing symbols
(%shadowing-symbols () :type list)
;; documentation string for this package
;; 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))
\f
;;;; iteration macros
\f
;;;; iteration macros
@@
-110,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."
"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 :doc-string-allowed nil)
(let ((flet-name (gensym "DO-SYMBOLS-")))
`(block nil
(flet ((,flet-name (,var)
(let ((flet-name (gensym "DO-SYMBOLS-")))
`(block nil
(flet ((,flet-name (,var)
@@
-121,9
+128,6
@@
(flet ((iterate-over-hash-table (table ignore)
(let ((hash-vec (package-hashtable-hash table))
(sym-vec (package-hashtable-table table)))
(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)))
(dotimes (i (length sym-vec))
(when (>= (aref hash-vec i) 2)
(let ((sym (aref sym-vec i)))
@@
-148,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."
"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)
(let ((flet-name (gensym "DO-SYMBOLS-")))
`(block nil
(flet ((,flet-name (,var)
@@
-158,9
+163,6
@@
(table (package-external-symbols package))
(hash-vec (package-hashtable-hash table))
(sym-vec (package-hashtable-table table)))
(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))))))
(dotimes (i (length sym-vec))
(when (>= (aref hash-vec i) 2)
(,flet-name (aref sym-vec i))))))
@@
-176,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."
"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)
(let ((flet-name (gensym "DO-SYMBOLS-")))
`(block nil
(flet ((,flet-name (,var)
@@
-186,9
+189,6
@@
(flet ((iterate-over-hash-table (table)
(let ((hash-vec (package-hashtable-hash table))
(sym-vec (package-hashtable-table table)))
(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)))))))
(dotimes (i (length sym-vec))
(when (>= (aref hash-vec i) 2)
(,flet-name (aref sym-vec i)))))))
@@
-230,7
+230,13
@@
(,packages `,(mapcar (lambda (package)
(if (packagep package)
package
(,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))))
(if (consp ,these-packages)
,these-packages
(list ,these-packages))))
@@
-243,6
+249,7
@@
`(setf ,package-use-list (package-%use-list (car ,packages)))
`(declare (ignore ,package-use-list)))
(macrolet ((,init-macro (next-kind)
`(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)
(let ((symbols (gensym)))
`(progn
(setf ,',kind ,next-kind)
@@
-283,7
+290,7
@@
(error 'simple-program-error
:format-control
"At least one of :INTERNAL, :EXTERNAL, or ~
(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
,(dolist (symbol symbol-types)
(unless (member symbol '(:internal :external :inherited))
(error 'program-error
@@
-294,6
+301,7
@@
(flet ((,real-symbol-p (number)
(> number 1)))
(macrolet ((,mname ()
(flet ((,real-symbol-p (number)
(> number 1)))
(macrolet ((,mname ()
+ (declare (optimize (inhibit-warnings 3)))
`(block ,',BLOCK
(loop
(case ,',kind
`(block ,',BLOCK
(loop
(case ,',kind
@@
-301,7
+309,7
@@
`((:internal
(setf ,',counter
(position-if #',',real-symbol-p
`((:internal
(setf ,',counter
(position-if #',',real-symbol-p
- ,',hash-vector
+ (the hash-vector ,',hash-vector)
:start (if ,',counter
(1+ ,',counter)
0)))
:start (if ,',counter
(1+ ,',counter)
0)))
@@
-314,7
+322,7
@@
`((:external
(setf ,',counter
(position-if #',',real-symbol-p
`((:external
(setf ,',counter
(position-if #',',real-symbol-p
- ,',hash-vector
+ (the hash-vector ,',hash-vector)
:start (if ,',counter
(1+ ,',counter)
0)))
:start (if ,',counter
(1+ ,',counter)
0)))
@@
-328,7
+336,9
@@
(flet ((,',inherited-symbol-p (number)
(when (,',real-symbol-p number)
(let* ((p (position
(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)))
:start (if ,',counter
(1+ ,',counter)
0)))
@@
-339,11
+349,13
@@
(car ,',packages)))
:inherited)))))
(setf ,',counter
(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
(cond (,',counter
(return-from
,',BLOCK