3 ### Dump Lisp images for faster script execution
5 ### (c) 2020 Mark Wooding
8 ###----- Licensing notice ---------------------------------------------------
10 ### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
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.
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
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/>.
25 ###--------------------------------------------------------------------------
26 ### Build-time configuration.
32 ###--------------------------------------------------------------------------
37 ## Report a fatal error.
38 lose
() { echo >&2 "$prog: $*"; exit 2; }
40 ## Quote a string so that Lisp will understand it.
41 lisp_quote
() { printf "%s\n" "$1" |
sed 's/[\\"]/\\&/g'; }
43 ## Mention that we're running a program.
44 run
() { echo "$*"; $lbuf "$@"; }
46 ## Figure out whether we can force line-buffering.
47 if stdbuf
--version
>/dev
/null
2>&1; then lbuf
="stdbuf -oL --"
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
53 copy
() { while IFS
= read -r line
; do printf "%s %s\n" "$1" "$line"; done; }
55 ###--------------------------------------------------------------------------
58 ## Load and upgrade ASDF.
59 load_asdf_rune
="(require \"asdf\")"
60 upgrade_asdf_rune
="(asdf:upgrade-asdf)"
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
68 (lambda (stream #1=#:char #2=#:arg)
69 (declare (ignore #1# #2#))
70 (values (read-line stream))))"
72 ## Push `:runlisp-script' into the `*features*' list.
73 set_script_feature_rune
="(pushnew :runlisp-script *features*)"
76 common_prelude_rune
="\
80 $set_script_feature_rune)"
82 ###--------------------------------------------------------------------------
83 ### Explain how to dump the various Lisp systems.
85 ## Maintain the master tables.
87 deflisp
() { lisps
=${lisps+$lisps }$1; eval ${1}_image
=\
$2; }
89 ## Steel Bank Common Lisp.
90 deflisp sbcl sbcl
+asdf.core
92 image
=$
(lisp_quote
"$1")
93 run
"${SBCL-sbcl}" --noinform
--no-userinit
--no-sysinit \
95 --eval "$load_asdf_rune" \
96 --eval "$common_prelude_rune" \
97 --eval "(sb-ext:save-lisp-and-die \"$image\")"
100 ## Clozure Common Lisp.
101 deflisp ccl ccl
+asdf.image
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...
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#)
118 (compile 'ccl::ccl-directory))" \
119 -e
"(ccl:save-application \"$image\"
121 :error-handler :quit)"
125 deflisp clisp clisp
+asdf.mem
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\"
137 ## Embeddable Common Lisp.
143 ## Start by compiling a copy of ASDF.
144 cat >"$tmp/ecl-build.lisp" <<EOF
147 (defparameter *asdf* (asdf:find-system "asdf"))
149 (defun right-here (pathname pattern)
150 (declare (ignore pattern))
152 (make-pathname :name (concatenate 'string
154 (lisp-implementation-type))
156 (pathname-name pathname))
159 :defaults *default-pathname-defaults*)
161 (asdf:initialize-output-translations '(:output-translations
163 (:function right-here))
164 :ignore-inherited-configuration))
166 (asdf:operate 'asdf:lib-op *asdf*)
169 (cd "$tmp" && run
"${ECL-ecl}" ${eclopt}norc
${eclopt}load
"ecl-build.lisp")
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)
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)
195 (format stream "~&usage: ~A -s SCRIPT -- ARGS~%"
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))
209 (let ((*package* (find-package "COMMON-LISP-USER")))
210 (load script :verbose nil :print nil))
212 (format *error-output* "~&~A (uncaught error): ~A~%" prog err)
217 (cd "$tmp" && run
"${ECL-ecl}" ${eclopt}norc
${eclopt}load
"ecl-asdf.fas" \
218 -s
-o
"ecl-run.o" ${eclopt}compile
"ecl-run.lisp")
220 ## Finally link everything together.
221 run
"${ECL-ecl}" ${eclopt}norc
-o
"$image"\
222 ${eclopt}link
"$tmp/ecl-asdf.o" "$tmp/ecl-run.o"
225 ## Carnegie--Mellon University Common Lisp.
226 deflisp cmucl cmucl
+asdf.core
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)"
237 ###--------------------------------------------------------------------------
238 ### Command-line processing.
240 usage
() { echo "usage: $prog [-acluv] [-o FILE] [LISP ...]"; }
241 version
() { echo "$prog, runlisp version $VERSION"; }
243 version
; echo; usage
; cat <<EOF
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
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.
259 unset outfile
; dir
=${RUNLISP_IMAGEDIR-$imagedir}; dir
=${dir%/}/
260 all
=nil checkinst
=nil bogus
=nil out
=nil update
=nil verbose
=nil
262 ## Parse the options.
263 while getopts "hVaclo:uv" opt
; do
266 V
) version
; exit 0 ;;
267 a
) all
=t checkinst
=t
;;
270 eval out
=\$
${i}_image
275 o
) outfile
=$OPTARG out
=t
; dir
= ;;
281 shift $
(( $OPTIND - 1 ))
283 ## If the destination is a directory then notice this.
285 t
) if [ -d
"$outfile" ]; then dir
=${outfile%/}/; out
=nil
; fi ;;
288 ## Check that everything matches.
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" ;;
294 *,*,t
) lose
"can't name explicit output file for multiple Lisp systems" ;;
297 ## Check that the Lisp systems named are actually known.
301 *) echo >&2 "$prog: unknown Lisp \`$lisp'"; exit 2 ;;
305 ## Complain if there were problems.
306 case $bogus in t
) usage
>&2; exit 2 ;; esac
308 ###--------------------------------------------------------------------------
311 ## Establish a temporary directory to work in.
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
319 trap 'rm -rf "$tmp"' EXIT INT TERM HUP
321 ## Send stdout to stderr or the log, depending on verbosity.
324 nil
) $lbuf cat -u
>"$tmp/log" ;;
329 ## Work through each requested Lisp system.
333 ## Figure out the output file to use.
334 case $out in nil
) eval outfile
=\
$dir\$
${lisp}_image
;; esac
336 ## Maybe we skip this one if the output already exists.
339 if [ -f
"$outfile" ]; then
342 echo >&2 "$prog: \`$outfile' already exists: skipping \`$lisp'"
350 ## If we're doing all the Lisps, then skip systems which aren't actually
354 LISP
=$
(echo $lisp |
tr a-z A-Z
)
355 eval lispprog
=\
${$LISP-$lisp}
356 if ! type >/dev
/null
2>&1 $lispprog; then
359 echo >&2 "$prog: command \`$LISP' not found: skipping \`$lisp'"
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
371 { { { { echo "dumping $lisp to \`$outfile'..."
372 set +e
; dump_
$lisp "$outfile" 4>&- 5>&-
374 copy
"|" >&4; } 2>&1 |
375 copy
"*" >&4; } 4>&1 |
376 output
; } 5>&1 </dev
/null
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.
383 *) case $verbose in nil
) cat >&2 "$tmp/log" ;; esac; exit=2 ;;
390 ###----- That's all, folks --------------------------------------------------