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

[runlisp] / runlisp-base.conf

;;; -*-conf-windows-*-

;; This file contains essential definitions for `runlisp'.  You are
;; encouraged to put your local changes in the main `runlisp.conf', or in
;; other files alongside this one in `runlisp.d/', rather then editing this
;; file.

;; Summary of syntax.
;;
;; Sections are started with a line `[NAME]', starting in the leftmost
;; column.  Empty lines and lines starting with `;' -- /without/ preceding
;; whitespace -- are ignored.  Assignments have the form `VAR = VALUE'; the
;; VALUE may be continued across multiple lines, if they begin with
;; whitespace.  All of the lines are stripped of initial and final whitespace
;; and concatenated with spaces.
;;
;; Values may contain substitutions:
;;
;;   * ${[SECTION:]VAR[?ALT]} -- replace with the value of VAR in SECTION; if
;;     not found, use ALT instead.  (If ALT isn't provided, it's an error.)
;;
;;   * $?[SECTION:]VAR{YES[|NO]} -- look up VAR in SECTION (or in the
;;     (original) current section, and `@COMMON'); if found, use YES,
;;     otherwise use NO.
;;
;; Variables are looked up starting in the home (or explicitly specified)
;; section, then proceeding to the parents assigned to `@PARENTS'.
;; (`@PARENTS' usually defaults to `@COMMON'; the parent of `@COMMON' is
;; `@BUILTIN'; `@BUILTIN' and `@ENV' have no parents.)
;;
;; At top-level, the text is split into words at whitespace, unless prevented
;; by double- and single-quote, or escaped by `\'.  Within single quotes, all
;; characters are treated literally.  Within double quotes, `\' and `$' still
;; works.  A variable reference within quotes, or within a word, suppresses
;; word-splitting and quoting, within the variable value -- but `$'
;; expansions still work.

;;;--------------------------------------------------------------------------
[@COMMON]

;; In order to avoid leaking symbols in `cl-user', the code fragments here
;; and in implementation definitions need to use uninterned symbols for their
;; local names, and use `#N=' and `#N#' reader macros to refer to them.  In
;; order to prevent conflicts with the ID numbers in these, the fragments
;; here use ID numbers from 1000 up to 9999, leaving 0--999 (and, if you
;; really need them, 10000 on upwards) for individual implementations.

;; Turn `#!' into a comment-to-end-of-line.  This is used in all Lisp
;; invocations, even though some of them don't apparently need it.  For
;; example, SBCL ignores an initial line beginning `#!' as a special feature
;; of its `--script' option.  Other Lisps won't do this, so a countermeasure
;; like the following is necessary in their case.  For the sake of a
;; consistent environment, we ignore `#!' lines everywhere, even in Lisps
;; which have their own, more specific, solution to this problem.
ignore-shebang =
        (set-dispatch-macro-character
         #\\# #\\!
         (lambda (#1000=#:stream #1001=#:char #1002=#:arg)
           (declare (ignore #1001# #1002#))
           (values (read-line #1000#))))

;; Clear all present symbols from the `COMMON-LISP-USER' package.  Some Lisps
;; leave débris in `COMMON-LISP-USER' -- for example, ECL leaves some
;; allegedly useful symbols lying around, while ABCL has a straight-up bug in
;; its `adjoin.lisp' file.
clear-cl-user =
        (let ((#1200=#:pkg (find-package "COMMON-LISP-USER")))
          (with-package-iterator (#1201=#:next #1200# :internal)
            (loop (multiple-value-bind (#1202=#:anyp #1203=#:sym #1204=#:how)
                      (#1201#)
                    (declare (ignore #1204#))
                    (unless #1202# (return))
                    (unintern #1203# #1200#)))))

;; Add `:runlisp-script' to `*features*' so that scripts can tell whether
;; they're supposed to sit quietly and be debugged in a Lisp session or run
;; as a script.
set-script-feature =
        (pushnew :runlisp-script *features*)

;; Load the system's ASDF.
require-asdf =
        (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
;; 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 =
        (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 =
        (funcall (intern "UPGRADE-ASDF" (find-package "ASDF")))

;; Common actions when resuming a custom image.
image-restore =
        (uiop:call-image-restore-hook)

;; Common prelude for script startup in vanilla images.  Most of this is
;; already done in custom images.
run-script-prelude =
        (progn
          (setf *load-verbose* nil *compile-verbose* nil)
          ${require-asdf}
          ${inhibit-asdf-upgrade}
          ${ignore-shebang}
          ${set-script-feature})

;; Common prelude for dumping images.
dump-image-prelude =
        (progn
          ${require-asdf}
          ${upgrade-asdf}
          ${inhibit-asdf-upgrade}
          ${ignore-shebang}
          ${set-script-feature})

;; An expression to determine the version information for the running Lisp.
lisp-version =
        (list (list* \'lisp
                     (lisp-implementation-type)
                     (multiple-value-list (lisp-implementation-version)))
              (cons \'asdf
                    (asdf:component-version (asdf:find-system "asdf"))))

;; Full pathname to custom image.
image-path = ${@image-dir}/${image-file}

;;;--------------------------------------------------------------------------
[sbcl]

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}" |
                         --eval "${run-script-prelude}"}
                --script "${@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}\")"

;;;--------------------------------------------------------------------------
[ccl]

command = ${@ENV:CCL?ccl}
image-file = ${@name}+asdf.image

run-script =
        ${command} -b -n -Q
                $?@image{-I "${image-path}" -e "${image-restore}" |
                         -e "${run-script-prelude}"}
                -l "${@script}" -e "(ccl:quit)" --

;; A snaglet occurs here.  CCL wants to use the image name as a clue to where
;; the rest of its installation is; but in fact the image is nowhere near its
;; installation.  So we must hack...
dump-image =
        ${command} -b -n -Q
                -e "${dump-image-prelude}"
                -e "(ccl::in-development-mode
                      (let ((#0=#:real-ccl-dir (ccl::ccl-directory)))
                        (defun ccl::ccl-directory ()
                          (let* ((#1=#:dirpath
                                   (ccl:getenv \"CCL_DEFAULT_DIRECTORY\")))
                            (if (and #1# (plusp (length (namestring #1#))))
                                (ccl::native-to-directory-pathname #1#)
                                #0#))))
                      (compile 'ccl::ccl-directory))"
                -e "(ccl:save-application \"${@image-new|q}\"
                                          :init-file nil
                                          :error-handler :quit)"

;;;--------------------------------------------------------------------------
[clisp]

;; CLisp causes much sadness.  Superficially, it's the most sensible of all
;; of the systems supported here: you just run `clisp SCRIPT -- ARGS ...' and
;; it works.
;;
;; The problems come when you want to do some preparatory work (e.g., load
;; `asdf') and then run the script.  There's a `-x' option to evaluate some
;; Lisp code, but it has three major deficiencies.
;;
;;   * It insists on printing the values of the forms it evaluates.  It
;;     prints a blank line even if the form goes out of its way to produce no
;;     values at all.  So the whole thing has to be a single top-level form
;;     which quits the Lisp rather than returning.
;;
;;   * For some idiotic reason, you can have /either/ `-x' forms /or/ a
;;     script, but not both.  So we have to include the `load' here
;;     explicitly.  I suppose that was inevitable because we have to inhibit
;;     printing of the result forms, but it's still a separate source of
;;     annoyance.
;;
;;   * The icing on the cake: the `-x' forms are collectively concatenated --
;;     without spaces! -- and used to build a string stream, which is then
;;     assigned over the top of `*standard-input*', making the original stdin
;;     somewhat fiddly to track down.
;;
;; There's a `-i' option which will load a file without any of this
;; stupidity, but nothing analogous for immediate expressions.

clisp-common-startup =
        (setf *standard-input* (ext:make-stream :input))
        (load "${@script|q}" :verbose nil :print nil)
        (ext:quit)

command = ${@ENV:CLISP?clisp}
image-file = ${@name}+asdf.mem

run-script =
        ${command}
                $?@image{-M "${image-path}" -q
                         -x "(progn
                               ${image-restore}
                               ${clisp-common-startup})" |
                         -norc -q
                         -x "(progn
                               ${run-script-prelude}
                               ${clisp-common-startup})"}
                --

dump-image =
        ${command} -norc -q -q
                -x "${dump-image-prelude}"
                -x "(ext:saveinitmem \"${@image-new|q}\" :norc t :script t)"

;;;--------------------------------------------------------------------------
[ecl]

command = ${@ENV:ECL?ecl}
image-file = ${@name}+asdf

run-script =
        $?@image{"${image-path}" -s "${@script}" |
                 ${@ENV:ECL?ecl} "${@ecl-opt}norc"
                         "${@ecl-opt}eval" "(progn
                                              ${run-script-prelude}
                                              ${clear-cl-user})"
                         "${@ecl-opt}shell" "${@script}"}
                --

dump-image =
        "${@data-dir}/dump-ecl"
                "${@image-new}" "${command}" "${@ecl-opt}" "${@tmp-dir}"

;;;--------------------------------------------------------------------------
[cmucl]

command = ${@ENV:CMUCL?cmucl}
image-file = ${@name}+asdf.core

run-script =
        ${command}
                $?@image{-core "${image-path}" -eval "${image-restore}" |
                         -batch -noinit -quiet
                                 -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})"}
                -load "${@script}" -eval "(ext:quit)" --

dump-image =
        ${command} -batch -noinit -quiet
                -eval "(progn ${dump-image-prelude} ${clear-cl-user})"
                -eval "(ext:save-lisp \"${@image-new|q}\"
                                      :batch-mode t :print-herald nil
                                      :site-init nil :load-init-file nil)"

;;;--------------------------------------------------------------------------
[abcl]

;; CLisp made a worthy effort, but ABCL still manages to take the prize.
;;
;;   * ABCL manages to avoid touching the `stderr' stream at all, ever.  Its
;;     startup machinery finds `stdout' (as `java.lang.System.out'), wraps it
;;     up in a Lisp stream, and uses the result as `*standard-output*' and
;;     `*error-output*' (and a goodly number of other things too).  So we
;;     must manufacture a working `stderr' the hard way.
;;
;;   * There doesn't appear to be any easy way to prevent toplevel errors
;;     from invoking the interactive debugger.  For extra fun, the debugger
;;     reads from `stdin' by default, so an input file which somehow manages
;;     to break the script can then take over its brain by providing Lisp
;;     forms for the debugger to evaluate.
;;
;;   * And, just to really top everything off, ABCL's `adjoin.lisp' is
;;     missing an `(in-package ...)' form at the top, so it leaks symbols
;;     into the `COMMON-LISP-USER' package.

command = ${@ENV:ABCL?abcl}

abcl-startup =
        (let ((#0=#:script "${@script|q}"))
          ${run-script-prelude}
          ${clear-cl-user}
          (setf *error-output*
                  (java:jnew "org.armedbear.lisp.Stream"
                             \'sys::system-stream
                             (java:jfield "java.lang.System" "err")
                             \'character
                             java:+true+))
          (handler-case (load #0# :verbose nil :print nil)
            (error (error)
              (format *error-output* "~A (unhandled error): ~A~%" #0# error)
            (ext:quit :status 255))))

run-script =
        ${command} --batch --noinform --noinit --nosystem
                --eval "${abcl-startup}"
                --

;;;----- That's all, folks --------------------------------------------------