chiark - git - mdw - runlisp/blob - dump-runlisp-image.in

   1 #! /bin/sh -e
   2 ###
   3 ### Dump Lisp images for faster script execution
   4 ###
   5 ### (c) 2020 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  10 ### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
  11 ###
  12 ### Runlisp is free software: you can redistribute it and/or modify it
  13 ### under the terms of the GNU General Public License as published by the
  14 ### Free Software Foundation; either version 3 of the License, or (at your
  15 ### option) any later version.
  16 ###
  17 ### Runlisp is distributed in the hope that it will be useful, but WITHOUT
  18 ### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  19 ### FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  20 ### for more details.
  21 ###
  22 ### You should have received a copy of the GNU General Public License
  23 ### along with Runlisp.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ###--------------------------------------------------------------------------
  26 ### Build-time configuration.
  27
  28 VERSION=@VERSION@
  29 imagedir=@imagedir@
  30 eclopt=@ECLOPT@
  31
  32 ###--------------------------------------------------------------------------
  33 ### Random utilities.
  34
  35 prog=${0##*/}
  36
  37 ## Report a fatal error.
  38 lose () { echo >&2 "$prog: $*"; exit 2; }
  39
  40 ## Quote a string so that Lisp will understand it.
  41 lisp_quote () { printf "%s\n" "$1" | sed 's/[\\"]/\\&/g'; }
  42
  43 ## Mention that we're running a program.
  44 run () { echo "$*"; $lbuf "$@"; }
  45
  46 ## Figure out whether we can force line-buffering.
  47 if stdbuf --version >/dev/null 2>&1; then lbuf="stdbuf -oL --"
  48 else lbuf=""; fi
  49
  50 ## Copy stdin to stdout, one line at a time.  This is important in the shell
  51 ## game below, to prevent lines from two incoming streams being interleaved
  52 ## in the log file.
  53 copy () { while IFS= read -r line; do printf "%s %s\n" "$1" "$line"; done; }
  54
  55 ###--------------------------------------------------------------------------
  56 ### Lisp runes.
  57
  58 ## Load and upgrade ASDF.
  59 load_asdf_rune="(require \"asdf\")"
  60 upgrade_asdf_rune="(asdf:upgrade-asdf)"
  61
  62 ## Ignore `#!' lines.  (We force this so as to provide a uniform environment,
  63 ## even though some Lisp implementations take special action when they know
  64 ## they're running scripts.)
  65 ignore_shebang_rune="\
  66 (set-dispatch-macro-character
  67  #\\# #\\!
  68  (lambda (stream #1=#:char #2=#:arg)
  69    (declare (ignore #1# #2#))
  70    (values (read-line stream))))"
  71
  72 ## Push `:runlisp-script' into the `*features*' list.
  73 set_script_feature_rune="(pushnew :runlisp-script *features*)"
  74
  75 ## All of the above.
  76 common_prelude_rune="\
  77 (progn
  78   $upgrade_asdf_rune
  79   $ignore_shebang_rune
  80   $set_script_feature_rune)"
  81
  82 ###--------------------------------------------------------------------------
  83 ### Explain how to dump the various Lisp systems.
  84
  85 ## Maintain the master tables.
  86 unset lisps
  87 deflisp () { lisps=${lisps+$lisps }$1; eval ${1}_image=\$2; }
  88
  89 ## Steel Bank Common Lisp.
  90 deflisp sbcl sbcl+asdf.core
  91 dump_sbcl () {
  92   image=$(lisp_quote "$1")
  93   run "${SBCL-sbcl}" --noinform --no-userinit --no-sysinit \
  94     --disable-debugger \
  95     --eval "$load_asdf_rune" \
  96     --eval "$common_prelude_rune" \
  97     --eval "(sb-ext:save-lisp-and-die \"$image\")"
  98 }
  99
 100 ## Clozure Common Lisp.
 101 deflisp ccl ccl+asdf.image
 102 dump_ccl () {
 103   image=$(lisp_quote "$1")
 104   ## A snaglet occurs here.  CCL wants to use the image name as a clue to
 105   ## where the rest of its installation is; but in fact the image is
 106   ## nowhere near its installation.  So we must hack...
 107
 108   run "${CCL-ccl}" -b -n -Q \
 109     -e "$load_asdf_rune" \
 110     -e "$common_prelude_rune" \
 111     -e "(ccl::in-development-mode
 112           (let ((#1=#:real-ccl-dir (ccl::ccl-directory)))
 113             (defun ccl::ccl-directory ()
 114               (let* ((#2=#:dirpath (ccl:getenv \"CCL_DEFAULT_DIRECTORY\")))
 115                 (if (and #2# (plusp (length (namestring #2#))))
 116                     (ccl::native-to-directory-pathname #2#)
 117                     #1#))))
 118           (compile 'ccl::ccl-directory))" \
 119     -e "(ccl:save-application \"$image\"
 120           :init-file nil
 121           :error-handler :quit)"
 122 }
 123
 124 ## GNU CLisp.
 125 deflisp clisp clisp+asdf.mem
 126 dump_clisp () {
 127   image=$(lisp_quote "$1")
 128   run "${CLISP-clisp}" -norc -q -q \
 129     -x "$load_asdf_rune" \
 130     -x "$common_prelude_rune" \
 131     -x "(ext:saveinitmem \"$image\"
 132           :norc t
 133           :script t)" \
 134     -- wrong arguments
 135 }
 136
 137 ## Embeddable Common Lisp.
 138 deflisp ecl ecl+asdf
 139 dump_ecl () {
 140   image=$1
 141   set -e
 142
 143   ## Start by compiling a copy of ASDF.
 144   cat >"$tmp/ecl-build.lisp" <<EOF
 145 (require "asdf")
 146
 147 (defparameter *asdf* (asdf:find-system "asdf"))
 148
 149 (defun right-here (pathname pattern)
 150   (declare (ignore pattern))
 151   (merge-pathnames
 152    (make-pathname :name (concatenate 'string
 153                                      (string-downcase
 154                                       (lisp-implementation-type))
 155                                      "-"
 156                                      (pathname-name pathname))
 157                   :type nil
 158                   :version nil
 159                   :defaults *default-pathname-defaults*)
 160    pathname))
 161 (asdf:initialize-output-translations '(:output-translations
 162                                        ((#p"/" :**/ :*.*.*)
 163                                         (:function right-here))
 164                                        :ignore-inherited-configuration))
 165
 166 (asdf:operate 'asdf:lib-op *asdf*)
 167 (si:quit 0)
 168 EOF
 169   (cd "$tmp" && run "${ECL-ecl}" ${eclopt}norc ${eclopt}load "ecl-build.lisp")
 170
 171   ## And now compile our driver code.
 172   cat >"$tmp/ecl-run.lisp" <<EOF
 173 (cl:defpackage #:runlisp
 174   (:use #:common-lisp))
 175 (cl:in-package #:runlisp)
 176
 177 (defun main ()
 178   $ignore_shebang_rune
 179   (asdf:register-immutable-system "asdf")
 180   (let ((pkg (find-package "COMMON-LISP-USER")))
 181     (with-package-iterator (next pkg :internal)
 182       (loop (multiple-value-bind (anyp sym how) (next)
 183               (declare (ignore how))
 184               (unless anyp (return))
 185               (unintern sym pkg)))))
 186   $set_script_feature_rune
 187   (let ((winning t) (script nil) (marker nil)
 188         (prog (file-namestring (si:argv 0))) (i 1) (argc (si:argc)))
 189     (labels ((lose (msg &rest args)
 190                (format *error-output* "~&~A: ~?~%" prog msg args)
 191                (setf winning nil))
 192              (quit (rc)
 193                (si:quit rc))
 194              (usage (stream)
 195                (format stream "~&usage: ~A -s SCRIPT -- ARGS~%"
 196                        prog))
 197              (getarg ()
 198                (and (< i argc) (prog1 (si:argv i) (incf i)))))
 199       (loop (let ((arg (getarg)))
 200               (cond ((null arg) (return))
 201                     ((string= arg "--") (setf marker t) (return))
 202                     ((string= arg "-s") (setf script (getarg)))
 203                     ((string= arg "-h") (usage *standard-output*) (quit 0))
 204                     (t (lose "unrecognized option \`~A'" arg)))))
 205       (unless script (lose "nothing to do"))
 206       (unless marker (lose "unexpected end of options (missing \`--'?)"))
 207       (unless winning (usage *error-output*) (quit 255))
 208       (handler-case
 209           (let ((*package* (find-package "COMMON-LISP-USER")))
 210             (load script :verbose nil :print nil))
 211         (error (err)
 212           (format *error-output* "~&~A (uncaught error): ~A~%" prog err)
 213           (quit 255)))
 214       (quit 0))))
 215 (main)
 216 EOF
 217   (cd "$tmp" && run "${ECL-ecl}" ${eclopt}norc ${eclopt}load "ecl-asdf.fas" \
 218     -s -o "ecl-run.o" ${eclopt}compile "ecl-run.lisp")
 219
 220   ## Finally link everything together.
 221   run "${ECL-ecl}" ${eclopt}norc -o "$image"\
 222     ${eclopt}link "$tmp/ecl-asdf.o" "$tmp/ecl-run.o"
 223 }
 224
 225 ## Carnegie--Mellon University Common Lisp.
 226 deflisp cmucl cmucl+asdf.core
 227 dump_cmucl () {
 228   image=$(lisp_quote "$1")
 229   run "${CMUCL-cmucl}" -batch -noinit -nositeinit -quiet \
 230     -eval "$load_asdf_rune" \
 231     -eval "$common_prelude_rune" \
 232     -eval "(ext:save-lisp \"$image\"
 233              :batch-mode t :print-herald nil
 234              :site-init nil :load-init-file nil)"
 235 }
 236
 237 ###--------------------------------------------------------------------------
 238 ### Command-line processing.
 239
 240 usage () { echo "usage: $prog [-acluv] [-o FILE] [LISP ...]"; }
 241 version () { echo "$prog, runlisp version $VERSION"; }
 242 help () {
 243   version; echo; usage; cat <<EOF
 244
 245 Options:
 246   -h                    Show this help text and exit successfully.
 247   -V                    Show the version number and exit successfully.
 248   -a                    Dump all installed Lisp implementations.
 249   -c                    Check that Lisp systems are installed before
 250                           trying to dump.
 251   -l                    List known Lisp systems and default image filenames.
 252   -o OUT                Store images in OUT (file or directory); default
 253                           is \`\$RUNLISP_IMAGEDIR' or \`$imagedir'
 254   -u                    Only dump images which don't exist already.
 255   -v                    Be verbose, even if things go well.
 256 EOF
 257 }
 258
 259 unset outfile; dir=${RUNLISP_IMAGEDIR-$imagedir}; dir=${dir%/}/
 260 all=nil checkinst=nil bogus=nil out=nil update=nil verbose=nil
 261
 262 ## Parse the options.
 263 while getopts "hVaclo:uv" opt; do
 264   case $opt in
 265     h) help; exit 0 ;;
 266     V) version; exit 0 ;;
 267     a) all=t checkinst=t ;;
 268     l)
 269       for i in $lisps; do
 270         eval out=\$${i}_image
 271         echo "$i -> $out"
 272       done
 273       exit 0
 274       ;;
 275     o) outfile=$OPTARG out=t; dir= ;;
 276     u) update=t ;;
 277     v) verbose=t ;;
 278     *) bogus=t ;;
 279   esac
 280 done
 281 shift $(( $OPTIND - 1 ))
 282
 283 ## If the destination is a directory then notice this.
 284 case $out in
 285   t) if [ -d "$outfile" ]; then dir=${outfile%/}/; out=nil; fi ;;
 286 esac
 287
 288 ## Check that everything matches.
 289 case $#,$all,$out in
 290   0,nil,*) lose "no Lisp systems to dump" ;;
 291   0,t,nil) set -- $lisps ;;
 292   *,t,*) lose "\`-a' makes no sense with explicit list" ;;
 293   1,nil,t) ;;
 294   *,*,t) lose "can't name explicit output file for multiple Lisp systems" ;;
 295 esac
 296
 297 ## Check that the Lisp systems named are actually known.
 298 for lisp in "$@"; do
 299   case " $lisps " in
 300     *" $lisp "*) ;;
 301     *) echo >&2 "$prog: unknown Lisp \`$lisp'"; exit 2 ;;
 302   esac
 303 done
 304
 305 ## Complain if there were problems.
 306 case $bogus in t) usage >&2; exit 2 ;; esac
 307
 308 ###--------------------------------------------------------------------------
 309 ### Dump the images.
 310
 311 ## Establish a temporary directory to work in.
 312 i=0
 313 while :; do
 314   tmp=${TMPDIR-/tmp}/runlisp-tmp.$$.
 315   if mkdir "$tmp" >/dev/null 2>&1; then break; fi
 316   case $i in 64) lose "failed to create temporary directory" ;; esac
 317   i=$(expr $i + 1)
 318 done
 319 trap 'rm -rf "$tmp"' EXIT INT TERM HUP
 320
 321 ## Send stdout to stderr or the log, depending on verbosity.
 322 output () {
 323   case $verbose in
 324     nil) $lbuf cat -u >"$tmp/log" ;;
 325     t) $lbuf cat >&2 ;;
 326   esac
 327 }
 328
 329 ## Work through each requested Lisp system.
 330 exit=0
 331 for lisp in "$@"; do
 332
 333   ## Figure out the output file to use.
 334   case $out in nil) eval outfile=\$dir\$${lisp}_image ;; esac
 335
 336   ## Maybe we skip this one if the output already exists.
 337   case $update in
 338     t)
 339       if [ -f "$outfile" ]; then
 340         case $verbose in
 341           t)
 342             echo >&2 "$prog: \`$outfile' already exists: skipping \`$lisp'"
 343             ;;
 344         esac
 345         continue
 346       fi
 347       ;;
 348   esac
 349
 350   ## If we're doing all the Lisps, then skip systems which aren't actually
 351   ## installed.
 352   case $checkinst in
 353     t)
 354       LISP=$(echo $lisp | tr a-z A-Z)
 355       eval lispprog=\${$LISP-$lisp}
 356       if ! type >/dev/null 2>&1 $lispprog; then
 357         case $verbose in
 358           t)
 359             echo >&2 "$prog: command \`$LISP' not found: skipping \`$lisp'"
 360             ;;
 361         esac
 362         continue
 363       fi
 364       ;;
 365   esac
 366
 367   ## Dump the Lisp, capturing its potentially drivellous output in a log
 368   ## (unless we're being verbose).  Be careful to keep stdout and stderr
 369   ## separate.
 370   rc=$(
 371     { { { { echo "dumping $lisp to \`$outfile'..."
 372             set +e; dump_$lisp "$outfile" 4>&- 5>&-
 373             echo $? >&5; } |
 374           copy "|" >&4; } 2>&1 |
 375         copy "*" >&4; } 4>&1 |
 376       output; } 5>&1 </dev/null
 377   )
 378
 379   ## If it failed, and we didn't already spray the output to the terminal,
 380   ## then do that now; also record that we encountered a problem.
 381   case $rc in
 382     0) ;;
 383     *) case $verbose in nil) cat >&2 "$tmp/log" ;; esac; exit=2 ;;
 384   esac
 385 done
 386
 387 ## All done.
 388 exit $exit
 389
 390 ###----- That's all, folks --------------------------------------------------