X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-package.lisp;h=00cbc54efe98a64f8ab6cd244cdcd6923e28fa8b;hb=57c91e4719ca9d0f9b8bef3b713ba40088a275f6;hp=7efbdff7931db4ed3563a6737234b31bbda320f9;hpb=8b44c2ab1f8608780991b5695b06bad59005fbb1;p=sbcl.git

diff --git a/src/code/target-package.lisp b/src/code/target-package.lisp
index 7efbdff..00cbc54 100644
--- a/src/code/target-package.lisp
+++ b/src/code/target-package.lisp
@@ -61,9 +61,6 @@
   (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)))
 
@@ -75,7 +72,7 @@
 
 (defmacro with-package-names ((names &key) &body body)
   `(let ((,names *package-names*))
-     (with-locked-hash-table (,names)
+     (with-locked-system-table (,names)
        ,@body)))
 
 ;;;; PACKAGE-HASHTABLE stuff
@@ -338,7 +335,8 @@ error if any of PACKAGES is not a valid package designator."
 ;;; 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)
@@ -599,7 +597,7 @@ implementation it is ~S." *default-package-use-list*)
        (cerror "Clobber existing package."
                "A package named ~S already exists" name)
        (setf clobber t))
-     (with-packages ()
+     (with-package-graph ()
        ;; Check for race, signal the error outside the lock.
        (when (and (not clobber) (find-package name))
          (go :restart))
@@ -779,7 +777,7 @@ implementation it is ~S." *default-package-use-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
@@ -793,7 +791,18 @@ implementation it is ~S." *default-package-use-list*)
              (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)))