README.org: Mention that `runlisp' can support non-free Lisps.

[runlisp] / runlisp-base.conf

diff --git a/runlisp-base.conf b/runlisp-base.conf
index d733c1c..7634e42 100644 (file)
--- a/runlisp-base.conf
+++ b/runlisp-base.conf
@@ -85,11 +85,24 @@ require-asdf =
 ;; Prevent ASDF from upgrading itself.  Otherwise it will do this
 ;; automatically if a script invokes `asdf:load-system', but that will have a
 ;; bad effect on startup time, and risks spamming the output streams with
 ;; Prevent ASDF from upgrading itself.  Otherwise it will do this
 ;; automatically if a script invokes `asdf:load-system', but that will have a
 ;; bad effect on startup time, and risks spamming the output streams with

-;; drivel.
+;; drivel.  Some ancient Lisps come with an ASDF which doesn't understand
+;; `register-immutable-system', so do the job by hand if necessary.

 inhibit-asdf-upgrade =
 inhibit-asdf-upgrade =

-       (funcall (intern "REGISTER-IMMUTABLE-SYSTEM"
-                        (find-package "ASDF"))
-                "asdf")
+       (let* ((#1300=#:root (find-package "ASDF"))
+              (#1301=#:ris (find-symbol "REGISTER-IMMUTABLE-SYSTEM" #1300#)))
+         (if (and #1301# (fboundp #1301#))
+             (funcall #1301# "asdf")
+             (let* ((#1302=#:fsys (find-package "ASDF/FIND-SYSTEM"))
+                    (#1303=#:iss (find-symbol "*IMMUTABLE-SYSTEMS*" #1302#))
+                    (#1304=#:dss (find-symbol "*DEFINED-SYSTEMS*" #1302#))
+                    (#1305=#:sys (find-symbol "SYSTEM" #1300#)))
+               (unless (symbol-value #1303#)
+                 (setf (symbol-value #1303#)
+                         (make-hash-table :test (function equal))))
+               (setf (gethash "asdf" (symbol-value #1303#)) t
+                     (gethash "asdf" (symbol-value #1304#))
+                       (cons (get-universal-time)
+                             (make-instance #1305# :name "asdf"))))))

 
 ;; Upgrade ASDF from the source registry.
 upgrade-asdf =
 
 ;; Upgrade ASDF from the source registry.
 upgrade-asdf =


@@ -135,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}" |


@@ -144,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}\")"
 
 ;;;--------------------------------------------------------------------------


@@ -261,7 +288,12 @@ run-script =
        ${command}
                $?@image{-core "${image-path}" -eval "${image-restore}" |
                         -batch -noinit -quiet
        ${command}
                $?@image{-core "${image-path}" -eval "${image-restore}" |
                         -batch -noinit -quiet

-                                -eval "(progn
+                                -eval "(handler-bind
+                                           ((warning
+                                              (lambda (#0=#:c)
+                                                (declare (ignore #0#))
+                                                (invoke-restart
+                                                 'muffle-warning))))

                                          (setf ext:*require-verbose* nil)
                                          ${run-script-prelude}
                                          ${clear-cl-user})"}
                                          (setf ext:*require-verbose* nil)
                                          ${run-script-prelude}
                                          ${clear-cl-user})"}