X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fchill.lisp;h=11566980f766059b6e119410d83cb4c5e1aa8270;hb=f0f3805c145f2699701997761e2c6f55c475c192;hp=50f0b9e3a7cfd40171f694f7a08fb7ae90f7bc9f;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/cold/chill.lisp b/src/cold/chill.lisp
index 50f0b9e..1156698 100644
--- a/src/cold/chill.lisp
+++ b/src/cold/chill.lisp
@@ -1,6 +1,6 @@
-;;;; This file is not used cold load time. Instead, it can be loaded
-;;;; into an initialized SBCL to get it into a nostalgic frame of
-;;;; mind, remembering the way things were in cold init, so that it
+;;;; This file is not used at cold load time. Instead, it can be
+;;;; loaded into an initialized SBCL to get it into a nostalgic frame
+;;;; of mind, remembering the way things were in cold init, so that it
 ;;;; can READ code which is ordinarily read only when bootstrapping.
 ;;;; (This can be useful when debugging the system, since the debugger
 ;;;; likes to be able to read the source for the code. It can also be
@@ -20,25 +20,32 @@
 (in-package "SB-COLD")
 
 ;;; We need the #! readtable modifications.
-(load "src/cold/shebang.lisp")
+(load (merge-pathnames "shebang.lisp" *load-truename*))
 
 ;;; #!+ and #!- now refer to *FEATURES* values (as opposed to the way
 ;;; that they referred to special target-only *SHEBANG-FEATURES* values
 ;;; during cold init).
 (setf sb-cold:*shebang-features* *features*)
+;;; 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")))
+(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 (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))))))
+  ;; 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)))))