(declare (function function))
;; FIXME: Since name conflicts can be signalled while holding the
;; mutex, user code can be run leading to lock ordering problems.
- ;;
- ;; This used to be a spinlock, but there it can be held for a long
- ;; time while the debugger waits for user input.
(sb!thread:with-recursive-lock (*package-graph-lock*)
(funcall function)))
(defmacro with-package-names ((names &key) &body body)
`(let ((,names *package-names*))
- (with-locked-hash-table (,names)
+ (with-locked-system-table (,names)
,@body)))
\f
;;;; PACKAGE-HASHTABLE stuff
;;; most other operations, are unspecified for deleted packages. We
;;; just do the easy thing and signal errors in that case.
(macrolet ((def (ext real)
- `(defun ,ext (x) (,real (find-undeleted-package-or-lose x)))))
+ `(defun ,ext (package-designator)
+ (,real (find-undeleted-package-or-lose package-designator)))))
(def package-nicknames package-%nicknames)
(def package-use-list package-%use-list)
(def package-used-by-list package-%used-by-list)
;;; If the symbol named by the first LENGTH characters of NAME doesn't exist,
;;; then create it, special-casing the keyword package.
-(defun intern* (name length package)
+(defun intern* (name length package &key no-copy)
(declare (simple-string name))
(multiple-value-bind (symbol where) (find-symbol* name length package)
(cond (where
(setf (values symbol where) (find-symbol* name length package))
(if where
(values symbol where)
- (let ((symbol-name (subseq name 0 length)))
+ (let ((symbol-name (cond (no-copy
+ (aver (= (length name) length))
+ name)
+ (t
+ ;; This so that SUBSEQ is inlined,
+ ;; because we need it fixed for cold init.
+ (string-dispatch
+ ((simple-array base-char (*))
+ (simple-array character (*)))
+ name
+ (declare (optimize speed))
+ (subseq name 0 length))))))
(with-single-package-locked-error
(:package package "interning ~A" symbol-name)
(let ((symbol (make-symbol symbol-name)))