runlisp-base.conf: Etch SBCL's idea of where its `home' is.

Older SBCL versions end up believing that their `home' directory is
wherever the image was loaded from, but this is wrong for our dumped
images.

The directory is set by the C runtime code and (rather unpleasantly)
passed through the `SBCL_HOME' environment variable to Lisp, which
retrieves it via the `sb-impl::sbcl-homedir-pathname' function.

On the affected older SBCL versions, when we're dumping an image,
replace `sb-impl::sbcl-homedir-pathname' with a version which just
parrots the pre-dumped value.

Mention in `README.org' that it doesn't describe the actual SBCL
configuration any more.  (Sadness.)

diff --git a/README.org b/README.org
index fd8c9e4083c2b126ea2982cac9680f95ca981751..29fb37df0edd952e238adf9826fab669ad6e20dd 100644 (file)
--- a/README.org
+++ b/README.org
@@ -328,7 +328,9 @@ Lisp.  (SBCL's command-line interface is well thought-out, so this is an
 ideal opportunity to explain how ~runlisp~ configuration works, without
 getting bogged down in the details of fighting less amenable Lisps.)
 
 ideal opportunity to explain how ~runlisp~ configuration works, without
 getting bogged down in the details of fighting less amenable Lisps.)
 

-The provided ~0base.conf~ file defines SBCL as follows.
+The provided ~0base.conf~ file used to define SBCL as follows.  (The
+real version now contains a kludge for old versions, which needn't
+concern us here.)

 
 : [sbcl]
 : 
 
 : [sbcl]
 : 

diff --git a/runlisp-base.conf b/runlisp-base.conf
index dc1ecefaf73435f6d82c4d94be065d3eb1abdeee..7634e422460fe34fe5557a6690decde4760751b0 100644 (file)
--- a/runlisp-base.conf
+++ b/runlisp-base.conf
@@ -148,6 +148,19 @@ image-path = ${@image-dir}/${image-file}
 command = ${@ENV:SBCL?sbcl}
 image-file = ${@name}+asdf.core
 
 command = ${@ENV:SBCL?sbcl}
 image-file = ${@name}+asdf.core
 

+;; Older versions of SBCL forget their home directory when an image is
+;; dumped, so we must help this one to remember.
+etch-sbcl-home =
+       (let* ((#100=#:sfs (find-symbol "*STATIC-FOREIGN-SYMBOLS*" "SB-IMPL"))
+              (#101=#:shp (find-symbol "SBCL-HOMEDIR-PATHNAME" "SB-IMPL")))
+         (unless (or (not #100#) (not #101#)
+                     (gethash "sbcl_home" (symbol-value #100#)))
+           (#+sb-package-locks without-package-locks
+            #-sb-package-locks progn
+             (setf (symbol-function #101#)
+                   (let ((#102=#:etched-sbcl-home (funcall #101#)))
+                     (lambda () #102#))))))
+

 run-script =
        ${command} --noinform
                $?@image{--core "${image-path}" --eval "${image-restore}" |
 run-script =
        ${command} --noinform
                $?@image{--core "${image-path}" --eval "${image-restore}" |


@@ -157,6 +170,7 @@ run-script =
 dump-image =
        ${command} --noinform --no-userinit --no-sysinit --disable-debugger
                --eval "${dump-image-prelude}"
 dump-image =
        ${command} --noinform --no-userinit --no-sysinit --disable-debugger
                --eval "${dump-image-prelude}"

+               --eval "${etch-sbcl-home}"

                --eval "(sb-ext:save-lisp-and-die \"${@image-new|q}\")"
 
 ;;;--------------------------------------------------------------------------
                --eval "(sb-ext:save-lisp-and-die \"${@image-new|q}\")"
 
 ;;;--------------------------------------------------------------------------

diff --git a/tests.at b/tests.at
index b7991db6ae9a7855ce7c5f00d0944511378ae5cb..c765753aed69e33d651118f9e5437564abcfc206 100644 (file)
--- a/tests.at
+++ b/tests.at
@@ -341,4 +341,15 @@ done
 
 AT_CLEANUP
 
 
 AT_CLEANUP
 

+###--------------------------------------------------------------------------
+### Implementation-specific tests.
+
+AT_SETUP([specific sbcl])
+AT_KEYWORDS([specific sbcl])
+PREPARE_LISP_TEST([sbcl])
+
+AT_CHECK([RUNLISP_PATH -e"(require 'sb-bsd-sockets)"])
+
+AT_CLEANUP
+

 ###----- That's all, folks --------------------------------------------------
 ###----- That's all, folks --------------------------------------------------