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

[runlisp] / runlisp-base.conf

diff --git a/runlisp-base.conf b/runlisp-base.conf
index dc1ecef..7634e42 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
 
+;; 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}" |
@@ -157,6 +170,7 @@ run-script =
 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}\")"
 
 ;;;--------------------------------------------------------------------------