X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fchill.lisp;h=11566980f766059b6e119410d83cb4c5e1aa8270;hb=51bc001b7a98af096af782a672389e51004af068;hp=9878c7e88753979d00a3db24b53470a850dd478d;hpb=e9d7104061dbcb5df1b0cbdb4afa559b7044ab62;p=sbcl.git diff --git a/src/cold/chill.lisp b/src/cold/chill.lisp index 9878c7e..1156698 100644 --- a/src/cold/chill.lisp +++ b/src/cold/chill.lisp @@ -29,19 +29,23 @@ ;;; Just in case we want to play with the initial value of ;;; backend-subfeatures (setf sb-cold:*shebang-backend-subfeatures* sb-c:*backend-subfeatures*) -;;; The nickname SB!XC now refers to the CL package. -(rename-package "COMMON-LISP" - "COMMON-LISP" - (cons "SB!XC" (package-nicknames "CL"))) -;;; Any other name SB!FOO refers to the package now called SB-FOO. -(dolist (package (list-all-packages)) - (let ((name (package-name package)) - (nicknames (package-nicknames package)) - (warm-name-prefix "SB-") - (cold-name-prefix "SB!")) - (when (and (> (length name) (length warm-name-prefix)) - (string= name warm-name-prefix :end1 (length warm-name-prefix))) - (let* ((stem (subseq name (length cold-name-prefix))) - (cold-name (concatenate 'simple-string cold-name-prefix stem))) - (rename-package package name (cons cold-name nicknames)))))) +(handler-bind ((sb-ext:package-locked-error #'continue)) + ;; The nickname SB!XC now refers to the CL package. + (rename-package "COMMON-LISP" "COMMON-LISP" + (cons "SB!XC" (package-nicknames "CL"))) + (sb-ext:unlock-package "CL") + + ;; Any other name SB!FOO refers to the package now called SB-FOO. + (dolist (package (list-all-packages)) + (let ((name (package-name package)) + (nicknames (package-nicknames package)) + (warm-name-prefix "SB-") + (cold-name-prefix "SB!")) + (when (and (> (length name) (length warm-name-prefix)) + (string= name warm-name-prefix + :end1 (length warm-name-prefix))) + (let* ((stem (subseq name (length cold-name-prefix))) + (cold-name (concatenate 'simple-string cold-name-prefix stem))) + (rename-package package name (cons cold-name nicknames))) + (sb-ext:unlock-package package)))))