--- /dev/null
+COPYING
+Makefile.in
+aclocal.m4
+build
+common.info
+configure
+stamp-vti
+version.texi
+deb-build
+texinfo.tex
+mkinstalldirs
+autom4te.cache
+missing
+install-sh
+acinclude.m4
+config
+*.aux
+*.cp
+*.dvi
+*.fn
+*.info
+*.ky
+*.log
+*.out
+*.pdf
+*.pg
+*.ps
+*.toc
+*.tp
+*.vr
--- /dev/null
+;;; -*-emacs-lisp-*-
+
+(setq skel-alist
+ (append
+ '((author . "Mark Wooding")
+ (full-title . "the Common Files Distribution (`common')")
+ (Program . "`Common'")
+ (program . "`common'"))
+ skel-alist))
--- /dev/null
+dnl -*-autoconf-*-
+
+### SYNOPSIS
+###
+### mdw_AUTO_VERSION
+###
+### DESCRIPTION
+###
+### Defines an m4 macro `AUTO_VERSION' which contains the current package's
+### version number, worked out in some clever way.
+###
+### The heavy lifting is performed by the `auto-version' script (q.v.). In
+### brief:
+###
+### * if this is a Git working tree (i.e., there is a `.git' file or
+### directory at toplevel) then call `git describe' and use its output;
+###
+### * if there is a `RELEASE' file, then use its contents literally;
+###
+### * if there is a `debian/changelog' file, then use the most recent
+### entry's version number;
+###
+### * otherwise use `UNKNOWN'.
+###
+### LICENSE
+###
+### Copyright (c) 2008 Mark Wooding <mdw@distorted.org.uk>
+###
+### This program is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation, either version 2 of the License, or (at your
+### option) any later version.
+###
+### This program is distributed in the hope that it will be useful, but
+### WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+### General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License along
+### with this program. If not, see <http://www.gnu.org/licenses/>.
+###
+### As a special exception, the respective Autoconf Macro's copyright owner
+### gives unlimited permission to copy, distribute and modify the configure
+### scripts that are the output of Autoconf when processing the Macro. You
+### need not follow the terms of the GNU General Public License when using
+### or distributing such scripts, even though portions of the text of the
+### Macro appear in them. The GNU General Public License (GPL) does govern
+### all other use of the material that constitutes the Autoconf Macro.
+###
+### This special exception to the GPL applies to versions of the Autoconf
+### Macro released by the Autoconf Archive. When you make and distribute a
+### modified version of the Autoconf Macro, you may extend this special
+### exception to the GPL to apply to your modified version as well.
+
+# serial 1
+AC_DEFUN([mdw_AUTO_VERSION], [m4_define([AUTO_VERSION], m4_esyscmd([
+ ver=UNKNOWN
+ for pre in ./ config/; do
+ try=${pre}auto-version
+ if test -x $try; then ver=$("$try"); break; fi
+ done
+ echo -n "$ver"
+]))])
--- /dev/null
+dnl -*-autoconf-*-
+
+### SYNOPSIS
+###
+### mdw_DECL_ENVIRON
+###
+### DESCRIPTION
+###
+### Define a preprocessor symbol `DECL_ENVIRON' if the `environ' vector is
+### declared in one of the `usual' places.
+###
+### LICENSE
+###
+### Copyright (c) 1999 Mark Wooding <mdw@distorted.org.uk>
+###
+### This program is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation, either version 2 of the License, or (at your
+### option) any later version.
+###
+### This program is distributed in the hope that it will be useful, but
+### WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+### General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License along
+### with this program. If not, see <http://www.gnu.org/licenses/>.
+###
+### As a special exception, the respective Autoconf Macro's copyright owner
+### gives unlimited permission to copy, distribute and modify the configure
+### scripts that are the output of Autoconf when processing the Macro. You
+### need not follow the terms of the GNU General Public License when using
+### or distributing such scripts, even though portions of the text of the
+### Macro appear in them. The GNU General Public License (GPL) does govern
+### all other use of the material that constitutes the Autoconf Macro.
+###
+### This special exception to the GPL applies to versions of the Autoconf
+### Macro released by the Autoconf Archive. When you make and distribute a
+### modified version of the Autoconf Macro, you may extend this special
+### exception to the GPL to apply to your modified version as well.
+
+# serial 1
+AC_DEFUN([mdw_DECL_ENVIRON],
+[AC_CACHE_CHECK([for declaration of \`environ'], mdw_cv_environ,
+[AC_EGREP_CPP([\<environ\>],
+[#include <sys/types.h>
+#if HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif], [mdw_cv_environ=yes], [mdw_cv_environ=no])])
+if test $mdw_cv_environ = yes; then
+ AC_DEFINE([DECL_ENVIRON], [1],
+ [Define if you have the `environ' vector of environment variables.])
+fi])
--- /dev/null
+dnl -*-autoconf-*-
+
+### SYNOPSIS
+###
+### mdw_DEFINE_PATHS(BODY)
+###
+### mdw_PROG(PROG)
+### mdw_PATH(PATH)
+### mdw_DEFINE_PROG(SYMBOL, PROG)
+### mdw_DEFINE_PATH(SYMBOL, PATH)
+###
+### DESCRIPTION
+###
+### This collection of macros is useful for hardcoding pathname strings
+### into binary programs.
+###
+### Within the BODY of `mdw_DEFINE_PATHS', a number of variables are `fixed
+### up' so that they can be properly expanded. The other macros are only
+### really useful within this body.
+###
+### `mdw_PROG' expands, in the shell, to the transformed name of the
+### program PROG.
+###
+### `mdw_PATH' expands, in the shell, to the recursive expansion of PATH,
+### which should be a string containing parameter expansions.
+###
+### `mdw_DEFINE_PROG' is a convenience macro which defines the preprocessor
+### SYMBOL to the result of `mdw_PROG(PROG)'; similarly `mdw_DEFINE_PATH'
+### defines SYMBOL to the result of `mdw_PATH(PATH)'.
+###
+### LICENSE
+###
+### Copyright (c) 2002 Mark Wooding <mdw@distorted.org.uk>
+###
+### This program is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation, either version 2 of the License, or (at your
+### option) any later version.
+###
+### This program is distributed in the hope that it will be useful, but
+### WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+### General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License along
+### with this program. If not, see <http://www.gnu.org/licenses/>.
+###
+### As a special exception, the respective Autoconf Macro's copyright owner
+### gives unlimited permission to copy, distribute and modify the configure
+### scripts that are the output of Autoconf when processing the Macro. You
+### need not follow the terms of the GNU General Public License when using
+### or distributing such scripts, even though portions of the text of the
+### Macro appear in them. The GNU General Public License (GPL) does govern
+### all other use of the material that constitutes the Autoconf Macro.
+###
+### This special exception to the GPL applies to versions of the Autoconf
+### Macro released by the Autoconf Archive. When you make and distribute a
+### modified version of the Autoconf Macro, you may extend this special
+### exception to the GPL to apply to your modified version as well.
+
+# serial 1
+AC_DEFUN([mdw_DEFINE_PATHS],
+[mdw_prefix=$prefix mdw_exec_prefix=$exec_prefix
+mdw_transform=$(echo "$program_transform_name"|sed 's,\\\\\\\\,\\\\,g; s,\\$\\$,$,g')
+test "$prefix" = "NONE" && prefix=$ac_default_prefix
+test "$exec_prefix" = "NONE" && exec_prefix=$prefix
+$1
+prefix=$mdw_prefix exec_prefix=$mdw_exec_prefix])
+
+AC_DEFUN([mdw_PROG], [$(echo "$1" | sed "$mdw_transform")])
+AC_DEFUN([mdw_PATH],
+[$(t="$1"; dnl
+while :; do case "$t" in *\$[]*) eval t=\"$t\" ;; *) break ;; esac; done; dnl
+echo "$t")])
+AC_DEFUN([mdw_DEFINE_PROG],
+ [AC_DEFINE_UNQUOTED([$1], ["mdw_PROG([$2])"], [Program name for $2.])])
+AC_DEFUN([mdw_DEFINE_PATH],
+ [AC_DEFINE_UNQUOTED([$1], ["mdw_PATH([$2])"], [Pathname for $2.])])
--- /dev/null
+dnl -*-autoconf-*-
+
+### SYNOPSIS
+###
+### mdw_SILENT_RULES
+###
+### DESCRIPTION
+###
+### Set Automake's `silent-rules' feature on by default, if available.
+###
+### LICENSE
+###
+### Copyright (c) 2010 Mark Wooding <mdw@distorted.org.uk>
+###
+### This program is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation, either version 2 of the License, or (at your
+### option) any later version.
+###
+### This program is distributed in the hope that it will be useful, but
+### WITHOUT ANY WARRANTY; without even the implied warranty of
+### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+### General Public License for more details.
+###
+### You should have received a copy of the GNU General Public License along
+### with this program. If not, see <http://www.gnu.org/licenses/>.
+###
+### As a special exception, the respective Autoconf Macro's copyright owner
+### gives unlimited permission to copy, distribute and modify the configure
+### scripts that are the output of Autoconf when processing the Macro. You
+### need not follow the terms of the GNU General Public License when using
+### or distributing such scripts, even though portions of the text of the
+### Macro appear in them. The GNU General Public License (GPL) does govern
+### all other use of the material that constitutes the Autoconf Macro.
+###
+### This special exception to the GPL applies to versions of the Autoconf
+### Macro released by the Autoconf Archive. When you make and distribute a
+### modified version of the Autoconf Macro, you may extend this special
+### exception to the GPL to apply to your modified version as well.
+
+# serial 1
+AC_DEFUN([mdw_SILENT_RULES],
+ [m4_ifdef([AM_SILENT_RULES],
+ [AM_SILENT_RULES([yes])],
+ [AC_SUBST([AM_DEFAULT_VERBOSITY], [1])])])
-COPYING
Makefile.in
-aclocal.m4
-build
-common.info
-configure
-stamp-vti
-version.texi
-deb-build
-texinfo.tex
-mkinstalldirs
-autom4te.cache
-missing
-install-sh
-acinclude.m4
-config
-*.aux
-*.cp
-*.dvi
-*.fn
-*.info
-*.ky
-*.log
-*.out
+*.tex
*.pdf
-*.pg
-*.ps
-*.toc
-*.tp
-*.vr
+/_inst/
+/aclocal.m4
+/autom4te.cache/
+/config/compile
+/config/config.h.in
+/config/depcomp
+/config/install-sh
+/config/missing
+/configure
+/t/testsuite
(setq skel-alist
(append
'((author . "Mark Wooding")
- (full-title . "the Common Files Distribution (`common')")
- (Program . "`Common'")
- (program . "`common'"))
+ (full-title . "Runlisp, a tool for invoking Common Lisp scripts")
+ (program . "Runlisp")
+ (licence-text . "[[gpl-3]]"))
skel-alist))
--- /dev/null
+.ext/cfd/licence/GPL-3
\ No newline at end of file
--- /dev/null
+# -*-org-*-
+#+TITLE: Hacking on =runlisp=
+#+AUTHOR: Mark Wooding
+#+LaTeX_CLASS: strayman
+
+* Adding a new Lisp implementation
+
+When a program needs to know about a bunch of /things/, I generally try
+to arrange that there's exactly one place where you put all of the
+knowledge about each particular /thing/. In the case of ~runlisp~, I've
+failed rather abjectly. Sorry.
+
+So, here's the list of places which need to be modified in order to
+teach ~runlisp~ about a new Lisp system.
+
+ + The main C source file ~runlisp.c~ has a master list macro named
+ ~LISP_SYSTEMS~, which just contains an entry ~_(foo)~ for each Lisp
+ system. Add a new entry for your new system here. This list
+ ordered according to my personal preference -- the /opinionated
+ order/.
+
+ + There's also a function ~run_foo~ defined in ~runlisp.c~ for each
+ Lisp system ~foo~. These are defined in a section headed `Invoking
+ Lisp systems', in the opinionated order.
+
+ + The manual page ~runlisp.1~ lists each supported Lisp system by name
+ in the section `Supported Common Lisp implementations'. These are
+ listed in alphabetical order by command name (so GNU CLisp is
+ ~clisp~, and therefore comes before ~ecl~) -- the /command order/.
+
+ + The ~README.org~ file also has a list of supported Lisp systems,
+ again in command order.
+
+ + In ~configure.ac~, there's a line ~mdw_CHECK_LISP([FOO], [foo])~ for
+ each known Lisp system in the `Checking for Lisp implementations'
+ section, in opinionated order.
+
+ + If the Lisp system needs any additional configure-time hacking, then
+ that goes at the end of the section. Currently only ECL needs
+ special treatment here, but these are notionally in opinionated
+ order.
+
+ + The file ~vars.am~ builds a list ~LISPS~ of the supported Lisp
+ systems in opinionated order.
+
+ + For each Lisp system that can have a custom image dumped, there's a
+ paragraph in the `Image dumping' section of ~Makefile.am~, which
+ says
+
+ : if DUMP_FOO
+ : image_DATA += foo+asdf.dump
+ : CLEANFILES += foo+asdf.dump
+ : foo+asdf.dump: dump-runlisp-image
+ : (v_dump)./dump-runlisp-image -o$@ foo
+ : endif
+
+ The ~DUMP_FOO~ conditional is already set up by ~mdw_CHECK_LISP~.
+ The ~.dump~ suffix should be whatever extension your Lisp system
+ usually uses to mark its image files. These paragraphs are in
+ opinionated order.
+
+ + For each Lisp system that can be dumped, there's a section in
+ ~dump-runlisp-image.in~ which goes
+
+ : ## Foo Common Lisp.
+ : deflisp foo foo+asdf.dump
+ : dump_foo () {
+ : ## ...
+ : }
+
+ These sections are in opinionated order.
+
+ + The ~tests.at~ file has /five/ lists of Lisp systems.
+
+ - The first, named ~LISP_SYSTEMS~ has a pair of entries, ~foo~,
+ ~foo/noimage~ for each Lisp system, in opinionated order.
+
+ - The second is in the macro ~WHICH_LISP~, which contains an entry
+ ~#+foo "foo"~ for each system, in opinionated order. The former
+ symbol is the Lisp system's (preferred) ~*features*~ keyword
+ name, which is usually the same as its command name, but, for
+ example, is ~cmu~ rather than ~cmucl~ for CMU CL.
+
+ - The third is a ~case~ block in the ~smoke~ test, which contains
+ an entry
+
+ : foo) initfile=.foorc ;;
+
+ naming the system's user initialization file, relative to the
+ user's home directory. (If your Lisp doesn't have one of these,
+ then this can be anything you like.)
+
+ - The fourth is another ~case~ block in the ~smoke~ test, which
+ contains an entry
+
+ : foo) impl="Foo Common Lisp" ;;
+
+ giving the Lisp system's ~lisp-implementation-type~ string.
+
+ - The fifth is in the ~preferences~ test: there's a ~set~ line
+ which simply lists the Lisp systems' command names. This is in
+ order of increasing startup time, because the test will be
+ running lots of trivial scripts, simply checking that the right
+ Lisp system is being run, so it's valuable to choose fast Lisps.
+
+ + The script ~bench/massage-benchmarks~ has a hash ~%LISP~ mapping
+ Lisp command names to short labels to use in graphs, in opinionated
+ order. Add an entry
+
+ : "foo" => "Foo CL",
+
+ to this hash.
+
+And now the actual pain: the benchmarks need to be run again, and the
+data and graphs in ~README.org~ need to be updated. Leave this to me.
+
--- /dev/null
+### -*-makefile-*-
+###
+### Build script for `runlisp'
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+include $(top_srcdir)/vars.am
+
+SUBDIRS =
+
+image_DATA =
+image_SCRIPTS =
+
+SUBDIRS += .
+
+ACLOCAL_AMFLAGS = -Im4
+
+###--------------------------------------------------------------------------
+### A library of common code.
+
+noinst_LIBRARIES += librunlisp.a
+librunlisp_a_SOURCES =
+
+librunlisp_a_SOURCES += common.c common.h
+librunlisp_a_SOURCES += lib.c lib.h
+librunlisp_a_SOURCES += mdwopt.c mdwopt.h
+librunlisp_a_SOURCES += sha256.c sha256.h
+
+###--------------------------------------------------------------------------
+### The main driver program.
+
+bin_PROGRAMS += runlisp
+runlisp_SOURCES = runlisp.c
+runlisp_LDADD = librunlisp.a
+man_MANS += runlisp.1
+doc_DATA += runlisp.pdf
+EXTRA_DIST += runlisp.1.in
+
+###--------------------------------------------------------------------------
+### Additional machinery.
+
+pkgdata_DATA += eval.lisp
+EXTRA_DIST += eval.lisp
+
+pkgdata_SCRIPTS += dump-ecl
+EXTRA_DIST += dump-ecl
+
+bin_PROGRAMS += query-runlisp-config
+query_runlisp_config_SOURCES = query-runlisp-config.c
+query_runlisp_config_LDADD = librunlisp.a
+man_MANS += query-runlisp-config.1
+doc_DATA += query-runlisp-config.pdf
+EXTRA_DIST += query-runlisp-config.1.in
+
+man_MANS += runlisp.conf.5
+doc_DATA += runlisp.conf.pdf
+EXTRA_DIST += runlisp.conf.5.in
+
+EXTRA_DIST += runlisp-base.conf
+install-data-hook::
+ $(MKDIR_P) $(DESTDIR)$(pkgconfdir)/runlisp.d
+ cp $(srcdir)/runlisp-base.conf \
+ $(DESTDIR)$(pkgconfdir)/runlisp.d/0base.conf
+uninstall-hook::
+ rm -f $(DESTDIR)$(pkgconfdir)/runlisp.d/0base.conf
+
+EXTRA_DIST += runlisp.conf
+install-data-hook::
+ $(MKDIR_P) $(DESTDIR)$(pkgconfdir)
+ if ! [ -f $(DESTDIR)$(pkgconfdir)/runlisp.conf ]; then \
+ cp $(srcdir)/runlisp.conf $(DESTDIR)$(pkgconfdir)/; \
+ fi
+uninstall-hook::
+ rm -f $(DESTDIR)$(pkgconfdir)/runlisp.conf
+
+###--------------------------------------------------------------------------
+### Image dumping.
+
+bin_PROGRAMS += dump-runlisp-image
+dump_runlisp_image_SOURCES = dump-runlisp-image.c
+dump_runlisp_image_LDADD = librunlisp.a
+man_MANS += dump-runlisp-image.1
+doc_DATA += dump-runlisp-image.pdf
+EXTRA_DIST += dump-runlisp-image.1.in
+
+DUMP_RUNLISP_IMAGE = $(v_dump)./dump-runlisp-image -f -O$@ \
+ -c$(srcdir)/runlisp-base.conf \
+ -odata-dir=$(srcdir)
+
+v_dump = $(v_dump_@AM_V@)
+v_dump_ = $(v_dump_@AM_DEFAULT_V@)
+v_dump_0 = @echo " DUMP $@";
+
+IMAGES =
+noinst_DATA += $(IMAGES)
+
+if DUMP_SBCL
+IMAGES += sbcl+asdf.core
+CLEANFILES += sbcl+asdf.core
+sbcl+asdf.core: dump-runlisp-image runlisp-base.conf
+ $(DUMP_RUNLISP_IMAGE) sbcl
+endif
+
+if DUMP_CCL
+IMAGES += ccl+asdf.image
+CLEANFILES += ccl+asdf.image
+ccl+asdf.image: dump-runlisp-image runlisp-base.conf
+ $(DUMP_RUNLISP_IMAGE) ccl
+endif
+
+if DUMP_CLISP
+IMAGES += clisp+asdf.mem
+CLEANFILES += clisp+asdf.mem
+clisp+asdf.mem: dump-runlisp-image runlisp-base.conf
+ $(DUMP_RUNLISP_IMAGE) clisp
+endif
+
+if DUMP_ECL
+IMAGES += ecl+asdf
+CLEANFILES += ecl+asdf
+ecl+asdf: dump-runlisp-image runlisp-base.conf dump-ecl
+ $(DUMP_RUNLISP_IMAGE) ecl
+endif
+
+if DUMP_CMUCL
+IMAGES += cmucl+asdf.core
+CLEANFILES += cmucl+asdf.core
+cmucl+asdf.core: dump-runlisp-image runlisp-base.conf
+ $(DUMP_RUNLISP_IMAGE) cmucl
+endif
+
+install-data-hook::
+ mkdir -p $(DESTDIR)$(imagedir)
+ set -e; for i in $(IMAGES); do \
+ j=$$(readlink $$i); \
+ cp $$j $(DESTDIR)$(imagedir)/$$j.new && \
+ mv $(DESTDIR)$(imagedir)/$$j.new \
+ $(DESTDIR)$(imagedir)/$$j; \
+ ln -sf $$j $(DESTDIR)$(imagedir)/$$i; \
+ done
+
+uninstall-hook::
+ set -e; for i in $(IMAGES); do \
+ if j=$$(readlink $(DESTDIR)$(imagedir)/$$i); then \
+ case $$j in \
+ $$i-*[!0-9a-f]) ;; \
+ $$i-*) rm -f $(DESTDIR)$(imagedir)/$$j ;; \
+ esac; \
+ fi; \
+ rm -f $(DESTDIR)$(imagedir)/$$i; \
+ done
+
+###--------------------------------------------------------------------------
+### Other subdirectories.
+
+## Documentation.
+SUBDIRS += doc
+
+## Testing.
+SUBDIRS += t
+
+## Benchmarking.
+if BENCHMARK
+SUBDIRS += bench
+endif
+
+###--------------------------------------------------------------------------
+### Distribution.
+
+## Release number.
+dist-hook::
+ echo $(VERSION) >$(distdir)/RELEASE
+
+## Additional build tools.
+EXTRA_DIST += config/auto-version
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+# -*-org-*-
+#+TITLE: ~runlisp~ -- run scripts written in Common Lisp
+#+AUTHOR: Mark Wooding
+#+LaTeX_CLASS: strayman
+#+LaTeX_HEADER: \usepackage{tikz, gnuplot-lua-tikz}
+
+~runlisp~ is a small C program intended to be run from a script ~#!~
+line. It selects and invokes a Common Lisp implementation, so as to run
+the script. In this sense, ~runlisp~ is a partial replacement for
+~cl-launch~.
+
+Currently, the following Lisp implementations are supported:
+
+ + Armed Bear Common Lisp (~abcl~),
+ + Clozure Common Lisp (~ccl~),
+ + GNU CLisp (~clisp~),
+ + Carnegie--Mellon Univerity Common Lisp (~cmucl~), and
+ + Embeddable Common Lisp (~ecl~), and
+ + Steel Bank Common Lisp (~sbcl~).
+
+Adding more Lisps is simply a matter of writing the necessary runes in a
+configuration file. Of course, there's a benefit to having a collection
+of high-quality configuration runes curated centrally, so I'm happy to
+accept submissions in support of any free[fn:free] Lisp implementations.
+
+[fn:free] Here I mean free as in freedom.
+
+
+* Writing scripts in Common Lisp
+
+** Basic use
+
+The obvious way to use ~runlisp~ is in a shebang (~#!~) line at the top
+of a script. For example:
+
+: #! /usr/local/bin/runlisp
+: (format t "Hello from Lisp!~%")
+
+Script interpreters must be named with absolute pathnames in shebang
+lines; if your ~runlisp~ is installed somewhere other than
+~/usr/local/bin/~ then you'll need to write something different.
+Alternatively, a common hack involves abusing the ~env~ program as a
+script interpreter, because it will do a path search for the program
+it's supposed to run:
+
+: #! /usr/bin/env runlisp
+: (format t "Hello from Lisp!~%")
+
+** Specific Lisps
+
+Lisp implementations are not created equal -- for good reason. If your
+script depends on the features of some particular Lisp implementation,
+then you can tell ~runlisp~ that it must use that implementation to run
+your script using the ~-L~ option; for example:
+
+: #! /usr/local/bin/runlisp -Lsbcl
+: (format t "Hello from Steel Bank Common Lisp!~%")
+
+If your script supports several Lisps, but not all, then list them all
+in the ~-L~ option, separated by commas:
+
+: #! /usr/local/bin/runlisp -Lsbcl,ccl
+: (format t #.(concatenate 'string
+: "Hello from "
+: #+sbcl "Steel Bank"
+: #+ccl "Clozure"
+: #-(or sbcl ccl) "an unexpected"
+: " Common Lisp!~%"))
+
+** Embedded options
+
+If your script requires features of particular Lisp implementations
+/and/ you don't want to hardcode an absolute path to ~runlisp~, then you
+have a problem. Most Unix-like operating systems will parse a shebang
+line into the initial ~#!~, the pathname to the interpreter program,
+and a /single/ optional argument: any further spaces don't separate
+further arguments: they just get included in the first argument, all the
+way up to the end of the line. So
+
+: #! /usr/bin/env runlisp -Lsbcl
+: (format t "Hello from Steel Bank Common Lisp!~%")
+
+won't work: it'll just try to run a program named ~runlisp -Lsbcl~, with
+a space in the middle of its name, and that's quite unlikely to exist.
+
+To help with this situation, ~runlisp~ reads /embedded options/ from
+your script. Specifically, if the script's second line contains the
+token ~@RUNLISP:~ then ~runlisp~ will parse additional options from this
+line. So the following will work properly.
+
+: #! /usr/bin/env runlisp
+: ;;; @RUNLISP: -Lsbcl
+: (format t "Hello from Steel Bank Common Lisp!~%")
+
+Embedded options are split at spaces properly. Spaces can be escaped or
+quoted in (an approximation to) the usual shell manner, should that be
+necessary. See the manpage for the gory details.
+
+** Common environment
+
+~runlisp~ puts some effort into making sure that Lisp scripts get the
+same view of the world regardless of which implementation is running
+them.
+
+For example:
+
+ + The ~asdf~ and ~uiop~ systems are loaded and ready for use.
+
+ + The script's command-line arguments are available in
+ ~uiop:*command-line-arguments*~. Its name can be found by calling
+ ~(uiop:argv0)~ -- though it's probably also in ~*load-pathname*~.
+
+ + The prevailing Unix standard input, output, and error files are
+ available through the Lisp ~*standard-input*~, ~*standard-output*~,
+ and ~*error-ouptut*~ streams, respectively. (This is, alas, not a
+ foregone conclusion.)
+
+ + The keyword ~:runlisp-script~ is added to the ~*features*~ list.
+ This means that your script can tell whether it's being run from the
+ command line, and should therefore do its thing and then quit; or
+ merely being loaded into a Lisp system, e.g., for debugging or
+ development, and should sit still and not do anything until it's
+ asked.
+
+See the manual for the complete list of guarantees.
+
+
+* Invoking Lisp implementations
+
+** Basic use
+
+A secondary use of ~runlisp~ is in build scripts for Lisp programs. If
+the entire project is just a Lisp library, then it's possibly acceptable
+to just provide an ASDF system definition and expect users to type
+~(asdf:load-system "mumble")~ to use it. If it's a program, or there
+are things other than Lisp which ASDF can't or shouldn't handle --
+significant pieces in other languages, or a Lisp executable image to
+make and install -- then it seems sensible to make the project's main
+build system be something language-agnostic, say Unix ~make~, and
+arrange for that to invoke ASDF at the appropriate time.
+
+But how should that be arranged? It's relatively easy for a project'
+Lisp code to support multiple Lisp implementation; but each
+implementation wants different runes for evaluating Lisp forms from the
+command line, and some of them don't provide an ideal environment for
+integrating into a build system. So ~runlisp~ provides a simple common
+command-line interface for evaluating Lisp forms. For example:
+
+: $ runlisp -e '(format t "~A~%" (+ 1 2))'
+: 3
+
+If your build script needs to get information out of Lisp, then wrapping
+~format~, or even ~prin1~, around forms is annoying; so ~runlisp~ has a
+~-p~ option which prints the values of the forms it evaluates.
+
+: $ runlisp -e '(+ 1 2)'
+: 3
+
+If a form produces multiple values, then ~-p~ will print all of them
+separated by spaces, on a single line:
+
+: $ runlisp -p '(floor 5 2)'
+: 2 1
+
+In addition to evaluating forms with ~-e~, and printing their values
+with ~-p~, you can also load a file of Lisp code using ~-l~.
+
+When ~runlisp~ is acting on ~-e~, ~-p~, and/or ~-l~ options, it's said
+to be running in /eval/ mode, rather than its usual /script/ mode. In
+script mode, it /doesn't/ set ~:runlisp-script~ in ~*features*~.
+
+You can still insist that ~runlisp~ use a particular Lisp
+implementation, or one of a subset of implementations, using the ~-L~
+option mentioned above.
+
+: $ runlisp -Lsbcl -p "(lisp-implementation-type)"
+: "SBCL"
+
+** Command-line processing
+
+When scripting a Lisp -- as opposed to running a Lisp script -- it's not
+necessarily the case that your script knows in advance exactly what it
+needs to ask Lisp to do. For example, it might need to tell Lisp to
+install a program in a particular directory, determined by Autoconf.
+While it's certainly /possible/ to quote such data and splice them into
+Lisp forms, it's more convenient to pass them in separately. So
+~runlisp~ ensures that the command-line options are available to Lisp
+forms via ~uiop:*command-line-arguments*~, as they are to a Lisp script.
+
+: $ runlisp -p "uiop:*command-line-arguments*" one two three
+: ("one" "two" "three")
+
+When running Lisp forms like this, ~(uiop:argv0)~ isn't very
+meaningful. (Currently, it reveals the name of the script which
+~runlisp~ uses to implement this feature.)
+
+
+* Configuring =runlisp=
+
+** Where =runlisp= looks for configuration
+
+You can influence which Lisp implementations are chosen by ~runlisp~ by
+writing configuration files, and/or setting environment variables.
+
+The ~runlisp~ program looks for configuration in a number of places.
+
+ + There's a system-global directory ~SYSCONFDIR/runlisp/runlisp.d/~.
+ All of the files in this directory named ~SOMETHING.conf~ are read,
+ in increasing lexicographical order by name. The package comes with
+ a file ~0base.conf~ intended to be read first, so that it can be
+ overridden if necessar. This sets up basic definitions, and defines
+ the necessary runes for those Lisp implementations which are
+ supported `out of the box'. New Lisp packages might come with
+ additional files to drop into this directory.
+
+ + There's a system-global file ~SYSCONFDIR/runlisp/runlisp.conf~ which
+ is intended to be edited by the system administrator to account for
+ any local quirks. This is read /after/ the directory, which is
+ intended to be used by distribution packages, so that the system
+ administrator can override them.
+
+ + Users can create files ~$HOME/.runlisp.conf~ and/or
+ ~$HOME/.config/runlisp.conf~[fn:xdg-config] in their home
+ directories to add support for privately installed Lisp systems, or
+ to override settings made by earlier configuration files.
+
+The configuration syntax is complicated, and explained in detail in the
+*runlisp.conf* manpage.
+
+Configuration options can also be set on the command line, though the
+effects are subtly different. Again, see the manual pages for details.
+
+[fn:xdg-config] More properly, in ~$XDG_CONFIG_HOME/runlisp.conf~, if
+you set that.
+
+
+** Deciding which Lisp implementation to use
+
+The ~prefer~ option specifies a /preference list/ of Lisp
+implementations. The value is a list of Lisp implementation names, as
+you'd give to ~-L~, separated by commas and/or spaces. If the
+environment variable ~RUNLISP_PREFER~ is set, then this overrides any
+value found in the configuration files.
+
+When deciding which Lisp implementation to use, ~runlisp~ works as
+follows. It builds a list of /acceptable/ Lisp implementations from the
+~-L~ command-line option, and a list of /preferred/ Lisp implementations
+from the ~prefer~ configuration option (or environment variable). If
+there aren't any ~-L~ options, then it assumes that /all/ Lisp
+implementations are acceptable; if no ~prefer~ option is set then it
+assumes that /no/ Lisp implementations are preferred. It then works
+through the preferred list in order: if it finds an implementation which
+is installed and acceptable, then it uses that one. If that doesn't
+work, then it works through the acceptable implementations that it
+hasn't tried yet, in order, and if it finds one of those that's
+installed, then it runs that one. Otherwise it reports an error and
+gives up.
+
+
+** Supporting new Lisp implementations
+
+~runlisp~ tries hard to make adding support for a new Lisp as painless
+as possible. An awkward Lisp will of course cause trouble, but
+~runlisp~ itself is easy.
+
+As a simple example, let's add support for the 32-bit version of
+Clozure~CL. The source code for Clozure~CL easily builds both 32- and
+64-bit binaries in either 32- or 64-bit userlands, and one might
+reasonably want to use the 32-bit CCL for some reason. The following
+configuration stanza is sufficient
+
+: [ccl32]
+: @PARENTS = ccl
+: command = ${@ENV:CCL32?ccl32}
+: image-file = ccl32+asdf.image
+
+ + The first line heads a configuration section, providing the name
+ which will be used for this Lisp implementation, e.g., in ~-L~
+ options or ~prefer~ lists.
+
+ + The second line tells ~runlisp~ that configuration settings not
+ found in this section should be looked up in the ~ccl~ section
+ instead.
+
+ + The third line defines the command to be used to invoke the Lisp
+ system. It tries to find an environment variable named ~CCL32~,
+ falling back to looking up ~ccl32~ in the path otherwise.
+
+And, err..., that's it. The ~@PARENTS~ setting uses the detailed
+command-line runes for ~ccl~, so they don't need to be written out
+again.
+
+That was rather anticlimactic, because all of the work got done
+somewhere else. So let's look at a complete example: Steel Bank Common
+Lisp. (SBCL's command-line interface is well thought-out, so this is an
+ideal opportunity to explain how ~runlisp~ configuration works, without
+getting bogged down in the details of fighting less amenable Lisps.)
+
+The provided ~0base.conf~ file defines SBCL as follows.
+
+: [sbcl]
+:
+: command = ${@ENV:SBCL?sbcl}
+: image-file = ${@NAME}+asdf.core
+:
+: 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 "(sb-ext:save-lisp-and-die \"${@IMAGENEW|q}\")"
+
+Let's take this in slightly larger pieces.
+
+ + We see the ~[sbcl]~ section heading, and the ~command~ setting
+ again. These should now be unsurprising.
+
+ + There's no ~@PARENTS~ setting, so by default the ~sbcl~ section
+ inherits settings from the ~@COMMON~ section, defined in
+ ~0base.conf~. We shall use a number of definitions from this
+ section.
+
+ + The ~image-file~ gives the name of the custom image file to look for
+ when trying to start SBCL, but not the directory. (The directory is
+ named by the ~image-dir~ configuration setting.) The image file
+ will be named ~sbcl+asdf.core~, but this isn't what's written.
+ Instead, it uses ~${@NAME}~, which is replaced by the name of the
+ section being processed. When we're running SBCL, this does the
+ same thing; but if someone wants to configure a new ~foo~ Lisp and
+ set ~@PARENTS~ to ~sbcl~, then the image file for ~foo~ will be
+ named ~foo+asdf.core~ by default. You needn't take such care when
+ configuring Lisp implementations for your own purposes, but it's
+ important for configurations which will be widely used.
+
+ + The ~run-script~ setting explains how to get SBCL to run a script.
+ This string is broken into words at (unquoted) spaces.
+
+ The syntax ~$?VAR{CONSEQ|ALT}~ means: if a configuration setting
+ ~VAR~ is defined, then expand to ~CONSEQ~; otherwise, expand to
+ ~ALT~. In this case, if the magic setting ~@IMAGE~ is defined, then
+ we add the tokens ~--core "${image-path}" --eval "${image-restore}"~
+ to the SBCL command line; otherwise, we add ~--eval
+ "${run-script-prelude}"~. The ~@IMAGE~ setting is defined by
+ ~runlisp~ only if (a)~a custom image was found in the correct placem
+ and (b)~use of custom images isn't disabled on its command line.
+
+ The ~${image-path}~ token expands to the full pathname to the custom
+ image file; ~image-restore~ is a predefined Lisp expression to be
+ run when starting from a dumped image (e.g., to get ASDF to refresh
+ its idea of which systems are available).
+
+ The ~run-script-prelude~ is another (somewhat involved) Lisp
+ expression which sets up a Lisp environment suitable for running
+ scripts -- e.g., by arranging to ignore ~#!~ lines, and pushing
+ ~:runlisp-script~ onto ~*features*~.
+
+ Finally, regardless of whether we're using a custom or vanilla
+ image, we add the tokens ~--script "${@SCRIPT}"~ to the command
+ line. The ~${@SCRIPT}~ token is replaced by the actual script
+ pathname. ~runlisp~ then appends further arguments from its own
+ command line and runs the command. (For most Lisps, ~uiop~ needs a
+ ~--~ marker before the user arguments, but not for SBCL.)
+
+ + Finally, ~dump-image~ defines a command line for dumping a custom
+ images. The ~dump-image-prelude~ setting is a Lisp expression for
+ setting up a Lisp so that it will be in a useful state when dumped:
+ it's very similar to ~run-script-prelude~, and is built out of many
+ of the same pieces.
+
+ The thing we haven't seen before is ~${@IMAENEW|q}~. The
+ ~@IMAGENEW~ setting is defined by the ~dump-runlisp-image~ program
+ the name the file in which the new image should be
+ saved.[fn:image-rename] The ~|q~ `filter' is new: it means that the
+ filename should be escaped suitable for inclusion in a Lisp quoted
+ string, by prefixing each ~\~ or ~"~ with a ~\~.
+
+That's more or less all there is. SBCL is a particularly simple
+example, but mostly because other Lisp implementations require fancier
+stunts /at the Lisp level/. The ~runlisp~-level configuration isn't any
+more complicated than SBCL.
+
+[fn:image-rename] ~dump-runlisp-image~ wants to avoid clobbering an
+existing image with a half-finished one, so it tries to arrange for the
+new image to be written to a different file, and then renames it once
+it's been created successfully.)
+
+
+* What's wrong with =cl-launch=?
+
+The short version is that ~cl-launch~ is slow and inconvenient.
+~cl-launch~ is a big, complicated Common Lisp/Bourne shell polyglot
+which tries to do everything but doesn't quite succeed.
+
+** It's slow.
+
+I took a trivial Lisp script:
+
+: (format t "Hello from ~A!~%~
+: Script = `~A'~%~
+: Arguments = (~{`~A'~^, ~})~%"
+: (lisp-implementation-type)
+: (uiop:argv0)
+: uiop:*command-line-arguments*)
+
+I timed how long it took to run on all of ~runlisp~'s supported Lisp
+implementations, and compared them to how long ~cl-launch~ took: the
+results are shown in table [[tab:runlisp-vanilla]]. ~runlisp~ is /at least/
+two and half times faster at running this script than ~cl-launch~ on all
+implementations except Clozure CL[fn:slow-ccl], and approaching four and
+a half times faster on SBCL.
+
+#+CAPTION: ~cl-launch~ vs ~runlisp~ (with vanilla images)
+#+NAME: tab:runlisp-vanilla
+#+ATTR_LATEX: :float t :placement [tbp]
+|------------------+-------------------+-----------------+----------------------|
+| *Implementation* | *~cl-launch~ (s)* | *~runlisp~ (s)* | *~runlisp~ (factor)* |
+|------------------+-------------------+-----------------+----------------------|
+| ABCL | 7.3378 | 2.6474 | 2.772 |
+| Clozure CL | 1.2888 | 0.9742 | 1.323 |
+| GNU CLisp | 1.2405 | 0.2703 | 4.589 |
+| CMU CL | 0.9521 | 0.3097 | 3.074 |
+| ECL | 0.8020 | 0.3236 | 2.478 |
+| SBCL | 0.3205 | 0.0874 | 3.667 |
+|------------------+-------------------+-----------------+----------------------|
+#+TBLFM: $4=$2/$3;%.3f
+
+But this is using the `vanilla' Lisp images installed with the
+implementations. ~runlisp~ by default builds custom images for most
+Lisp implementations, which improves startup performance significantly;
+see table [[tab:runlisp-custom]]. (I don't currently know how to build a
+useful custom image for ABCL. ~runlisp~ does build a custom image for
+ECL, but it doesn't help significantly.) These results are summarized
+in figure [[fig:lisp-graph]].
+
+#+CAPTION: ~cl-launch~ vs ~runlisp~ (with custom images)
+#+NAME: tab:runlisp-custom
+#+ATTR_LATEX: :float t :placement [tbp]
+|------------------+-------------------+-----------------+----------------------|
+| *Implementation* | *~cl-launch~ (s)* | *~runlisp~ (s)* | *~runlisp~ (factor)* |
+|------------------+-------------------+-----------------+----------------------|
+| ABCL | 7.3378 | 2.7023 | 2.715 |
+| Clozure CL | 1.2888 | 0.0371 | 34.739 |
+| GNU CLisp | 1.2405 | 0.0191 | 64.948 |
+| CMU CL | 0.9521 | 0.0060 | 158.683 |
+| ECL | 0.8020 | 0.3275 | 2.449 |
+| SBCL | 0.3205 | 0.0064 | 50.078 |
+|------------------+-------------------+-----------------+----------------------|
+#+TBLFM: $4=$2/$3;%.3f
+
+#+CAPTION: Comparison of ~runlisp~ and ~cl-launch~ times
+#+NAME: fig:lisp-graph
+#+ATTR_LATEX: :float t :placement [tbp]
+[[file:doc/lisp-graph.tikz]]
+
+Unlike ~cl-launch~, with some Lisp implementations at least, ~runlisp~
+startup performance is usefully comparable to other popular scripting
+language implementations. I wrote similarly trivial scripts in a number
+of other languages, and timed them; the results are tabulated in table
+[[tab:runlisp-interp]] and graphed in figure [[fig:interp-graph]].
+
+#+CAPTION: ~runlisp~ vs other interpreters
+#+NAME: tab:runlisp-interp
+#+ATTR_LATEX: :float t :placement [tbp]
+|------------------------------+-------------|
+| *Implementation* | *Time (ms)* |
+|------------------------------+-------------|
+| Clozure CL | 37.1 |
+| GNU CLisp | 19.1 |
+| CMU CL | 6.0 |
+| SBCL | 6.4 |
+|------------------------------+-------------|
+| Perl | 1.1 |
+| Python | 6.8 |
+|------------------------------+-------------|
+| Debian Almquist shell (dash) | 1.2 |
+| GNU Bash | 1.5 |
+| Z Shell | 3.1 |
+|------------------------------+-------------|
+| Tiny C (compile & run) | 1.6 |
+| GCC (precompiled) | 0.6 |
+|------------------------------+-------------|
+
+#+CAPTION: Comparison of ~runlisp~ and other script interpreters
+#+NAME: fig:interp-graph
+#+Attr_latex: :float t :placement [tbp]
+[[file:doc/interp-graph.tikz]]
+
+(All the timings in this section were performed on the same 2020 Dell
+XPS13 laptop running Debian `buster'. The tools used to make the
+measurements are included in the source distribution, in the ~bench/~
+subdirectory.)
+
+[fn:slow-ccl] I don't know why Clozure CL shows such a small difference
+here.
+
+** It's inconvenient
+
+~cl-launch~ has this elaborate machinery which reads shell script
+fragments from various places and sets variables like ~$LISPS~, but it
+doesn't quite work.
+
+Unlike other scripting languages such as Perl or Python, Common Lisp has
+lots of implementations, and they all have various unique features (and
+bugs) which a script might rely on (or need to avoid). Also, a user
+might have preferences about which Lisps to use. ~cl-launch~'s approach
+to this problem is a ~system_preferred_lisps~ shell function which can
+be used in ~~/.cl-launchrc~ to select a Lisp system for a particular
+`software system', though this notion doesn't appear to be well-defined,
+but this all works by editing a single ~$LISPS~ shell variable. By
+contrast, ~runlisp~ has a ~-L~ option with which scripts can specify the
+Lisp systems they support (in a preference order), and a ~prefer~
+configuration setting with which users can express their own
+preferences: ~runlisp~ will never choose a Lisp system which the script
+can't deal with, but it will respect the user's relative preferences.
+
+Also, ~cl-launch~ is a monolith. Adding a new Lisp implementation to
+it, or changing how a particular implementation is invoked, is rather
+involved. By contrast, ~runlisp~ makes this remarkably easy, as
+described in [[Supporting new Lisp implementations]].
+
+** It doesn't establish a (useful) common environment
+
+A number of Lisp systems are annoyingly deficient in their handling of
+scripts.
+
+For example, when GNU CLisp's ~-x~ option is used, it rebinds
+~*standard-input*~ to an internal string stream holding the expression
+passed in on the command line, leaving the process's actual stdin nearly
+impossible to access.
+
+: $ date | cl-launch -l sbcl -i "(princ (read-line nil nil))" # expected
+: Sun 9 Aug 14:39:10 BST 2020
+: $ date | cl-launch -l clisp -i "(princ (read-line nil nil))" # bug!
+: NIL
+
+As another example, Armed Bear Common Lisp doesn't seem to believe in
+the stderr stream: when it starts up, ~*error-ouptut*~ is bound to the
+standard output, just like ~*standard-output*~. Also, ~cl-launch~
+loading ASDF causes a huge number of ~style-warning~ messages to be
+written to stdout, making ABCL pretty much useless for writing filter
+scripts.
+
+: $ cl-launch -l sbcl -i '(progn
+: (format *standard-output* "output~%")
+: (format *error-output* "error~%"))' \
+: > >(sed 's/^/stdout: /') 2> >(sed 's/^/stderr: /')
+: stdout: output
+: stderr: error
+: $ cl-launch -l abcl -i '(progn
+: (format *standard-output* "output~%")
+: (format *error-output* "error~%"))' \
+: > >(sed 's/^/stdout: /') 2> >(sed 's/^/stderr: /')
+: [1813 lines of compiler warnings tagged `stdout:']
+: stdout: output
+: stdout: error
+
+~runlisp~ takes care of all of this, providing a basic but useful common
+level of shell integration for all its supported Lisp implementations.
+In particular:
+
+ + It ensures that the standard Unix `stdin', `stdout', and `stdarr'
+ file descriptors are hooked up to the Lisp ~*standard-input*~,
+ ~*standard-output*~, and ~*error-output*~ streams.
+
+ + It ensures that starting a script doesn't write a deluge of
+ diagnostic drivel.
+
+The complete details are given in ~runlisp~'s manpage.
+
+** Why might one prefer =cl-launch= anyway?
+
+On the other hand, ~cl-launch~ is well established and full-featured.
+
+~cl-launch~ compiles scripts before trying to run them, so they'll run
+faster on Lisps which use an interpreter by default. It has a caching
+feature so running a script a second time doesn't need to recompile it.
+If your scripts are compute-intensive and benefit from ahead-of-time
+compilation then maybe ~cl-launch~ is preferable.
+
+~cl-launch~ supports more Lisp systems. I only have six installed on my
+development machine at the moment, so those are the ones that ~runlisp~
+supports. If you want your scripts to be able to run on other Lisps,
+then ~cl-launch~ is the way to do that. Of course, I welcome patches to
+help ~runlisp~ support other free Lisp implementations. ~cl-launch~
+also supports proprietary Lisps: I have very little interest in these,
+so if you want to run scripts using Allegro or LispWorks then
+~cl-launch~ is your only choice.
--- /dev/null
+### -*-makefile-*-
+###
+### Build script for start-up benchmarks
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+include $(top_srcdir)/vars.am
+
+GNUPLOT = gnuplot
+
+FORCE =
+FORCE:
+.PHONY: FORCE
+
+###--------------------------------------------------------------------------
+### Preliminaries.
+
+v_bench = $(v_bench_@AM_V@)
+v_bench_ = $(v_bench_@AM_DEFAULT_V@)
+v_bench_0 = @echo " BENCH $@";
+
+BENCHES =
+bench: $(BENCHES)
+
+noinst_PROGRAMS += timeit
+timeit_SOURCES = timeit.c
+
+CLEANFILES += *.out *.bench
+
+###--------------------------------------------------------------------------
+### Lisp systems using `runlisp'.
+
+RUNLISP = $(top_builddir)/runlisp \
+ -c$(top_srcdir)/runlisp-base.conf \
+ -oimage-dir=$(top_builddir)
+EXTRA_DIST += t.lisp
+
+RUNLISP_BENCHES = $(foreach l,$(LISPS), runlisp.$l.bench)
+BENCHES += $(RUNLISP_BENCHES)
+$(RUNLISP_BENCHES): runlisp.%.bench: timeit $(FORCE)
+ $(v_bench)./timeit $(RUNLISP) -L$* -- \
+ $(srcdir)/t.lisp a b c >runlisp.$*.out 2>$@
+
+RUNLISP_NOIMAGE_BENCHES = $(foreach l,$(LISPS), runlisp-noimage.$l.bench)
+BENCHES += $(RUNLISP_NOIMAGE_BENCHES)
+$(RUNLISP_NOIMAGE_BENCHES): runlisp-noimage.%.bench: timeit $(FORCE)
+ $(v_bench)./timeit $(RUNLISP) -D -L$* -- \
+ $(srcdir)/t.lisp a b c >runlisp-noimage.$*.out 2>$@
+
+###--------------------------------------------------------------------------
+### Lisp systems using `cl-launch'.
+
+CL_LAUNCH_BENCHES = $(foreach l,$(LISPS), cl-launch.$l.bench)
+BENCHES += $(CL_LAUNCH_BENCHES)
+$(CL_LAUNCH_BENCHES): cl-launch.%.bench: timeit $(FORCE)
+ $(v_bench)./timeit cl-launch -X -l $* -- $(srcdir)/t.lisp a b c >cl-launch.$*.out 2>$@
+
+###--------------------------------------------------------------------------
+### C programs (as a baseline).
+
+BENCHES += c.tcc.bench
+c.tcc.bench: timeit $(FORCE)
+ $(v_bench)./timeit tcc -run $(srcdir)/t.c a b c >c.tcc.out 2>$@
+
+BENCHES += c.gcc.bench
+noinst_PROGRAMS += t.c.gcc
+t_c_gcc_SOURCES = t.c
+c.gcc.bench: t.c.gcc timeit $(FORCE)
+ $(v_bench)./timeit ./t.c.gcc a b c >c.gcc.out 2>$@
+
+###--------------------------------------------------------------------------
+### Other scripting languages.
+
+BENCHES += perl.bench
+EXTRA_DIST += t.pl
+perl.bench: timeit $(FORCE)
+ $(v_bench)./timeit perl -- $(srcdir)/t.pl a b c >perl.out 2>$@
+
+BENCHES += python.bench
+EXTRA_DIST += t.py
+python.bench: timeit $(FORCE)
+ $(v_bench)./timeit python -- $(srcdir)/t.py a b c >python.out 2>$@
+
+SHELLS = dash bash zsh
+EXTRA_DIST += t.sh
+SHELL_BENCHES = $(foreach s,$(SHELLS), shell.$s.bench)
+BENCHES += $(SHELL_BENCHES)
+$(SHELL_BENCHES): shell.%.bench: timeit $(FORCE)
+ $(v_bench)TEST_SHELL=$* ./timeit $* -- $(srcdir)/t.sh a b c >shell.$*.out 2>$@
+
+###--------------------------------------------------------------------------
+### Reporting.
+
+GRAPHS =
+noinst_DATA += $(GRAPHS)
+CLEANFILES += $(GRAPHS)
+
+v_massage = $(v_massage_@AM_V@)
+v_massage_ = $(v_massage_@AM_DEFAULT_V@)
+v_massage_0 = @echo " MASSAGE $@";
+
+v_gnuplot = $(v_gnuplot_@AM_V@)
+v_gnuplot_ = $(v_gnuplot_@AM_DEFAULT_V@)
+v_gnuplot_0 = @echo " GNUPLOT $@";
+
+CLEANFILES += bench.data
+bench.data: $(BENCHES) massage-benchmarks
+ $(v_massage)$(srcdir)/massage-benchmarks >$@.new && mv $@.new $@
+
+GRAPHS += lisp-graph.tikz
+lisp-graph.tikz: lisp-graph.gp bench.data
+ $(v_gnuplot)$(GNUPLOT) $< >$@.new && mv $@.new $@
+
+GRAPHS += interp-graph.tikz
+interp-graph.tikz: interp-graph.gp bench.data
+ $(v_gnuplot)$(GNUPLOT) $< >$@.new && mv $@.new $@
+
+graphs: $(GRAPHS)
+.PHONY: graphs
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+### -*-gnuplot-*-
+
+set terminal tikz
+
+set style data histogram
+set xtic rotate by -35 offset -1, 0 scale 0
+set style fill solid
+set style histogram cluster gap 1
+
+unset key
+set border 3
+set tics nomirror
+set ylabel "Time (ms) to run trivial script"
+
+plot "bench.data" index "> interp" using (1000*$2):xtic(1)
--- /dev/null
+### -*-gnuplot-*-
+
+set terminal tikz
+
+set style data histogram
+set xtics rotate by -35 scale 0
+set style fill solid
+set style histogram cluster
+
+set border 3
+set tics nomirror
+set ylabel "Time (s) to run trivial script"
+
+plot for [i = 2:4] "bench.data" index "> lisp" using i:xtic(1) \
+ title columnheader(i)
--- /dev/null
+#! /usr/bin/perl
+
+use autodie;
+
+my %LISP =
+ ("sbcl" => "SBCL",
+ "ccl" => "Clozure CL",
+ "ecl" => "ECL",
+ "clisp" => "GNU CLisp",
+ "cmucl" => "CMU CL",
+ "abcl" => "ABCL");
+my %LABEL =
+ ("perl" => "Perl",
+ "python" => "Python",
+ "c.tcc" => "Tiny C",
+ "c.gcc" => "GCC",
+ "shell.dash" => "dash",
+ "shell.bash" => "GNU Bash",
+ "shell.zsh" => "Z Shell");
+
+for my $l (keys %LISP) { $LABEL{"runlisp.$l"} = $LISP{$l}; }
+
+{
+ my %d;
+
+ sub timing ($) {
+ my ($f) = @_;
+ return $d{$f} if exists $d{$f};
+ open my $fh, "<", "$f.bench";
+ (my $data = readline $fh) =~ s/^.* elapsed = ([0-9.]+)s.*$/$1/;
+ return $d{$f} = $data;
+ }
+}
+
+print <<EOF;
+#> lisp
+"Lisp system" "\\\\texttt{cl-launch}" "\\\\texttt{runlisp} (vanilla image)" "\\\\texttt{runlisp} (custom image)"
+EOF
+for my $l (sort keys %LISP) {
+ printf "\"%s\" %.4f %.4f %.4f\n",
+ $LISP{$l},
+ timing("cl-launch.$l"),
+ timing("runlisp-noimage.$l"),
+ timing("runlisp.$l");
+}
+print "\n\n";
+
+print <<EOF;
+#> interp
+EOF
+for my $i
+ ("runlisp.ccl", "runlisp.clisp", "runlisp.cmucl", "runlisp.sbcl",
+ "perl", "python",
+ "shell.dash", "shell.bash", "shell.zsh",
+ "c.tcc", "c.gcc")
+ { printf "\"%s\" %.4f\n", $LABEL{$i}, timing $i; }
--- /dev/null
+#include <stdio.h>
+
+#if __clang__
+# define IMPL "Clang"
+#elif __TINYC__
+# define IMPL "TCC"
+#elif __GNUC__
+# define IMPL "GCC"
+#else
+# define IMPL "an unknown C implementation"
+#endif
+
+int main(int argc, char *argv[])
+{
+ int i;
+
+ puts("Hello from " IMPL "!");
+ printf("Script = `%s'\n", argv[0]);
+ fputs("Arguments = (", stdout);
+ for (i = 1; i < argc; i++) {
+ if (i > 1) fputs(", ", stdout);
+ printf("`%s'", argv[i]);
+ }
+ putchar(')'); putchar('\n');
+ return (0);
+}
--- /dev/null
+#! /usr/bin/runlisp
+
+(format t "Hello from ~A!~%~
+ Script = `~A'~%~
+ Arguments = (~{`~A'~^, ~})~%"
+ (lisp-implementation-type)
+ (uiop:argv0)
+ uiop:*command-line-arguments*)
--- /dev/null
+#! /usr/bin/perl
+
+printf <<EOF, $0, join ", ", map "`$_'", @ARGV;
+Hello from Perl!
+Script = `%s'
+Arguments = (%s)
+EOF
--- /dev/null
+#! /usr/bin/python
+
+import sys as SYS
+
+print("""\
+Hello from Python!
+Script = `%s'
+Arguments = (%s)""" %
+ (SYS.argv[0], ", ".join("`%s'" % arg for arg in SYS.argv[1:])))
--- /dev/null
+#! /bin/sh
+
+cat <<EOF
+Hello from ${TEST_SHELL-an unknown shell}!
+Script = $0
+Arguments = ($*)
+EOF
--- /dev/null
+#include <errno.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#include <unistd.h>
+#include <sys/resource.h>
+#include <sys/time.h>
+#include <sys/wait.h>
+
+static const char *progname = "timeit";
+
+static void set_progname(const char *prog)
+{
+ const char *p;
+
+ p = strrchr(prog, '/');
+ progname = p ? p + 1 : progname;
+}
+
+static void lose(const char *msg, ...)
+{
+ va_list ap;
+
+ va_start(ap, msg);
+ fprintf(stderr, "%s: ", progname);
+ vfprintf(stderr, msg, ap);
+ fputc('\n', stderr);
+ va_end(ap);
+ exit(127);
+}
+
+static double timeval_to_float(const struct timeval *tv)
+ { return (tv->tv_sec + tv->tv_usec*1e-6); }
+
+int main(int argc, char *argv[])
+{
+ struct rusage ru;
+ struct timeval t0, t1, t;
+ pid_t kid;
+ int i, st;
+
+ set_progname(argv[0]);
+ gettimeofday(&t0, 0);
+ kid = fork(); if (kid < 0) lose("fork failed: %s", strerror(errno));
+ if (!kid) {
+ execvp(argv[1], argv + 1);
+ lose("exec (`%s') failed: %s", argv[1], strerror(errno));
+ }
+ if (wait4(kid, &st, 0, &ru) < 0) lose("wait failed: %s", strerror(errno));
+ gettimeofday(&t1, 0);
+ if (st) {
+ if (WIFSIGNALED(st))
+ lose("program killed by signal %d\n", WTERMSIG(st));
+ else if (WIFEXITED(st))
+ lose("program failed with status %d\n", WEXITSTATUS(st));
+ else
+ lose("program exited with incomprehensible status 0x%04x\n", st);
+ }
+
+ if (t0.tv_usec > t1.tv_usec) {
+ t.tv_sec = t1.tv_sec - t0.tv_sec - 1;
+ t.tv_usec = t1.tv_usec + 1000000 - t0.tv_usec;
+ } else {
+ t.tv_sec = t1.tv_sec - t0.tv_sec;
+ t.tv_usec = t1.tv_usec - t0.tv_usec;
+ }
+
+ for (i = 1; i < argc; i++) {
+ if (i > 1) fputc(' ', stderr);
+ fputs(argv[i], stderr);
+ }
+ fprintf(stderr, ": elapsed = %.4fs; user = %.4fs; system = %.4fs\n",
+ timeval_to_float(&t),
+ timeval_to_float(&ru.ru_utime),
+ timeval_to_float(&ru.ru_stime));
+ return (0);
+}
--- /dev/null
+/* -*-c-*-
+ *
+ * Common functionality of a less principled nature
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "config.h"
+
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <dirent.h>
+#include <pwd.h>
+#include <unistd.h>
+
+#include <sys/stat.h>
+
+#include "common.h"
+#include "lib.h"
+
+/*----- Public variables --------------------------------------------------*/
+
+struct config config = CONFIG_INIT; /* main configuration */
+struct config_section *toplevel, *builtin, *common, *env; /* well-known
+ * sections */
+unsigned verbose = 1; /* verbosity level */
+
+/*----- Miscellany --------------------------------------------------------*/
+
+/* Look up the environment variable NAME.
+ *
+ * If it's found, return the value; otherwise return DFLT. This function
+ * looks up the environment variable in the `@ENV' configuration section, so
+ * (a) it's likely more efficient than getenv(3), and (b) the `init_config'
+ * function must have been called earlier.
+ */
+const char *my_getenv(const char *name, const char *dflt)
+{
+ struct config_var *var;
+
+ var = config_find_var(&config, env, 0, name);
+ return (var ? var->val : dflt);
+}
+
+/* Parse and return an integer from the string P.
+ *
+ * Report an error if the string doesn't look like an integer, or if it's not
+ * between MIN and MAX (inclusive). Qualify error messages using the
+ * adjective WHAT.
+ */
+long parse_int(const char *what, const char *p, long min, long max)
+{
+ long n;
+ int oerr = errno;
+ char *q;
+
+ errno = 0;
+ n = strtol(p, &q, 0);
+ while (ISSPACE(*q)) q++;
+ if (errno || *q) lose("invalid %s `%s'", what, p);
+ if (n < min || n > max)
+ lose("%s %ld out of range (must be between %ld and %ld)",
+ what, n, min, max);
+ errno = oerr;
+ return (n);
+}
+
+/* Append a word P to string D, quoting and/or escaping it in shell style.
+ *
+ * It tries to pick a `good' way to protect metacharacters, but the precise
+ * details aren't guaranteed to remain stable.
+ */
+static void putword(struct dstr *d, const char *p)
+{
+ unsigned bare = 0, sq = 2, dq = 2;
+ const char *q, *e, *f;
+ size_t n;
+
+ /* Pass one: count up how many extra escaping and/or quoting characters
+ * we'd need for each quoting strategy: `bare' is no quoting, just adding
+ * toothpicks before naughty characters; `dq' is double quotes, with fewer
+ * toothpicks; and `sq' is single quotes, with the somewhat awful rune
+ * `'\''' rune replacing embedded single quotes. The quoting strategies
+ * start off with a two-character penalty for the surrounding quotes.
+ */
+ for (q = p; *q; q++)
+ switch (*q) {
+ case '\\': case '"': case '`': case '$': case '!': bare++; dq++; break;
+ case '\'': bare++; sq += 3; break;
+ case '^': case '|': case ';': case '&': case '(': case ')':
+ case '<': case '>':
+ case '*': case '?': case '[':
+ case '#':
+ bare++; break;
+ default:
+ if (ISSPACE(*q)) bare++;
+ break;
+ }
+
+ /* Prepare for the output loop: `q' will be a string of naughty characters
+ * which need escaping somehow; `e' is a sequence to insert before each
+ * naughty character, and `f' is a final string to add to the end. We'll
+ * put the initial quote on ourselves, if necessary.
+ */
+ if (bare < dq && bare < sq)
+ { q = "\\\"`$!'^|;&()<>*?[# \b\f\n\r\t\v"; e = "\\"; f = ""; }
+ else if (dq < sq)
+ { q = "\\\"`$!"; e = "\\"; dstr_putc(d, '"'); f = "\""; }
+ else
+ { q = "'"; e = "'\\'"; dstr_putc(d, '\''); f = "'"; }
+
+ /* Work through the input string inserting escapes as we go. */
+ for (;;) {
+ n = strcspn(p, q);
+ if (n) { dstr_putm(d, p, n); p += n; }
+ if (!*p) break;
+ dstr_puts(d, e); dstr_putc(d, *p++);
+ }
+ dstr_puts(d, f);
+}
+
+/* Format string-vector AV as a sequence of possibly-quoted words.
+ *
+ * Append the resulting list to D.
+ */
+void argv_string(struct dstr *d, const struct argv *av)
+{
+ size_t i;
+
+ for (i = 0; i < av->n; i++) {
+ if (i) dstr_putc(d, ' ');
+ putword(d, av->v[i]);
+ }
+ dstr_putz(d);
+}
+
+/*----- Internal utilities ------------------------------------------------*/
+
+/* Append the user's home directory to D. */
+static void homedir(struct dstr *d)
+{
+ static const char *home = 0;
+ const char *p;
+ struct passwd *pw;
+
+ if (!home) {
+
+ p = my_getenv("HOME", 0);
+ if (p) home = p;
+ else {
+ pw = getpwuid(getuid());
+ if (!pw) lose("can't find user in password database");
+ home = xstrdup(pw->pw_dir);
+ }
+ }
+ dstr_puts(d, home);
+}
+
+/* Append the user's XDG configuration directory to D. */
+static void user_config_dir(struct dstr *d)
+{
+ const char *p;
+
+ p = my_getenv("XDG_CONFIG_HOME", 0);
+ if (p) dstr_puts(d, p);
+ else { homedir(d); dstr_puts(d, "/.config"); }
+}
+
+/*----- File utilities ----------------------------------------------------*/
+
+/* Return whether PATH names an existing file.
+ *
+ * This will return zero if PATH names something which isn't a regular file.
+ * If `FEF_EXEC' is set in F, then additionally ensure that it's executable
+ * by the (real) calling uid. If `FEF_VERBOSE' is set in F, then report on
+ * the outcome of the check to standard error.
+ */
+int file_exists_p(const char *path, unsigned f)
+{
+ struct stat st;
+
+ if (stat(path, &st)) {
+ if (f&FEF_VERBOSE) moan("file `%s' not found", path);
+ return (0);
+ } else if (!(S_ISREG(st.st_mode))) {
+ if (f&FEF_VERBOSE) moan("`%s' is not a regular file", path);
+ return (0);
+ } else if ((f&FEF_EXEC) && access(path, X_OK)) {
+ if (f&FEF_VERBOSE) moan("file `%s' is not executable", path);
+ return (0);
+ } else {
+ if (f&FEF_VERBOSE) moan("found file `%s'", path);
+ return (1);
+ }
+}
+
+/* Return whether PROG can be found in the `PATH'.
+ *
+ * If PROG is a pathname (absolute or relative -- i.e., if it contains a
+ * `/'), then just check that it names an executable program. Otherwise
+ * check to see whether `DIR/PROG' exists and is executable for any DIR in
+ * the `PATH'. The flags F are as for `file_exists_p'.
+ */
+int found_in_path_p(const char *prog, unsigned f)
+{
+ struct dstr p = DSTR_INIT, d = DSTR_INIT;
+ const char *path;
+ char *q;
+ size_t n, avail, proglen;
+ int i, rc;
+
+ if (strchr(prog, '/'))
+ return (file_exists_p(prog, f | FEF_EXEC));
+ path = my_getenv("PATH", 0);
+ if (path)
+ dstr_puts(&p, path);
+ else {
+ dstr_puts(&p, ".:");
+ i = 0;
+ again:
+ avail = p.sz - p.len;
+ n = confstr(_CS_PATH, p.p + p.len, avail);
+ if (avail > n) { i++; assert(i < 2); dstr_ensure(&p, n); goto again; }
+ }
+
+ q = p.p; proglen = strlen(prog);
+ for (;;) {
+ n = strcspn(q, ":");
+ dstr_reset(&d);
+ if (n) dstr_putm(&d, q, n);
+ else dstr_putc(&d, '.');
+ dstr_putc(&d, '/');
+ dstr_putm(&d, prog, proglen);
+ dstr_putz(&d);
+ if (file_exists_p(d.p, (verbose >= 4 ? f : f&~FEF_VERBOSE) | FEF_EXEC)) {
+ if (verbose == 2) moan("found program `%s'", d.p);
+ rc = 1; goto end;
+ }
+ q += n; if (!*q) break; else q++;
+ }
+
+ rc = 0;
+end:
+ dstr_release(&p); dstr_release(&d);
+ return (rc);
+}
+
+/* Try to run a program as indicated by the argument list AV.
+ *
+ * This is essentially execvp(3). If `TEF_VERBOSE' is set in F then trace
+ * what's going on to standard error. If `TEF_DRYRUN' is set in F then don't
+ * actually try to run the program: just check whether it exists and is
+ * vaguely plausible. Return -1 if there was a problem, or 0 if it was
+ * successful but didn't actually run the program because of the flags
+ * settings.
+ */
+int try_exec(struct argv *av, unsigned f)
+{
+ struct dstr d = DSTR_INIT;
+ int rc;
+
+ assert(av->n); argv_appendz(av);
+ if (verbose >= 2) { argv_string(&d, av); moan("trying %s...", d.p); }
+ if (f&TEF_DRYRUN) {
+ if (found_in_path_p(av->v[0], f&TEF_VERBOSE ? FEF_VERBOSE : 0))
+ { rc = 0; goto end; }
+ } else {
+ execvp(av->v[0], av->v);
+ if (errno != ENOENT) {
+ moan("failed to exec `%s': %s", av->v[0], strerror(errno));
+ _exit(127);
+ }
+ }
+
+ if (verbose >= 2) moan("`%s' not found", av->v[0]);
+ rc = -1;
+end:
+ dstr_release(&d);
+ return (rc);
+}
+
+/*----- Configuration -----------------------------------------------------*/
+
+/* Initialize the configuration machinery.
+ *
+ * This establishes the standard configuration sections `@CONFIG',
+ * `@BUILTIN', `@COMMON', and `@ENV', setting the corresponding global
+ * variables, and populates `@BUILTIN' (from compile-time configuration) and
+ * `@ENV' (from the environment variables).
+ */
+void init_config(void)
+{
+ toplevel = config_find_section(&config, CF_CREAT, "@CONFIG");
+ builtin = config_find_section(&config, CF_CREAT, "@BUILTIN");
+ common = config_find_section(&config, CF_CREAT, "@COMMON");
+ env = config_find_section(&config, CF_CREAT, "@ENV");
+ config_set_fallback(&config, common);
+ config_set_parent(builtin, 0);
+ config_set_parent(common, builtin);
+ config_set_parent(env, 0);
+ config_read_env(&config, env);
+
+ config_set_var(&config, builtin, CF_LITERAL,
+ "@%data-dir", DATADIR);
+ config_set_var(&config, builtin, 0,
+ "@data-dir", "${@ENV:RUNLISP_DATADIR?"
+ "${@CONFIG:data-dir?"
+ "${@BUILTIN:@%data-dir}}}");
+ config_set_var(&config, builtin, CF_LITERAL,
+ "@%image-dir", IMAGEDIR);
+ config_set_var(&config, builtin, 0,
+ "@image-dir", "${@ENV:RUNLISP_IMAGEDIR?"
+ "${@CONFIG:image-dir?"
+ "${@BUILTIN:@%image-dir}}}");
+
+#ifdef ECL_OPTIONS_GNU
+ config_set_var(&config, builtin, CF_LITERAL, "@%ecl-opt", "--");
+#else
+ config_set_var(&config, builtin, CF_LITERAL, "@%ecl-opt", "-");
+#endif
+ config_set_var(&config, builtin, 0,
+ "@ecl-opt", "${@CONFIG:ecl-opt?${@BUILTIN:@%ecl-opt}}");
+}
+
+/* Read a named configuration FILE.
+ *
+ * WHAT is an adjective describing the configuration file, to be used in
+ * diagnostics; FILE is the actual filename to read; and F holds `CF_...'
+ * flags for `config_read_file', which actually does most of the work.
+ */
+void read_config_file(const char *what, const char *file, unsigned f)
+{
+ if (!config_read_file(&config, file, f)) {
+ if (verbose >= 2)
+ moan("read %s configuration file `%s'", what, file);
+ } else {
+ if (verbose >= 3)
+ moan("ignoring missing %s configuration file `%s'", what, file);
+ }
+}
+
+/* Order strings lexicographically.
+ *
+ * This function is intended to be passed an argument to qsort(3).
+ */
+static int order_strings(const void *xx, const void *yy)
+ { const char *const *x = xx, *const *y = yy; return (strcmp(*x, *y)); }
+
+/* Read all of the configuration files in directory PATH.
+ *
+ * WHAT is an adjective describing the configuration directory, to be used in
+ * diagnostics; FILE is the actual filename to read; and F holds `CF_...'
+ * flags for `config_read_file', which actually reads the files.
+ *
+ * All of the files named `*.conf' in the directory are read, in ascending
+ * lexicographical order by name. If `CF_NOENTOK' is set in F, then ignore
+ * an error explaining that the directory doesn't exist. (This only ignores
+ * `ENOENT': any other problem is still a fatal error.)
+ */
+void read_config_dir(const char *what, const char *path, unsigned f)
+{
+ struct argv av = ARGV_INIT;
+ struct dstr dd = DSTR_INIT;
+ struct stat st;
+ DIR *dir;
+ struct dirent *d;
+ size_t i, n, len;
+
+ dir = opendir(path);
+ if (!dir) {
+ if (!(f&CF_NOENTOK) || errno != ENOENT)
+ lose("failed to read %s configuration directory `%s': %s",
+ what, path, strerror(errno));
+ if (verbose >= 3)
+ moan("ignoring missing %s configuration directory `%s'", what, path);
+ return;
+ }
+
+ dstr_puts(&dd, path); dstr_putc(&dd, '/'); n = dd.len;
+ for (;;) {
+ d = readdir(dir); if (!d) break;
+ len = strlen(d->d_name);
+ if (len < 5 || STRCMP(d->d_name + len - 5, !=, ".conf")) continue;
+ dd.len = n; dstr_putm(&dd, d->d_name, len); dstr_putz(&dd);
+ if (stat(dd.p, &st))
+ lose("failed to read file metadata for `%s': %s",
+ dd.p, strerror(errno));
+ if (!S_ISREG(st.st_mode)) continue;
+ argv_append(&av, xstrdup(d->d_name));
+ }
+
+ qsort(av.v, av.n, sizeof(*av.v), order_strings);
+
+ for (i = 0; i < av.n; i++) {
+ dd.len = n; dstr_puts(&dd, av.v[i]);
+ read_config_file(what, dd.p, f&~CF_NOENTOK);
+ }
+
+ for (i = 0; i < av.n; i++) free(av.v[i]);
+ argv_release(&av); dstr_release(&dd); closedir(dir);
+ return;
+}
+
+/* Read configuration from a file or directory PATH.
+ *
+ * If PATH exists and names a directory then process all of the files within,
+ * as for `read_config_dir'; otherwise try to read it as a file, as for
+ * `read_config_file'. The flags F are passed to the respective function.
+ */
+void read_config_path(const char *path, unsigned f)
+{
+ struct stat st;
+
+ if (!stat(path, &st) && S_ISDIR(st.st_mode))
+ read_config_dir("command-line specified ", path, f);
+ else
+ read_config_file("command-line specified", path, f);
+}
+
+/* Apply a configuration variable setting in command-line syntax.
+ *
+ * ASSIGN should be a string in the form `[SECT:]VAR=VALUE'. Set VAR to
+ * VALUE in section SECT (defaults to `@CONFIG'). The variable is set with
+ * `CF_OVERRIDE' set to prevent the setting from being overwritten by a
+ * configuration file.
+ */
+int set_config_var(const char *assign)
+{
+ struct config_section *sect;
+ const char *p, *q;
+
+ p = strchr(assign, '=');
+ if (!p) { moan("missing `=' in option assignment"); return (-1); }
+ q = strchr(assign, ':');
+ if (!q || q > p)
+ { sect = toplevel; q = assign; }
+ else if (q == assign)
+ lose("expected section or variable name in option assignment");
+ else {
+ sect = config_find_section_n(&config, CF_CREAT, assign, q - assign);
+ q++;
+ }
+ if (p == q) lose("expected variable name in option assignment");
+ config_set_var_n(&config, sect, CF_LITERAL | CF_OVERRIDE,
+ q, p - q, p + 1, strlen(p + 1));
+ return (0);
+}
+
+/* Load the default configuration files.
+ *
+ * This will read `ETCDIR/runlisp.d/*.conf', `ETCDIR/runlisp.conf',
+ * `~/.runlisp.conf', and `~/.config/runlisp.conf'.
+ */
+void load_default_config(void)
+{
+ const char *p;
+ struct dstr d = DSTR_INIT;
+
+ p = my_getenv("RUNLISP_SYSCONFIG_DIR", ETCDIR "/runlisp.d");
+ read_config_dir("system", p, CF_NOENTOK);
+ p = my_getenv("RUNLISP_SYSCONFIG", ETCDIR "/runlisp.conf");
+ read_config_file("system", p, 0);
+
+ p = my_getenv("RUNLISP_USERCONFIG", 0);
+ if (p)
+ read_config_file("user", p, CF_NOENTOK);
+ else {
+ dstr_reset(&d); homedir(&d); dstr_puts(&d, "/.runlisp.conf");
+ read_config_file("user", d.p, CF_NOENTOK);
+ dstr_reset(&d); user_config_dir(&d); dstr_puts(&d, "/runlisp.conf");
+ read_config_file("user", d.p, CF_NOENTOK);
+ }
+ dstr_release(&d);
+}
+
+/* Dump the configuration to standard error. */
+void dump_config(void)
+{
+ struct config_section_iter si;
+ struct config_section *sect;
+ struct config_var_iter vi;
+ struct config_var *var;
+
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ for (config_start_var_iter(&config, sect, &vi);
+ (var = config_next_var(&vi)); )
+ moan("config %s:%s = %s",
+ CONFIG_SECTION_NAME(sect), CONFIG_VAR_NAME(var), var->val);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+/* -*-c-*-
+ *
+ * Common functionality of a less principled nature
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef COMMON_H
+#define COMMON_H
+
+#ifdef __cplusplus
+ extern "C" {
+#endif
+
+/*----- Externally defined types ------------------------------------------*/
+
+struct dstr;
+struct argv;
+
+/*----- Public variables --------------------------------------------------*/
+
+extern struct config config;
+extern struct config_section *toplevel, *builtin, *common, *env;
+extern unsigned verbose;
+
+/*----- Functions provided ------------------------------------------------*/
+
+extern const char *my_getenv(const char */*name*/, const char */*dflt*/);
+ /* Look up the environment variable NAME.
+ *
+ * If it's found, return the value; otherwise return DFLT. This
+ * function looks up the environment variable in the `@ENV'
+ * configuration section, so (a) it's likely more efficient than
+ * getenv(3), and (b) the `init_config' function must have been
+ * called earlier.
+ */
+
+extern long parse_int(const char */*what*/, const char */*p*/,
+ long /*min*/, long /*max*/);
+ /* Parse and return an integer from the string P.
+ *
+ * Report an error if the string doesn't look like an integer, or if
+ * it's not between MIN and MAX (inclusive). Qualify error messages
+ * using the adjective WHAT.
+ */
+
+extern void argv_string(struct dstr */*d*/, const struct argv */*av*/);
+ /* Format string-vector AV as a sequence of possibly-quoted words.
+ *
+ * Append the resulting list to D.
+ */
+
+extern int file_exists_p(const char */*path*/, unsigned /*f*/);
+#define FEF_EXEC 1u
+#define FEF_VERBOSE 2u
+ /* Return whether PATH names an existing file.
+ *
+ * This will return zero if PATH names something which isn't a
+ * regular file. If `FEF_EXEC' is set in F, then additionally ensure
+ * that it's executable by the (real) calling uid. If `FEF_VERBOSE'
+ * is set in F, then report on the outcome of the check to standard
+ * error.
+ */
+
+extern int found_in_path_p(const char */*prog*/, unsigned /*f*/);
+ /* Return whether PROG can be found in the `PATH'.
+ *
+ * If PROG is a pathname (absolute or relative -- i.e., if it
+ * contains a `/'), then just check that it names an executable
+ * program. Otherwise check to see whether `DIR/PROG' exists and is
+ * executable for any DIR in the `PATH'. The flags F are as for
+ * `file_exists_p'.
+ */
+
+extern int try_exec(struct argv */*av*/, unsigned /*f*/);
+#define TEF_DRYRUN 1u
+#define TEF_VERBOSE 2u
+ /* Try to run a program as indicated by the argument list AV.
+ *
+ * This is essentially execvp(3). If `TEF_VERBOSE' is set in F then
+ * trace what's going on to standard error. If `TEF_DRYRUN' is set
+ * in F then don't actually try to run the program: just check
+ * whether it exists and is vaguely plausible. Return -1 if there
+ * was a problem, or 0 if it was successful but didn't actually run
+ * the program because of the flags settings.
+ */
+
+extern void init_config(void);
+ /* Initialize the configuration machinery.
+ *
+ * This establishes the standard configuration sections `@CONFIG',
+ * `@BUILTIN', `@COMMON', and `@ENV', setting the corresponding
+ * global variables, and populates `@BUILTIN' (from compile-time
+ * configuration) and `@ENV' (from the environment variables).
+ */
+
+extern void read_config_file(const char */*what*/,
+ const char */*file*/, unsigned /*f*/);
+ /* Read a named configuration FILE.
+ *
+ * WHAT is an adjective describing the configuration file, to be used
+ * in diagnostics; FILE is the actual filename to read; and F holds
+ * `CF_...' flags for `config_read_file', which actually does most
+ * of the work.
+ */
+
+extern void read_config_dir(const char */*what*/,
+ const char */*path*/, unsigned /*f*/);
+ /* Read all of the configuration files in directory PATH.
+ *
+ * WHAT is an adjective describing the configuration directory, to be
+ * used in diagnostics; FILE is the actual filename to read; and F
+ * holds `CF_...' flags for `config_read_file', which actually reads
+ * the files.
+ *
+ * All of the files named `*.conf' in the directory are read, in
+ * ascending lexicographical order by name. If `CF_NOENTOK' is set
+ * in F, then ignore an error explaining that the directory doesn't
+ * exist. (This only ignores `ENOENT': any other problem is still a
+ * fatal error.)
+ */
+
+extern void read_config_path(const char */*path*/, unsigned /*f*/);
+ /* Read configuration from a file or directory PATH.
+ *
+ * If PATH exists and names a directory then process all of the files
+ * within, as for `read_config_dir'; otherwise try to read it as a
+ * file, as for `read_config_file'. The flags F are passed to the
+ * respective function.
+ */
+
+extern int set_config_var(const char */*assign*/);
+ /* Apply a configuration variable setting in command-line syntax.
+ *
+ * ASSIGN should be a string in the form `[SECT:]VAR=VALUE'. Set VAR
+ * to VALUE in section SECT (defaults to `@CONFIG'). The variable is
+ * set with `CF_OVERRIDE' set to prevent the setting from being
+ * overwritten by a configuration file.
+ */
+
+extern void load_default_config(void);
+ /* Load the default configuration files.
+ *
+ * This will read `ETCDIR/runlisp.d/*.conf', `ETCDIR/runlisp.conf',
+ * `~/.runlisp.conf', and `~/.config/runlisp.conf'.
+ */
+
+extern void dump_config(void);
+ /* Dump the configuration to standard error. */
+
+/*----- That's all, folks -------------------------------------------------*/
+
+#ifdef __cplusplus
+ }
+#endif
+
+#endif
--- /dev/null
+../.ext/cfd/build/auto-version
\ No newline at end of file
--- /dev/null
+../.ext/cfd/build/confsubst
\ No newline at end of file
--- /dev/null
+dnl -*-autoconf-*-
+dnl
+dnl Configuration script for `runlisp'
+dnl
+dnl (c) 2020 Mark Wooding
+dnl
+
+dnl----- Licensing notice ---------------------------------------------------
+dnl
+dnl This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+dnl
+dnl Runlisp is free software: you can redistribute it and/or modify it
+dnl under the terms of the GNU General Public License as published by the
+dnl Free Software Foundation; either version 3 of the License, or (at your
+dnl option) any later version.
+dnl
+dnl Runlisp is distributed in the hope that it will be useful, but WITHOUT
+dnl ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+dnl FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+dnl for more details.
+dnl
+dnl You should have received a copy of the GNU General Public License
+dnl along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+dnl--------------------------------------------------------------------------
+dnl Initialization.
+
+mdw_AUTO_VERSION
+AC_INIT([runlisp], AUTO_VERSION, [mdw@distorted.org.uk])
+AC_CONFIG_SRCDIR([runlisp.c])
+AC_CONFIG_AUX_DIR([config])
+AM_INIT_AUTOMAKE([foreign])
+mdw_SILENT_RULES
+
+AC_PROG_CC
+AX_CFLAGS_WARN_ALL
+mdw_DECL_ENVIRON
+AC_CHECK_FUNC([strsignal])
+case $ac_cv_func_strsignal in no) AC_DECL_SYS_SIGLIST ;; esac
+
+AC_PROG_RANLIB
+
+AC_CHECK_PROGS([AUTOM4TE], [autom4te])
+
+dnl--------------------------------------------------------------------------
+dnl Checking for Lisp implementations.
+
+imagedir=$localstatedir/$PACKAGE_NAME; AC_SUBST(imagedir)
+mdw_DEFINE_PATHS([
+ mdw_DEFINE_PATH([IMAGEDIR], [$imagedir])
+ mdw_DEFINE_PATH([ETCDIR], [$sysconfdir/$PACKAGE_NAME])
+ mdw_DEFINE_PATH([DATADIR], [$datadir/$PACKAGE_NAME])])
+
+AC_ARG_ENABLE([imagedump],
+ [AS_HELP_STRING([--enable-imagedump[=SYSTEMS]],
+ [make dumps of Lisp SYSTEMS with ASDF etc. preloaded;
+ SYSTEMS is `yes', `no', or a comma-separated list of
+ system names])],
+ [], [enable_imagedump=yes])
+
+AC_DEFUN([mdw_CHECK_LISP],
+[AC_CHECK_PROGS([$1], [$2])
+AC_ARG_VAR([$1], [Path to the $1 Lisp system.])
+case $[]$1:,$enable_imagedump, in
+ :*) dump=nil ;;
+ *:,yes, | *:*,$2,*) dump=t ;;
+ *) dump=nil ;;
+esac
+AM_CONDITIONAL([DUMP_$1], [test $dump = t])])
+
+mdw_CHECK_LISP([SBCL], [sbcl])
+mdw_CHECK_LISP([CCL], [ccl])
+mdw_CHECK_LISP([CLISP], [clisp])
+mdw_CHECK_LISP([ECL], [ecl])
+mdw_CHECK_LISP([CMUCL], [cmucl])
+mdw_CHECK_LISP([ABCL], [abcl])
+
+dnl ECL is changing its command-line option syntax, because that will make
+dnl things much better or something. So we need to figure out which version
+dnl of the syntax to use.
+mdw_ecl_opts=hunoz
+if test "x$ECL" != x; then
+ AC_MSG_CHECKING([ECL command-line option flavour])
+ ver=$($ECL --version)
+ case $ver in
+ [ECL\ [0-9].*] | [ECL\ 1[0-5].*]) mdw_ecl_opts=trad ;;
+ [ECL\ 1[6-9].*] | [ECL\ [2-9][0-9].*]) mdw_ecl_opts=gnu ;;
+ *) AC_MSG_ERROR([unsupported ECL version \`$ver']) ;;
+ esac
+ AC_MSG_RESULT([$mdw_ecl_opts])
+ case $mdw_ecl_opts in
+ gnu) AC_DEFINE([ECL_OPTIONS_GNU], [1],
+ [Define 1 if ECL uses GNU-style `--FOO' options]) ;;
+ esac
+ case $mdw_ecl_opts in
+ gnu) ECLOPT=-- ;;
+ trad) ECLOPT=- ;;
+ *) AC_MSG_ERROR([internal error: unexpected value for `$mdw_ecl_opts']) ;;
+ esac
+fi
+AC_SUBST([ECLOPT])
+
+dnl--------------------------------------------------------------------------
+dnl Benchmarking support.
+
+dnl This has lots of random dependencies, and isn't really very useful. Turn
+dnl it off unless the user is very keen.
+AC_ARG_ENABLE([benchmark],
+ [AS_HELP_STRING([--enable-benchmark],
+ [turn on script-startup benchmark machinery])],
+ [mdw_bench=$enableval], [mdw_bench=no])
+AM_CONDITIONAL([BENCHMARK], [test "$mdw_bench" = yes])
+
+dnl--------------------------------------------------------------------------
+dnl Produce output.
+
+AC_CONFIG_HEADER([config/config.h])
+AC_CONFIG_TESTDIR([t])
+
+AC_CONFIG_FILES([Makefile]
+ [bench/Makefile doc/Makefile]
+ [t/Makefile t/atlocal])
+AC_OUTPUT
+
+dnl----- That's all, folks --------------------------------------------------
--- /dev/null
+### -*-makefile-*-
+###
+### Additional documentation files
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+include $(top_srcdir)/vars.am
+
+EXTRA_DIST += bench.data
+
+EXTRA_DIST += lisp-graph.tikz
+EXTRA_DIST += interp-graph.tikz
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+#> lisp
+"Lisp system" "\\texttt{cl-launch}" "\\texttt{runlisp} (vanilla image)" "\\texttt{runlisp} (custom image)"
+"ABCL" 7.3378 2.6474 2.7023
+"Clozure CL" 1.2888 0.9742 0.0371
+"GNU CLisp" 1.2405 0.2703 0.0191
+"CMU CL" 0.9521 0.3097 0.0060
+"ECL" 0.8020 0.3236 0.3275
+"SBCL" 0.3205 0.0874 0.0064
+
+
+#> interp
+"Clozure CL" 0.0371
+"GNU CLisp" 0.0191
+"CMU CL" 0.0060
+"SBCL" 0.0064
+"Perl" 0.0011
+"Python" 0.0068
+"dash" 0.0012
+"GNU Bash" 0.0015
+"Z Shell" 0.0031
+"Tiny C" 0.0016
+"GCC" 0.0006
--- /dev/null
+\begin{tikzpicture}[gnuplot]
+%% generated with GNUPLOT 5.2p6 (Lua 5.3; terminal rev. Nov 2018, script rev. 107)
+%% Wed 26 Aug 2020 21:13:41 BST
+\path (0.000,0.000) rectangle (12.500,8.750);
+\gpcolor{color=gp lt color border}
+\gpsetlinetype{gp lt border}
+\gpsetdashtype{gp dt solid}
+\gpsetlinewidth{1.00}
+\draw[gp path] (1.136,1.363)--(1.316,1.363);
+\node[gp node right] at (0.952,1.363) {$0$};
+\draw[gp path] (1.136,2.248)--(1.316,2.248);
+\node[gp node right] at (0.952,2.248) {$5$};
+\draw[gp path] (1.136,3.133)--(1.316,3.133);
+\node[gp node right] at (0.952,3.133) {$10$};
+\draw[gp path] (1.136,4.017)--(1.316,4.017);
+\node[gp node right] at (0.952,4.017) {$15$};
+\draw[gp path] (1.136,4.902)--(1.316,4.902);
+\node[gp node right] at (0.952,4.902) {$20$};
+\draw[gp path] (1.136,5.787)--(1.316,5.787);
+\node[gp node right] at (0.952,5.787) {$25$};
+\draw[gp path] (1.136,6.672)--(1.316,6.672);
+\node[gp node right] at (0.952,6.672) {$30$};
+\draw[gp path] (1.136,7.556)--(1.316,7.556);
+\node[gp node right] at (0.952,7.556) {$35$};
+\draw[gp path] (1.136,8.441)--(1.316,8.441);
+\node[gp node right] at (0.952,8.441) {$40$};
+\node[gp node left,rotate=-35] at (1.853,1.179) {Clozure CL};
+\node[gp node left,rotate=-35] at (2.754,1.179) {GNU CLisp};
+\node[gp node left,rotate=-35] at (3.655,1.179) {CMU CL};
+\node[gp node left,rotate=-35] at (4.556,1.179) {SBCL};
+\node[gp node left,rotate=-35] at (5.457,1.179) {Perl};
+\node[gp node left,rotate=-35] at (6.358,1.179) {Python};
+\node[gp node left,rotate=-35] at (7.258,1.179) {dash};
+\node[gp node left,rotate=-35] at (8.159,1.179) {GNU Bash};
+\node[gp node left,rotate=-35] at (9.060,1.179) {Z Shell};
+\node[gp node left,rotate=-35] at (9.961,1.179) {Tiny C};
+\node[gp node left,rotate=-35] at (10.862,1.179) {GCC};
+\draw[gp path] (1.136,8.441)--(1.136,1.363)--(11.947,1.363);
+\node[gp node center,rotate=-270] at (0.276,4.902) {Time (ms) to run trivial script};
+\gpfill{rgb color={0.580,0.000,0.827}} (1.812,1.363)--(2.263,1.363)--(2.263,7.929)--(1.812,7.929)--cycle;
+\gpcolor{rgb color={0.580,0.000,0.827}}
+\draw[gp path] (1.812,1.363)--(1.812,7.928)--(2.262,7.928)--(2.262,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (2.713,1.363)--(3.164,1.363)--(3.164,4.744)--(2.713,4.744)--cycle;
+\draw[gp path] (2.713,1.363)--(2.713,4.743)--(3.163,4.743)--(3.163,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (3.614,1.363)--(4.065,1.363)--(4.065,2.426)--(3.614,2.426)--cycle;
+\draw[gp path] (3.614,1.363)--(3.614,2.425)--(4.064,2.425)--(4.064,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (4.514,1.363)--(4.966,1.363)--(4.966,2.496)--(4.514,2.496)--cycle;
+\draw[gp path] (4.514,1.363)--(4.514,2.495)--(4.965,2.495)--(4.965,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (5.415,1.363)--(5.867,1.363)--(5.867,1.559)--(5.415,1.559)--cycle;
+\draw[gp path] (5.415,1.363)--(5.415,1.558)--(5.866,1.558)--(5.866,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (6.316,1.363)--(6.768,1.363)--(6.768,2.567)--(6.316,2.567)--cycle;
+\draw[gp path] (6.316,1.363)--(6.316,2.566)--(6.767,2.566)--(6.767,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (7.217,1.363)--(7.669,1.363)--(7.669,1.576)--(7.217,1.576)--cycle;
+\draw[gp path] (7.217,1.363)--(7.217,1.575)--(7.668,1.575)--(7.668,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (8.118,1.363)--(8.570,1.363)--(8.570,1.629)--(8.118,1.629)--cycle;
+\draw[gp path] (8.118,1.363)--(8.118,1.628)--(8.569,1.628)--(8.569,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (9.019,1.363)--(9.470,1.363)--(9.470,1.913)--(9.019,1.913)--cycle;
+\draw[gp path] (9.019,1.363)--(9.019,1.912)--(9.469,1.912)--(9.469,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (9.920,1.363)--(10.371,1.363)--(10.371,1.647)--(9.920,1.647)--cycle;
+\draw[gp path] (9.920,1.363)--(9.920,1.646)--(10.370,1.646)--(10.370,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (10.821,1.363)--(11.272,1.363)--(11.272,1.470)--(10.821,1.470)--cycle;
+\draw[gp path] (10.821,1.363)--(10.821,1.469)--(11.271,1.469)--(11.271,1.363)--cycle;
+\gpcolor{color=gp lt color border}
+\draw[gp path] (1.136,8.441)--(1.136,1.363)--(11.947,1.363);
+%% coordinates of the plot area
+\gpdefrectangularnode{gp plot 1}{\pgfpoint{1.136cm}{1.363cm}}{\pgfpoint{11.947cm}{8.441cm}}
+\end{tikzpicture}
+%% gnuplot variables
--- /dev/null
+\begin{tikzpicture}[gnuplot]
+%% generated with GNUPLOT 5.2p6 (Lua 5.3; terminal rev. Nov 2018, script rev. 107)
+%% Wed 26 Aug 2020 21:13:41 BST
+\path (0.000,0.000) rectangle (12.500,8.750);
+\gpcolor{color=gp lt color border}
+\gpsetlinetype{gp lt border}
+\gpsetdashtype{gp dt solid}
+\gpsetlinewidth{1.00}
+\draw[gp path] (0.952,1.363)--(1.132,1.363);
+\node[gp node right] at (0.768,1.363) {$0$};
+\draw[gp path] (0.952,2.248)--(1.132,2.248);
+\node[gp node right] at (0.768,2.248) {$1$};
+\draw[gp path] (0.952,3.133)--(1.132,3.133);
+\node[gp node right] at (0.768,3.133) {$2$};
+\draw[gp path] (0.952,4.017)--(1.132,4.017);
+\node[gp node right] at (0.768,4.017) {$3$};
+\draw[gp path] (0.952,4.902)--(1.132,4.902);
+\node[gp node right] at (0.768,4.902) {$4$};
+\draw[gp path] (0.952,5.787)--(1.132,5.787);
+\node[gp node right] at (0.768,5.787) {$5$};
+\draw[gp path] (0.952,6.672)--(1.132,6.672);
+\node[gp node right] at (0.768,6.672) {$6$};
+\draw[gp path] (0.952,7.556)--(1.132,7.556);
+\node[gp node right] at (0.768,7.556) {$7$};
+\draw[gp path] (0.952,8.441)--(1.132,8.441);
+\node[gp node right] at (0.768,8.441) {$8$};
+\node[gp node left,rotate=-35] at (2.523,1.179) {ABCL};
+\node[gp node left,rotate=-35] at (4.093,1.179) {Clozure CL};
+\node[gp node left,rotate=-35] at (5.664,1.179) {GNU CLisp};
+\node[gp node left,rotate=-35] at (7.235,1.179) {CMU CL};
+\node[gp node left,rotate=-35] at (8.806,1.179) {ECL};
+\node[gp node left,rotate=-35] at (10.376,1.179) {SBCL};
+\draw[gp path] (0.952,8.441)--(0.952,1.363)--(11.947,1.363);
+\node[gp node center,rotate=-270] at (0.276,4.902) {Time (s) to run trivial script};
+\node[gp node right] at (10.479,8.107) {\texttt{cl-launch}};
+\gpfill{rgb color={0.580,0.000,0.827}} (10.663,8.030)--(11.579,8.030)--(11.579,8.184)--(10.663,8.184)--cycle;
+\gpcolor{rgb color={0.580,0.000,0.827}}
+\draw[gp path] (10.663,8.030)--(11.579,8.030)--(11.579,8.184)--(10.663,8.184)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (2.209,1.363)--(2.524,1.363)--(2.524,7.856)--(2.209,7.856)--cycle;
+\draw[gp path] (2.209,1.363)--(2.209,7.855)--(2.523,7.855)--(2.523,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (3.779,1.363)--(4.094,1.363)--(4.094,2.504)--(3.779,2.504)--cycle;
+\draw[gp path] (3.779,1.363)--(3.779,2.503)--(4.093,2.503)--(4.093,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (5.350,1.363)--(5.665,1.363)--(5.665,2.462)--(5.350,2.462)--cycle;
+\draw[gp path] (5.350,1.363)--(5.350,2.461)--(5.664,2.461)--(5.664,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (6.921,1.363)--(7.236,1.363)--(7.236,2.206)--(6.921,2.206)--cycle;
+\draw[gp path] (6.921,1.363)--(6.921,2.205)--(7.235,2.205)--(7.235,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (8.491,1.363)--(8.807,1.363)--(8.807,2.074)--(8.491,2.074)--cycle;
+\draw[gp path] (8.491,1.363)--(8.491,2.073)--(8.806,2.073)--(8.806,1.363)--cycle;
+\gpfill{rgb color={0.580,0.000,0.827}} (10.062,1.363)--(10.377,1.363)--(10.377,1.648)--(10.062,1.648)--cycle;
+\draw[gp path] (10.062,1.363)--(10.062,1.647)--(10.376,1.647)--(10.376,1.363)--cycle;
+\gpcolor{color=gp lt color border}
+\node[gp node right] at (10.479,7.799) {\texttt{runlisp} (vanilla image)};
+\gpfill{rgb color={0.000,0.620,0.451}} (10.663,7.722)--(11.579,7.722)--(11.579,7.876)--(10.663,7.876)--cycle;
+\gpcolor{rgb color={0.000,0.620,0.451}}
+\draw[gp path] (10.663,7.722)--(11.579,7.722)--(11.579,7.876)--(10.663,7.876)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (2.523,1.363)--(2.838,1.363)--(2.838,3.706)--(2.523,3.706)--cycle;
+\draw[gp path] (2.523,1.363)--(2.523,3.705)--(2.837,3.705)--(2.837,1.363)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (4.093,1.363)--(4.409,1.363)--(4.409,2.226)--(4.093,2.226)--cycle;
+\draw[gp path] (4.093,1.363)--(4.093,2.225)--(4.408,2.225)--(4.408,1.363)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (5.664,1.363)--(5.979,1.363)--(5.979,1.603)--(5.664,1.603)--cycle;
+\draw[gp path] (5.664,1.363)--(5.664,1.602)--(5.978,1.602)--(5.978,1.363)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (7.235,1.363)--(7.550,1.363)--(7.550,1.638)--(7.235,1.638)--cycle;
+\draw[gp path] (7.235,1.363)--(7.235,1.637)--(7.549,1.637)--(7.549,1.363)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (8.806,1.363)--(9.121,1.363)--(9.121,1.650)--(8.806,1.650)--cycle;
+\draw[gp path] (8.806,1.363)--(8.806,1.649)--(9.120,1.649)--(9.120,1.363)--cycle;
+\gpfill{rgb color={0.000,0.620,0.451}} (10.376,1.363)--(10.691,1.363)--(10.691,1.441)--(10.376,1.441)--cycle;
+\draw[gp path] (10.376,1.363)--(10.376,1.440)--(10.690,1.440)--(10.690,1.363)--cycle;
+\gpcolor{color=gp lt color border}
+\node[gp node right] at (10.479,7.491) {\texttt{runlisp} (custom image)};
+\gpfill{rgb color={0.337,0.706,0.914}} (10.663,7.414)--(11.579,7.414)--(11.579,7.568)--(10.663,7.568)--cycle;
+\gpcolor{rgb color={0.337,0.706,0.914}}
+\draw[gp path] (10.663,7.414)--(11.579,7.414)--(11.579,7.568)--(10.663,7.568)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (2.837,1.363)--(3.152,1.363)--(3.152,3.755)--(2.837,3.755)--cycle;
+\draw[gp path] (2.837,1.363)--(2.837,3.754)--(3.151,3.754)--(3.151,1.363)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (4.408,1.363)--(4.723,1.363)--(4.723,1.397)--(4.408,1.397)--cycle;
+\draw[gp path] (4.408,1.363)--(4.408,1.396)--(4.722,1.396)--(4.722,1.363)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (5.978,1.363)--(6.293,1.363)--(6.293,1.381)--(5.978,1.381)--cycle;
+\draw[gp path] (5.978,1.363)--(5.978,1.380)--(6.292,1.380)--(6.292,1.363)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (7.549,1.363)--(7.864,1.363)--(7.864,1.369)--(7.549,1.369)--cycle;
+\draw[gp path] (7.549,1.363)--(7.549,1.368)--(7.863,1.368)--(7.863,1.363)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (9.120,1.363)--(9.435,1.363)--(9.435,1.654)--(9.120,1.654)--cycle;
+\draw[gp path] (9.120,1.363)--(9.120,1.653)--(9.434,1.653)--(9.434,1.363)--cycle;
+\gpfill{rgb color={0.337,0.706,0.914}} (10.690,1.363)--(11.006,1.363)--(11.006,1.370)--(10.690,1.370)--cycle;
+\draw[gp path] (10.690,1.363)--(10.690,1.369)--(11.005,1.369)--(11.005,1.363)--cycle;
+\gpcolor{color=gp lt color border}
+\draw[gp path] (0.952,8.441)--(0.952,1.363)--(11.947,1.363);
+%% coordinates of the plot area
+\gpdefrectangularnode{gp plot 1}{\pgfpoint{0.952cm}{1.363cm}}{\pgfpoint{11.947cm}{8.441cm}}
+\end{tikzpicture}
+%% gnuplot variables
--- /dev/null
+### -*-sh-*-
+###
+### Auxiliary script for dumping ECL
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+set -e
+
+case $# in 4) ;; *) echo >&2 "usage: $0 IMAGE ECL ECLOPT TMP"; exit 2 ;; esac
+image=$1 ecl=$2 eclopt=$3 tmp=$4
+
+run () { echo "$*"; "$@"; }
+
+## Start by compiling a copy of ASDF.
+cat >"$tmp/ecl-build.lisp" <<'EOF'
+(require "asdf")
+
+(defparameter *asdf* (asdf:find-system "asdf")
+ "The `asdf' system itself.")
+
+(defun right-here (pathname pattern)
+ "An `asdf:initialize-output-translations' function: use current directory.
+
+ This function should be used in a `(:function ...)' form as the right hand
+ side of an `asdf:initialize-output-translations' entry. It causes the
+ output file to be written to the current directory, regardless of the
+ pathname of the input file(s)."
+ (declare (ignore pattern))
+ (merge-pathnames (make-pathname :name (pathname-name pathname)
+ :type nil
+ :version nil
+ :defaults *default-pathname-defaults*)
+ pathname))
+
+;; Configure the translations.
+(asdf:initialize-output-translations
+ '(:output-translations ((#p"/" :**/ :*.*.*) (:function right-here))
+ :ignore-inherited-configuration))
+
+;; Generate a linkable library for `asdf'.
+(asdf:operate 'asdf:lib-op *asdf*)
+
+;; We're done.
+(si:quit 0)
+EOF
+(cd "$tmp" && run "$ecl" ${eclopt}norc ${eclopt}load "ecl-build.lisp")
+
+## And now compile our driver code.
+cat >"$tmp/ecl-run.lisp" <<'EOF'
+(cl:defpackage #:runlisp
+ (:use #:common-lisp))
+(cl:in-package #:runlisp)
+
+(defun main ()
+ "Run a script, passing it some arguments."
+
+ ;; Ensure that `#!' is treated as a comment-to-end-of-line.
+ (set-dispatch-macro-character
+ #\# #\!
+ (lambda (#1=#:stream #2=#:char #3=#:arg)
+ (declare (ignore #2# #3#))
+ (values (read-line #1#))))
+
+ ;; Inhibit `asdf' from trying to update itself. This will only make script
+ ;; startup even slower than it already is.
+ (asdf:register-immutable-system "asdf")
+
+ ;; Remove extraneous symbols from the `COMMON-LISP-USER' package. For some
+ ;; reason, ECL likes to intern symbols in this package. They're at best
+ ;; useless to us, and possibly a nuisance.
+ (let ((pkg (find-package "COMMON-LISP-USER")))
+ (with-package-iterator (next pkg :internal)
+ (loop (multiple-value-bind (anyp sym how) (next)
+ (declare (ignore how))
+ (unless anyp (return))
+ (unintern sym pkg)))))
+
+ ;; Inform the script that it's being run from the command line.
+ (pushnew :runlisp-script *features*)
+
+ ;; Work through our command-line arguments to figure out what to do.
+ (let ((winning t) (script nil) (marker nil)
+ (prog (file-namestring (si:argv 0))) (i 1) (argc (si:argc)))
+
+ (labels ((lose (msg &rest args)
+ ;; Report an error and give up; MSG and ARGS are as for
+ ;; `format'.
+ (format *error-output* "~&~A: ~?~%" prog msg args)
+ (setf winning nil))
+
+ (quit (rc)
+ ;; End the process, exiting with status RC.
+ (si:quit rc))
+
+ (usage (stream)
+ ;; Print a synopsis of this front-end's usage to STREAM.
+ (format stream "~&usage: ~A -s SCRIPT -- ARGS~%"
+ prog))
+
+ (getarg ()
+ ;; Collect and the next command-line argument. Return `nil'
+ ;; if there are none remaining.
+ (and (< i argc) (prog1 (si:argv i) (incf i)))))
+
+ ;; Work through the options.
+ (loop (let ((arg (getarg)))
+ (cond
+
+ ;; If there's nothing left, we're done parsing.
+ ((null arg) (return))
+
+ ;; If we've found `--' then remember this, and stop.
+ ((string= arg "--") (setf marker t) (return))
+
+ ;; If we've found `-s' then the next argument is the script.
+ ((string= arg "-s") (setf script (getarg)))
+
+ ;; If we've found `-h' then give a very brief usage summary.
+ ((string= arg "-h") (usage *standard-output*) (quit 0))
+
+ ;; Otherwise it's an error.
+ (t (lose "unrecognized option \`~A'" arg)))))
+
+ ;; Check various things. If there's no script, then there's nothing
+ ;; for us to do. The `uiop' library uses a `--' marker to find the
+ ;; start of the user options, so things won't work if it's missing.
+ (unless marker (lose "unexpected end of options (missing \`--'?)"))
+
+ ;; If anything went wrong then remind the user of the usage, and exit
+ ;; unsuccessfully.
+ (unless winning (usage *error-output*) (quit 255))
+
+ ;; Run the script. If it encounters an error and fails to handle it,
+ ;; then report it briefly and exit.
+ (handler-case
+ (let ((*package* (find-package "COMMON-LISP-USER")))
+ (load script :verbose nil :print nil))
+ (error (err)
+ (format *error-output* "~&~A (uncaught error): ~A~%" prog err)
+ (quit 255)))
+
+ ;; Everything worked. We're done.
+ (quit 0))))
+
+;; Just run the main function. (Done this way so that it gets compiled.)
+(main)
+EOF
+(cd "$tmp" && run "$ecl" ${eclopt}norc ${eclopt}load "asdf.fas" \
+ -s -o "ecl-run.o" ${eclopt}compile "ecl-run.lisp")
+
+## Finally link everything together.
+run "$ecl" ${eclopt}norc -o "$image" \
+ ${eclopt}link "$tmp/asdf.o" "$tmp/ecl-run.o"
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+.\" -*-nroff-*-
+.\"
+.\" Manual for `dump-runlisp-image'
+.\"
+.\" (c) 2020 Mark Wooding
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+.\"
+.\" Runlisp is free software: you can redistribute it and/or modify it
+.\" under the terms of the GNU General Public License as published by the
+.\" Free Software Foundation; either version 3 of the License, or (at your
+.\" option) any later version.
+.\"
+.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
+.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+.\" for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+.
+.ie t \{\
+. ds o \(bu
+. if \n(.g \{\
+. fam P
+. ev an-1
+. fam P
+. ev
+. \}
+.\}
+.el \{\
+. ds o o
+.\}
+.
+.de hP
+.IP
+\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
+..
+.ds , \h'.16667m'
+.
+.\"--------------------------------------------------------------------------
+.TH dump-runlisp-image 1 "12 August 2020" "Mark Wooding"
+.SH NAME
+dump-runlisp-image \- dump Lisp images for faster script execution
+.
+.\"--------------------------------------------------------------------------
+.SH SYNOPSIS
+.
+.B dump-runlisp-image
+.RB [ \-RUafinqrv ]
+.RB [ +RUfinr ]
+.RB [ \-O
+.IR output ]
+.br
+ \&
+.RB [ \-c
+.IR conf ]
+.RB [ \-o
+.RI [ sect \c
+.BR : ] \c
+.IB var = \c
+.IR value ]
+.RB [ \-j
+.IR njobs ]
+.RI [ lisp
+\&...]
+.
+.\"--------------------------------------------------------------------------
+.SH DESCRIPTION
+.
+The
+.B dump-runlisp-image
+program builds custom images for use by
+.BR runlisp (1).
+For many Lisp implementation,
+a custom image,
+with ASDF already loaded,
+can start scripts much more quickly
+than the `vanilla' images installed by default.
+The downside is that custom images may be rather large.
+.
+.SS "Options"
+The following options are accepted on the command line.
+.
+.TP
+.BR "\-h" ", " "\-\-help"
+Write a synopsis of
+.BR dump-runlisp-image 's
+command-line syntax
+and a description of the command-line options
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-V" ", " "\-\-version"
+Write
+.BR dump-runlisp-image 's
+version number
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-R" ", " "\-\-remove-other"
+After processing the selected Lisp implementations,
+delete all of the image files corresponding to other Lisps
+defined in the configuration.
+Negate with
+.B +R
+or
+.BR \-\-no-remove-other .
+.
+.TP
+.BR "\-U" ", " "\-\-remove-unknown"
+After processing the selected Lisp implementations,
+delete all of the files in the image directory which
+.I aren't
+image files of a configured Lisp implementation.
+Negate with
+.B +U
+or
+.BR \-\-no-remove-unknown .
+.
+.TP
+.BI "\-O" "\fR, " "\-\-output=" output
+If
+.I output
+names a directory,
+then write images to that directory
+with their default names as specified in the configuration file.
+Otherwise,
+exactly one Lisp implementation must be explicitly named,
+the
+.RB ` \-R '
+and
+.RB `\-U '
+options must not be set,
+and
+the image is written to a file named
+.IR output .
+By default,
+images are written to the directory in which
+.BR runlisp (1)
+will look in when checking for custom images:
+run
+.B query-runlisp-config -x@image-dir
+to see the default setting.
+.
+.TP
+.BR "\-a" ", " "\-\-all-configured"
+Select all configured Lisp implementations.
+You must either list Lisp implementations explicitly on the command line
+or set the
+.RB ` \- a'
+option,
+but not both.
+.
+.TP
+.BI "\-c" "\fR, " "\-\-config-file=" conf
+Read configuration from
+.IR conf .
+If
+.I conf
+is a directory, then all of the files within
+whose names end with
+.RB ` .conf ',
+are loaded, in ascending lexicographical order;
+otherwise,
+.I conf
+is opened as a file.
+All of the files are expected to as described in
+.BR runlisp.conf (5).
+.
+.TP
+.BR "\-f" ", " "\-\-force"
+Create fresh Lisp images
+even if a file with the appropriate name
+already exists.
+Negate with
+.B +f
+or
+.BR \-\-no-force .
+.
+.TP
+.BR "\-i" ", " "\-\-check-installed"
+Only select those Lisp implementations
+which are actually installed
+(and can be found).
+To count as `installed',
+the program named by
+.B command
+must exist and be executable in one of the directories listed in the
+.B PATH
+environment variable,
+as must the command named in the first word of the
+.B dump-image
+command line.
+Note that a Lisp implementation which fails this check
+is not counted as `selected' for the purposes of the
+.RB ` \-R '
+option above.
+For example, the command
+.B "dump-runlisp-image \-Rai"
+will dump images for Lisps which have been installed since the last run,
+and delete images for Lisps which have been uninstalled since then.
+Negate with
+.B +i
+or
+.BR \-\-no-check-installed .
+.
+.TP
+.BI "\-j" "\fR, " "\-\-jobs=" njobs
+Dump image for up to
+.I njobs
+Lisp implementations in parallel.
+The default is to run the jobs sequentially.
+.
+.TP
+.BR "\-n" ", " "-\-dry-run"
+Don't actually run any commands to dump images.
+This may be helpful for the curious,
+in conjunction with
+.RB ` \-v '
+to increase the verbosity.
+Negate with
+.B +n
+or
+.BR "\-\-no-dry-run" .
+.
+.TP
+.BR "\-q" ", " "\-\-quiet"
+Don't print warning messages.
+This option may be repeated:
+each use reduces verbosity by one step,
+counteracting one
+.RB ` \-v '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+.
+.TP
+.BR "\-r" ", " "\-\-remove-image"
+Delete image files for the selected Lisp implementations,
+rather than dumping them.
+Negate with
+.B +r
+or
+.BR \-\-no-remove-image .
+.
+.TP
+.BR "\-v" ", " "\-\-verbose"
+Be more verbose about the process of creating images.
+Lisp implementations can be rather noisy:
+by default,
+.B dump-runlisp-image
+runs silently unless something goes wrong,
+in which case it prints the failed Lisp command line
+and its output.
+If you set
+.B \-v
+then
+.B dump-runlisp-image
+will show Lisp implementation's noise immediately,
+without waiting to see whether it succeeds or fails.
+.
+.SS "Operation"
+The
+.B dump-runlisp-image
+program first determines a collection of
+.I selected
+Lisp implementations.
+If the
+.RB ` \-a '
+option is not set,
+then the selected Lisps are those named on the command line.
+If
+.RB ` \-a '
+is set,
+and the configuration contains a setting for
+.B dump
+in the
+.B @CONFIG
+section,
+then its (expanded) value is taken to be
+a list of Lisp implementation names
+separated by commas and/or one or more whitespace characters,
+and these named Lisp implementations are selected;
+if there is no
+.B dump
+setting, then
+.I all
+configured Lisp implementations which claim support for custom images
+\(en i.e., configuration sections with settings for
+.B run-script
+and
+.B image-file
+\(en are selected, and the
+.RB ` \-i '
+option is forced on.
+If the
+.RB ` \-i '
+option is set,
+then only those Lisp implementations which are actually installed
+are selected.
+.PP
+Having established the selected Lisps,
+.B dump-runlisp-image
+proceeds to act on them:
+in the absence of the
+.RB ` \-r '
+option,
+it attempts to dump a custom image
+for each selected Lisp implementation,
+unless an image file already exists
+or the
+.RB ` \-f '
+option is set.
+(Note that
+.RB ` \-f '
+is an optimization of image dumping,
+and does not affect selection.)
+On the other hand, if
+.RB ` \-r '
+is set,
+then the custom image files of the selected Lisp implementations
+are deleted.
+.PP
+Next, if the
+.RB ` \-R '
+option is set,
+then all the images for Lisp implementations
+which are defined in the configuration
+but were
+.I not
+selected
+are deleted.
+.PP
+Finally, if the
+.RB ` \-U '
+option is set,
+then all files in the image directory
+which aren't recognized as being
+the custom image of some Lisp implementation
+are deleted.
+.PP
+If all of these operations are successfully performed
+then
+.B dump-runlisp-image
+exits with status 0;
+if there was a problem with the command line,
+or if any jobs fail,
+then it exits with status 127.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH SEE ALSO
+.BR query-runlisp-config (1),
+.BR runlisp (1),
+.BR runlisp.conf (5).
+.
+.SH AUTHOR
+Mark Wooding, <mdw@distorted.org.uk>
+.
+.\"----- That's all, folks --------------------------------------------------
--- /dev/null
+/* -*-c-*-
+ *
+ * Dump custom Lisp images for faster script execution
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "config.h"
+
+#include <assert.h>
+#include <ctype.h>
+#include <errno.h>
+#include <signal.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+#include <dirent.h>
+#include <fcntl.h>
+#include <unistd.h>
+
+#include <sys/select.h>
+#include <sys/stat.h>
+#include <sys/time.h>
+#include <sys/uio.h>
+#include <sys/wait.h>
+
+#include "common.h"
+#include "lib.h"
+#include "mdwopt.h"
+#include "sha256.h"
+
+/*----- Static data -------------------------------------------------------*/
+
+/* The state required to break an output stream from a subprocess into lines
+ * so we can prefix them appropriately. Once our process starts, the `buf'
+ * points to a buffer of `MAXLINE' bytes. This is arranged as a circular
+ * buffer, containing `len' bytes starting at offset `off', and wrapping
+ * around to the start of the buffer if it runs off the end.
+ *
+ * The descriptor `fd' is reset to -1 after it's seen end-of-file.
+ */
+struct linebuf {
+ int fd; /* our file descriptor (or -1) */
+ char *buf; /* line buffer, or null */
+ unsigned off, len; /* offset */
+};
+#define MAXLINE 16384u /* maximum acceptable line length */
+
+/* Job-state constants. */
+enum {
+ JST_INTERN, /* not that kind of job */
+ JST_VERSION, /* hashing the Lisp version number */
+ JST_DUMP, /* dumping the custom image */
+ JST_NSTATE
+};
+
+/* The state associated with an image-dumping job. */
+struct job {
+ struct treap_node _node; /* treap intrusion */
+ struct job *next; /* next job in whichever list */
+ unsigned st; /* job state (`JST_...') */
+ struct config_section *sect; /* the system-definition section */
+ struct config_var *dumpvar; /* the `dump-image' variable */
+ struct argv av_version, av_dump; /* argument vectors to execute */
+ char *imgnew, *imghash, *imgnewlink, *imglink; /* link and final outputs */
+ char *oldimg; /* old image name */
+ FILE *log; /* log output file (`stdout'?) */
+ pid_t kid; /* process id of child (or -1) */
+ int exit; /* exit status from child */
+ struct sha256_state h; /* hash context for version */
+ struct linebuf out, err; /* line buffers for stdout, stderr */
+};
+#define JOB_NAME(job) TREAP_NODE_KEY(job)
+#define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job)
+
+static struct treap jobs = TREAP_INIT, /* Lisp systems seen so far */
+ good = TREAP_INIT; /* files ok to be in image dir */
+static struct job /* lists of jobs */
+ *job_ready, **job_ready_tail = &job_ready, /* queue of jobs to start */
+ *job_delete, **job_delete_tail = &job_delete, /* queue of delete jobs */
+ *job_run; /* list of active jobs */
+static unsigned nrun, maxrun = 1; /* running and maximum job counts */
+static int rc = 0; /* code that we should return */
+static int nullfd; /* file descriptor for `/dev/null' */
+static const char *tmpdir; /* temporary directory path */
+
+static int sig_pipe[2] = { -1, -1 }; /* pipe for reporting signals */
+static sigset_t caught, pending; /* signals we catch; have caught */
+static int sigloss = -1; /* signal that caused us to lose */
+
+static unsigned flags = 0; /* flags for the application */
+#define AF_BOGUS 0x0001u /* invalid comand-line syntax */
+#define AF_SETCONF 0x0002u /* explicit configuration */
+#define AF_DRYRUN 0x0004u /* don't actually do it */
+#define AF_ALL 0x0008u /* dump all known Lisps */
+#define AF_FORCE 0x0010u /* dump even if images exist */
+#define AF_CHECKINST 0x0020u /* check Lisp exists before dump */
+#define AF_REMOVE 0x0040u /* remove selected Lisp images */
+#define AF_CLEAN 0x0080u /* remove other Lisp images */
+#define AF_JUNK 0x0100u /* remove unrecognized files */
+
+/*----- Miscellany --------------------------------------------------------*/
+
+/* Report a (printf(3)-style) message MSG, and remember to fail later. */
+static PRINTF_LIKE(1, 2) void bad(const char *msg, ...)
+ { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 127; }
+
+/* Answer whether a string consists entirely of hex digits. */
+static int hex_digits_p(const char *p, size_t sz)
+{
+ const char *l;
+
+ for (l = p + sz; p < l; p++) if (!ISXDIGIT(*p)) return (0);
+ return (1);
+}
+
+/*----- File utilities ----------------------------------------------------*/
+
+/* Main recursive subroutine for `recursive_delete'.
+ *
+ * The string DD currently contains the pathname of a directory, without a
+ * trailing `/' (though there is /space/ for a terminating zero or whatever).
+ * Recursively delete all of the files and directories within it. Appending
+ * further text to DD is OK, but clobbering the characters which are there
+ * already isn't allowed.
+ */
+static void recursive_delete_(struct dstr *dd)
+{
+ DIR *dir;
+ struct dirent *d;
+ size_t n = dd->len;
+
+ /* Open the directory. */
+ dd->p[n] = 0; dir = opendir(dd->p);
+ if (!dir)
+ lose("failed to open directory `%s' for cleanup: %s",
+ dd->p, strerror(errno));
+
+ /* We'll need to build pathnames for the files inside the directory, so add
+ * the separating `/' character. Remember the length of this prefix
+ * because this is the point we'll be rewinding to for each filename we
+ * find.
+ */
+ dd->p[n++] = '/';
+
+ /* Now go through each file in turn. */
+ for (;;) {
+
+ /* Get a filename. If we've run out then we're done. Skip the special
+ * `.' and `..' entries.
+ */
+ d = readdir(dir); if (!d) break;
+ if (d->d_name[0] == '.' && (!d->d_name[1] ||
+ (d->d_name[1] == '.' && !d->d_name[2])))
+ continue;
+
+ /* Rewind the string offset and append the new filename. */
+ dd->len = n; dstr_puts(dd, d->d_name);
+
+ /* Try to delete it the usual way. If it was actually a directory then
+ * recursively delete it instead. (We could lstat(2) it first, but this
+ * should be at least as quick to identify a directory, and it'll save a
+ * lstat(2) call in the (common) case that it's not a directory.
+ */
+ if (!unlink(dd->p));
+ else if (errno == EISDIR) recursive_delete_(dd);
+ else lose("failed to delete file `%s': %s", dd->p, strerror(errno));
+ }
+
+ /* We're done. Try to delete the directory. (It's possible that there was
+ * some problem with enumerating the directory, but we'll ignore that: if
+ * it matters then the directory won't be empty and the rmdir(2) will
+ * fail.)
+ */
+ closedir(dir);
+ dd->p[--n] = 0;
+ if (rmdir(dd->p))
+ lose("failed to delete directory `%s': %s", dd->p, strerror(errno));
+}
+
+/* Recursively delete the thing named PATH. */
+static void recursive_delete(const char *path)
+{
+ struct dstr d = DSTR_INIT;
+ dstr_puts(&d, path); recursive_delete_(&d); dstr_release(&d);
+}
+
+/* Configure a file descriptor FD.
+ *
+ * Set its nonblocking state to NONBLOCK and close-on-exec state to CLOEXEC.
+ * In both cases, -1 means to leave it alone, zero means to turn it off, and
+ * any other nonzero value means to turn it on.
+ */
+static int configure_fd(const char *what, int fd, int nonblock, int cloexec)
+{
+ int fl, nfl;
+
+ if (nonblock != -1) {
+ fl = fcntl(fd, F_GETFL); if (fl < 0) goto fail;
+ if (nonblock) nfl = fl | O_NONBLOCK;
+ else nfl = fl&~O_NONBLOCK;
+ if (fl != nfl && fcntl(fd, F_SETFL, nfl)) goto fail;
+ }
+
+ if (cloexec != -1) {
+ fl = fcntl(fd, F_GETFD); if (fl < 0) goto fail;
+ if (cloexec) nfl = fl | FD_CLOEXEC;
+ else nfl = fl&~FD_CLOEXEC;
+ if (fl != nfl && fcntl(fd, F_SETFD, nfl)) goto fail;
+ }
+
+ return (0);
+
+fail:
+ bad("failed to configure %s descriptor: %s", what, strerror(errno));
+ return (-1);
+}
+
+/* Create a temporary directory and remember where we put it. */
+static void set_tmpdir(void)
+{
+ struct dstr d = DSTR_INIT;
+ size_t n;
+ unsigned i;
+
+ /* Start building the path name. Remember the length: we'll rewind to
+ * here and try again if our first attempt doesn't work.
+ */
+ dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
+ i = 0; n = d.len;
+
+ /* Keep trying until it works. */
+ for (;;) {
+
+ /* Build a complete name. */
+ d.len = n; dstr_putf(&d, "%d", rand());
+
+ /* Try to create the directory. If it worked, we're done. If it failed
+ * with `EEXIST' then we'll try again for a while, but give up it it
+ * doesn't look like we're making any progress. If it failed for some
+ * other reason then there's probably not much hope so give up.
+ */
+ if (!mkdir(d.p, 0700)) break;
+ else if (errno != EEXIST)
+ lose("failed to create temporary directory `%s': %s",
+ d.p, strerror(errno));
+ else if (++i >= 32) {
+ d.len = n; dstr_puts(&d, "???");
+ lose("failed to create temporary directory `%s': too many attempts",
+ d.p);
+ }
+ }
+
+ /* Remember the directory name. */
+ tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
+}
+
+/*----- Signal handling ---------------------------------------------------*/
+
+/* Forward reference into job management. */
+static void reap_children(void);
+
+/* Clean things up on exit.
+ *
+ * Currently this just means to delete the temporary directory if we've made
+ * one.
+ */
+static void cleanup(void)
+ { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
+
+/* Check to see whether any signals have arrived, and do the sensible thing
+ * with them.
+ */
+static void check_signals(void)
+{
+ sigset_t old, pend;
+ char buf[32];
+ ssize_t n;
+
+ /* Ensure exclusive access to the signal-handling machinery, drain the
+ * signal pipe, and take a copy of the set of caught signals.
+ */
+ sigprocmask(SIG_BLOCK, &caught, &old);
+ pend = pending; sigemptyset(&pending);
+ for (;;) {
+ n = read(sig_pipe[0], buf, sizeof(buf));
+ if (!n) lose("(internal) signal pipe closed!");
+ if (n < 0) break;
+ }
+ if (errno != EAGAIN && errno != EWOULDBLOCK)
+ lose("failed to read signal pipe: %s", strerror(errno));
+ sigprocmask(SIG_SETMASK, &old, 0);
+
+ /* Check for each signal of interest to us.
+ *
+ * Interrupty signals just set `sigloss' -- the `run_jobs' loop will know
+ * to unravel everything if this happens. If `SIGCHLD' happened, then
+ * check on job process status.
+ */
+ if (sigismember(&pend, SIGINT)) sigloss = SIGINT;
+ else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP;
+ else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM;
+ if (sigismember(&pend, SIGCHLD)) reap_children();
+}
+
+/* The actual signal handler.
+ *
+ * Set the appropriate signal bit in `pending', and a byte (of any value)
+ * down the signal pipe to wake up the select(2) loop.
+ */
+static void handle_signal(int sig)
+{
+ sigset_t old;
+ char x = '!';
+
+ /* Ensure exclusive access while we fiddle with the `caught' set. */
+ sigprocmask(SIG_BLOCK, &caught, &old);
+ sigaddset(&pending, sig);
+ sigprocmask(SIG_SETMASK, &old, 0);
+
+ /* Wake up the select(2) loop. If this fails, there's not a lot we can do
+ * about it.
+ */
+ DISCARD(write(sig_pipe[1], &x, 1));
+}
+
+/* Install our signal handler to catch SIG.
+ *
+ * If `SIGF_IGNOK' is set in F then don't trap the signal if it's currently
+ * ignored. (This is used for signals like `SIGINT', which usually should
+ * interrupt us; but if the caller wants us to ignore them, we should do as
+ * it wants.)
+ *
+ * WHAT describes the signal, for use in diagnostic messages.
+ */
+#define SIGF_IGNOK 1u
+static void set_signal_handler(const char *what, int sig, unsigned f)
+{
+ struct sigaction sa, sa_old;
+
+ sigaddset(&caught, sig);
+
+ if (f&SIGF_IGNOK) {
+ if (sigaction(sig, 0, &sa_old)) goto fail;
+ if (sa_old.sa_handler == SIG_IGN) return;
+ }
+
+ sa.sa_handler = handle_signal;
+ sigemptyset(&sa.sa_mask);
+ sa.sa_flags = SA_NOCLDSTOP;
+ if (sigaction(sig, &sa, 0)) goto fail;
+
+ return;
+
+fail:
+ lose("failed to set %s signal handler: %s", what, strerror(errno));
+}
+
+/*----- Line buffering ----------------------------------------------------*/
+
+/* Find the next newline in the line buffer BUF.
+ *
+ * The search starts at `BUF->off', and potentially covers the entire buffer
+ * contents. Set *LINESZ_OUT to the length of the line, in bytes. (Callers
+ * must beware that the text of the line may wrap around the ends of the
+ * buffer.) Return zero if we found a newline, or nonzero if the search
+ * failed.
+ */
+static int find_newline(struct linebuf *buf, size_t *linesz_out)
+{
+ char *nl;
+
+ if (buf->off + buf->len <= MAXLINE) {
+ /* The buffer contents is in one piece. Just search it. */
+
+ nl = memchr(buf->buf + buf->off, '\n', buf->len);
+ if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+
+ } else {
+ /* The buffer contents is in two pieces. We must search both of them. */
+
+ nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off);
+ if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+ nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off));
+ if (nl)
+ { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); }
+ }
+
+ return (-1);
+}
+
+/* Write a completed line out to the JOB's log file.
+ *
+ * The line starts at BUF->off, and continues for N bytes, not including the
+ * newline (which, in fact, might not exist at all). Precede the actual text
+ * of the line with the JOB's name, and the MARKER character, and follow it
+ * with the TAIL text (which should include an actual newline character).
+ */
+static void write_line(struct job *job, struct linebuf *buf,
+ size_t n, char marker, const char *tail)
+{
+ fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker);
+ if (buf->off + n <= MAXLINE)
+ fwrite(buf->buf + buf->off, 1, n, job->log);
+ else {
+ fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log);
+ fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log);
+ }
+ fputs(tail, job->log);
+}
+
+/* Hash N bytes freshly added to the buffer BUF. */
+static void hash_input(struct linebuf *buf, size_t n, struct sha256_state *h)
+{
+ size_t start = (buf->off + buf->len)%MAXLINE;
+
+ if (start + n <= MAXLINE)
+ sha256_hash(h, buf->buf + start, n);
+ else {
+ sha256_hash(h, buf->buf + start, MAXLINE - start);
+ sha256_hash(h, buf->buf, n - (MAXLINE - start));
+ }
+}
+
+/* Collect output lines from JOB's process and write them to the log.
+ *
+ * Read data from BUF's file descriptor. Output complete (or overlong) lines
+ * usng `write_line'. On end-of-file, output any final incomplete line in
+ * the same way, close the descriptor, and set it to -1.
+ *
+ * As a rather unpleasant quirk, if the hash-state pointer H is not null,
+ * then also feed all the data received into it.
+ */
+static void prefix_lines(struct job *job, struct linebuf *buf, char marker,
+ struct sha256_state *h)
+{
+ struct iovec iov[2]; int niov;
+ ssize_t n;
+ size_t linesz;
+
+ /* Read data into the buffer. This fancy dance with readv(2) is probably
+ * overkill.
+ *
+ * We can't have BUF->len = MAXLINE because we'd have flushed out a
+ * maximum-length buffer as an incomplete line last time.
+ */
+ assert(buf->len < MAXLINE);
+ if (!buf->off) {
+ iov[0].iov_base = buf->buf + buf->len;
+ iov[0].iov_len = MAXLINE - buf->len;
+ niov = 1;
+ } else if (buf->off + buf->len >= MAXLINE) {
+ iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE;
+ iov[0].iov_len = MAXLINE - buf->len;
+ niov = 1;
+ } else {
+ iov[0].iov_base = buf->buf + buf->off + buf->len;
+ iov[0].iov_len = MAXLINE - (buf->off + buf->len);
+ iov[1].iov_base = buf->buf;
+ iov[1].iov_len = buf->off;
+ niov = 1;
+ }
+ n = readv(buf->fd, iov, niov);
+
+ if (n < 0) {
+ /* An error occurred. If there's no data to read after all then just
+ * move on. Otherwise we have a problem.
+ */
+
+ if (errno == EAGAIN || errno == EWOULDBLOCK) return;
+ lose("failed to read job `%s' output stream: %s",
+ JOB_NAME(job), strerror(errno));
+ } else if (!n) {
+ /* We've hit end-of-file. Close the stream, and write out any
+ * unterminated partial line.
+ */
+
+ close(buf->fd); buf->fd = -1;
+ if (buf->len)
+ write_line(job, buf, buf->len, marker, " [missing final newline]\n");
+ } else {
+ /* We read some fresh data. Output any new complete lines. */
+
+ /* If we're supposed to hash data as it comes in then we should do that
+ * now.
+ */
+ if (h) hash_input(buf, n, h);
+
+ /* Include the new material in the buffer length, and write out any
+ * complete lines we find.
+ */
+ buf->len += n;
+ while (!find_newline(buf, &linesz)) {
+ write_line(job, buf, linesz, marker, "\n");
+ buf->len -= linesz + 1;
+ buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE;
+ }
+
+ if (!buf->len)
+ /* If there's nothing left then we might as well reset the buffer
+ * offset to the start of the buffer.
+ */
+ buf->off = 0;
+ else if (buf->len == MAXLINE) {
+ /* We've filled the buffer with stuff that's not a whole line. Flush
+ * it out anyway.
+ */
+ write_line(job, buf, MAXLINE, marker, " [...]\n");
+ buf->off = buf->len = 0;
+ }
+ }
+}
+
+/*----- Job management ----------------------------------------------------*/
+
+/* Record the SZ-byte leafname at P as being legitimate, so that it doesn't
+ * get junked.
+ */
+static void notice_filename(const char *p, size_t sz)
+{
+ struct treap_node *node;
+ struct treap_path path;
+
+ node = treap_probe(&good, p, sz, &path);
+ if (!node) {
+ node = xmalloc(sizeof(*node));
+ treap_insert(&good, &path, node, p, sz);
+ }
+}
+
+/* There are basically two kinds of jobs.
+ *
+ * An `internal' job -- state `JST_INTERN' -- can be handled entirely within
+ * this process. Internal jobs have trivial lifecycles: they're created, put
+ * on a queue, executed, and thrown away. Jobs are executed when some code
+ * decides to walk the appropriate queue and do the work. As a result, they
+ * don't need to have distinctive states: `JST_INTERN' only exists to
+ * distinguish internal jobs from active ones if they somehow manage to end
+ * up in the external-job machinery.
+ *
+ * External jobs all work in basically the same way: we fork and exec a
+ * sequence of subprocess to do the work. The majority of handling external
+ * jobs is in the care and feeding of these subprocesses, so they end up on
+ * various lists primarily concerned with the state of the subprocesses, and
+ * the progress of the job through its sequence of subprocesses is recorded
+ * in the job's `st' field.
+ *
+ * External jobs have a comparatively complicated lifecycle.
+ *
+ * * Initially, the job is on the `ready' queue by `add_job'. It has no
+ * child process or log file.
+ *
+ * * At some point, `start_jobs' decides to start this job up: a log file
+ * is created (if the job doesn't have one already), a child process is
+ * forked, and pipes are set up to capture the child's output. It gets
+ * moved to the `run' list (which is not maintained in any particular
+ * order). Jobs on the `run' list participate in the main select(2)
+ * loop.
+ *
+ * * When the job's child process dies and the pipes capturing its output
+ * streams finally dry up, the job is considered finished. What happens
+ * next depends on its state: either it gets updated somehow, and pushed
+ * back onto the end of the `ready' queue so that another child can be
+ * started, or the job is finished and dies.
+ *
+ * The counter `nrun' counts the number of actually running jobs, i.e., those
+ * with living child processes. This doesn't simply count the number of jobs
+ * on the `run' list: remember that the latter also contains jobs whose child
+ * has died, but whose output has not yet been collected.
+ */
+
+/* Consider a Lisp system description and maybe add a job to the right queue.
+ *
+ * The Lisp system is described by the configuration section SECT. Most of
+ * the function is spent on inspecting this section for suitability and
+ * deciding what to do about it.
+ *
+ * The precise behaviour depends on F, which should be the bitwise-OR of a
+ * `JQ_...' constant and zero or more flags, as follows.
+ *
+ * * The bits covered by `JMASK_QUEUE' identify which queue the job should
+ * be added to if the section defines a cromulent Lisp system:
+ *
+ * -- `JQ_NONE' -- don't actually make a job at all;
+ * -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or
+ * -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue.
+ *
+ * * `JF_PICKY': The user identified this Lisp system explicitly, so
+ * complain if the configuration section doesn't look right. This is
+ * clear if the caller is just enumerating all of the configuration
+ * sections: without this feature, we'd be checking everything twice,
+ * which (a) is inefficient, and -- more importantly -- (b) could lead to
+ * problems if the two checks are inconsistent.
+ *
+ * * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not
+ * actually installed. (This is usually set for `JQ_READY' calls, so
+ * that we don't try to dump Lisps which aren't there, but clear for
+ * `JQ_DELETE' calls so that we clear out Lisps which have gone away.)
+ *
+ * * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists.
+ *
+ * * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so
+ * that we can identify everything else we find in the image directory as
+ * junk.
+ */
+#define JMASK_QUEUE 3u /* which queue to add good Lisp to */
+#define JQ_NONE 0u /* don't add to any queue */
+#define JQ_READY 1u /* `job_ready' */
+#define JQ_DELETE 2u /* `job_delete' */
+#define JF_PICKY 4u /* lose if section isn't Lisp defn */
+#define JF_CHECKINST 8u /* maybe check Lisp is installed */
+#define JF_CHECKEXIST 16u /* skip if image already exists */
+#define JF_NOTICE 32u /* record Lisp's image basename */
+
+#define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST)
+#define JADD_DEFAULT (JQ_READY | JF_CHECKINST)
+#define JADD_CLEANUP (JQ_DELETE)
+#define JADD_NOTICE (JQ_NONE)
+static void add_job(unsigned f, struct config_section *sect)
+{
+ const char *name;
+ struct job *job, ***tail;
+ struct treap_path jobpath;
+ struct config_var *dumpvar, *runvar, *imgvar;
+ struct dstr d = DSTR_INIT, dd = DSTR_INIT;
+ struct argv av_version = ARGV_INIT, av_dump = ARGV_INIT;
+ struct stat st;
+ char *imgnewlink = 0, *imglink = 0, *oldimg = 0, *p;
+ unsigned jst;
+ size_t i, len;
+ ssize_t n;
+ unsigned fef;
+
+ /* We'll want the section's name for all sorts of things. */
+ name = CONFIG_SECTION_NAME(sect);
+ len = CONFIG_SECTION_NAMELEN(sect);
+
+ /* Check to see whether this Lisp system is already queued up.
+ *
+ * We'll get around to adding the new job node to the treap right at the
+ * end, so use a separate path object to keep track of where to put it.
+ */
+ job = treap_probe(&jobs, name, len, &jobpath);
+ if (job) {
+ if ((f&JF_PICKY) && verbose >= 1)
+ moan("ignoring duplicate Lisp `%s'", JOB_NAME(job));
+ goto end;
+ }
+
+ /* Check that the section defines a Lisp, and that it can be dumped.
+ *
+ * It's not obvious that this is right. Maybe there should be some
+ * additional flag so that we don't check dumpability if we're planning to
+ * delete the image. But it /is/ right: since the thing which tells us
+ * whether we can dump is that the section tells us the image's name, if
+ * it can't be dumped then we won't know what file to delete! So we have
+ * no choice.
+ */
+ runvar = config_find_var(&config, sect, CF_INHERIT, "run-script");
+ if (!runvar) {
+ if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name);
+ else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name);
+ goto end;
+ }
+ imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file");
+ if (!imgvar) {
+ if (f&JF_PICKY)
+ lose("Lisp implementation `%s' doesn't use custom images", name);
+ else if (verbose >= 3)
+ moan("skipping Lisp `%s': no custom image support", name);
+ goto end;
+ }
+
+ /* Check that the other necessary variables are present. */
+ dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image");
+ if (!dumpvar)
+ lose("variable `dump-image' not defined for Lisp `%s'", name);
+
+ /* Build the job's command lines. */
+ config_subst_split_var(&config, sect, runvar, &av_version);
+ if (!av_version.n)
+ lose("empty `run-script' command for Lisp implementation `%s'", name);
+ argv_append(&av_version, xstrdup("?(lisp-implementation-version)"));
+ config_subst_split_var(&config, sect, dumpvar, &av_dump);
+ if (!av_dump.n)
+ lose("empty `dump-image' command for Lisp implementation `%s'", name);
+
+ /* If we're supposed to check that the Lisp exists before proceeding then
+ * do that. There are /two/ commands to check: the basic Lisp command,
+ * /and/ the command to actually do the dumping, which might not be the
+ * same thing. (Be careful not to check the same command twice, though,
+ * because that would cause us to spam the user with redundant
+ * diagnostics.)
+ */
+ if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) {
+ fef = (verbose >= 3 ? FEF_VERBOSE : 0);
+ if (!found_in_path_p(av_version.v[0], fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find Lisp command `%s'",
+ name, av_version.v[0]);
+ goto end;
+ }
+ if (STRCMP(av_version.v[0], !=, av_dump.v[0]) &&
+ !found_in_path_p(av_dump.v[0], fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find dump command `%s'",
+ av_dump.v[0], d.p);
+ goto end;
+ }
+ }
+
+ /* Collect the output image file names. */
+ imglink =
+ config_subst_string_alloc(&config, sect, "<internal>", "${@image-link}");
+ imgnewlink =
+ config_subst_string_alloc(&config, sect,
+ "<internal>", "${@image-newlink}");
+
+ /* Determine the image link basename. If necessary, record it so that it
+ * doesn't get junked.
+ */
+ dstr_reset(&dd); config_subst_var(&config, sect, imgvar, &dd);
+ if (f&JF_NOTICE) notice_filename(dd.p, dd.len);
+
+ /* Fill in the directory name for the output image. */
+ dstr_reset(&d);
+ p = strrchr(imglink, '/');
+ if (p) dstr_putm(&d, imglink, p + 1 - imglink);
+
+ /* Inspect the existing image link if there is one, and record its
+ * destination.
+ */
+ for (;;) {
+
+ /* Read the link destination. The `lstat'/`readlink' two-step is
+ * suggested by the POSIX specification.
+ */
+ if (lstat(imglink, &st)) {
+ if (verbose >= (errno == ENOENT ? 3 : 1))
+ moan("failed to read metadata for Lisp `%s' image link `%s': %s",
+ name, imglink, strerror(errno));
+ break;
+ }
+ if (!S_ISLNK(st.st_mode)) {
+ if (verbose >= 1)
+ moan("Lisp `%s' image link `%s' isn't a symbolic link",
+ name, imglink);
+ break;
+ }
+ dstr_ensure(&d, st.st_size + 1);
+ n = readlink(imglink, d.p + d.len, d.sz - d.len);
+ if (n < 0) {
+ moan("failed to read Lisp `%s' image link `%s': %s",
+ name, imglink, strerror(errno));
+ break;
+ }
+ if (n == d.sz - d.len) continue;
+
+ /* Check that the link has the right form. (We don't want to delete the
+ * referent if it's not actually our image.)
+ *
+ * We expect the referent to look like ${image-file} followed by a hyphen
+ * and some hex digits.
+ */
+ if (n <= dd.len ||
+ STRNCMP(d.p + d.len, !=, dd.p, dd.len) ||
+ d.p[d.len + dd.len] != '-' ||
+ !hex_digits_p(d.p + (d.len + dd.len + 1), n - (dd.len + 1))) {
+ if (verbose >= 1)
+ moan("Lisp `%s' image link `%s' has unexpected referent `%s'",
+ name, imglink, d.p);
+ break;
+ }
+
+ /* OK, so it looks legit. Protect it from being junked. */
+ if (f&JF_NOTICE) notice_filename(d.p + d.len, n);
+ d.p[d.len + n] = 0; d.len += n;
+ oldimg = xstrndup(d.p, d.len);
+ break;
+ }
+
+ /* All preflight checks complete. Build the job and hook it onto the end
+ * of the list. (Steal the command-line vector so that we don't try to
+ * free it during cleanup.)
+ */
+ switch (f&JMASK_QUEUE) {
+ case JQ_NONE: jst = JST_INTERN; tail = 0; break;
+ case JQ_READY: jst = JST_VERSION; tail = &job_ready_tail; break;
+ case JQ_DELETE: jst = JST_INTERN; tail = &job_delete_tail; break;
+ default: assert(0);
+ }
+ job = xmalloc(sizeof(*job));
+ job->st = jst; job->sect = sect; job->dumpvar = dumpvar;
+ job->kid = -1; job->log = 0;
+ job->out.fd = -1; job->out.buf = 0;
+ job->err.fd = -1; job->err.buf = 0;
+ job->av_version = av_version; argv_init(&av_version);
+ argv_init(&job->av_dump);
+ job->imgnew = 0; job->imghash = 0;
+ job->imgnewlink = imgnewlink; imgnewlink = 0;
+ job->imglink = imglink; imglink = 0;
+ job->oldimg = oldimg; oldimg = 0;
+ treap_insert(&jobs, &jobpath, &job->_node, name, len);
+ if (tail) { **tail = job; *tail = &job->next; }
+
+end:
+ /* All done. Cleanup time. */
+ for (i = 0; i < av_version.n; i++) free(av_version.v[i]);
+ for (i = 0; i < av_dump.n; i++) free(av_dump.v[i]);
+ free(imgnewlink); free(imglink); free(oldimg);
+ dstr_release(&d); dstr_release(&dd);
+ argv_release(&av_version); argv_release(&av_dump);
+}
+
+/* As `add_job' above, but look the Lisp implementation up by name.
+ *
+ * The flags passed to `add_job' are augmented with `JF_PICKY' because this
+ * is an explicitly-named Lisp implementation.
+ */
+static void add_named_job(unsigned f, const char *name, size_t len)
+{
+ struct config_section *sect;
+
+ sect = config_find_section_n(&config, 0, name, len);
+ if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
+ add_job(f | JF_PICKY, sect);
+}
+
+/* Free the JOB and all the resources it holds.
+ *
+ * Close the pipes; kill the child process. Everything must go.
+ */
+static void release_job(struct job *job)
+{
+ size_t i;
+ struct job *j;
+
+ if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */
+ if (job->log && job->log != stdout) fclose(job->log);
+ free(job->imgnew); free(job->imghash);
+ free(job->imglink); free(job->imgnewlink);
+ free(job->oldimg);
+ for (i = 0; i < job->av_version.n; i++) free(job->av_version.v[i]);
+ for (i = 0; i < job->av_dump.n; i++) free(job->av_dump.v[i]);
+ argv_release(&job->av_version); argv_release(&job->av_dump);
+ free(job->out.buf); if (job->out.fd >= 0) close(job->out.fd);
+ free(job->err.buf); if (job->err.fd >= 0) close(job->err.fd);
+ j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job);
+ free(job);
+}
+
+/* Do all the necessary things when JOB finishes (successfully or not).
+ *
+ * Eventually the job is either freed (using `release_job'), or updated and
+ * stuffed back into the `job_run' queue. The caller is expected to have
+ * already unlinked the job from its current list.
+ */
+static void finish_job(struct job *job)
+{
+ char buf[16483], *p;
+ unsigned char *hbuf;
+ struct dstr d = DSTR_INIT;
+ size_t i, n;
+ int ok = 0;
+
+ /* Start a final line to the job log describing its eventual fate.
+ *
+ * This is where we actually pick apart the exit status. Set `ok' if it
+ * actually succeeded, because that's all anything else cares about.
+ */
+ fprintf(job->log, "%-13s > ", JOB_NAME(job));
+ if (WIFEXITED(job->exit)) {
+ if (!WEXITSTATUS(job->exit))
+ { fputs("completed successfully\n", job->log); ok = 1; }
+ else
+ fprintf(job->log, "failed with exit status %d\n",
+ WEXITSTATUS(job->exit));
+ } else if (WIFSIGNALED(job->exit))
+ fprintf(job->log, "killed by signal %d (%s%s)", WTERMSIG(job->exit),
+#if defined(HAVE_STRSIGNAL)
+ strsignal(WTERMSIG(job->exit)),
+#elif defined(HAVE_DECL_SYS_SIGLIST)
+ sys_siglist[WTERMSIG(job->exit)],
+#else
+ "unknown signal",
+#endif
+#ifdef WCOREDUMP
+ WCOREDUMP(job->exit) ? "; core dumped" :
+#endif
+ "");
+ else
+ fprintf(job->log, "exited with incomprehensible status %06o\n",
+ job->exit);
+
+ /* What happens next depends on the state of the job. This is the main
+ * place which advanced the job state machine.
+ */
+ if (ok) switch (job->st) {
+
+ case JST_VERSION:
+ /* We've retrieved the Lisp system's version string. */
+
+ /* Complete the hashing and convert to hex. */
+ hbuf = (unsigned char *)buf + 32; sha256_done(&job->h, hbuf);
+ for (i = 0; i < 8; i++) sprintf(buf + 2*i, "%02x", hbuf[i]);
+ if (verbose >= 2)
+ moan("Lisp `%s' version hash = %s", JOB_NAME(job), buf);
+
+ /* Determine the final version-qualified name for the image. */
+ config_set_var(&config, job->sect, CF_LITERAL, "@hash", buf);
+ job->imghash =
+ config_subst_string_alloc(&config, job->sect,
+ "<internal>", "${@image-out}");
+ job->imgnew =
+ config_subst_string_alloc(&config, job->sect,
+ "<internal>", "${@image-new}");
+
+ /* Determine the basename of the final image. */
+ p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+ /* Inspect the current link pointer to see if we have the right
+ * version.
+ */
+ if (!(flags&AF_FORCE) &&
+ job->oldimg &&
+ STRCMP(job->oldimg, ==, job->imghash) &&
+ !access(job->oldimg, F_OK)) {
+ if (verbose >= 2)
+ moan("Lisp `%s' image `%s' already up-to-date",
+ JOB_NAME(job), job->imghash);
+ break;
+ }
+
+ /* Make sure that there's a clear space for the new image to be
+ * written.
+ */
+ if (!(flags&AF_DRYRUN) && unlink(job->imgnew) && errno != ENOENT) {
+ bad("failed to clear Lisp `%s' image staging path `%s': %s",
+ JOB_NAME(job), job->imgnew, strerror(errno));
+ break;
+ }
+
+ /* If we're still here then we've decided to dump a new image. Update
+ * the job state, and put it back on the run queue.
+ */
+ config_subst_split_var(&config, job->sect,
+ job->dumpvar, &job->av_dump);
+ assert(job->av_dump.n);
+ job->st = JST_DUMP;
+ *job_ready_tail = job; job_ready_tail = &job->next; job->next = 0;
+ job = 0;
+ break;
+
+ case JST_DUMP:
+ /* We've finished dumping a custom image. It's time to apply the
+ * finishing touches.
+ */
+
+ /* Rename the image into place. If this fails, blame it on the dump
+ * job, because the chances are good that it failed to produce the
+ * image properly.
+ */
+ if (rename(job->imgnew, job->imghash)) {
+ fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
+ "output image `%s' to `%s': %s",
+ JOB_NAME(job), JOB_NAME(job),
+ job->imgnew, job->imghash, strerror(errno));
+ ok = 0; break;
+ }
+
+ /* Determine the basename of the final image. */
+ p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+ /* Build the symlink. Start by setting the link in the staging path,
+ * and then rename, in order to ensure continuity.
+ */
+ if (unlink(job->imgnewlink) && errno != ENOENT) {
+ bad("failed to clear Lisp `%s' link staging path `%s': %s",
+ JOB_NAME(job), job->imgnewlink, strerror(errno));
+ break;
+ }
+ if (symlink(p, job->imgnewlink)) {
+ bad("failed to create Lisp `%s' image link `%s': %s",
+ JOB_NAME(job), job->imgnewlink, strerror(errno));
+ break;
+ }
+ if (rename(job->imgnewlink, job->imglink)) {
+ bad("failed to rename Lisp `%s' image link `%s' to `%s': %s",
+ JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno));
+ break;
+ }
+ if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash) &&
+ unlink(job->oldimg) && errno != ENOENT) {
+ if (verbose >= 1)
+ moan("failed to delete old Lisp `%s' image `%s': %s",
+ JOB_NAME(job), job->oldimg, strerror(errno));
+ }
+
+ /* I think we're all done. */
+ break;
+
+ default:
+ assert(0);
+ }
+
+ /* If the job failed and we're being quiet then write out the log that we
+ * made.
+ */
+ if (!ok && verbose < 2) {
+ rewind(job->log);
+ for (;;) {
+ n = fread(buf, 1, sizeof(buf), job->log);
+ if (n) fwrite(buf, 1, n, stdout);
+ if (n < sizeof(buf)) break;
+ }
+ }
+
+ /* Also make a node to stderr about what happened. (Just to make sure
+ * that we've gotten someone's attention.)
+ */
+ if (!ok) bad("failed to dump Lisp `%s'", JOB_NAME(job));
+
+ /* Finally free the job control block. */
+ if (job) release_job(job);
+ dstr_release(&d);
+}
+
+/* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */
+static void reap_children(void)
+{
+ struct job *job;
+ pid_t kid;
+ int st;
+
+ for (;;) {
+
+ /* Collect a child exit status. If there aren't any more then we're
+ * done.
+ */
+ kid = waitpid(0, &st, WNOHANG);
+ if (kid <= 0) break;
+
+ /* Try to find a matching job. If we can't, then we should just ignore
+ * it.
+ */
+ for (job = job_run; job; job = job->next)
+ if (job->kid == kid) goto found;
+ continue;
+
+ found:
+ /* Mark the job as dead, and save its exit status. */
+ job->exit = st; job->kid = -1; nrun--;
+ }
+
+ /* If there was a problem with waitpid(2) then report it. */
+ if (kid < 0 && errno != ECHILD)
+ lose("failed to collect child process exit status: %s", strerror(errno));
+}
+
+/* Execute the handler for some JOB. */
+static NORETURN void job_child(struct job *job, struct argv *av)
+{
+ try_exec(av, 0);
+ moan("failed to run `%s': %s", av->v[0], strerror(errno));
+ _exit(127);
+}
+
+/* Start up jobs while there are (a) jobs to run and (b) slots to run them
+ * in.
+ */
+static void start_jobs(void)
+{
+ struct dstr d = DSTR_INIT;
+ int p_out[2], p_err[2];
+ struct job *job;
+ struct argv *av;
+ pid_t kid;
+
+ /* Keep going until either we run out of jobs, or we've got enough running
+ * already.
+ */
+ while (job_ready && nrun < maxrun) {
+
+ /* Set things up ready. If things go wrong, we need to know what stuff
+ * needs to be cleaned up.
+ */
+ job = job_ready; job_ready = job->next;
+ if (!job_ready) job_ready_tail = &job_ready;
+ p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
+
+ /* Figure out what to do. */
+ switch (job->st) {
+ case JST_VERSION: av = &job->av_version; break;
+ case JST_DUMP: av = &job->av_dump; break;
+ default: assert(0);
+ }
+
+ /* If we're not actually going to do anything, now is the time to not do
+ * that. We should do the version-hashing step unconditionally.
+ */
+ switch (job->st) {
+ case JST_VERSION:
+ break;
+ case JST_DUMP:
+ if (flags&AF_DRYRUN) {
+ if (try_exec(av,
+ TEF_DRYRUN |
+ (verbose >= 2 && !(flags&AF_CHECKINST)
+ ? TEF_VERBOSE : 0)))
+ rc = 127;
+ else if (verbose >= 2)
+ printf("%-13s > not dumping `%s' (dry run)\n",
+ JOB_NAME(job), JOB_NAME(job));
+ release_job(job);
+ continue;
+ }
+ break;
+ default:
+ assert(0);
+ }
+
+ /* Do one-time setup for external jobs. */
+ if (!job->log) {
+
+ /* Make a temporary subdirectory for this job to use. */
+ dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job));
+ if (mkdir(d.p, 0700)) {
+ bad("failed to create working directory for job `%s': %s",
+ JOB_NAME(job), strerror(errno));
+ goto fail;
+ }
+
+ /* Create the job's log file. If we're being verbose then that's just
+ * our normal standard output -- /not/ stderr: it's likely that users
+ * will want to pipe this stuff through a pager or something, and
+ * that'll be easier if we use stdout. Otherwise, make a file in the
+ * temporary directory.
+ */
+ if (verbose >= 2)
+ job->log = stdout;
+ else {
+ dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+");
+ if (!job->log)
+ lose("failed to open log file `%s': %s", d.p, strerror(errno));
+ }
+ }
+
+ /* Make the pipes to capture the child process's standard output and
+ * error streams.
+ */
+ if (pipe(p_out) || pipe(p_err)) {
+ bad("failed to create pipes for job `%s': %s",
+ JOB_NAME(job), strerror(errno));
+ goto fail;
+ }
+ if (configure_fd("job stdout pipe", p_out[0], 1, 1) ||
+ configure_fd("job stdout pipe", p_out[1], 0, 1) ||
+ configure_fd("job stderr pipe", p_err[0], 1, 1) ||
+ configure_fd("job stderr pipe", p_err[1], 0, 1) ||
+ configure_fd("log file", fileno(job->log), 1, 1))
+ goto fail;
+
+ /* Initialize the output-processing structures ready for use. */
+ if (job->st == JST_VERSION) sha256_init(&job->h);
+ job->out.buf = xmalloc(MAXLINE); job->out.off = job->out.len = 0;
+ job->out.fd = p_out[0]; p_out[0] = -1;
+ job->err.buf = xmalloc(MAXLINE); job->err.off = job->err.len = 0;
+ job->err.fd = p_err[0]; p_err[0] = -1;
+
+ /* Print a note to the top of the log. */
+ dstr_reset(&d); argv_string(&d, av);
+ fprintf(job->log, "%-13s > starting %s\n", JOB_NAME(job), d.p);
+
+ /* Flush the standard output stream. (Otherwise the child might try to
+ * flush it too.)
+ */
+ fflush(stdout);
+
+ /* Spin up the child process. */
+ kid = fork();
+ if (kid < 0) {
+ bad("failed to fork process for job `%s': %s",
+ JOB_NAME(job), strerror(errno));
+ goto fail;
+ }
+ if (!kid) {
+ if (dup2(nullfd, 0) < 0 ||
+ dup2(p_out[1], 1) < 0 ||
+ dup2(p_err[1], 2) < 0)
+ lose("failed to juggle job `%s' file descriptors: %s",
+ JOB_NAME(job), strerror(errno));
+ job_child(job, av);
+ }
+
+ /* Close the ends of the pipes that we don't need. Move the job into
+ * the running list.
+ */
+ close(p_out[1]); close(p_err[1]);
+ job->kid = kid; job->next = job_run; job_run = job; nrun++;
+ continue;
+
+ fail:
+ /* Clean up the wreckage if it didn't work. */
+ if (p_out[0] >= 0) close(p_out[0]);
+ if (p_out[1] >= 0) close(p_out[1]);
+ if (p_err[0] >= 0) close(p_err[0]);
+ if (p_err[1] >= 0) close(p_err[1]);
+ release_job(job);
+ }
+
+ /* All done except for some final tidying up. */
+ dstr_release(&d);
+}
+
+/* Take care of all of the jobs until they're all done. */
+static void run_jobs(void)
+{
+ struct job *job, *next, **link;
+ int nfd;
+ fd_set fd_in;
+
+ for (;;) {
+
+ /* If there are jobs still to be started and we have slots to spare then
+ * start some more up.
+ */
+ start_jobs();
+
+ /* If the queues are now all empty then we're done. (No need to check
+ * `job_ready' here: `start_jobs' would have started them if `job_run'
+ * was empty.
+ */
+ if (!job_run) break;
+
+ /* Prepare for the select(2) call: watch for the signal pipe and all of
+ * the job pipes.
+ */
+#define SET_FD(dir, fd) do { \
+ int _fd = (fd); \
+ FD_SET(_fd, &fd_##dir); \
+ if (_fd >= nfd) nfd = _fd + 1; \
+} while (0)
+
+ FD_ZERO(&fd_in); nfd = 0;
+ SET_FD(in, sig_pipe[0]);
+ for (job = job_run; job; job = job->next) {
+ if (job->out.fd >= 0) SET_FD(in, job->out.fd);
+ if (job->err.fd >= 0) SET_FD(in, job->err.fd);
+ }
+
+#undef SET_FD
+
+ /* Find out what's going on. */
+ if (select(nfd, &fd_in, 0, 0, 0) < 0) {
+ if (errno == EINTR) continue;
+ else lose("select failed: %s", strerror(errno));
+ }
+
+ /* If there were any signals then handle them. */
+ if (FD_ISSET(sig_pipe[0], &fd_in)) {
+ check_signals();
+ if (sigloss >= 0) {
+ /* We hit a fatal signal. Kill off the remaining jobs and abort. */
+ for (job = job_ready; job; job = next)
+ { next = job->next; release_job(job); }
+ for (job = job_run; job; job = next)
+ { next = job->next; release_job(job); }
+ break;
+ }
+ }
+
+ /* Collect output from running jobs, and clear away any dead jobs once
+ * we've collected all their output.
+ */
+ for (link = &job_run, job = *link; job; job = next) {
+ if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
+ prefix_lines(job, &job->out, '|',
+ job->st == JST_VERSION ? &job->h : 0);
+ if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
+ prefix_lines(job, &job->err, '*', 0);
+ next = job->next;
+ if (job->kid > 0 || job->out.fd >= 0 || job->err.fd >= 0)
+ link = &job->next;
+ else
+ { *link = next; finish_job(job); }
+ }
+ }
+}
+
+/*----- Main program ------------------------------------------------------*/
+
+/* Help and related functions. */
+static void version(FILE *fp)
+ { fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); }
+
+static void usage(FILE *fp)
+{
+ fprintf(fp, "\
+usage: %s [-RUadfinqrv] [+RUdfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+ [-O FILE|DIR] [-j NJOBS] [LISP ...]\n",
+ progname);
+}
+
+static void help(FILE *fp)
+{
+ version(fp); fputc('\n', fp); usage(fp);
+ fputs("\n\
+Help options:\n\
+ -h, --help Show this help text and exit successfully.\n\
+ -V, --version Show version number and exit successfully.\n\
+\n\
+Diagnostics:\n\
+ -n, --dry-run Don't run run anything (useful with `-v').\n\
+ -q, --quiet Don't print warning messages.\n\
+ -v, --verbose Print informational messages (repeatable).\n\
+\n\
+Configuration:\n\
+ -c, --config-file=CONF Read configuration from CONF (repeatable).\n\
+ -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
+\n\
+Image dumping:\n\
+ -O, --output=FILE|DIR Store image(s) in FILE or DIR.\n\
+ -R, --remove-other Delete image files for other Lisp systems.\n\
+ -U, --remove-unknown Delete unrecognized files in image dir.\n\
+ -a, --all-configured Select all configured implementations.\n\
+ -d, --cleanup Delete images which are no longer wanted.\n\
+ -f, --force Dump images even if they already exist.\n\
+ -i, --check-installed Check Lisp systems exist before dumping.\n\
+ -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n\
+ -r, --remove-image Delete image files, instead of creating.\n",
+ fp);
+}
+
+static void show_job_list(const char *what, struct job *job)
+{
+ struct dstr d = DSTR_INIT;
+ int first;
+
+ first = 1;
+ for (; job; job = job->next) {
+ if (first) first = 0;
+ else dstr_puts(&d, ", ");
+ dstr_putf(&d, "`%s'", JOB_NAME(job));
+ }
+ if (first) dstr_puts(&d, "(none)");
+ dstr_putz(&d);
+ moan("%s: %s", what, d.p);
+}
+
+/* Main program. */
+int main(int argc, char *argv[])
+{
+ struct config_section_iter si;
+ struct config_section *sect;
+ struct config_var *var;
+ const char *out = 0, *p, *q, *l;
+ struct job *job;
+ struct stat st;
+ struct dstr d = DSTR_INIT;
+ DIR *dir;
+ struct dirent *de;
+ int i, fd;
+ size_t n, o;
+ unsigned f;
+
+ /* Command-line options. */
+ static const struct option opts[] = {
+ { "help", 0, 0, 'h' },
+ { "version", 0, 0, 'V' },
+ { "output", OPTF_ARGREQ, 0, 'O' },
+ { "remove-other", OPTF_NEGATE, 0, 'R' },
+ { "remove-unknown", OPTF_NEGATE, 0, 'U' },
+ { "all-configured", 0, 0, 'a' },
+ { "config-file", OPTF_ARGREQ, 0, 'c' },
+ { "force", OPTF_NEGATE, 0, 'f' },
+ { "check-installed", OPTF_NEGATE, 0, 'i' },
+ { "jobs", OPTF_ARGREQ, 0, 'j' },
+ { "dry-run", OPTF_NEGATE, 0, 'n' },
+ { "set-option", OPTF_ARGREQ, 0, 'o' },
+ { "quiet", 0, 0, 'q' },
+ { "remove-image", OPTF_NEGATE, 0, 'r' },
+ { "verbose", 0, 0, 'v' },
+ { 0, 0, 0, 0 }
+ };
+
+ /* Initial setup. */
+ set_progname(argv[0]);
+ init_config();
+ srand(time(0));
+
+ /* Parse the options. */
+ optprog = (/*unconst*/ char *)progname;
+
+#define FLAGOPT(ch, f) \
+ case ch: \
+ flags |= f; \
+ break; \
+ case ch | OPTF_NEGATED: \
+ flags &= ~f; \
+ break
+
+ for (;;) {
+ i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:d+f+i+j:n+o:qr+v", opts, 0, 0,
+ OPTF_NEGATION | OPTF_NOPROGNAME);
+ if (i < 0) break;
+ switch (i) {
+ case 'h': help(stdout); exit(0);
+ case 'V': version(stdout); exit(0);
+ case 'O': out = optarg; break;
+ FLAGOPT('R', AF_CLEAN);
+ FLAGOPT('U', AF_JUNK);
+ case 'a': flags |= AF_ALL; break;
+ case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break;
+ FLAGOPT('f', AF_FORCE);
+ FLAGOPT('i', AF_CHECKINST);
+ case 'j': maxrun = parse_int("number of jobs", optarg, 1, 65535); break;
+ FLAGOPT('n', AF_DRYRUN);
+ case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break;
+ case 'q': if (verbose) verbose--; break;
+ FLAGOPT('r', AF_REMOVE);
+ case 'v': verbose++; break;
+ default: flags |= AF_BOGUS; break;
+ }
+ }
+
+#undef FLAGOPT
+
+ /* CHeck that everything worked. */
+ optind++;
+ if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS;
+ if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+
+ /* Load default configuration if no explicit files were requested. */
+ if (!(flags&AF_SETCONF)) load_default_config();
+
+ /* OK, so we've probably got some work to do. Let's set things up ready.
+ * It'll be annoying if our standard descriptors aren't actually set up
+ * properly, so we'll make sure those slots are populated. We'll need a
+ * `/dev/null' descriptor anyway (to be stdin for the jobs). We'll also
+ * need a temporary directory, and it'll be less temporary if we don't
+ * arrange to delete it when we're done. And finally we'll need to know
+ * when a child process exits.
+ */
+ for (;;) {
+ fd = open("/dev/null", O_RDWR);
+ if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno));
+ if (fd > 2) { nullfd = fd; break; }
+ }
+ configure_fd("null fd", nullfd, 0, 1);
+ atexit(cleanup);
+ if (pipe(sig_pipe))
+ lose("failed to create signal pipe: %s", strerror(errno));
+ configure_fd("signal pipe (read end)", sig_pipe[0], 1, 1);
+ configure_fd("signal pipe (write end)", sig_pipe[1], 1, 1);
+ sigemptyset(&caught); sigemptyset(&pending);
+ set_signal_handler("SIGTERM", SIGTERM, SIGF_IGNOK);
+ set_signal_handler("SIGINT", SIGINT, SIGF_IGNOK);
+ set_signal_handler("SIGHUP", SIGHUP, SIGF_IGNOK);
+ set_signal_handler("SIGCHLD", SIGCHLD, 0);
+
+ /* Create the temporary directory and export it into the configuration. */
+ set_tmpdir();
+ config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir);
+ config_set_var(&config, builtin, 0,
+ "@tmp-dir", "${@BUILTIN:@%tmp-dir}/${@name}");
+
+ /* Work out where the image files are going to go. If there's no `-O'
+ * option then we use the main `image-dir'. Otherwise what happens depends
+ * on whether this is a file or a directory.
+ */
+ if (!out) {
+ config_set_var(&config, builtin, 0,
+ "@image-link", "${@image-dir}/${image-file}");
+ var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir");
+ assert(var); out = config_subst_var_alloc(&config, builtin, var);
+ } else if (!stat(out, &st) && S_ISDIR(st.st_mode)) {
+ config_set_var(&config, builtin, CF_LITERAL, "@%out-dir", out);
+ config_set_var(&config, builtin, 0,
+ "@image-link", "${@BUILTIN:@%out-dir}/${image-file}");
+ } else if (argc - optind != 1)
+ lose("can't dump multiple Lisps to a single output file");
+ else if (flags&AF_JUNK)
+ lose("can't clear junk in a single output file");
+ else if (flags&AF_CLEAN)
+ lose("can't clean other images with a single output file");
+ else
+ config_set_var(&config, builtin, CF_LITERAL, "@image-link", out);
+
+ /* Set the staging and versioned filenames. */
+ config_set_var(&config, builtin, 0,
+ "@image-out", "${@image-link}-${@hash}");
+ config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new");
+ config_set_var(&config, builtin, 0,
+ "@image-newlink", "${@image-link}.new");
+
+ config_set_var(&config, builtin, 0, "@script",
+ "${@ENV:RUNLISP_EVAL?"
+ "${@CONFIG:eval-script?"
+ "${@data-dir}/eval.lisp}}");
+
+ /* Configure an initial value for `@hash'. This is necessary so that
+ * `add_job' can expand `dump-image' to check that the command exists.
+ */
+ config_set_var(&config, builtin, CF_LITERAL, "@hash", "!!!unset!!!");
+
+ /* Dump the final configuration if we're being very verbose. */
+ if (verbose >= 5) dump_config();
+
+ /* There are a number of different strategies we might employ, depending on
+ * the exact request.
+ *
+ * queue queue clear
+ * REMOVE CLEAN JUNK selected others junk?
+ *
+ * * nil nil ready/delete -- no
+ * * nil t ready/delete none yes
+ * nil t nil ready delete no
+ * nil t t ready -- yes
+ * t t nil -- delete no
+ * t t t -- -- yes
+ */
+
+ /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan
+ * the selected Lisp systems and add them to the appropriate queue.
+ *
+ * Bit-hack: if they are not both set, then their complements are not both
+ * clear.
+ */
+ if (~flags&(AF_REMOVE | AF_CLEAN)) {
+
+ /* Determine the flags for `add_job' when we select the Lisp systems. If
+ * we intend to clear junk then we must notice the image names we
+ * encounter. If we're supposed to check that Lisps exist before dumping
+ * then do that -- but it doesn't make any sense for deletion.
+ */
+ f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY;
+ if (flags&AF_JUNK) f |= JF_NOTICE;
+ if (flags&AF_CHECKINST) f |= JF_CHECKINST;
+ if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST;
+
+ /* If we have named Lisps, then process them. */
+ if (!(flags&AF_ALL))
+ for (i = optind; i < argc; i++)
+ add_named_job(f, argv[i], strlen(argv[i]));
+
+ /* Otherwise we're supposed to dump `all' of them. If there's a `dump'
+ * configuration setting then we need to parse that. Otherwise we just
+ * try all of them.
+ */
+ else {
+ var = config_find_var(&config, toplevel, CF_INHERIT, "dump");
+ if (!var) {
+ /* No setting. Just do all of the Lisps which look available. */
+
+ f |= JF_CHECKINST;
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
+ } else {
+ /* Parse the `dump' list. */
+
+ dstr_reset(&d); config_subst_var(&config, toplevel, var, &d);
+ p = d.p; l = p + d.len;
+ for (;;) {
+ while (p < l && ISSPACE(*p)) p++;
+ if (p >= l) break;
+ q = p;
+ while (p < l && !ISSPACE(*p) && *p != ',') p++;
+ add_named_job(f, q, p - q);
+ while (p < l && ISSPACE(*p)) p++;
+ if (p < l && *p == ',') p++;
+ }
+ }
+ }
+ }
+
+ /* Second step: if exactly one of `AF_CLEAN' and `AF_JUNK' is set, then we
+ * need to scan all of the remaining Lisps and add them to the `delete'
+ * queue.
+ */
+ if (!(flags&AF_CLEAN) != !(flags&AF_JUNK)) {
+
+ /* Determine the flag settings. If we're junking, then we're not
+ * cleaning -- we just want to mark images belonging to other Lisps as
+ * off-limits to the junking scan.
+ */
+ f = flags&AF_CLEAN ? JQ_DELETE : JQ_NONE | JF_NOTICE;
+
+ /* Now scan the Lisp systems. */
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
+ }
+
+ /* Terminate the job queues. */
+ *job_ready_tail = 0;
+ *job_delete_tail = 0;
+
+ /* Report on what it is we're about to do. */
+ if (verbose >= 3) {
+ show_job_list("dumping Lisp images", job_ready);
+ show_job_list("deleting Lisp images", job_delete);
+ }
+
+ /* If there turns out to be nothing to do, then mention this. */
+ if (!(flags&AF_REMOVE) && verbose >= 2 && !job_ready)
+ moan("no Lisp images to dump");
+
+ /* Run the dumping jobs. */
+ run_jobs();
+
+ /* Check for any last signals. If we hit any fatal signals then we should
+ * kill ourselves so that the exit status will be right.
+ */
+ check_signals();
+ if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); }
+
+ /* Now delete Lisps which need deleting. */
+ while (job_delete) {
+ job = job_delete; job_delete = job->next;
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting `%s' image link `%s' (dry run)",
+ JOB_NAME(job), job->imglink);
+ if (job->oldimg && verbose >= 2)
+ moan("not deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->oldimg);
+ } else {
+ if (verbose >= 2)
+ moan("deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->imglink);
+ if (unlink(job->imglink) && errno != ENOENT)
+ bad("failed to delete `%s' image link `%s': %s",
+ JOB_NAME(job), job->imglink, strerror(errno));
+ if (job->oldimg && unlink(job->oldimg) && errno != ENOENT)
+ bad("failed to delete `%s' image `%s': %s",
+ JOB_NAME(job), job->oldimg, strerror(errno));
+ }
+ }
+
+ /* Finally, maybe delete all of the junk files in the image directory. */
+ if (flags&AF_JUNK) {
+ dir = opendir(out);
+ if (!dir)
+ lose("failed to open image directory `%s': %s", out, strerror(errno));
+ dstr_reset(&d);
+ dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len;
+ if (verbose >= 2)
+ moan("cleaning up junk in image directory `%s'", out);
+ for (;;) {
+ de = readdir(dir); if (!de) break;
+ if (de->d_name[0] == '.' &&
+ (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2])))
+ continue;
+ n = strlen(de->d_name);
+ d.len = o; dstr_putm(&d, de->d_name, n + 1);
+ if (!treap_lookup(&good, de->d_name, n)) {
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting junk file `%s' (dry run)", d.p);
+ } else {
+ if (verbose >= 2)
+ moan("deleting junk file `%s'", d.p);
+ if (unlink(d.p) && errno != ENOENT)
+ bad("failed to delete junk file `%s': %s", d.p, strerror(errno));
+ }
+ }
+ }
+ }
+
+ /* All done! */
+ return (rc);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+;;; -*-lisp-*-
+;;;
+;;; Evaluate expressions and run scripts
+;;;
+;;; (c) 2020 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+;;;
+;;; Runlisp is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by the
+;;; Free Software Foundation; either version 3 of the License, or (at your
+;;; option) any later version.
+;;;
+;;; Runlisp is distributed in the hope that it will be useful, but WITHOUT
+;;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+;;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+;;; for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+(cl:defpackage #:runlisp
+ (:use #:common-lisp))
+(cl:in-package #:runlisp)
+
+(setf *features* (remove :runlisp-script *features*))
+
+(let ((*package* (find-package "COMMON-LISP-USER")))
+ (let ((token (cons 'token nil))
+ (args uiop:*command-line-arguments*)
+ (list nil))
+ (flet ((foreach-form (func arg)
+ (with-input-from-string (in arg)
+ (loop (let ((form (read in nil token)))
+ (when (eq form token) (return))
+ (funcall func form)))))
+ (print-form (form)
+ (format t "~@[~{~S~^ ~}~%~]"
+ (multiple-value-list (eval form)))))
+ (loop (let ((arg (pop args)))
+ (when (or (null arg) (string= arg "--")) (return))
+ (when (zerop (length arg))
+ (error "empty argument (no indicator)"))
+ (let ((rest (subseq arg 1)))
+ (ecase (char arg 0)
+ (#\! (push (lambda ()
+ (foreach-form #'eval rest))
+ list))
+ (#\? (push (lambda ()
+ (foreach-form #'print-form rest))
+ list))
+ (#\< (push (lambda ()
+ (load rest))
+ list)))))))
+ (let ((uiop:*command-line-arguments* args))
+ (mapc #'funcall (nreverse list)))))
--- /dev/null
+/* -*-c-*-
+ *
+ * Common definitions for `runlisp'
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "config.h"
+
+#include <assert.h>
+
+#include <ctype.h>
+#include <errno.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <unistd.h>
+
+#include "lib.h"
+
+/*----- Diagnostic utilities ----------------------------------------------*/
+
+const char *progname = "???";
+ /* Our program name, for use in error messages. */
+
+/* Set `progname' from the pathname in PROG (typically from `argv[0]'). */
+void set_progname(const char *prog)
+{
+ const char *p;
+
+ p = strrchr(prog, '/');
+ progname = p ? p + 1 : progname;
+}
+
+/* Report an error or warning in Unix style, given a captured argument
+ * cursor.
+ */
+void vmoan(const char *msg, va_list ap)
+{
+ fprintf(stderr, "%s: ", progname);
+ vfprintf(stderr, msg, ap);
+ fputc('\n', stderr);
+}
+
+/* Issue a warning message. */
+void moan(const char *msg, ...)
+ { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); }
+
+/* Issue a fatal error message and exit unsuccessfully. */
+void lose(const char *msg, ...)
+ { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); exit(127); }
+
+/*----- Memory allocation -------------------------------------------------*/
+
+/* Allocate and return a pointer to N bytes, or report a fatal error.
+ *
+ * Release the pointer using `free' as usual. If N is zero, returns null
+ * (but you are not expected to check for this).
+ */
+void *xmalloc(size_t n)
+{
+ void *p;
+
+ if (!n) return (0);
+ p = malloc(n); if (!p) lose("failed to allocate memory");
+ return (p);
+}
+
+/* Resize the block at P (from `malloc' or `xmalloc') to be N bytes long.
+ *
+ * The block might (and probably will) move, so it returns the new address.
+ * If N is zero, then the block is freed (if necessary) and a null pointer
+ * returned; otherwise, if P is null then a fresh block is allocated. If
+ * allocation fails, then a fatal error is reported.
+ */
+void *xrealloc(void *p, size_t n)
+{
+ if (!n) { free(p); return (0); }
+ else if (!p) return (xmalloc(n));
+ p = realloc(p, n); if (!p) lose("failed to allocate memory");
+ return (p);
+}
+
+/* Allocate and return a copy of the N-byte string starting at P.
+ *
+ * The new string is null-terminated, though P need not be. If allocation
+ * fails, then a fatal error is reported.
+ */
+char *xstrndup(const char *p, size_t n)
+{
+ char *q = xmalloc(n + 1);
+
+ memcpy(q, p, n); q[n] = 0;
+ return (q);
+}
+
+/* Allocate and return a copy of the null-terminated string starting at P.
+ *
+ * If allocation fails, then a fatal error is reported.
+ */
+char *xstrdup(const char *p) { return (xstrndup(p, strlen(p))); }
+
+/*----- Dynamic strings ---------------------------------------------------*/
+
+/* Initialize the string D.
+ *
+ * Usually you'd use the static initializer `DSTR_INIT'.
+ */
+void dstr_init(struct dstr *d) { d->p = 0; d->len = d->sz = 0; }
+
+/* Reset string D so it's empty again. */
+void dstr_reset(struct dstr *d) { d->len = 0; }
+
+/* Ensure that D has at least N unused bytes available. */
+void dstr_ensure(struct dstr *d, size_t n)
+{
+ size_t need = d->len + n, newsz;
+
+ if (need <= d->sz) return;
+ newsz = d->sz ? 2*d->sz : 16;
+ while (newsz < need) newsz *= 2;
+ d->p = xrealloc(d->p, newsz); d->sz = newsz;
+}
+
+/* Release the memory held by D.
+ *
+ * It must be reinitialized (e.g., by `dstr_init') before it can be used
+ * again.
+ */
+void dstr_release(struct dstr *d) { free(d->p); }
+
+/* Append the N-byte string at P to D.
+ *
+ * P need not be null-terminated. D will not be null-terminated
+ * afterwards.
+ */
+void dstr_putm(struct dstr *d, const void *p, size_t n)
+ { dstr_ensure(d, n); memcpy(d->p + d->len, p, n); d->len += n; }
+
+/* Append the null-terminated string P to D.
+ *
+ * D /is/ guaranteed to be null-terminated after this.
+ */
+void dstr_puts(struct dstr *d, const char *p)
+{
+ size_t n = strlen(p);
+
+ dstr_ensure(d, n + 1);
+ memcpy(d->p + d->len, p, n + 1);
+ d->len += n;
+}
+
+/* Append the single character CH to D.
+ *
+ * D will not be null-terminated afterwards.
+ */
+void dstr_putc(struct dstr *d, int ch)
+ { dstr_ensure(d, 1); d->p[d->len++] = ch; }
+
+/* Append N copies of the character CH to D.
+ *
+ * D will not be null-terminated afterwards.
+ */
+void dstr_putcn(struct dstr *d, int ch, size_t n)
+ { dstr_ensure(d, n); memset(d->p + d->len, ch, n); d->len += n; }
+
+/* Null-terminate the string D.
+ *
+ * This doesn't change the length of D. If further stuff is appended then
+ * the null terminator will be overwritten.
+ */
+void dstr_putz(struct dstr *d)
+ { dstr_ensure(d, 1); d->p[d->len] = 0; }
+
+/* Append stuff to D, determined by printf(3) format string P and argument
+ * tail AP.
+ *
+ * D will not be null-terminated afterwards.
+ */
+void dstr_vputf(struct dstr *d, const char *p, va_list ap)
+{
+ va_list ap2;
+ size_t r;
+ int n;
+
+ r = d->sz - d->len;
+ va_copy(ap2, ap);
+ n = vsnprintf(d->p + d->len, r, p, ap2); assert(n >= 0);
+ va_end(ap2);
+ if (n >= r) {
+ dstr_ensure(d, n + 1); r = d->sz - d->len;
+ n = vsnprintf(d->p + d->len, r, p, ap); assert(n >= 0); assert(n < r);
+ }
+ d->len += n;
+}
+
+/* Append stuff to D, determined by printf(3) format string P and arguments.
+ *
+ * D will not be null-terminated afterwards.
+ */
+PRINTF_LIKE(2, 3) void dstr_putf(struct dstr *d, const char *p, ...)
+ { va_list ap; va_start(ap, p); dstr_vputf(d, p, ap); va_end(ap); }
+
+/* Append the next input line from FP to D.
+ *
+ * Return 0 on success, or -1 if reading immediately fails or encounters
+ * end-of-file (call ferror(3) to distinguish). Any trailing newline is
+ * discarded: it is not possible to determine whether the last line was ended
+ * with a newline. D is guaranteed to be null-terminated afterwards.
+ */
+int dstr_readline(struct dstr *d, FILE *fp)
+{
+ size_t n;
+ int any = 0;
+
+ for (;;) {
+ dstr_ensure(d, 2);
+ if (!fgets(d->p + d->len, d->sz - d->len, fp)) break;
+ n = strlen(d->p + d->len); assert(n > 0); any = 1;
+ d->len += n;
+ if (d->p[d->len - 1] == '\n') { d->p[--d->len] = 0; break; }
+ }
+
+ if (!any) return (-1);
+ else return (0);
+}
+
+/*----- Dynamic vectors of strings ----------------------------------------*/
+
+/* Initialize the vector AV.
+ *
+ * Usually you'd use the static initializer `ARGV_INIT'.
+ */
+void argv_init(struct argv *av)
+ { av->v = 0; av->o = av->n = av->sz = 0; }
+
+/* Reset the vector AV so that it's empty again. */
+void argv_reset(struct argv *av) { av->n = 0; }
+
+/* Ensure that AV has at least N unused slots at the end. */
+void argv_ensure(struct argv *av, size_t n)
+{
+ size_t need = av->n + av->o + n, newsz;
+
+ if (need <= av->sz) return;
+ newsz = av->sz ? 2*av->sz : 8;
+ while (newsz < need) newsz *= 2;
+ av->v = xrealloc(av->v - av->o, newsz*sizeof(char *)); av->v += av->o;
+ av->sz = newsz;
+}
+
+/* Ensure that AV has at least N unused slots at the /start/. */
+void argv_ensure_offset(struct argv *av, size_t n)
+{
+ size_t newoff;
+
+ /* Stupid version. We won't, in practice, be prepending lots of stuff, so
+ * avoid the extra bookkeeping involved in trying to make a double-ended
+ * extendable array asymptotically efficient.
+ */
+ if (av->o >= n) return;
+ newoff = 16;
+ while (newoff < n) newoff *= 2;
+ argv_ensure(av, newoff - av->o);
+ memmove(av->v + newoff - av->o, av->v, av->n*sizeof(char *));
+ av->v += newoff - av->o; av->o = newoff;
+}
+
+/* Release the memory held by AV.
+ *
+ * It must be reinitialized (e.g., by `argv_init') before it can be used
+ * again.
+ */
+void argv_release(struct argv *av) { free(av->v - av->o); }
+
+/* Append the pointer P to AV. */
+void argv_append(struct argv *av, char *p)
+ { argv_ensure(av, 1); av->v[av->n++] = p; }
+
+/* Append a null pointer to AV, without extending the vactor length.
+ *
+ * The null pointer will be overwritten when the next string is appended.
+ */
+void argv_appendz(struct argv *av)
+ { argv_ensure(av, 1); av->v[av->n] = 0; }
+
+/* Append a N-element vector V of pointers to AV. */
+void argv_appendn(struct argv *av, char *const *v, size_t n)
+{
+ argv_ensure(av, n);
+ memcpy(av->v + av->n, v, n*sizeof(const char *));
+ av->n += n;
+}
+
+/* Append the variable-length vector BV to AV. */
+void argv_appendav(struct argv *av, const struct argv *bv)
+ { argv_appendn(av, bv->v, bv->n); }
+
+/* Append the pointers from a variable-length argument list AP to AV.
+ *
+ * The list is terminated by a null pointer.
+ */
+void argv_appendv(struct argv *av, va_list ap)
+{
+ char *p;
+ for (;;) { p = va_arg(ap, char *); if (!p) break; argv_append(av, p); }
+}
+
+/* Append the argument pointers, terminated by a null pointer, to AV. */
+void argv_appendl(struct argv *av, ...)
+ { va_list ap; va_start(ap, av); argv_appendv(av, ap); va_end(ap); }
+
+/* Prepend the pointer P to AV. */
+void argv_prepend(struct argv *av, char *p)
+ { argv_ensure_offset(av, 1); *--av->v = p; av->o--; av->n++; }
+
+/* Prepend a N-element vector V of pointers to AV. */
+void argv_prependn(struct argv *av, char *const *v, size_t n)
+{
+ argv_ensure_offset(av, n);
+ av->o -= n; av->v -= n; av->n += n;
+ memcpy(av->v, v, n*sizeof(const char *));
+}
+
+/* Prepend the variable-length vector BV to AV. */
+void argv_prependav(struct argv *av, const struct argv *bv)
+ { argv_prependn(av, bv->v, bv->n); }
+
+/* Prepend the pointers from a variable-length argument list AP to AV.
+ *
+ * The list is terminated by a null pointer.
+ */
+void argv_prependv(struct argv *av, va_list ap)
+{
+ char *p, **v;
+ size_t n = 0;
+
+ for (;;) {
+ p = va_arg(ap, char *); if (!p) break;
+ argv_prepend(av, p); n++;
+ }
+ v = av->v;
+ while (n >= 2) {
+ p = v[0]; v[0] = v[n - 1]; v[n - 1] = p;
+ v++; n -= 2;
+ }
+}
+
+/* Prepend the argument pointers, terminated by a null pointer, to AV. */
+void argv_prependl(struct argv *av, ...)
+ { va_list ap; va_start(ap, av); argv_prependv(av, ap); va_end(ap); }
+
+/*----- Treaps ------------------------------------------------------------*/
+
+/* Return nonzero if the AN-byte string A is strictly precedes the BN-byte
+ * string B in a lexicographic ordering.
+ *
+ * All comparisons of keys is handled by this function.
+ */
+static int str_lt(const char *a, size_t an, const char *b, size_t bn)
+{
+ /* This is a little subtle. We need only compare the first N bytes of the
+ * strings, where N is the length of the shorter string. If this
+ * distinguishes the two strings, then we're clearly done. Otherwise, if
+ * the prefixes are equal then the shorter string is the smaller one. If
+ * the two strings are the same length, then they're equal.
+ *
+ * Hence, if A is the strictly shorter string, then A precedes B if A
+ * precedes or matches the prefix of B; otherwise A only precedes B if A
+ * strictly precedes the prefix of B.
+ */
+ if (an < bn) return (MEMCMP(a, <=, b, an));
+ else return (MEMCMP(a, <, b, bn));
+}
+
+/* Initialize the treap T.
+ *
+ * Usually you'd use the static initializer `TREAP_INIT'.
+ */
+void treap_init(struct treap *t) { t->root = 0; }
+
+/* Look up the KN-byte key K in the treap T.
+ *
+ * Return a pointer to the matching node if one was found, or null otherwise.
+ */
+void *treap_lookup(const struct treap *t, const char *k, size_t kn)
+{
+ struct treap_node *n = t->root, *candidate = 0;
+
+ /* This is a simple prototype for some of the search loops we'll encounter
+ * later. Notice that we use a strict one-sided comparison, rather than
+ * the more conventional two-sided comparison.
+ *
+ * The main loop will find the largest key not greater than K.
+ */
+ while (n)
+ /* Compare the node's key against our key. If the node is too large,
+ * then we ignore it and move left. Otherwise remember this node for
+ * later, and move right to see if we can find a better, larger node.
+ */
+
+ if (str_lt(k, kn, n->k, n->kn)) n = n->left;
+ else { candidate = n; n = n->right; }
+
+ /* If the candidate node is less than our key then we failed. Otherwise,
+ * by trichotomy, we have found the correct node.
+ */
+ if (!candidate || str_lt(candidate->k, candidate->kn, k, kn)) return (0);
+ return (candidate);
+}
+
+/* Look up the KN-byte K in the treap T, recording a path in P.
+ *
+ * This is similar to `treap_lookup', in that it returns the requested node
+ * if it already exists, or null otherwise, but it also records in P
+ * information to be used by `treap_insert' to insert a new node with the
+ * given key if it's not there already.
+ */
+void *treap_probe(struct treap *t, const char *k, size_t kn,
+ struct treap_path *p)
+{
+ struct treap_node **nn = &t->root, *candidate = 0;
+ unsigned i = 0;
+
+ /* This walk is similar to `treap_lookup' above, except that we also record
+ * the address of each node pointer we visit along the way.
+ */
+ for (;;) {
+ assert(i < TREAP_PATHMAX); p->path[i++] = nn;
+ if (!*nn) break;
+ if (str_lt(k, kn, (*nn)->k, (*nn)->kn)) nn = &(*nn)->left;
+ else { candidate = *nn; nn = &(*nn)->right; }
+ }
+ p->nsteps = i;
+
+ /* Check to see whether we found the right node. */
+ if (!candidate || str_lt(candidate->k, candidate->kn, k, kn)) return (0);
+ return (candidate);
+}
+
+/* Insert a new node N into T, associating it with the KN-byte key K.
+ *
+ * Use the path data P, from `treap_probe', to help with insertion.
+ */
+void treap_insert(struct treap *t, const struct treap_path *p,
+ struct treap_node *n, const char *k, size_t kn)
+{
+ size_t i = p->nsteps;
+ struct treap_node **nn, **uu, *u;
+ unsigned wt;
+
+ /* Fill in the node structure. */
+ n->k = xstrndup(k, kn); n->kn = kn;
+ n->wt = wt = rand(); n->left = n->right = 0;
+
+ /* Prepare for the insertion.
+ *
+ * The path actually points to each of the links traversed when searching
+ * for the node, starting with the `root' pointer, then the `left' or
+ * `right' pointer of the root node, and so on; `nsteps' will always be
+ * nonzero, since the path will always pass through the root, and the final
+ * step, `path->path[path->nsteps - 1]' will always be the address of a
+ * null pointer onto which the freshly inserted node could be hooked in
+ * order to satisfy the binary-search-tree ordering. (Of course, this will
+ * likely /not/ satisfy the heap condition, so more work needs to be done.)
+ *
+ * Throughout, NN is our current candidate for where to attach the node N.
+ * As the loop progresses, NN will ascend to links further up the tree, and
+ * N will be adjusted to accumulate pieces of the existing tree structure.
+ * We'll stop when we find that the parent node's weight is larger than our
+ * new node's weight, at which point we can just set *NN = N; or if we run
+ * out of steps in the path, in which case *NN is the root pointer.
+ */
+ assert(i); nn = p->path[--i];
+ while (i--) {
+
+ /* Collect the next step in the path, and get the pointer to the node. */
+ uu = p->path[i]; u = *uu;
+
+ /* If this node's weight is higher, then we've found the right level and
+ * we can stop.
+ */
+ if (wt <= u->wt) break;
+
+ /* The node U is lighter than our new node N, so we must rotate in order
+ * to fix things. If we were currently planning to hook N as the left
+ * subtree of U, then we rotate like this:
+ *
+ * | |
+ * U (N)
+ * / \ / \
+ * (N) Z ---> X U
+ * / \ / \
+ * X Y Y Z
+ *
+ * On the other hand, if we ere planning to hook N as the right subtree
+ * of U, then we do the opposite rotation:
+ *
+ * | |
+ * U (N)
+ * / \ / \
+ * X (N) ---> U Z
+ * / \ / \
+ * Y Z X Y
+ *
+ * These transformations clearly preserve the ordering of nodes in the
+ * binary search tree, and satisfy the heap condition in the subtree
+ * headed by N.
+ */
+ if (nn == &u->left) { u->left = n->right; n->right = u; }
+ else { u->right = n->left; n->left = u; }
+
+ /* And this arrangement must be attached to UU, or some higher attachment
+ * point. The subtree satisfies the heap condition, and can be attached
+ * safely at the selected place.
+ */
+ nn = uu;
+ }
+
+ /* We've found the right spot. Hook the accumulated subtree into place. */
+ *nn = n;
+}
+
+/* Remove the node with the KN-byte K from T.
+ *
+ * Return the address of the node we removed, or null if it couldn't be
+ * found.
+ */
+void *treap_remove(struct treap *t, const char *k, size_t kn)
+{
+ struct treap_node **nn = &t->root, **candidate = 0, *n, *l, *r;
+
+ /* Search for the matching node, but keep track of the address of the link
+ * which points to our target node.
+ */
+ while (*nn)
+ if (str_lt(k, kn, (*nn)->k, (*nn)->kn)) nn = &(*nn)->left;
+ else { candidate = nn; nn = &(*nn)->right; }
+
+ /* If this isn't the right node then give up. */
+ if (!candidate || str_lt((*candidate)->k, (*candidate)->kn, k, kn))
+ return (0);
+
+ /* Now we need to disentangle the node from the tree. This is essentially
+ * the reverse of insertion: we pretend that this node is suddenly very
+ * light, and mutate the tree so as to restore the heap condition until
+ * eventually our node is a leaf and can be cut off without trouble.
+ *
+ * Throughout, the link *NN notionally points to N, but we don't actually
+ * update it until we're certain what value it should finally take.
+ */
+ nn = candidate; n = *nn; l = n->left; r = n->right;
+ for (;;)
+
+ /* If its left subtree is empty then we can replace our node by its right
+ * subtree and be done. Similarly, if the right subtree is empty then we
+ * replace the node by its left subtree.
+ *
+ * | | | |
+ * (N) ---> R ; (N) ---> L
+ * / \ / \
+ * * R L *
+ */
+ if (!l) { *nn = r; break; }
+ else if (!r) { *nn = l; break; }
+
+ /* Otherwise we need to rotate the pointers so that the heavier of the
+ * two children takes the place of our node; thus we have either
+ *
+ * | |
+ * (N) L
+ * / \ / \
+ * L R ---> X (N)
+ * / \ / \
+ * X Y Y R
+ *
+ * or
+ *
+ * | |
+ * (N) R
+ * / \ / \
+ * L R ---> (N) Y
+ * / \ / \
+ * X Y L X
+ *
+ * Again, these transformations clearly preserve the ordering of nodes in
+ * the binary search tree, and the heap condition.
+ */
+ else if (l->wt > r->wt)
+ { *nn = l; nn = &l->right; l = n->left = l->right; }
+ else
+ { *nn = r; nn = &r->left; r = n->right = r->left; }
+
+ /* Release the key buffer, and return the node that we've now detached. */
+ free(n->k); return (n);
+}
+
+/* Initialize an iterator I over T's nodes. */
+void treap_start_iter(struct treap *t, struct treap_iter *i)
+{
+ struct treap_node *n = t->root;
+ unsigned sp = 0;
+
+ /* The `stack' in the iterator structure is an empty ascending stack of
+ * nodes which have been encountered, and their left subtrees investigated,
+ * but not yet visited by the iteration.
+ *
+ * Iteration begins by stacking the root node, its left child, and so on,
+ * At the end of this, the topmost entry on the stack is the least node of
+ * the tree, followed by its parent, grandparent, and so on up to the root.
+ */
+ while (n) {
+ assert(sp < TREAP_PATHMAX);
+ i->stack[sp++] = n; n = n->left;
+ }
+ i->sp = sp;
+}
+
+/* Return the next node from I, in ascending order by key.
+ *
+ * If there are no more nodes, then return null.
+ */
+void *treap_next(struct treap_iter *i)
+{
+ struct treap_node *n, *o;
+ unsigned sp = i->sp;
+
+ /* We say that a node is /visited/ once it's been returned by this
+ * iterator. To traverse a tree in order, then, we traverse its left
+ * subtree, visit the tree root, and traverse its right subtree -- which is
+ * a fine recursive definition, but we need a nonrecursive implementation.
+ *
+ * As is usual in this kind of essential structural recursion, we maintain
+ * a stack. The invariant that we'll maintain is as follows.
+ *
+ * 1. If the stack is empty, then all nodes have been visited.
+ *
+ * 2, If the stack is nonempty then the topmost entry on the stack is the
+ * least node which has not yet been visited -- and therefore is the
+ * next node to visit.
+ *
+ * 3. The earlier entries in the stack are, in (top to bottom) order,
+ * those of the topmost node's parent, grandparent, etc., up to the
+ * root, which have not yet been visited. More specifically, a node
+ * appears in the stack if and only if some node in its left subtree
+ * is nearer the top of the stack.
+ *
+ * When we initialized the iterator state (in `treap_start_iter' above), we
+ * traced a path to the leftmost leaf, stacking the root, its left-hand
+ * child, and so on. The leftmost leaf is clearly the first node to be
+ * visited, and its entire ancestry is on the stack since none of these
+ * nodes has yet been visited. (If the tree is empty, then we have done
+ * nothing, the stack is empty, and there are no nodes to visit.) This
+ * establishes the base case for the induction.
+ */
+
+ /* So, if the stack is empty now, then (1) all of the nodes have been
+ * visited and there's nothing left to do. Return null.
+ */
+ if (!sp) return (0);
+
+ /* It's clear that, if we pop the topmost element of the stack, visit it,
+ * and arrange to reestablish the invariant, then we'll visit the nodes in
+ * the correct order, pretty much by definition.
+ *
+ * So, pop a node off the stack. This is the node we shall return. But
+ * before we can do that, we must reestablish the above invariant.
+ * Firstly, the current node is removed from the stack, because we're about
+ * to visit it, and visited nodes don't belong on the stack. Then there
+ * are two cases to consider.
+ *
+ * * If the current node's right subtree is not empty, then the next node
+ * to be visited is the leftmost node in that subtree. All of the
+ * nodes on the stack are ancestors of the current node, and the right
+ * subtree consists of its descendants, so none of them are already on
+ * the stack; and they're all greater than the current node, and
+ * therefore haven't been visited. Therefore, we must push the current
+ * node's right child, its /left/ child, and so on, proceeding
+ * leftwards until we fall off the bottom of the tree.
+ *
+ * * Otherwise, we've finished traversing some subtree. Either we are
+ * now done, or (3) we have just finished traversing the left subtree
+ * of the next topmost item on the stack. This must therefore be the
+ * next node to visit. The rest of the stack is already correct.
+ */
+ n = i->stack[--sp];
+ o = n->right;
+ while (o) {
+ assert(sp < TREAP_PATHMAX);
+ i->stack[sp++] = o; o = o->left;
+ }
+ i->sp = sp;
+ return (n);
+}
+
+/* Recursively check the subtree headed by N.
+ *
+ * No node should have weight greater than MAXWT, to satisfy the heap
+ * condition; if LO is not null, then all node keys should be strictly
+ * greater than LO, and, similarly, if HI is not null, then all keys should
+ * be strictly smaller than HI.
+ */
+static void check_subtree(struct treap_node *n, unsigned maxwt,
+ const char *klo, const char *khi)
+{
+ /* Check the heap condition. */
+ assert(n->wt <= maxwt);
+
+ /* Check that the key is in bounds. (Use `strcmp' here to ensure that our
+ * own `str_lt' is working correctly.)
+ */
+ if (klo) assert(STRCMP(n->k, >, klo));
+ if (khi) assert(STRCMP(n->k, <, khi));
+
+ /* Check the left subtree. Node weights must be bounded above by our own
+ * weight. And everykey in the left subtree must be smaller than our
+ * current key. We propagate the lower bound.
+ */
+ if (n->left) check_subtree(n->left, n->wt, klo, n->k);
+
+ /* Finally, check the right subtree. This time, every key must be larger
+ * than our key, and we propagate the upper bound.
+ */
+ if (n->right) check_subtree(n->right, n->wt, n->k, khi);
+}
+
+/* Check the treap structure rules for T. */
+void treap_check(struct treap *t)
+ { if (t->root) check_subtree(t->root, t->root->wt, 0, 0); }
+
+/* Recursively dump the subtree headed by N, indenting the output lines by
+ * IND spaces.
+ */
+static void dump_node(struct treap_node *n, int ind)
+{
+ if (n->left) dump_node(n->left, ind + 1);
+ printf(";;%*s [%10u] `%s'\n", 2*ind, "", n->wt, n->k);
+ if (n->right) dump_node(n->right, ind + 1);
+}
+
+/* Dump the treap T to standard output, for debugging purposes. */
+void treap_dump(struct treap *t) { if (t->root) dump_node(t->root, 0); }
+
+/*----- Configuration file parsing ----------------------------------------*/
+
+#ifndef DECL_ENVIRON
+ extern char **environ;
+#endif
+
+/* Advance P past a syntactically valid name, but no further than L.
+ *
+ * Return the new pointer. If no name is found, report an error, blaming
+ * FILE and LINE; WHAT is an adjective for the kind of name that was
+ * expected.
+ */
+static const char *scan_name(const char *what,
+ const char *p, const char *l,
+ const char *file, unsigned line)
+{
+ const char *q = p;
+
+ while (q < l &&
+ (ISALNUM(*q) || *q == '-' || *q == '_' || *q == '.' || *q == '/' ||
+ *q == '*' || *q == '+' || *q == '%' || *q == '@'))
+ q++;
+ if (q == p) lose("%s:%u: expected %s name", file, line, what);
+ return (q);
+}
+
+/* Initialize the configuration state CONF.
+ *
+ * Usually you'd use the static initializer `CONFIG_INIT'.
+ */
+void config_init(struct config *conf)
+ { treap_init(&conf->sections); }
+
+/* Find and return the section with null-terminated NAME in CONF.
+ *
+ * If no section is found, the behaviour depends on whether `CF_CREAT' is set
+ * in F: if so, an empty section is created and returned; otherwise, a null
+ * pointer is returned.
+ */
+struct config_section *config_find_section(struct config *conf, unsigned f,
+ const char *name)
+ { return (config_find_section_n(conf, f, name, strlen(name))); }
+
+/* Find and return the section with the SZ-byte NAME in CONF.
+ *
+ * This works like `config_find_section', but with an explicit length for the
+ * NAME rather than null-termination.
+ */
+struct config_section *config_find_section_n(struct config *conf, unsigned f,
+ const char *name, size_t sz)
+{
+ struct config_section *sect;
+ struct treap_path path;
+
+ if (!(f&CF_CREAT))
+ sect = treap_lookup(&conf->sections, name, sz);
+ else {
+ sect = treap_probe(&conf->sections, name, sz, &path);
+ if (!sect) {
+ sect = xmalloc(sizeof(*sect));
+ if (!conf->head) conf->tail = &conf->head;
+ sect->next = 0; *conf->tail = sect; conf->tail = §->next;
+ sect->parents = 0; sect->nparents = SIZE_MAX;
+ treap_init(§->vars); treap_init(§->cache);
+ treap_insert(&conf->sections, &path, §->_node, name, sz);
+ config_set_var_n(conf, sect, CF_LITERAL, "@name", 5, name, sz);
+ }
+ }
+ return (sect);
+}
+
+/* Set the fallback section for CONF to be SECT.
+ *
+ * That is, if a section has no explicit parents, then by default it will
+ * have a single parent which is SECT. If SECT is null then there is no
+ * fallback section, and sections which don't have explicitly specified
+ * parents have no parents at all. (This is the default situation.)
+ */
+void config_set_fallback(struct config *conf, struct config_section *sect)
+ { conf->fallback = sect; }
+
+/* Arrange that SECT has PARENT as its single parent section.
+ *
+ * If PARENT is null, then arrange that SECT has no parents at all. In
+ * either case, any `@parents' setting will be ignored.
+ */
+void config_set_parent(struct config_section *sect,
+ struct config_section *parent)
+{
+ if (!parent)
+ sect->nparents = 0;
+ else {
+ sect->parents = xmalloc(sizeof(*sect->parents));
+ sect->parents[0] = parent; sect->nparents = 1;
+ }
+}
+
+/* Initialize I to iterate over the sections defined in CONF. */
+void config_start_section_iter(struct config *conf,
+ struct config_section_iter *i)
+ { i->sect = conf->head; }
+
+/* Return the next section from I, in order of creation.
+ *
+ * If there are no more sections, then return null.
+ */
+struct config_section *config_next_section(struct config_section_iter *i)
+{
+ struct config_section *sect;
+
+ sect = i->sect;
+ if (sect) i->sect = sect->next;
+ return (sect);
+}
+
+/* Initialize the `parents' links of SECT, if they aren't set up already.
+ *
+ * If SECT contains a `@parents' setting then parse it to determine the
+ * parents; otherwise use CONF's fallbeck section, as established by
+ * `config_set_fallback'.
+ */
+static void set_config_section_parents(struct config *conf,
+ struct config_section *sect)
+{
+ struct config_section *parent;
+ struct config_var *var;
+ const char *file; unsigned line;
+ size_t i, n;
+ char *p, *q, *l;
+ struct argv av = ARGV_INIT;
+
+ /* If the section already has parents established then there's nothing to
+ * do.
+ */
+ if (sect->nparents != SIZE_MAX) return;
+
+ /* Look up `@parents', without recursion! */
+ var = treap_lookup(§->vars, "@parents", 8);
+ if (!var) {
+ /* No explicit setting: use the fallback setting. */
+
+ if (!conf->fallback || conf->fallback == sect)
+ sect->nparents = 0;
+ else {
+ sect->parents = xmalloc(sizeof(*sect->parents)); sect->nparents = 1;
+ sect->parents[0] = conf->fallback;
+ }
+ } else {
+ /* Found a `@parents' list: parse it and set the parents list. */
+
+ file = var->file; line = var->line; if (!file) file = "<internal>";
+
+ /* We do this in two phases. First, we parse out the section names, and
+ * record start/limit pointer pairs in `av'.
+ */
+ p = var->val; l = p + var->n; while (p < l && ISSPACE(*p)) p++;
+ while (*p) {
+ q = p;
+ p = (/*unconst*/ char *)scan_name("parent section", p, l, file, line);
+ argv_append(&av, q); argv_append(&av, p);
+ while (p < l && ISSPACE(*p)) p++;
+ if (p >= l) break;
+ if (*p == ',') do p++; while (ISSPACE(*p));
+ }
+
+ /* Now that we've finished parsing, we know how many parents we're going
+ * to have, so we can allocate the `parents' vector and fill it in.
+ */
+ sect->nparents = av.n/2;
+ sect->parents = xmalloc(sect->nparents*sizeof(*sect->parents));
+ for (i = 0; i < av.n; i += 2) {
+ n = av.v[i + 1] - av.v[i];
+ parent = config_find_section_n(conf, 0, av.v[i], n);
+ if (!parent)
+ lose("%s:%u: unknown parent section `%.*s'",
+ file, line, (int)n, av.v[i]);
+ sect->parents[i/2] = parent;
+ }
+ }
+
+ /* All done. */
+ argv_release(&av);
+}
+
+/* Find a setting of the SZ-byte variable NAME in CONF, starting from SECT.
+ *
+ * If successful, return a pointer to the variable; otherwise return null.
+ * Inheritance cycles and ambiguous inheritance are diagnosed as fatal
+ * errors.
+ */
+struct config_var *search_recursive(struct config *conf,
+ struct config_section *sect,
+ const char *name, size_t sz)
+{
+ struct config_cache_entry *cache;
+ struct treap_path path;
+ struct config_var *var, *v;
+ size_t i, j = j;
+
+ /* If the variable is defined locally then we can just return it. */
+ var = treap_lookup(§->vars, name, sz); if (var) return (var);
+
+ /* If we have no parents then there's no way we can find it. */
+ set_config_section_parents(conf, sect);
+ if (!sect->parents) return (0);
+
+ /* Otherwise we must visit the section's parents. We can avoid paying for
+ * this on every lookup by using a cache. If there's already an entry for
+ * this variable then we can return the result immediately (note that we
+ * cache both positive and negative outcomes). Otherwise we create a new
+ * cache entry, do the full recursive search, and fill in the result when
+ * we're done.
+ *
+ * The cache also helps us detect cycles: we set the `CF_OPEN' flag on a
+ * new cache entry when it's first created, and clear it when we fill in
+ * the result: if we encounter an open cache entry again, we know that
+ * we've found a cycle.
+ */
+ cache = treap_probe(§->cache, name, sz, &path);
+ if (!cache) {
+ cache = xmalloc(sizeof(*cache)); cache->f = CF_OPEN;
+ treap_insert(§->cache, &path, &cache->_node, name, sz);
+ } else if (cache->f&CF_OPEN)
+ lose("inheritance cycle through section `%s'",
+ CONFIG_SECTION_NAME(sect));
+ else
+ return (cache->var);
+
+ /* Recursively search in each parent. We insist that all parents that find
+ * a variable find the same binding; otherwise we declare ambiguous
+ * inheritance.
+ */
+ for (i = 0; i < sect->nparents; i++) {
+ v = search_recursive(conf, sect->parents[i], name, sz);
+ if (!v);
+ else if (!var) { var = v; j = i; }
+ else if (var != v)
+ lose("section `%s' inherits variable `%s' ambiguously "
+ "via `%s' and `%s'",
+ CONFIG_SECTION_NAME(sect), CONFIG_VAR_NAME(var),
+ CONFIG_SECTION_NAME(sect->parents[j]),
+ CONFIG_SECTION_NAME(sect->parents[i]));
+ }
+
+ /* All done: fill the cache entry in, clear the open flag, and return the
+ * result.
+ */
+ cache->var = var; cache->f &= ~CF_OPEN;
+ return (var);
+}
+
+/* Find and return the variable with null-terminated NAME in SECT.
+ *
+ * If `CF_INHERIT' is set in F, then the function searches the section's
+ * parents recursively; otherwise, it only checks to see whether the variable
+ * is set directly in SECT.
+ *
+ * If no variable is found, the behaviour depends on whether `CF_CREAT' is
+ * set in F: if so, an empty variable is created and returned; otherwise, a
+ * null pointer is returned.
+ *
+ * Setting both `CF_INHERIT' and `CF_CREAT' is not useful.
+ */
+struct config_var *config_find_var(struct config *conf,
+ struct config_section *sect,
+ unsigned f, const char *name)
+ { return (config_find_var_n(conf, sect, f, name, strlen(name))); }
+
+/* Find and return the variable with the given SZ-byte NAME in SECT.
+ *
+ * This works like `config_find_var', but with an explicit length for the
+ * NAME rather than null-termination.
+ */
+struct config_var *config_find_var_n(struct config *conf,
+ struct config_section *sect,
+ unsigned f, const char *name, size_t sz)
+{
+ struct config_var *var;
+ struct treap_path path;
+
+ if (f&CF_INHERIT)
+ var = search_recursive(conf, sect, name, sz);
+ else if (!(f&CF_CREAT))
+ var = treap_lookup(§->vars, name, sz);
+ else {
+ var = treap_probe(§->vars, name, sz, &path);
+ if (!var) {
+ var = xmalloc(sizeof(*var));
+ var->val = 0; var->file = 0; var->f = 0; var->line = 1;
+ treap_insert(§->vars, &path, &var->_node, name, sz);
+ }
+ }
+ return (var);
+}
+
+/* Set variable NAME to VALUE in SECT, with associated flags F.
+ *
+ * The names are null-terminated. The flags are variable flags: see `struct
+ * config_var' for details. Returns the variable.
+ *
+ * If the variable is already set and has the `CF_OVERRIDE' flag, then this
+ * function does nothing unless `CF_OVERRIDE' is /also/ set in F.
+ */
+struct config_var *config_set_var(struct config *conf,
+ struct config_section *sect,
+ unsigned f,
+ const char *name, const char *value)
+{
+ return (config_set_var_n(conf, sect, f,
+ name, strlen(name),
+ value, strlen(value)));
+}
+
+/* As `config_set_var', except that the variable NAME and VALUE have explicit
+ * lengths (NAMELEN and VALUELEN, respectively) rather than being null-
+ * terminated.
+ */
+struct config_var *config_set_var_n(struct config *conf,
+ struct config_section *sect,
+ unsigned f,
+ const char *name, size_t namelen,
+ const char *value, size_t valuelen)
+{
+ struct config_var *var =
+ config_find_var_n(conf, sect, CF_CREAT, name, namelen);
+
+ if (var->f&~f&CF_OVERRIDE) return (var);
+ free(var->val); var->val = xstrndup(value, valuelen); var->n = valuelen;
+ var->f = f;
+ return (var);
+}
+
+/* Initialize I to iterate over the variables directly defined in SECT. */
+void config_start_var_iter(struct config *conf, struct config_section *sect,
+ struct config_var_iter *i)
+ { treap_start_iter(§->vars, &i->i); }
+
+/* Return next variable from I, in ascending lexicographical order.
+ *
+ * If there are no more variables, then return null.
+ */
+struct config_var *config_next_var(struct config_var_iter *i)
+ { return (treap_next(&i->i)); }
+
+/* Read and parse configuration FILE, applying its settings to CONF.
+ *
+ * If all goes well, the function returns 0. If the file is not found, then
+ * the behaviour depends on whether `CF_NOENTOK' is set in F: if so, then the
+ * function simply returns -1. Otherwise, a fatal error is reported. Note
+ * that this /only/ applies if the file does not exist (specifically, opening
+ * it fails with `ENOENT') -- any other problems are reported as fatal
+ * errors regardless of the flag setting.
+ */
+int config_read_file(struct config *conf, const char *file, unsigned f)
+{
+ struct config_section *sect;
+ struct config_var *var;
+ struct dstr d = DSTR_INIT, dd = DSTR_INIT;
+ unsigned line = 0;
+ const char *p, *q, *r;
+ FILE *fp;
+
+ /* Try to open the file. */
+ fp = fopen(file, "r");
+ if (!fp) {
+ if ((f&CF_NOENTOK) && errno == ENOENT) return (-1);
+ lose("failed to open configuration file `%s': %s",
+ file, strerror(errno));
+ }
+
+ /* Find the initial section. */
+ sect = config_find_section(conf, CF_CREAT, "@CONFIG"); var = 0;
+
+ /* Work through the file, line by line. */
+ for (;;) {
+ dstr_reset(&d); if (dstr_readline(&d, fp)) break;
+ line++;
+
+ /* Trim trailing spaces from the line. The syntax is sensitive to
+ * leading spaces, so we can't trim those yet.
+ */
+ while (d.len && ISSPACE(d.p[d.len - 1])) d.len--;
+ d.p[d.len] = 0;
+
+ if (!*d.p || *d.p == ';')
+ /* Ignore comments entirely. (In particular, a comment doesn't
+ * interrupt a multiline variable value.)
+ */
+ ;
+
+ else if (ISSPACE(d.p[0])) {
+ /* The line starts with whitespace, so it's a continuation line. */
+
+ /* Skip the initial whitespace. */
+ p = d.p; while (ISSPACE(*p)) p++;
+
+ /* If we aren't collecting a variable value then this is an error.
+ * Otherwise, accumulate it into the current value.
+ */
+ if (!var)
+ lose("%s:%u: continuation line, but no variable", file, line);
+ if (dd.len) dstr_putc(&dd, ' ');
+ dstr_putm(&dd, p, d.len - (p - d.p));
+
+ } else {
+ /* The line starts in the first column. */
+
+ /* If there's a value value being collected then we must commit it to
+ * its variable (unless there's already a setting there that says we
+ * shouldn't).
+ */
+ if (var) {
+ if (!(var->f&CF_OVERRIDE))
+ { var->val = xstrndup(dd.p, dd.len); var->n = dd.len; }
+ var = 0;
+ }
+
+ /* Now decide what kind of line this is. */
+ if (d.p[0] == '[') {
+ /* It's a section header. */
+
+ /* Parse the header. */
+ p = d.p + 1; while (ISSPACE(*p)) p++;
+ q = scan_name("section", p, d.p + d.len, file, line);
+ r = q; while (ISSPACE(*r)) r++;
+ if (*r != ']')
+ lose("%s:%u: expected `]' in section header", file, line);
+ if (r[1])
+ lose("%s:%u: trailing junk after `]' in section header",
+ file, line);
+
+ /* Create the new section. */
+ sect = config_find_section_n(conf, CF_CREAT, p, q - p);
+
+ } else {
+ /* It's a variable assignment. Parse the name out. */
+ p = scan_name("variable", d.p, d.p + d.len, file, line);
+ var = config_find_var_n(conf, sect, CF_CREAT, d.p, p - d.p);
+ while (ISSPACE(*p)) p++;
+ if (*p != '=') lose("%s:%u: missing `=' in assignment", file, line);
+ p++; while (ISSPACE(*p)) p++;
+
+ /* Clear out the variable's initial value, unless we shouldn't
+ * override it.
+ */
+ if (!(var->f&CF_OVERRIDE)) {
+ free(var->val); var->val = 0; var->f = 0;
+ free(var->file); var->file = xstrdup(file); var->line = line;
+ }
+ dstr_reset(&dd); dstr_puts(&dd, p);
+ }
+ }
+ }
+
+ /* If there's a value under construction then commit the result. */
+ if (var && !(var->f&CF_OVERRIDE))
+ { var->val = xstrndup(dd.p, dd.len); var->n = dd.len; }
+
+ /* Close the file. */
+ if (fclose(fp))
+ lose("error reading configuration file `%s': %s", file, strerror(errno));
+
+ /* All done. */
+ dstr_release(&d); dstr_release(&dd);
+ return (0);
+}
+
+/* Populate SECT with environment variables.
+ *
+ * Environment variables are always set with `CF_LITERAL'.
+ */
+void config_read_env(struct config *conf, struct config_section *sect)
+{
+ const char *p, *v;
+ size_t i;
+
+ for (i = 0; (p = environ[i]) != 0; i++) {
+ v = strchr(p, '='); if (!v) continue;
+ config_set_var_n(conf, sect, CF_LITERAL, p, v - p, v + 1, strlen(v + 1));
+ }
+}
+
+/*----- Substitution and quoting ------------------------------------------*/
+
+/* The substitution and word-splitting state.
+ *
+ * This only keeps track of the immutable parameters for the substitution
+ * task: stuff which changes (flags, filtering state, cursor position) is
+ * maintained separately.
+ */
+struct subst {
+ struct config *config; /* configuration state */
+ struct config_section *home; /* home section for lookups */
+ struct dstr *d; /* current word being constructed */
+ struct argv *av; /* output word list */
+};
+
+/* Flags for `subst' and related functions. */
+#define SF_SPLIT 0x0001u /* split at (unquoted) whitespace */
+#define SF_QUOT 0x0002u /* currently within double quotes */
+#define SF_SUBST 0x0004u /* apply `$-substitutions */
+#define SF_SUBEXPR 0x0008u /* stop at delimiter `|' or `}' */
+#define SF_SPANMASK 0x00ffu /* mask for the above */
+
+#define SF_WORD 0x0100u /* output word under construction */
+#define SF_SKIP 0x0200u /* not producing output */
+#define SF_LITERAL 0x0400u /* do not expand or substitute */
+#define SF_UPCASE 0x0800u /* convert to uppercase */
+#define SF_DOWNCASE 0x1000u /* convert to lowercase */
+#define SF_CASEMASK 0x1800u /* mask for case conversions */
+
+/* Apply filters encoded in QFILT and F to the text from P to L, and output.
+ *
+ * SB is the substitution state which, in particular, explains where the
+ * output should go.
+ *
+ * The filters are encoded as flags `SF_UPCASE' and `SF_DOWNCASE' for case
+ * conversions, and a nesting depth QFILT for toothpick escaping. (QFILT is
+ * encoded as the number of toothpicks to print: see `subst' for how this
+ * determined.)
+ */
+static void filter_string(const char *p, const char *l,
+ const struct subst *sb, unsigned qfilt, unsigned f)
+{
+ size_t r, n;
+ char *q; const char *pp, *ll;
+
+ if (!qfilt && !(f&SF_CASEMASK))
+ /* Fast path: there's nothing to do: just write to the output. */
+ dstr_putm(sb->d, p, l - p);
+
+ else for (;;) {
+ /* We must be a bit more circumspect. */
+
+ /* Determine the length of the next span of characters which don't need
+ * escaping. (If QFILT is zero then this is everything.)
+ */
+ r = l - p; n = qfilt ? strcspn(p, "\"\\") : r;
+ if (n > r) n = r;
+
+ if (!(f&SF_CASEMASK))
+ /* No case conversion: we can just emit this chunk. */
+
+ dstr_putm(sb->d, p, n);
+
+ else {
+ /* Case conversion to do. Arrange enough space for the output, and
+ * convert it character by character.
+ */
+
+ dstr_ensure(sb->d, n); q = sb->d->p + sb->d->len; pp = p; ll = p + n;
+ if (f&SF_DOWNCASE) while (pp < ll) *q++ = TOLOWER(*pp++);
+ else if (f&SF_UPCASE) while (pp < ll) *q++ = TOUPPER(*pp++);
+ sb->d->len += n;
+ }
+
+ /* If we've reached the end then stop. */
+ if (n >= r) break;
+
+ /* Otherwise we must have found a character which requires escaping.
+ * Emit enough toothpicks.
+ */
+ dstr_putcn(sb->d, '\\', qfilt);
+
+ /* This character is now done, so we can skip over and see if there's
+ * another chunk of stuff we can do at high speed.
+ */
+ dstr_putc(sb->d, p[n]); p += n + 1;
+ }
+}
+
+/* Scan and resolve a `[SECT:]VAR' specifier at P.
+ *
+ * Return the address of the next character following the specifier. L is a
+ * limit on the region of the buffer that we should process; SB is the
+ * substitution state which provides the home section if none is given
+ * explicitly; FILE and LINE are the source location to blame for problems.
+ */
+static const char *retrieve_varspec(const char *p, const char *l,
+ const struct subst *sb,
+ struct config_var **var_out,
+ const char *file, unsigned line)
+{
+ struct config_section *sect = sb->home;
+ const char *t;
+
+ t = scan_name("section or variable", p, l, file, line);
+ if (t < l && *t == ':') {
+ sect = config_find_section_n(sb->config, 0, p, t - p);
+ p = t + 1; t = scan_name("variable", p, l, file, line);
+ }
+
+ if (!sect) *var_out = 0;
+ else *var_out = config_find_var_n(sb->config, sect, CF_INHERIT, p, t - p);
+ return (t);
+}
+
+/* Substitute and/or word-split text.
+ *
+ * The input text starts at P, and continues to (just before) L. Context for
+ * the task is provided by SB; the source location to blame is FILE and LINE
+ * (FILE may be null so that this can be passed directly from a `config_var'
+ * without further checking); QFILT is the nesting depth in toothpick-
+ * escaping; and F holds a mask of `SF_...' flags.
+ */
+static const char *subst(const char *p, const char *l,
+ const struct subst *sb,
+ const char *file, unsigned line,
+ unsigned qfilt, unsigned f)
+{
+ struct config_var *var;
+ const char *q0, *q1, *t;
+ unsigned subqfilt, ff;
+ size_t n;
+
+ /* It would be best if we could process literal text at high speed. To
+ * this end,
+ */
+ static const char *const delimtab[] = {
+
+#define ESCAPE "\\" /* always watch for `\'-escapes */
+#define SUBST "$" /* check for `$' if `SF_SUBST' set */
+#define WORDSEP " \f\r\n\t\v'\"" /* space, quotes if `SF_SPLIT' but
+ * not `SF_QUOT' */
+#define QUOT "\"" /* only quotes if `SF_SPLIT' and
+ * `SF_QUOT' */
+#define DELIM "|}" /* end delimiters of `SF_SUBEXPR' */
+
+ ESCAPE,
+ ESCAPE WORDSEP,
+ 0,
+ ESCAPE QUOT,
+ ESCAPE SUBST,
+ ESCAPE SUBST WORDSEP,
+ 0,
+ ESCAPE SUBST QUOT,
+ ESCAPE DELIM,
+ ESCAPE DELIM WORDSEP,
+ 0,
+ ESCAPE DELIM QUOT,
+ ESCAPE DELIM SUBST,
+ ESCAPE DELIM SUBST WORDSEP,
+ 0,
+ ESCAPE DELIM SUBST QUOT
+
+#undef COMMON
+#undef WORDSEP
+#undef SQUOT
+#undef DELIM
+ };
+
+ /* Set FILE to be useful if it was null on entry. */
+ if (!file) file = "<internal>";
+
+ /* If the text is literal then hand off to `filter_string'. This obviously
+ * starts a word.
+ */
+ if (f&SF_LITERAL) {
+ filter_string(p, l, sb, qfilt, f);
+ f |= SF_WORD;
+ goto done;
+ }
+
+ /* Chew through the input until it's all gone. */
+ while (p < l) {
+
+ if ((f&(SF_SPLIT | SF_QUOT)) == SF_SPLIT && ISSPACE(*p)) {
+ /* This is whitespace, we're supposed to split, and we're not within
+ * quotes, so we should split here.
+ */
+
+ /* If there's a word in progress then we should commit it. */
+ if (f&SF_WORD) {
+ if (!(f&SF_SKIP)) {
+ argv_append(sb->av, xstrndup(sb->d->p, sb->d->len));
+ dstr_reset(sb->d);
+ }
+ f &= ~SF_WORD;
+ }
+
+ /* Skip over further whitespace at high speed. */
+ do p++; while (p < l && ISSPACE(*p));
+
+ } else if (*p == '\\') {
+ /* This is a toothpick, so start a new word and add the next character
+ * to it.
+ */
+
+ /* If there's no next charact3er then we should be upset. */
+ p++; if (p >= l) lose("%s:%u: unfinished `\\' escape", file, line);
+
+ if (!(f&SF_SKIP)) {
+
+ /* If this is a double quote or backslash then check DFLT to see if
+ * it needs escaping.
+ */
+ if (qfilt && (*p == '"' || *p == '\\'))
+ dstr_putcn(sb->d, '\\', qfilt);
+
+ /* Output the character. */
+ if (f&SF_DOWNCASE) dstr_putc(sb->d, TOLOWER(*p));
+ else if (f&SF_UPCASE) dstr_putc(sb->d, TOUPPER(*p));
+ else dstr_putc(sb->d, *p);
+ }
+
+ /* Move past the escaped character. Remember we started a word. */
+ p++; f |= SF_WORD;
+
+ } else if ((f&SF_SPLIT) && *p == '"') {
+ /* This is a double quote, and we're word splitting. We're definitely
+ * in a word now. Toggle whether we're within quotes.
+ */
+
+ f ^= SF_QUOT; f |= SF_WORD; p++;
+
+ } else if ((f&(SF_SPLIT | SF_QUOT)) == SF_SPLIT && *p == '\'') {
+ /* This is a single quote, and we're word splitting but not within
+ * double quotes. Find the matching end quote, and just output
+ * everything between literally.
+ */
+
+ p++; t = strchr(p, '\'');
+ if (!t || t >= l) lose("%s:%u: missing `''", file, line);
+ if (!(f&SF_SKIP)) filter_string(p, t, sb, qfilt, f);
+ p = t + 1; f |= SF_WORD;
+
+ } else if ((f&SF_SUBEXPR) && (*p == '|' || *p == '}')) {
+ /* This is an end delimiter, and we're supposed to stop here. */
+ break;
+
+ } else if ((f&SF_SUBST) && *p == '$') {
+ /* This is a `$' and we're supposed to do substitution. */
+
+ /* The kind of substitution is determined by the next character. */
+ p++; if (p >= l) lose("%s:%u: incomplete substitution", file, line);
+
+ /* Prepare flags for a recursive substitution.
+ *
+ * Hide our quote state from the recursive call. If we're within a
+ * word, then disable word-splitting.
+ */
+ ff = f&~(SF_QUOT | (f&SF_WORD ? SF_SPLIT : 0));
+
+ /* Now dispatch based on the following character. */
+ switch (*p) {
+
+ case '?':
+ /* A conditional expression: $?VAR{CONSEQ[|ALT]} */
+
+ /* Skip initial space. */
+ p++; while (p < l && ISSPACE(*p)) p++;
+
+ /* Find the variable. */
+ p = retrieve_varspec(p, l, sb, &var, file, line);
+
+ /* Skip whitespace again. */
+ while (p < l && ISSPACE(*p)) p++;
+
+ /* Expect the opening `{'. */
+ if (p > l || *p != '{') lose("%s:%u: expected `{'", file, line);
+ p++;
+
+ /* We'll process the parts recursively, but we need to come back
+ * when we hit the appropriate delimiters, so arrange for that.
+ */
+ ff |= SF_SUBEXPR;
+
+ /* Process the consequent (skip if the variable wasn't found). */
+ p = subst(p, l, sb, file, line, qfilt,
+ ff | (var ? 0 : SF_SKIP));
+
+ /* If there's a `|' then process the alternative too (skip if the
+ * variable /was/ found).
+ */
+ if (p < l && *p == '|')
+ p = subst(p + 1, l, sb, file, line, qfilt,
+ ff | (var ? SF_SKIP : 0));
+
+ /* We should now be past the closing `}'. */
+ if (p >= l || *p != '}') lose("%s:%u: missing `}'", file, line);
+ p++;
+ break;
+
+ case '{':
+ /* A variable substitution: ${VAR[|FILT]...[?ALT]} */
+
+ /* Skip initial whitespace. */
+ p++; while (p < l && ISSPACE(*p)) p++;
+
+ /* Find the variable. */
+ q0 = p; p = retrieve_varspec(p, l, sb, &var, file, line); q1 = p;
+
+ /* Determine the filters to apply when substituting the variable
+ * value.
+ */
+ subqfilt = qfilt;
+ for (;;) {
+
+ /* Skip spaces again. */
+ while (p < l && ISSPACE(*p)) p++;
+
+ /* If there's no `|' then there are no more filters, so stop. */
+ if (p >= l || *p != '|') break;
+
+ /* Skip the `|' and more spaces. */
+ p++; while (p < l && ISSPACE(*p)) p++;
+
+ /* Collect the filter name. */
+ t = scan_name("filter", p, l, file, line);
+
+ /* Dispatch on the filter name. */
+ if (t - p == 1 && *p == 'q')
+ /* `q' -- quote for Lisp string.
+ *
+ * We're currently adding Q `\' characters before each naughty
+ * character. But a backslash itself is naughty too, so that
+ * makes Q + 1 naughty characters, each of which needs a
+ * toothpick, so now we need Q + (Q + 1) = 2 Q + 1 toothpicks.
+ *
+ * Calculate this here rather than at each point toothpicks
+ * needs to be deployed.
+ */
+
+ subqfilt = 2*subqfilt + 1;
+
+ else if (t - p == 1 && *p == 'l')
+ /* `u' -- convert to uppercase.
+ *
+ * If a case conversion is already set, then that will override
+ * whatever we do here, so don't bother.
+ */
+
+ { if (!(ff&SF_CASEMASK)) ff |= SF_DOWNCASE; }
+
+ else if (t - p == 1 && *p == 'u')
+ /* `u' -- convert to uppercase.
+ *
+ * If a case conversion is already set, then that will override
+ * whatever we do here, so don't bother.
+ */
+ { if (!(ff&SF_CASEMASK)) ff |= SF_UPCASE; }
+
+ else
+ /* Something else we didn't understand. */
+ lose("%s:%u: unknown filter `%.*s'",
+ file, line, (int)(t - p), p);
+
+ /* Continue from after the filter name. */
+ p = t;
+ }
+
+ /* If we're not skipping, and we found a variable, then substitute
+ * its value. This is the point where we need to be careful about
+ * recursive expansion.
+ */
+ if (!(f&SF_SKIP) && var) {
+ if (var->f&CF_EXPAND)
+ lose("%s:%u: recursive expansion of variable `%.*s'",
+ file, line, (int)(q1 - q0), q0);
+ var->f |= CF_EXPAND;
+ subst(var->val, var->val + var->n, sb,
+ var->file, var->line, subqfilt,
+ ff | (var->f&CF_LITERAL ? SF_LITERAL : 0));
+ var->f &= ~CF_EXPAND;
+ }
+
+ /* If there's an alternative, then we need to process (or maybe
+ * skip) it. Otherwise, we should complain if there was no
+ * veriable, and we're not skipping.
+ */
+ if (p < l && *p == '?')
+ p = subst(p + 1, l, sb, file, line, subqfilt,
+ ff | SF_SUBEXPR | (var ? SF_SKIP : 0));
+ else if (!var && !(f&SF_SKIP))
+ lose("%s:%u: unknown variable `%.*s'",
+ file, line, (int)(q1 - q0), q0);
+
+ /* Expect a `}' here. (No need to skip spaces: we already did that
+ * after scanning for filters, and either there was no alternative,
+ * or we advanced to a delimiter character anyway.)
+ */
+ if (p >= l || *p != '}') lose("%s:%u: missing `}'", file, line);
+ p++;
+ break;
+
+ default:
+ /* Something else. That's a shame. */
+ lose("%s:%u: unexpected `$'-substitution `%c'", file, line, *p);
+ }
+
+ /* Complain if we started out in word-splitting state, and therefore
+ * have added a whole number of words to the output, but there's a
+ * word-fragment stuck onto the end of this substitution.
+ */
+ if (p < l && !(~f&~(SF_WORD | SF_SPLIT)) && !ISSPACE(*p) &&
+ !((f&SF_SUBEXPR) && (*p == '|' || *p == '}')))
+ lose("%s:%u: surprising word boundary "
+ "after splicing substitution",
+ file, line);
+ }
+
+ else {
+ /* Something else. Try to skip over this at high speed.
+ *
+ * This makes use of the table we set up earlier.
+ */
+
+ n = strcspn(p, delimtab[f&SF_SPANMASK]);
+ if (n > l - p) n = l - p;
+ if (!(f&SF_SKIP)) filter_string(p, p + n, sb, qfilt, f);
+ p += n; f |= SF_WORD;
+ }
+ }
+
+done:
+ /* Sort out the wreckage. */
+
+ /* If we're still within quotes then something has gone wrong. */
+ if (f&SF_QUOT) lose("%s:%u: missing `\"'", file, line);
+
+ /* If we're within a word, and should be splitting, then commit the word to
+ * the output list.
+ */
+ if ((f&(SF_WORD | SF_SPLIT | SF_SKIP)) == (SF_SPLIT | SF_WORD)) {
+ argv_append(sb->av, xstrndup(sb->d->p, sb->d->len));
+ dstr_reset(sb->d);
+ }
+
+ /* And, with that, we're done. */
+ return (p);
+}
+
+/* Expand substitutions in a string.
+ *
+ * Expand the null-terminated string P relative to the HOME section, using
+ * configuration CONFIG, and appending the result to dynamic string D. Blame
+ * WHAT in any error messages.
+ */
+void config_subst_string(struct config *config, struct config_section *home,
+ const char *what, const char *p, struct dstr *d)
+{
+ struct subst sb;
+
+ sb.config = config; sb.home = home; sb.d = d;
+ subst(p, p + strlen(p), &sb, what, 0, 0, SF_SUBST);
+ dstr_putz(d);
+}
+
+/* Expand substitutions in a string.
+ *
+ * Expand the null-terminated string P relative to the HOME section, using
+ * configuration CONFIG, returning the result as a freshly malloc(3)ed
+ * string. Blame WHAT in any error messages.
+ */
+char *config_subst_string_alloc(struct config *config,
+ struct config_section *home,
+ const char *what, const char *p)
+{
+ struct dstr d = DSTR_INIT;
+ char *q;
+
+ config_subst_string(config, home, what, p, &d);
+ q = xstrndup(d.p, d.len); dstr_release(&d); return (q);
+}
+
+/* Expand substitutions in a variable.
+ *
+ * Expand the value of the variable VAR relative to the HOME section, using
+ * configuration CONFIG, appending the result to dynamic string D.
+ */
+void config_subst_var(struct config *config, struct config_section *home,
+ struct config_var *var, struct dstr *d)
+{
+ struct subst sb;
+
+ sb.config = config; sb.home = home; sb.d = d;
+ var->f |= CF_EXPAND;
+ subst(var->val, var->val + var->n, &sb, var->file, var->line, 0,
+ SF_SUBST | (var->f&CF_LITERAL ? SF_LITERAL : 0));
+ var->f &= ~CF_EXPAND;
+ dstr_putz(d);
+}
+
+/* Expand substitutions in a variable.
+ *
+ * Expand the value of the variable VAR relative to the HOME section, using
+ * configuration CONFIG, returning the result as a freshly malloc(3)ed
+ * string.
+ */
+char *config_subst_var_alloc(struct config *config,
+ struct config_section *home,
+ struct config_var *var)
+{
+ struct dstr d = DSTR_INIT;
+ char *q;
+
+ config_subst_var(config, home, var, &d);
+ q = xstrndup(d.p, d.len); dstr_release(&d); return (q);
+}
+
+/* Expand substitutions in a variable and split into words.
+ *
+ * Expand and word-split the value of the variable VAR relative to the HOME
+ * section, using configuration CONFIG, appending the resulting words into
+ * the vector AV.
+ */
+void config_subst_split_var(struct config *config,
+ struct config_section *home,
+ struct config_var *var, struct argv *av)
+{
+ struct dstr d = DSTR_INIT;
+ struct subst sb;
+
+ sb.config = config; sb.home = home; sb.av = av; sb.d = &d;
+ var->f |= CF_EXPAND;
+ subst(var->val, var->val + var->n, &sb, var->file, var->line, 0,
+ SF_SUBST | SF_SPLIT | (var->f&CF_LITERAL ? SF_LITERAL : 0));
+ var->f &= ~CF_EXPAND;
+ dstr_release(&d);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+/* -*-c-*-
+ *
+ * Common definitions for `runlisp'
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef LIB_H
+#define LIB_H
+
+#ifdef __cplusplus
+ extern "C" {
+#endif
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <limits.h>
+#include <stdarg.h>
+#include <stddef.h>
+#include <stdio.h>
+
+/*----- Handy macros ------------------------------------------------------*/
+
+#define N(v) (sizeof(v)/sizeof((v)[0]))
+ /* The number of elements in the array V. */
+
+/* Figure out the compiler version to see whether fancy tricks will work. */
+#if defined(__GNUC__)
+# define GCC_VERSION_P(maj, min) \
+ (__GNUC__ > (maj) || (__GNUC__ == (maj) && __GNUC_MINOR__ >= (min)))
+#else
+# define GCC_VERSION_P(maj, min) 0
+#endif
+
+#ifdef __clang__
+# define CLANG_VERSION_P(maj, min) \
+ (__clang_major__ > (maj) || (__clang_major__ == (maj) && \
+ __clang_minor__ >= (min)))
+#else
+# define CLANG_VERSION_P(maj, min) 0
+#endif
+
+#if GCC_VERSION_P(2, 5) || CLANG_VERSION_P(3, 3)
+
+# define NORETURN __attribute__((__noreturn__))
+ /* Mark a function as not returning. */
+
+# define PRINTF_LIKE(fix, aix) __attribute__((__format__(printf, fix, aix)))
+ /* Mark a function as accepting a printf(3)-like format string as
+ * argument FIX, with arguments to be substituted starting at AIX.
+ */
+#endif
+
+#if GCC_VERSION_P(4, 0) || CLANG_VERSION_P(3, 3)
+
+# define EXECL_LIKE(ntrail) __attribute__((__sentinel__(ntrail)))
+ /* Mark a function as expecting a variable number of arguments
+ * terminated by a null pointer, followed by NTRAIL further
+ * arguments.
+ */
+
+#endif
+
+/* Couldn't detect fancy compiler features. We'll have to make do
+ * without.
+ */
+#ifndef NORETURN
+# define NORETURN
+#endif
+#ifndef PRINTF_LIKE
+# define PRINTF_LIKE(fix, aix)
+#endif
+#ifndef EXECL_LIKE
+# define EXECL_LIKE(ntrail)
+#endif
+
+#define DISCARD(x) do if (x); while (0)
+ /* Discard the result of evaluating expression X, without upsetting
+ * the compiler.
+ */
+
+#define END ((const char *)0)
+ /* A null pointer to terminate the argument tail to an `EXECL_LIKE'
+ * function. (Note that `NULL' is /not/ adequate for this purpose,
+ * since it might expand simply to `0', which is an integer, not a
+ * pointer, and might well be the wrong size and/or value.)
+ */
+
+/* Wrap up <ctype.h> macros with explicit conversions to `unsigned char'. */
+#define CTYPE_HACK(func, ch) (func((unsigned char)(ch)))
+#define ISSPACE(ch) CTYPE_HACK(isspace, ch)
+#define ISALNUM(ch) CTYPE_HACK(isalnum, ch)
+#define ISXDIGIT(ch) CTYPE_HACK(isxdigit, ch)
+#define TOLOWER(ch) CTYPE_HACK(tolower, ch)
+#define TOUPPER(ch) CTYPE_HACK(toupper, ch)
+
+/* Wrap up comparison functions to take an ordering relation as part of their
+ * syntax. This makes it much harder to screw up.
+ */
+#define MEMCMP(x, op, y, n) (memcmp((x), (y), (n)) op 0)
+#define STRCMP(x, op, y) (strcmp((x), (y)) op 0)
+#define STRNCMP(x, op, y, n) (strncmp((x), (y), (n)) op 0)
+
+#ifndef SIZE_MAX
+# define SIZE_MAX (-(size_t)1)
+#endif
+ /* The largest value that can be stored in an object of type
+ * `size_t'. A proper <limits.h> setting would be a preprocessor-
+ * time constant, but we don't actually need that.
+ */
+
+/*----- Diagnostic utilities ----------------------------------------------*/
+
+extern const char *progname;
+ /* Our program name, for use in error messages. */
+
+extern void set_progname(const char */*prog*/);
+ /* Set `progname' from the pathname in PROG (typically from
+ * `argv[0]').
+ */
+
+extern void vmoan(const char */*msg*/, va_list /*ap*/);
+ /* Report an error or warning in Unix style, given a captured
+ * argument cursor.
+ */
+
+extern PRINTF_LIKE(1, 2) void moan(const char */*msg*/, ...);
+ /* Issue a warning message. */
+
+extern NORETURN PRINTF_LIKE(1, 2) void lose(const char */*msg*/, ...);
+ /* Issue a fatal error message and exit unsuccessfully. */
+
+/*----- Memory allocation -------------------------------------------------*/
+
+extern void *xmalloc(size_t /*n*/);
+ /* Allocate and return a pointer to N bytes, or report a fatal error.
+ *
+ * Release the pointer using `free' as usual. If N is zero, returns
+ * null (but you are not expected to check for this).
+ */
+
+extern void *xrealloc(void */*p*/, size_t /*n*/);
+ /* Resize the block at P (from `malloc' or `xmalloc') to be N bytes
+ * long.
+ *
+ * The block might (and probably will) move, so it returns the new
+ * address. If N is zero, then the block is freed (if necessary) and
+ * a null pointer returned; otherwise, if P is null then a fresh
+ * block is allocated. If allocation fails, then a fatal error is
+ * reported.
+ */
+
+extern char *xstrndup(const char */*p*/, size_t /*n*/);
+ /* Allocate and return a copy of the N-byte string starting at P.
+ *
+ * The new string is null-terminated, though P need not be. If
+ * allocation fails, then a fatal error is reported.
+ */
+
+extern char *xstrdup(const char */*p*/);
+ /* Allocate and return a copy of the null-terminated string starting
+ * at P.
+ *
+ * If allocation fails, then a fatal error is reported.
+ */
+
+/*----- Dynamic strings ---------------------------------------------------*/
+
+/* A dynamic string.
+ *
+ * Note that the string might not be null-terminated.
+ */
+struct dstr {
+ char *p; /* string base address */
+ size_t len; /* current string length */
+ size_t sz; /* allocated size of buffer */
+};
+#define DSTR_INIT { 0, 0, 0 }
+
+extern void dstr_init(struct dstr */*d*/);
+ /* Initialize the string D.
+ *
+ * Usually you'd use the static initializer `DSTR_INIT'.
+ */
+
+extern void dstr_reset(struct dstr */*d*/);
+ /* Reset string D so it's empty again. */
+
+extern void dstr_ensure(struct dstr */*d*/, size_t /*n*/);
+ /* Ensure that D has at least N unused bytes available. */
+
+extern void dstr_release(struct dstr */*d*/);
+ /* Release the memory held by D.
+ *
+ * It must be reinitialized (e.g., by `dstr_init') before it can be
+ * used again.
+ */
+
+extern void dstr_putm(struct dstr */*d*/, const void */*p*/, size_t /*n*/);
+ /* Append the N-byte string at P to D.
+ *
+ * P need not be null-terminated. D will not be null-terminated
+ * afterwards.
+ */
+
+extern void dstr_puts(struct dstr */*d*/, const char */*p*/);
+ /* Append the null-terminated string P to D.
+ *
+ * D /is/ guaranteed to be null-terminated after this.
+ */
+
+extern void dstr_putc(struct dstr */*d*/, int /*ch*/);
+ /* Append the single character CH to D.
+ *
+ * D will not be null-terminated afterwards.
+ */
+
+extern void dstr_putcn(struct dstr */*d*/, int /*ch*/, size_t /*n*/);
+ /* Append N copies of the character CH to D.
+ *
+ * D will not be null-terminated afterwards.
+ */
+
+extern void dstr_putz(struct dstr */*d*/);
+ /* Null-terminate the string D.
+ *
+ * This doesn't change the length of D. If further stuff is appended
+ * then the null terminator will be overwritten.
+ */
+
+extern void dstr_vputf(struct dstr */*d*/,
+ const char */*p*/, va_list /*ap*/);
+ /* Append stuff to D, determined by printf(3) format string P and
+ * argument tail AP.
+ *
+ * D will not be null-terminated afterwards.
+ */
+
+extern PRINTF_LIKE(2, 3)
+ void dstr_putf(struct dstr */*d*/, const char */*p*/, ...);
+ /* Append stuff to D, determined by printf(3) format string P and
+ * arguments.
+ *
+ * D will not be null-terminated afterwards.
+ */
+
+extern int dstr_readline(struct dstr */*d*/, FILE */*fp*/);
+ /* Append the next input line from FP to D.
+ *
+ * Return 0 on success, or -1 if reading immediately fails or
+ * encounters end-of-file (call ferror(3) to distinguish). Any
+ * trailing newline is discarded: it is not possible to determine
+ * whether the last line was ended with a newline. D is guaranteed
+ * to be null-terminated afterwards.
+ */
+
+/*----- Dynamic vectors of strings ----------------------------------------*/
+
+/* A dynamic vector of strings.
+ *
+ * This machinery only actually tracks character pointers. It assumes that
+ * the caller will manage the underlying storage for the strings.
+ *
+ * Note that `v' always points to the first element in the vector. The
+ * underlying storage starts `o' slots before this.
+*/
+struct argv {
+ char **v; /* pointer the first element */
+ size_t n; /* length of the vector */
+ size_t o; /* number of spare slots at start */
+ size_t sz; /* allocated size (in slots) */
+};
+#define ARGV_INIT { 0, 0, 0, 0 }
+
+extern void argv_init(struct argv */*a*/v);
+ /* Initialize the vector AV.
+ *
+ * Usually you'd use the static initializer `ARGV_INIT'.
+ */
+
+extern void argv_reset(struct argv */*av*/);
+ /* Reset the vector AV so that it's empty again. */
+
+extern void argv_ensure(struct argv */*av*/, size_t /*n*/);
+ /* Ensure that AV has at least N unused slots at the end. */
+
+extern void argv_ensure_offset(struct argv */*av*/, size_t /*n*/);
+ /* Ensure that AV has at least N unused slots at the /start/. */
+
+extern void argv_release(struct argv */*av*/);
+ /* Release the memory held by AV.
+ *
+ * It must be reinitialized (e.g., by `argv_init') before it can be
+ * used again.
+ */
+
+extern void argv_append(struct argv */*av*/, char */*p*/);
+ /* Append the pointer P to AV. */
+
+extern void argv_appendz(struct argv */*av*/);
+ /* Append a null pointer to AV, without extending the vactor length.
+ *
+ * The null pointer will be overwritten when the next string is
+ * appended.
+ */
+
+extern void argv_appendn(struct argv */*av*/,
+ char *const */*v*/, size_t /*n*/);
+ /* Append a N-element vector V of pointers to AV. */
+
+extern void argv_appendav(struct argv */*av*/, const struct argv */*bv*/);
+ /* Append the variable-length vector BV to AV. */
+
+extern void argv_appendv(struct argv */*av*/, va_list /*ap*/);
+ /* Append the pointers from a variable-length argument list AP to AV.
+ *
+ * The list is terminated by a null pointer.
+ */
+
+extern EXECL_LIKE(0) void argv_appendl(struct argv */*av*/, ...);
+ /* Append the argument pointers, terminated by a null pointer, to
+ * AV.
+ */
+
+extern void argv_prepend(struct argv */*av*/, char */*p*/);
+ /* Prepend the pointer P to AV. */
+
+extern void argv_prependn(struct argv */*av*/,
+ char *const */*v*/, size_t /*n*/);
+ /* Prepend a N-element vector V of pointers to AV. */
+
+extern void argv_prependav(struct argv */*av*/, const struct argv */*bv*/);
+ /* Prepend the variable-length vector BV to AV. */
+
+extern void argv_prependv(struct argv */*av*/, va_list /*ap*/);
+ /* Prepend the pointers from a variable-length argument list AP to
+ * AV.
+ *
+ * The list is terminated by a null pointer.
+ */
+
+extern EXECL_LIKE(0) void argv_prependl(struct argv */*av*/, ...);
+ /* Prepend the argument pointers, terminated by a null pointer, to
+ * AV.
+ */
+
+/*----- Treaps ------------------------------------------------------------*/
+
+/* A `treap' is a data structure for associating values with keys. This
+ * implementation assumes that keys are simply text strings.
+ */
+struct treap {
+ struct treap_node *root;
+};
+#define TREAP_INIT { 0 }
+
+/* A treap is a combination of a binary search tree and a binary heap. The
+ * nodes are ordered according to the search keys, in the usual way, so that
+ * all the keys in a node's left subtree precede that node's key, and all of
+ * the keys in its right subtree follow the node's key. The trick is that
+ * the tree must /also/ satisfy the heap condition regarding randomly
+ * assigned `weights' attached to each node: so a node's weight must not be
+ * less than their weight of either of its children.
+ *
+ * This combination uniquely determines the structure of the tree, except for
+ * nodes whose weights exactly match one (or both) of their children. (The
+ * root must be the heaviest node in the tree. The root's key splits the
+ * remaining nodes into left and right subtrees, whose structure is then
+ * uniquely determined by induction.)
+ *
+ * This is an /intrusive/ data structure. A caller is expected to include a
+ * `struct treap_node' as (probably) the initial part of a larger structure.
+ */
+struct treap_node {
+ unsigned wt; /* weight (randomly assigned) */
+ struct treap_node *left, *right; /* left and right subtrees */
+ char *k; size_t kn; /* key pointer and length */
+};
+#define TREAP_NODE_KEY(n) (((const struct treap_node *)(n))->k + 0)
+#define TREAP_NODE_KEYLEN(n) (((const struct treap_node *)(n))->kn + 0)
+
+/* We can't allocate nodes ourselves, because only the caller knows how.
+ * Instead, insertion is split into two operations: `treap_probe' looks to
+ * see whether a matching node is already in the treap, and returns it if so;
+ * otherwise, it flls in this `treap_path' structure, which is passed back to
+ * `treap_insert' to help it add the fresh node into the treap. (See the
+ * commentary in `treap_probe' and `treap_insert' for the details.)
+ */
+#define TREAP_PATHMAX 64
+struct treap_path {
+ struct treap_node **path[TREAP_PATHMAX];
+ unsigned nsteps;
+};
+
+/* An external iterator for a treap. (See the commentary for
+ * `treap_start_iter' and `treap_next' for the details.)
+ */
+struct treap_iter {
+ struct treap_node *stack[TREAP_PATHMAX];
+ unsigned sp;
+};
+
+extern void treap_init(struct treap */*t*/);
+ /* Initialize the treap T.
+ *
+ * Usually you'd use the static initializer `TREAP_INIT'.
+ */
+
+extern void *treap_lookup(const struct treap */*t*/,
+ const char */*k*/, size_t /*kn*/);
+ /* Look up the KN-byte key K in the treap T.
+ *
+ * Return a pointer to the matching node if one was found, or null
+ * otherwise.
+ */
+
+extern void *treap_probe(struct treap */*t*/,
+ const char */*k*/, size_t /*kn*/,
+ struct treap_path */*p*/);
+ /* Look up the KN-byte K in the treap T, recording a path in P.
+ *
+ * This is similar to `treap_lookup', in that it returns the
+ * requested node if it already exists, or null otherwise, but it
+ * also records in P information to be used by `treap_insert' to
+ * insert a new node with the given key if it's not there already.
+ */
+
+extern void treap_insert(struct treap */*t*/, const struct treap_path */*p*/,
+ struct treap_node */*n*/,
+ const char */*k*/, size_t /*kn*/);
+ /* Insert a new node N into T, associating it with the KN-byte key K.
+ *
+ * Use the path data P, from `treap_probe', to help with insertion.
+ */
+
+extern void *treap_remove(struct treap */*t*/,
+ const char */*k*/, size_t /*kn*/);
+ /* Remove the node with the KN-byte K from T.
+ *
+ * Return the address of the node we removed, or null if it couldn't
+ * be found.
+ */
+
+extern void treap_start_iter(struct treap */*t*/, struct treap_iter */*i*/);
+ /* Initialize an iterator I over T's nodes. */
+
+extern void *treap_next(struct treap_iter */*i*/);
+ /* Return the next node from I, in ascending order by key.
+ *
+ * If there are no more nodes, then return null.
+ */
+
+extern void treap_check(struct treap */*t*/);
+ /* Check the treap structure rules for T. */
+
+extern void treap_dump(struct treap */*t*/);
+ /* Dump the treap T to standard output, for debugging purposes. */
+
+/*----- Configuration file parsing ----------------------------------------*/
+
+/* A configuration file. */
+struct config {
+ struct treap sections; /* treap of sections */
+ struct config_section *head, **tail; /* section list, in creation order */
+ struct config_section *fallback; /* default parent section */
+};
+#define CONFIG_INIT { TREAP_INIT, 0, 0 }
+
+/* A configuration section. */
+struct config_section {
+ struct treap_node _node; /* treap intrustion */
+ struct config_section *next; /* next section in creation order */
+ struct config_section **parents; size_t nparents; /* vector of parents */
+ struct treap vars; /* treap of variables */
+ struct treap cache; /* inheritance cache */
+};
+#define CONFIG_SECTION_NAME(sect) TREAP_NODE_KEY(sect)
+#define CONFIG_SECTION_NAMELEN(sect) TREAP_NODE_KEYLEN(sect)
+
+/* An entry in a section's inheritance cache: see `search_recursive' for
+ * details.
+ */
+struct config_cache_entry {
+ struct treap_node _node; /* treap intrusion */
+ unsigned f; /* flags */
+#define CF_OPEN 1u /* traps inheritance cycles */
+ struct config_var *var; /* pointer to inherited variable */
+};
+
+/* A configuration variable. */
+struct config_var {
+ struct treap_node _node; /* treap intrusion */
+ char *file; unsigned line; /* source location, or null/0 */
+ char *val; size_t n; /* value pointer and length */
+ unsigned f; /* flags */
+#define CF_LITERAL 1u /* value should not be expanded */
+#define CF_EXPAND 2u /* traps expansion cycles */
+#define CF_OVERRIDE 4u /* override settings from files */
+};
+#define CONFIG_VAR_NAME(var) TREAP_NODE_KEY(var)
+#define CONFIG_VAR_NAMELEN(var) TREAP_NODE_KEYLEN(var)
+
+/* A section iterator.
+ *
+ * (Sections are visited in the order in which they were created.)
+ */
+struct config_section_iter {
+ struct config_section *sect; /* next section to return */
+};
+
+/* A variable iterator.
+ *
+ * (Variables are visited in lexicographical order.)
+ */
+struct config_var_iter {
+ struct treap_iter i;
+};
+
+/* Common flags. */
+#define CF_CREAT 1u /* create section or variable */
+#define CF_INHERIT 2u /* look up variable in parents */
+
+extern void config_init(struct config */*conf*/);
+ /* Initialize the configuration state CONF.
+ *
+ * Usually you'd use the static initializer `CONFIG_INIT'.
+ */
+
+extern struct config_section *config_find_section(struct config */*conf*/,
+ unsigned /*f*/,
+ const char */*name*/);
+ /* Find and return the section with null-terminated NAME in CONF.
+ *
+ * If no section is found, the behaviour depends on whether
+ * `CF_CREAT' is set in F: if so, an empty section is created and
+ * returned; otherwise, a null pointer is returned.
+ */
+
+extern struct config_section *config_find_section_n(struct config */*conf*/,
+ unsigned /*f*/,
+ const char */*name*/,
+ size_t /*sz*/);
+ /* Find and return the section with the given SZ-byte NAME in CONF.
+ *
+ * This works like `config_find_section', but with an explicit length
+ * for the NAME rather than null-termination.
+ */
+
+extern void config_set_fallback(struct config */*conf*/,
+ struct config_section */*sect*/);
+ /* Set the fallback section for CONF to be SECT.
+ *
+ * That is, if a section has no explicit parents, then by default it
+ * will have a single parent which is SECT. If SECT is null then
+ * there is no fallback section, and sections which don't have
+ * explicitly specified parents have no parents at all. (This is the
+ * default situation.)
+ */
+
+extern void config_set_parent(struct config_section */*sect*/,
+ struct config_section */*parent*/);
+ /* Arrange that SECT has PARENT as its single parent section.
+ *
+ * If PARENT is null, then arrange that SECT has no parents at all.
+ * In either case, any `@parents' setting will be ignored.
+ */
+
+extern void config_start_section_iter(struct config */*conf*/,
+ struct config_section_iter */*i*/);
+ /* Initialize I to iterate over the sections defined in CONF. */
+
+extern struct config_section *config_next_section
+ (struct config_section_iter */*i*/);
+ /* Return the next section from I, in order of creation.
+ *
+ * If there are no more sections, then return null.
+ */
+
+extern struct config_var *config_find_var(struct config */*conf*/,
+ struct config_section */*sect*/,
+ unsigned /*f*/,
+ const char */*name*/);
+ /* Find and return the variable with null-terminated NAME in SECT.
+ *
+ * If `CF_INHERIT' is set in F, then the function searches the
+ * section's parents recursively; otherwise, it only checks to see
+ * whether the variable is set directly in SECT.
+ *
+ * If no variable is found, the behaviour depends on whether
+ * `CF_CREAT' is set in F: if so, an empty variable is created and
+ * returned; otherwise, a null pointer is returned.
+ *
+ * Setting both `CF_INHERIT' and `CF_CREAT' is not useful.
+ */
+
+extern struct config_var *config_find_var_n(struct config */*conf*/,
+ struct config_section */*sect*/,
+ unsigned /*f*/,
+ const char */*name*/,
+ size_t /*sz*/);
+ /* Find and return the variable with the given SZ-byte NAME in SECT.
+ *
+ * This works like `config_find_var', but with an explicit length for
+ * the NAME rather than null-termination.
+ */
+
+extern struct config_var *config_set_var(struct config */*conf*/,
+ struct config_section */*sect*/,
+ unsigned /*f*/,
+ const char */*name*/,
+ const char */*value*/);
+ /* Set variable NAME to VALUE in SECT, with associated flags F.
+ *
+ * The names are null-terminated. The flags are variable flags: see
+ * `struct config_var' for details. Returns the variable.
+ *
+ * If the variable is already set and has the `CF_OVERRIDE' flag,
+ * then this function does nothing unless `CF_OVERRIDE' is /also/ set
+ * in F.
+ */
+
+extern struct config_var *config_set_var_n(struct config */*conf*/,
+ struct config_section */*sect*/,
+ unsigned /*f*/,
+ const char */*name*/,
+ size_t /*namelen*/,
+ const char */*value*/,
+ size_t /*valuelen*/);
+ /* As `config_set_var', except that the variable NAME and VALUE have
+ * explicit lengths (NAMELEN and VALUELEN, respectively) rather than
+ * being null- terminated.
+ */
+
+extern void config_start_var_iter(struct config */*conf*/,
+ struct config_section */*sect*/,
+ struct config_var_iter */*i*/);
+ /* Initialize I to iterate over the variables directly defined in
+ * SECT.
+ */
+
+extern struct config_var *config_next_var(struct config_var_iter */*i*/);
+ /* Return next variable from I, in ascending lexicographical order.
+ *
+ * If there are no more variables, then return null.
+ */
+
+extern int config_read_file(struct config */*conf*/, const char */*file*/,
+ unsigned /*f*/);
+#define CF_NOENTOK 1u
+ /* Read and parse configuration FILE, applying its settings to CONF.
+ *
+ * If all goes well, the function returns 0. If the file is not
+ * found, then the behaviour depends on whether `CF_NOENTOK' is set
+ * in F: if so, then the function simply returns -1. Otherwise, a
+ * fatal error is reported. Note that this /only/ applies if the
+ * file does not exist (specifically, opening it fails with `ENOENT')
+ * -- any other problems are reported as fatal errors regardless of
+ * the flag setting.
+ */
+
+extern void config_read_env(struct config */*conf*/,
+ struct config_section */*sect*/);
+ /* Populate SECT with environment variables.
+ *
+ * Environment variables are always set with `CF_LITERAL'.
+ */
+
+extern void config_subst_string(struct config */*config*/,
+ struct config_section */*home*/,
+ const char */*what*/,
+ const char */*p*/, struct dstr */*d*/);
+ /* Expand substitutions in a string.
+ *
+ * Expand the null-terminated string P relative to the HOME section,
+ * using configuration CONFIG, and appending the result to dynamic
+ * string D. Blame WHAT in any error messages.
+ */
+
+extern char *config_subst_string_alloc(struct config */*config*/,
+ struct config_section */*home*/,
+ const char */*what*/,
+ const char */*p*/);
+ /* Expand substitutions in a string.
+ *
+ * Expand the null-terminated string P relative to the HOME section,
+ * using configuration CONFIG, returning the result as a freshly
+ * malloc(3)ed string. Blame WHAT in any error messages.
+ */
+
+extern void config_subst_var(struct config */*config*/,
+ struct config_section */*home*/,
+ struct config_var */*var*/,
+ struct dstr */*d*/);
+ /* Expand substitutions in a variable.
+ *
+ * Expand the value of the variable VAR relative to the HOME section,
+ * using configuration CONFIG, appending the result to dynamic string
+ * D.
+ */
+
+extern char *config_subst_var_alloc(struct config */*config*/,
+ struct config_section */*home*/,
+ struct config_var */*var*/);
+ /* Expand substitutions in a variable.
+ *
+ * Expand the value of the variable VAR relative to the HOME section,
+ * using configuration CONFIG, returning the result as a freshly
+ * malloc(3)ed string.
+ */
+
+extern void config_subst_split_var(struct config */*config*/,
+ struct config_section */*home*/,
+ struct config_var */*var*/,
+ struct argv */*av*/);
+ /* Expand substitutions in a variable and split into words.
+ *
+ * Expand and word-split the value of the variable VAR relative to
+ * the HOME section, using configuration CONFIG, appending the
+ * resulting words into the vector AV.
+ */
+
+/*----- That's all, folks -------------------------------------------------*/
+
+#ifdef __cplusplus
+ }
+#endif
+
+#endif
+++ /dev/null
-dnl -*-autoconf-*-
-
-### SYNOPSIS
-###
-### mdw_AUTO_VERSION
-###
-### DESCRIPTION
-###
-### Defines an m4 macro `AUTO_VERSION' which contains the current package's
-### version number, worked out in some clever way.
-###
-### The heavy lifting is performed by the `auto-version' script (q.v.). In
-### brief:
-###
-### * if this is a Git working tree (i.e., there is a `.git' file or
-### directory at toplevel) then call `git describe' and use its output;
-###
-### * if there is a `RELEASE' file, then use its contents literally;
-###
-### * if there is a `debian/changelog' file, then use the most recent
-### entry's version number;
-###
-### * otherwise use `UNKNOWN'.
-###
-### LICENSE
-###
-### Copyright (c) 2008 Mark Wooding <mdw@distorted.org.uk>
-###
-### This program is free software: you can redistribute it and/or modify it
-### under the terms of the GNU General Public License as published by the
-### Free Software Foundation, either version 2 of the License, or (at your
-### option) any later version.
-###
-### This program is distributed in the hope that it will be useful, but
-### WITHOUT ANY WARRANTY; without even the implied warranty of
-### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-### General Public License for more details.
-###
-### You should have received a copy of the GNU General Public License along
-### with this program. If not, see <http://www.gnu.org/licenses/>.
-###
-### As a special exception, the respective Autoconf Macro's copyright owner
-### gives unlimited permission to copy, distribute and modify the configure
-### scripts that are the output of Autoconf when processing the Macro. You
-### need not follow the terms of the GNU General Public License when using
-### or distributing such scripts, even though portions of the text of the
-### Macro appear in them. The GNU General Public License (GPL) does govern
-### all other use of the material that constitutes the Autoconf Macro.
-###
-### This special exception to the GPL applies to versions of the Autoconf
-### Macro released by the Autoconf Archive. When you make and distribute a
-### modified version of the Autoconf Macro, you may extend this special
-### exception to the GPL to apply to your modified version as well.
-
-# serial 1
-AC_DEFUN([mdw_AUTO_VERSION], [m4_define([AUTO_VERSION], m4_esyscmd([
- ver=UNKNOWN
- for pre in ./ config/; do
- try=${pre}auto-version
- if test -x $try; then ver=$("$try"); break; fi
- done
- echo -n "$ver"
-]))])
--- /dev/null
+../.ext/cfd/m4/mdw-auto-version.m4
\ No newline at end of file
+++ /dev/null
-dnl -*-autoconf-*-
-
-### SYNOPSIS
-###
-### mdw_DECL_ENVIRON
-###
-### DESCRIPTION
-###
-### Define a preprocessor symbol `DECL_ENVIRON' if the `environ' vector is
-### declared in one of the `usual' places.
-###
-### LICENSE
-###
-### Copyright (c) 1999 Mark Wooding <mdw@distorted.org.uk>
-###
-### This program is free software: you can redistribute it and/or modify it
-### under the terms of the GNU General Public License as published by the
-### Free Software Foundation, either version 2 of the License, or (at your
-### option) any later version.
-###
-### This program is distributed in the hope that it will be useful, but
-### WITHOUT ANY WARRANTY; without even the implied warranty of
-### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-### General Public License for more details.
-###
-### You should have received a copy of the GNU General Public License along
-### with this program. If not, see <http://www.gnu.org/licenses/>.
-###
-### As a special exception, the respective Autoconf Macro's copyright owner
-### gives unlimited permission to copy, distribute and modify the configure
-### scripts that are the output of Autoconf when processing the Macro. You
-### need not follow the terms of the GNU General Public License when using
-### or distributing such scripts, even though portions of the text of the
-### Macro appear in them. The GNU General Public License (GPL) does govern
-### all other use of the material that constitutes the Autoconf Macro.
-###
-### This special exception to the GPL applies to versions of the Autoconf
-### Macro released by the Autoconf Archive. When you make and distribute a
-### modified version of the Autoconf Macro, you may extend this special
-### exception to the GPL to apply to your modified version as well.
-
-# serial 1
-AC_DEFUN([mdw_DECL_ENVIRON],
-[AC_CACHE_CHECK([for declaration of \`environ'], mdw_cv_environ,
-[AC_EGREP_CPP([\<environ\>],
-[#include <sys/types.h>
-#if HAVE_UNISTD_H
-#include <unistd.h>
-#endif
-#if STDC_HEADERS
-#include <stdlib.h>
-#include <stddef.h>
-#endif], [mdw_cv_environ=yes], [mdw_cv_environ=no])])
-if test $mdw_cv_environ = yes; then
- AC_DEFINE([DECL_ENVIRON], [1],
- [Define if you have the `environ' vector of environment variables.])
-fi])
--- /dev/null
+../.ext/cfd/m4/mdw-decl-environ.m4
\ No newline at end of file
+++ /dev/null
-dnl -*-autoconf-*-
-
-### SYNOPSIS
-###
-### mdw_DEFINE_PATHS(BODY)
-###
-### mdw_PROG(PROG)
-### mdw_PATH(PATH)
-### mdw_DEFINE_PROG(SYMBOL, PROG)
-### mdw_DEFINE_PATH(SYMBOL, PATH)
-###
-### DESCRIPTION
-###
-### This collection of macros is useful for hardcoding pathname strings
-### into binary programs.
-###
-### Within the BODY of `mdw_DEFINE_PATHS', a number of variables are `fixed
-### up' so that they can be properly expanded. The other macros are only
-### really useful within this body.
-###
-### `mdw_PROG' expands, in the shell, to the transformed name of the
-### program PROG.
-###
-### `mdw_PATH' expands, in the shell, to the recursive expansion of PATH,
-### which should be a string containing parameter expansions.
-###
-### `mdw_DEFINE_PROG' is a convenience macro which defines the preprocessor
-### SYMBOL to the result of `mdw_PROG(PROG)'; similarly `mdw_DEFINE_PATH'
-### defines SYMBOL to the result of `mdw_PATH(PATH)'.
-###
-### LICENSE
-###
-### Copyright (c) 2002 Mark Wooding <mdw@distorted.org.uk>
-###
-### This program is free software: you can redistribute it and/or modify it
-### under the terms of the GNU General Public License as published by the
-### Free Software Foundation, either version 2 of the License, or (at your
-### option) any later version.
-###
-### This program is distributed in the hope that it will be useful, but
-### WITHOUT ANY WARRANTY; without even the implied warranty of
-### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-### General Public License for more details.
-###
-### You should have received a copy of the GNU General Public License along
-### with this program. If not, see <http://www.gnu.org/licenses/>.
-###
-### As a special exception, the respective Autoconf Macro's copyright owner
-### gives unlimited permission to copy, distribute and modify the configure
-### scripts that are the output of Autoconf when processing the Macro. You
-### need not follow the terms of the GNU General Public License when using
-### or distributing such scripts, even though portions of the text of the
-### Macro appear in them. The GNU General Public License (GPL) does govern
-### all other use of the material that constitutes the Autoconf Macro.
-###
-### This special exception to the GPL applies to versions of the Autoconf
-### Macro released by the Autoconf Archive. When you make and distribute a
-### modified version of the Autoconf Macro, you may extend this special
-### exception to the GPL to apply to your modified version as well.
-
-# serial 1
-AC_DEFUN([mdw_DEFINE_PATHS],
-[mdw_prefix=$prefix mdw_exec_prefix=$exec_prefix
-mdw_transform=$(echo "$program_transform_name"|sed 's,\\\\\\\\,\\\\,g; s,\\$\\$,$,g')
-test "$prefix" = "NONE" && prefix=$ac_default_prefix
-test "$exec_prefix" = "NONE" && exec_prefix=$prefix
-$1
-prefix=$mdw_prefix exec_prefix=$mdw_exec_prefix])
-
-AC_DEFUN([mdw_PROG], [$(echo "$1" | sed "$mdw_transform")])
-AC_DEFUN([mdw_PATH],
-[$(t="$1"; dnl
-while :; do case "$t" in *\$[]*) eval t=\"$t\" ;; *) break ;; esac; done; dnl
-echo "$t")])
-AC_DEFUN([mdw_DEFINE_PROG],
- [AC_DEFINE_UNQUOTED([$1], ["mdw_PROG([$2])"], [Program name for $2.])])
-AC_DEFUN([mdw_DEFINE_PATH],
- [AC_DEFINE_UNQUOTED([$1], ["mdw_PATH([$2])"], [Pathname for $2.])])
--- /dev/null
+../.ext/cfd/m4/mdw-define-paths.m4
\ No newline at end of file
+++ /dev/null
-dnl -*-autoconf-*-
-
-### SYNOPSIS
-###
-### mdw_SILENT_RULES
-###
-### DESCRIPTION
-###
-### Set Automake's `silent-rules' feature on by default, if available.
-###
-### LICENSE
-###
-### Copyright (c) 2010 Mark Wooding <mdw@distorted.org.uk>
-###
-### This program is free software: you can redistribute it and/or modify it
-### under the terms of the GNU General Public License as published by the
-### Free Software Foundation, either version 2 of the License, or (at your
-### option) any later version.
-###
-### This program is distributed in the hope that it will be useful, but
-### WITHOUT ANY WARRANTY; without even the implied warranty of
-### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-### General Public License for more details.
-###
-### You should have received a copy of the GNU General Public License along
-### with this program. If not, see <http://www.gnu.org/licenses/>.
-###
-### As a special exception, the respective Autoconf Macro's copyright owner
-### gives unlimited permission to copy, distribute and modify the configure
-### scripts that are the output of Autoconf when processing the Macro. You
-### need not follow the terms of the GNU General Public License when using
-### or distributing such scripts, even though portions of the text of the
-### Macro appear in them. The GNU General Public License (GPL) does govern
-### all other use of the material that constitutes the Autoconf Macro.
-###
-### This special exception to the GPL applies to versions of the Autoconf
-### Macro released by the Autoconf Archive. When you make and distribute a
-### modified version of the Autoconf Macro, you may extend this special
-### exception to the GPL to apply to your modified version as well.
-
-# serial 1
-AC_DEFUN([mdw_SILENT_RULES],
- [m4_ifdef([AM_SILENT_RULES],
- [AM_SILENT_RULES([yes])],
- [AC_SUBST([AM_DEFAULT_VERBOSITY], [1])])])
--- /dev/null
+../.ext/cfd/m4/mdw-silent-rules.m4
\ No newline at end of file
--- /dev/null
+.ext/cfd/src/mdwopt.c
\ No newline at end of file
--- /dev/null
+.ext/cfd/src/mdwopt.h
\ No newline at end of file
--- /dev/null
+.\" -*-nroff-*-
+.\"
+.\" Manual for `query-runlisp-config'
+.\"
+.\" (c) 2020 Mark Wooding
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+.\"
+.\" Runlisp is free software: you can redistribute it and/or modify it
+.\" under the terms of the GNU General Public License as published by the
+.\" Free Software Foundation; either version 3 of the License, or (at your
+.\" option) any later version.
+.\"
+.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
+.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+.\" for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+..
+.ie t \{\
+. ds o \(bu
+. if \n(.g \{\
+. fam P
+. ev an-1
+. fam P
+. ev
+. \}
+.\}
+.el \{\
+. ds o o
+.\}
+.
+.de hP
+.IP
+\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
+..
+.
+.\"--------------------------------------------------------------------------
+.TH query-runlisp-config 1 "2 August 2020" "Mark Wooding"
+.SH NAME
+query-runlisp-config \- inspect and debug runlisp configuration files
+.
+.\"--------------------------------------------------------------------------
+.SH SYNOPSIS
+.
+.B query-runlisp-config
+.RB [ \-Lqv ]
+.RB [ \-c
+.IR conf ]
+.RB [ \-o
+.RI [ sect \c
+.BR : ] \c
+.IB var = \c
+.IR value ]
+.br
+ \&
+.RB [ \-l
+.IR sect ]
+.RB [ \-p
+.RI [ sect \c
+.BR : ] \c
+.IR var ]
+.RB [ \-w
+.RI [ sect \c
+.BR : ] \c
+.IR var ]
+.RB [ \-x
+.RI [ sect \c
+.BR : ] \c
+.IR var ]
+.
+.\"--------------------------------------------------------------------------
+.SH DESCRIPTION
+.
+The
+.B query-runlisp-config
+program assists with understanding and debugging
+.BR runlisp.conf (5)
+files.
+.
+.SS "Options"
+The command-line options are as follows.
+.
+.TP
+.BR "\-h" ", " "\-\-help"
+Write a synopsis of
+.BR query-runlisp-config 's
+command-line syntax
+and a description of the command-line options
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-V" ", " "\-\-version"
+Write
+.BR query-runlisp-config 's
+version number
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-L" ", " "\-\-list-sections"
+List all of the known section names to standard output.
+.
+.TP
+.BI "\-c" "\fR, " "\-\-config-file=" conf
+Read configuration from
+.IR conf .
+If
+.I conf
+is a directory, then all of the files within
+whose names end with
+.RB ` .conf ',
+are loaded, in ascending lexicographical order;
+otherwise,
+.I conf
+is opened as a file.
+All of the files are expected to as described in
+.BR runlisp.conf (5).
+.
+.TP
+.BI "\-l" "\fR, " "\-\-list-variables=" sect
+List all of the variables assigned in section
+.I sect
+to standard output.
+.
+.TP
+.BI "\-o" "\fR, " "\-\-set-option=\fR[" sect :\fR] var = value
+Assign
+.I value
+to the variable
+.I var
+in configuration section
+.IR sect ,
+or
+.B @CONFIG
+if no section is specified.
+The value is unexpandable,
+and overrides any similarly named setting
+from the configuration file(s).
+.
+.TP
+.BI "\-p" "\fR, " "\-\-print-variable=\fR[" sect :\fR] var
+Print the raw (unexpanded) result of looking up the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
+.
+.TP
+.BR "\-q" ", " "\-\-quiet"
+Don't print warning messages.
+This option may be repeated:
+each use reduces verbosity by one step,
+counteracting one
+.RB ` \-v '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+.
+.TP
+.BR "\-v" ", " "\-\-verbose"
+Print informational or debugging messages.
+This option may be repeated:
+each use increases verbosity by one step,
+counteracting one
+.RB ` \-q '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+Higher verbosity levels print informational and debugging messages.
+.
+.TP
+.BI "\-w" "\fR, " "\-\-split-variable=\fR[" sect :\fR] var
+Print the result of looking up, expanding, and word-splitting the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
+The words are quoted in shell-style, and separated by spaces.
+.
+.TP
+.BI "\-x" "\fR, " "\-\-expand-variable=\fR[" sect :\fR] var
+Print the result of looking up and expanding the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
+.
+.\"--------------------------------------------------------------------------
+.
+.SH SEE ALSO
+.BR dump-runlisp-image (1),
+.BR query-runlisp-config (1),
+.BR runlisp (1).
+.
+.SH AUTHOR
+Mark Wooding, <mdw@distorted.org.uk>
+.
+.
+.\"----- That's all, folks --------------------------------------------------
--- /dev/null
+/* -*-c-*-
+ *
+ * Explore and debug `runlisp' configration
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "config.h"
+
+#include <assert.h>
+#include <ctype.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "common.h"
+#include "lib.h"
+#include "mdwopt.h"
+
+/*----- Static data -------------------------------------------------------*/
+
+/* Query operations. */
+enum {
+ OP_LISTSEC, /* list all sections */
+ OP_LISTVAR, /* list variables in a section */
+ OP_RAW, /* print a variable's value */
+ OP_SUBST, /* print variable's expansion */
+ OP_SPLIT, /* print word-split variable */
+ OP_LIMIT
+};
+
+/* A node in the list of queued-up operations. */
+struct op {
+ struct op *next; /* link to next op in the list */
+ unsigned code; /* operation code (`OP_...') */
+ const char *arg; /* argument (from command-line) */
+};
+
+static struct op *oplist; /* list of queued-up operations */
+
+static unsigned flags = 0; /* flags for the application */
+#define AF_BOGUS 0x0001u /* invalid command-line syntax */
+#define AF_SETCONF 0x0002u /* explicit configuration */
+
+/*----- Main code ---------------------------------------------------------*/
+
+/* Append a new node to the list of delayed operations, with CODE and ARG.
+ *
+ * The address of the final link (initially, the list head) is in
+ * *TAIL_INOUT: make this point to the new node, and then update it to point
+ * to the link in the new node.
+ */
+static void add_op(struct op ***tail_inout, unsigned code, const char *arg)
+{
+ struct op *op = xmalloc(sizeof(*op));
+ op->code = code; op->arg = arg; **tail_inout = op; *tail_inout = &op->next;
+}
+
+/* Given an ARG of the form `[SECT:]VAR', set *SECT_OUT and *VAR_OUT to the
+ * requested home section and variable. Leave these null if they can't be
+ * found.
+ */
+static void find_var(const char *arg,
+ struct config_section **sect_out,
+ struct config_var **var_out)
+{
+ struct config_section *sect;
+ const char *p;
+
+ p = strchr(arg, ':');
+ if (!p)
+ { sect = toplevel; p = arg; }
+ else
+ { sect = config_find_section_n(&config, 0, arg, p - arg); p++; }
+ *sect_out = sect;
+ if (!sect) *var_out = 0;
+ else *var_out = config_find_var(&config, sect, CF_INHERIT, p);
+}
+
+/* Help and related functions. */
+static void version(FILE *fp)
+ { fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); }
+
+static void usage(FILE *fp)
+{
+ fprintf(fp, "\
+usage: %s [-Lqv] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+ [-l SECT] [-p [SECT:]VAR] [-w [SECT:]VAR] [-x [SECT:]VAR]\n",
+ progname);
+}
+
+static void help(FILE *fp)
+{
+ version(fp); fputc('\n', fp); usage(fp);
+ fputs("\n\
+Help options:\n\
+ -h, --help Show this help text and exit successfully.\n\
+ -V, --version Show version number and exit successfully.\n\
+\n\
+Diagnostics:\n\
+ -q, --quiet Don't print warning messages.\n\
+ -v, --verbose Print informational messages (repeatable).\n\
+\n\
+Configuration:\n\
+ -c, --config-file=CONF Read configuration from CONF (repeatable).\n\
+ -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
+\n\
+Output:\n\
+ -L, --list-sections List all known section names in order.\n\
+ -l, --list-variables=SECTION List all defined variables in SECTION.\n\
+ -p, --print-variable=[SECT:]VAR Print the raw (unexpanded) value of VAR.\n\
+ -w, --split-variable=[SECT:]VAR Expand and word-split VAR and print.\n\
+ -x, --expand-variable=[SECT:]VAR Expand VAR and print the result.\n", fp);
+}
+
+/* Main program. */
+int main(int argc, char *argv[])
+{
+ struct config_section_iter si;
+ struct config_section *sect;
+ struct config_var_iter vi;
+ struct config_var *var;
+ struct op *op, **tail = &oplist;
+ struct dstr d = DSTR_INIT;
+ struct argv av = ARGV_INIT;
+ int i;
+
+ /* Command-line options. */
+ static const struct option opts[] = {
+ { "help", 0, 0, 'h' },
+ { "version", 0, 0, 'V' },
+ { "list-sections", 0, 0, 'L' },
+ { "config-file", OPTF_ARGREQ, 0, 'c' },
+ { "list-variables", OPTF_ARGREQ, 0, 'l' },
+ { "set-option", OPTF_ARGREQ, 0, 'o' },
+ { "print-variable", OPTF_ARGREQ, 0, 'p' },
+ { "quiet", 0, 0, 'q' },
+ { "verbose", 0, 0, 'v' },
+ { "split-variable", OPTF_ARGREQ, 0, 'w' },
+ { "expand-variable", OPTF_ARGREQ, 0, 'x' },
+ { 0, 0, 0, 0 }
+ };
+
+ /* Initial setup. */
+ set_progname(argv[0]);
+ init_config();
+
+ /* Parse the options.
+ *
+ * We must delay the query operations until the configuration is loaded,
+ * but we won't know whether to load the default configuration until we're
+ * sure that that there are no `-c' options. So just stash the queries in
+ * a list until later.
+ */
+ optprog = (/*unconst*/ char *)progname;
+ for (;;) {
+ i = mdwopt(argc - 1, argv + 1, "hVLc:l:o:p:qvw:x:", opts, 0, 0,
+ OPTF_NOPROGNAME);
+ if (i < 0) break;
+ switch (i) {
+ case 'h': help(stdout); exit(0);
+ case 'V': version(stdout); exit(0);
+ case 'L': add_op(&tail, OP_LISTSEC, 0); break;
+ case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break;
+ case 'l': add_op(&tail, OP_LISTVAR, optarg); break;
+ case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break;
+ case 'p': add_op(&tail, OP_RAW, optarg); break;
+ case 'q': if (verbose) verbose--; break;
+ case 'v': verbose++; break;
+ case 'w': add_op(&tail, OP_SPLIT, optarg); break;
+ case 'x': add_op(&tail, OP_SUBST, optarg); break;
+ default: flags |= AF_BOGUS; break;
+ }
+ }
+
+ /* Check that everything worked. */
+ optind++;
+ if (optind < argc) flags |= AF_BOGUS;
+ if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+ *tail = 0; if (!oplist) lose("nothing to do");
+
+ /* Load default configuration if no explicit files were requested. */
+ if (!(flags&AF_SETCONF)) load_default_config();
+
+ /* Work through the operations we stashed earlier. */
+ for (op = oplist; op; op = op->next)
+ switch (op->code) {
+
+ case OP_LISTSEC:
+ printf("sections:\n");
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ printf("\t%s\n", CONFIG_SECTION_NAME(sect));
+ break;
+
+ case OP_LISTVAR:
+ sect = config_find_section(&config, 0, op->arg);
+ if (!sect)
+ printf("section `%s' not found\n", op->arg);
+ else {
+ printf("section `%s' variables:\n", CONFIG_SECTION_NAME(sect));
+ for (config_start_var_iter(&config, sect, &vi);
+ (var = config_next_var(&vi)); )
+ printf("\t%s\n", CONFIG_VAR_NAME(var));
+ }
+ break;
+
+ case OP_RAW:
+ find_var(op->arg, §, &var);
+ if (!var) printf("%s not found\n", op->arg);
+ else printf("%s = %s\n", op->arg, var->val);
+ break;
+
+ case OP_SUBST:
+ find_var(op->arg, §, &var);
+ if (!var)
+ printf("%s not found\n", op->arg);
+ else {
+ dstr_reset(&d); config_subst_var(&config, sect, var, &d);
+ printf("%s = %s\n", op->arg, d.p);
+ }
+ break;
+
+ case OP_SPLIT:
+ find_var(op->arg, §, &var);
+ if (!var)
+ printf("%s not found\n", op->arg);
+ else {
+ argv_reset(&av); config_subst_split_var(&config, sect, var, &av);
+ dstr_reset(&d); argv_string(&d, &av);
+ printf("%s = %s\n", op->arg, d.p);
+ }
+ break;
+
+ default:
+ assert(0);
+ }
+
+ /* All done. */
+ return (0);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+;;; -*-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 `@CONFIG' 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]
+
+;; 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 (#1=#:stream #2=#:char #3=#:arg)
+ (declare (ignore #2# #3#))
+ (values (read-line #1#))))
+
+;; 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 ((#4=#:pkg (find-package "COMMON-LISP-USER")))
+ (with-package-iterator (#5=#:next #4# :internal)
+ (loop (multiple-value-bind (#6=#:anyp #7=#:sym #8=#:how)
+ (#5#)
+ (declare (ignore #8#))
+ (unless #6# (return))
+ (unintern #7# #4#)))))
+
+;; 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.
+inhibit-asdf-upgrade =
+ (funcall (intern "REGISTER-IMMUTABLE-SYSTEM"
+ (find-package "ASDF"))
+ "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})
+
+;; Full pathname to custom image.
+image-path = ${@image-dir}/${image-file}
+
+;; Command to delete image.
+delete-image = rm -f ${image-path}
+
+;;;--------------------------------------------------------------------------
+[sbcl]
+
+command = ${@ENV:SBCL?sbcl}
+image-file = ${@name}+asdf.core
+
+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 "(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 ((#1=#:real-ccl-dir (ccl::ccl-directory)))
+ (defun ccl::ccl-directory ()
+ (let* ((#2=#:dirpath
+ (ccl:getenv \"CCL_DEFAULT_DIRECTORY\")))
+ (if (and #2# (plusp (length (namestring #2#))))
+ (ccl::native-to-directory-pathname #2#)
+ #1#))))
+ (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 -nositeinit -quiet
+ -eval "(progn
+ (setf ext:*require-verbose* nil)
+ ${run-script-prelude})"}
+ -load "${@script}" -eval "(ext:quit)" --
+
+dump-image =
+ ${command} -batch -noinit -nositeinit -quiet
+ -eval "${dump-image-prelude}"
+ -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 ((#9=#: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 #9# :verbose nil :print nil)
+ (error (error)
+ (format *error-output* "~A (unhandled error): ~A~%" #9# error)
+ (ext:quit :status 255))))
+
+run-script =
+ ${command} --batch --noinform --noinit --nosystem
+ --eval "${abcl-startup}"
+ --
+
+;;;----- That's all, folks --------------------------------------------------
--- /dev/null
+.\" -*-nroff-*-
+.\"
+.\" Manual for `runlisp'
+.\"
+.\" (c) 2020 Mark Wooding
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+.\"
+.\" Runlisp is free software: you can redistribute it and/or modify it
+.\" under the terms of the GNU General Public License as published by the
+.\" Free Software Foundation; either version 3 of the License, or (at your
+.\" option) any later version.
+.\"
+.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
+.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+.\" for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+.
+.ie t \{\
+. ds o \(bu
+. if \n(.g \{\
+. fam P
+. ev an-1
+. fam P
+. ev
+. \}
+.\}
+.el \{\
+. ds o o
+.\}
+.
+.de hP
+.IP
+\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
+..
+.
+.\"--------------------------------------------------------------------------
+.TH runlisp 1 "2 August 2020" "Mark Wooding"
+.SH NAME
+runlisp \- run Common Lisp programs as scripts
+.
+.\"--------------------------------------------------------------------------
+.SH SYNOPSIS
+.
+.B runlisp
+.RI [ options ]
+.RB [ \-\- ]
+.I script
+.RI [ arguments
+\&...]
+.br
+.B runlisp
+.RI [ options ]
+.RB [ \-e
+.IR form ]
+.RB [ \-l
+.IR file ]
+.RB [ \-p
+.IR form ]
+.RB [ \-\- ]
+.RI [ arguments
+\&...]
+.PP
+where
+.I options
+is
+.br
+ \&
+.RB [ \-CDEnqv ]
+.RB [ +DEn ]
+.RB [ \-L
+.IB sys , sys , \fR...]
+.RB [ \-c
+.IR conf ]
+.RB [ \-o
+.RI [ sect \c
+.BR : ] \c
+.IB var = \c
+.IR value ]
+.
+.\"--------------------------------------------------------------------------
+.SH DESCRIPTION
+.
+The
+.B runlisp
+program has two main functions.
+.hP 1.
+It can be used in a script's
+.RB ` #! '
+line to run a Common Lisp script.
+.hP 2.
+It can be used in build scripts
+to invoke a Common Lisp system,
+e.g., to build a standalone program.
+.
+.SS "Options"
+Options are read from the command line, as usual,
+but also (by default) from the script's second line,
+following a
+.RB ` @RUNLISP: '
+marker: see
+.B Operation
+below for the details.
+.
+.PP
+The options accepted are as follows.
+.
+.TP
+.BR "\-h" ", " "\-\-help"
+Write a synopsis of
+.BR query-runlisp-config 's
+command-line syntax
+and a description of the command-line options
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-V" ", " "\-\-version"
+Write
+.BR query-runlisp-config 's
+version number
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-D" ", " "\-\-vanilla-image"
+Don't check for a custom Lisp image.
+Usually,
+.B runlisp
+tries to start Lisp systems using a custom image,
+so that they'll start more quickly;
+the
+.RB ` \-D '
+option forces the use of the default `vanilla' image
+provided with the system.
+There's not usually any good reason to prefer the vanilla image,
+except for performance comparisons, or debugging
+.B runlisp
+itself.
+Negate with
+.B +D
+or
+.BR \-\-no-vanilla-image .
+.
+.TP
+.BR "\-E" ", " "\-\-command-line-only"
+Don't read embedded options from the
+second line of the
+.I script
+file.
+Negate with
+.B +E
+or
+.BR \-\-no-command-line-only .
+This has no effect in eval mode.
+which is set at compile time.
+.
+.TP
+.BI "\-L" "\fR, " "\-\-accept-lisp=" sys , sys ,\fR...
+Use one of the named Lisp systems.
+Each
+.I sys
+must name a supported Lisp system;
+the names are separated by a comma
+.RB ` , '
+and/or one or more whitespace characters.
+This option may be given more than once:
+the effect is the same as a single option
+listing all of the systems named, in the same order.
+If a system is named more than once,
+a warning is issued (at verbosity level 1 or higher),
+and all but the first occurrence is ignored.
+.
+.TP
+.BI "\-c" "\fR, " "\-\-config-file=" conf
+Read configuration from
+.IR conf .
+If
+.I conf
+is a directory, then all of the files within
+whose names end with
+.RB ` .conf ',
+are loaded, in ascending lexicographical order;
+otherwise,
+.I conf
+is opened as a file.
+All of the files are expected to as described in
+.BR runlisp.conf (5).
+.
+.TP
+.BI "\-e" "\fR, " "\-\-evaluate-expression=" expr
+Evaluate the expression(s)
+.I expr
+and discard the resulting values.
+This option causes
+.B runlisp
+to execute in
+.I eval
+mode.
+.
+.TP
+.BI "\-l" "\fR, " "\-\-load-file=" file
+Read and evaluate forms from the
+.IR file .
+This option causes
+.B runlisp
+to execute in
+.I eval
+mode.
+.
+.TP
+.BR "\-n" ", " "-\-dry-run"
+Don't actually start the Lisp environment.
+This may be helpful for the curious,
+in conjunction with
+.RB ` \-v '
+to increase the verbosity.
+Negate with
+.B +n
+or
+.BR "\-\-no-dry-run" .
+.
+.TP
+.BI "\-p" "\fR, " "\-\-print-expressin=" expr
+Evaluate the expression(s)
+.I expr
+and print the resulting value(s)
+to standard output
+(as if by
+.BR prin1 ).
+If a form produces multiple values,
+they are printed on a single line,
+separated by a single space character;
+if a form produces no values at all,
+then nothing is printed \(en not even a newline character.
+This option causes
+.B runlisp
+to execute in
+.I eval
+mode.
+.
+.TP
+.BR "\-q" ", " "\-\-quiet"
+Don't print warning messages.
+This option may be repeated:
+each use reduces verbosity by one step,
+counteracting one
+.RB ` \-v '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+.
+.TP
+.BR "\-v" ", " "\-\-verbose"
+Print informational or debugging messages.
+This option may be repeated:
+each use increases verbosity by one step,
+counteracting one
+.RB ` \-q '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+Higher verbosity levels print informational and debugging messages.
+.
+.PP
+The
+.RB ` \-e ',
+.RB ` \-l ',
+and
+.RB ` \-p '
+options may only be given on the command-line itself,
+not following a
+.RB `@ RUNLISP: '
+marker in a script.
+These options may be given multiple times:
+they will be processed in the order given.
+If any of these options is given, then no
+.I script
+name will be parsed;
+instead, use
+.RB ` \-l '
+to load code from files.
+The
+.IR arguments ,
+ppif any,
+are still made available to the evaluated forms and loaded files.
+.
+.SS "Operation"
+The
+.B runlisp
+program behaves as follows.
+.
+.hP 1.
+The first thing it does is parse its command line.
+Options must precede positional arguments,
+though the boundary may be marked explicitly using
+.RB ` \-\- '
+if desired.
+If the command line contains any of
+.RB ` \-e ',
+.RB ` \-l ',
+or
+.RB ` \-p ',
+then
+.B runlisp
+treats all of its positional arguments as
+.I arguments
+to provide to the given forms and files,
+and runs in
+.I eval
+mode;
+otherwise, the first positional argument becomes the
+.I script
+name, the remaining ones become
+.IR arguments ,
+and
+.B runlisp
+runs in
+.I script
+mode.
+.hP 2.
+In
+.I script
+mode,
+.B runlisp
+reads the second line of the script file,
+and checks to see if it contains the string
+.RB ` @RUNLISP: '.
+If so, then the following text is parsed
+for
+.IR "embedded options" ,
+as follows.
+.RS
+.PP
+The text is split into words
+separated by sequences of whitespace characters.
+Whitespace,
+and other special characters,
+can be included in a word by
+.I quoting
+or
+.IR escaping .
+Text between single quotes
+.BR ' ... '
+is included literally, without any further interpretation;
+text between double quotes
+.BR """" ... """"
+is treated literally,
+except that escaping can still be used
+to escape (e.g.) double quotes and the escape character itself.
+Outside of single quotes, a backslash
+.RB ` \e '
+causes the following character to be included in a word
+regardless of its usual meaning.
+(None of this allows a newline character
+to be included in a word:
+this is simply not possible.)
+A word which is
+.RB ` \-\- '
+before processing quoting and escaping
+marks the end of embedded options.
+As a concession to Emacs users,
+if the sequence
+.RB ` \-*\- '
+appears at the start of a word
+before processing quoting and escaping,
+then everything up to and including the next occurrence of
+.RB ` \-*\- '
+is ignored.
+.PP
+The resulting list of words
+is processed as if it held further command-line options.
+Currently, only
+.RB ` \-D '
+and
+.RB ` \-L '
+options are permitted in embedded option lists:
+.RB ` \-h '
+and
+.RB ` \-v '
+are clearly only useful in interactive use;
+setting
+.RB ` \-q '
+or
+.RB ` \-v '
+would just be annoying;
+setting
+.RB ` \-c '
+or
+.RB ` \-o '
+would override the user's command-line settings;
+it's clearly too late to set
+.RB ` \-E ';
+and
+.B runlisp
+is now committed to
+.I script
+mode, so it's too late for
+.RB ` \-e ',
+.RB ` \-l ',
+and
+.RB ` \-p '
+too.
+.PP
+(This feature allows scripts to provide options even if they use
+.BR env (1)
+to find
+.B runlisp
+on the
+.BR PATH ,
+or to provide more than one option,
+since many operating systems pass the text following
+the interpreter name on a
+.RB ` #! '
+line as a single argument, without further splitting it at spaces.)
+.RE
+.
+.hP 3.
+If no
+.RB ` \-c '
+options were given,
+then the default configuration files are read:
+the system configuration from
+.B @etcdir@/runlisp.conf
+and
+.BR @etcdir@/runlisp.d/*.conf ,
+and the user configuration from
+.B ~/.runlisp.conf
+and/or
+.BR ~/.config/runlisp.conf :
+see
+.RB runlisp.conf (5)
+for the details.
+.
+.hP 4.
+The list of
+.I "acceptable Lisp implementations"
+is determined.
+If any
+.RB ` \-L '
+options have been found,
+then the list of acceptable implementations
+consists of all of the implementations mentioned in
+.RB ` -L '
+options
+in any of the places
+.B runlisp
+looked for options,
+in the order of their first occurrence.
+(If an implementation is named more than once,
+then
+.B runlisp
+prints a warning to stderr
+and ignores all but the first occurrence.)
+If no
+.RB ` \-L '
+option is given, then
+.B runlisp
+uses a default list,
+which consists of all of the Lisp implementations
+defined in its configuration,
+in the order in which they were defined.
+.
+.hP 5.
+The list of
+.I "preferred Lisp implementations"
+is determined.
+If the environment variable
+.B RUNLISP_PREFER
+is set,
+then its value should be a list of names of Lisp implementations
+separated by a comma and/or one or more whitespace characters.
+Otherwise, if there is a setting for the variable
+.B prefer
+in the
+.B @CONFIG
+configuration section,
+then its (expanded) value should be a list of Lisp implementations,
+in the same way.
+Otherwise, the list of preferred implementations is empty.
+.
+.hP 6.
+If
+.B runlisp
+is running in
+.I eval
+mode, then a new command line is built,
+which invokes an internal script,
+instructing it to evaluate and print the requested expressions,
+and load the requested files.
+.
+.hP 7.
+Acceptable Lisp implementations are tried in turn.
+First, the preferred implementations
+which are also listed as acceptable implementations
+are tried, in the order in which they appear
+in the preferred implementations list;
+then, the remaining acceptable implementations are tried
+in the order in which they appear
+in the acceptable implementations list.
+.RS
+.PP
+A Lisp implementation is defined by a configuration section
+which defines a variable
+.BR run-script .
+The name of the configuration section
+is the name of the Lisp implementation,
+as used in the acceptable and preferred lists described above.
+.hP (a)
+The variable
+.B image-file
+is looked up in the configuration section.
+If a value is found, then
+.B runlisp
+looks up and expands
+.BR image-path ,
+and checks to see if a file exists with the resulting name.
+If so, it sets the variable
+.B @image
+to
+.B t
+in the configuration section.
+.hP (b)
+The variable
+.B run-script
+is expanded and word-split.
+The
+.I script
+(an internal script, in
+.I eval
+mode)
+and
+.IR argument s
+are appended, and
+the entire list is passed to the
+.BR execvp (3)
+function.
+If that succeeds, the Lisp implementation runs;
+if it fails with
+.B ENOENT
+then other Lisp systems are tried;
+if it fails with some other error, then
+.B runlisp
+reports an error message to stderr
+and exits unsuccessfully
+(with code 127).
+If the
+.RB ` \-n '
+option was given, then
+.B runlisp
+just simulates the behaviour of
+.BR execvp (3),
+printing messages to stderr
+if the verbosity level is sufficiently high,
+and exits.
+.
+.SS "Script environment"
+Many Lisp implementations don't provide a satisfactory environment
+for scripts to run in.
+The actual task of invoking a Lisp implementation
+is left to configuration,
+but the basic configuration supplied with
+.B runlisp
+ensures the following facts about their environment.
+.hP \*o
+The keyword
+.B :runlisp-script
+is added to the
+.B *features*
+list if
+.B runlisp
+is running in
+.I script
+mode.
+.hP \*o
+Most Lisp systems support a user initialization file
+which they load before entering the REPL;
+some also have a system initialization file.
+The
+.B runlisp
+program arranges
+.I not
+to read these files,
+so that the Lisp environment is reasonably predictable,
+and to avoid slowing down script startup
+with things which are convenient for use in an interactive session,
+but can't be relied upon by a script anyway.
+.hP \*o
+The Unix standard input, standard output, and standard error files
+are available through the Lisp
+.BR *standard-input* ,
+.BR *standard-output* ,
+and
+.BR *error-output*
+streams, respectively.
+.hP \*o
+Both
+.B *compile-verbose*
+and
+.B *load-verbose*
+are set to nil.
+On CMU\ CL,
+.B ext:*require-verbose*
+is also nil.
+Alas, this is insufficient to muffle noise while loading add-on systems
+on some implementations.
+.hP \*o
+If an error is signalled, and not caught by user code,
+then the process will print a message to stderr
+and exit with a nonzero status.
+The reported message may be a long, ugly backtrace,
+or a terse error report.
+If no error is signalled but not caught,
+then the process will exit with status 0.
+.hP \*o
+The initial package is
+.BR COMMON-LISP-USER ,
+which has no symbols `present' (i.e., imported or interned).
+.hP \*o
+The
+.B asdf
+and
+.B uiop
+systems are already loaded.
+Further systems can be loaded using
+.B asdf:load-system
+as usual.
+The script name
+(which is only meaningful if
+.B runlisp
+is in
+.I script
+mode, obviously)
+and arguments are available through the
+.B uiop:argv0
+function and
+.B uiop:*command-line-arguments*
+variable, respectively.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH BUGS
+.hP \*o
+Loading ASDF systems is irritatingly noisy
+with some Lisp implementations.
+Suggestions for how to improve this are welcome.
+.hP \*o
+More Lisp implementations should be supported.
+I've supported the ones I have installed.
+I'm not willing to put a great deal of effort into supporting
+non-free Lisp implementations;
+but help supporting free Lisps is much appreciated.
+.hP \*o
+The protocol for passing the script name through to
+.B uiop
+(specifically, through the
+.B __CL_ARGV0
+environment variable)
+is terribly fragile,
+but supporting
+.B uiop
+is obviously a better approach than introducing a
+.BR runlisp -specific
+interface to the same information.
+I don't know how to fix this:
+suggestions are welcome.
+.
+.SH SEE ALSO
+.BR dump-runlisp-image (1),
+.BR query-runlisp-config (1),
+.BR runlisp.conf (5).
+.
+.SH AUTHOR
+Mark Wooding, <mdw@distorted.org.uk>
+.
+.\"----- That's all, folks --------------------------------------------------
--- /dev/null
+/* -*-c-*-
+ *
+ * Invoke Lisp scripts and implementations
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include "config.h"
+
+#include <ctype.h>
+#include <errno.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "common.h"
+#include "lib.h"
+#include "mdwopt.h"
+
+/*----- Static data -------------------------------------------------------*/
+
+/* The state we need for a Lisp system. */
+struct lispsys {
+ struct treap_node _node; /* treap intrusion */
+ struct lispsys *next_lisp, /* link in all-Lisps list */
+ *next_accept, /* link acceptable-Lisps list */
+ *next_prefer, /* link in preferred-Lisps list */
+ *next_order; /* link in overall-order list */
+ unsigned f; /* flags */
+#define LF_KNOWN 1u /* this is actually a Lisp */
+#define LF_ACCEPT 2u /* this is an acceptable Lisp */
+#define LF_PREFER 4u /* this is a preferred Lisp */
+ struct config_section *sect; /* configuration section */
+ struct config_var *var; /* `run-script variable */
+};
+#define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp)
+#define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp)
+
+/* Pick out a link from a `struct lispsys' object given its offset. */
+#define LISP_LINK(lisp, linkoff) \
+ ((struct lispsys **)((unsigned char *)(lisp) + (linkoff)))
+
+/* A list of Lisp systems. */
+struct lispsys_list {
+ struct lispsys *head, **tail; /* list head and tail */
+};
+
+static struct argv argv_tail = ARGV_INIT; /* accumulates eval-mode args */
+struct treap lispsys = TREAP_INIT; /* track duplicate Lisp systems */
+static struct lispsys_list /* lists of Lisp systems */
+ lisps = { 0, &lisps.head }, /* all known */
+ accept = { 0, &accept.head }, /* acceptable */
+ prefer = { 0, &prefer.head }; /* preferred */
+
+static unsigned flags = 0; /* flags for the application */
+#define AF_CMDLINE 0x0000u /* options are from command-line */
+#define AF_EMBED 0x0001u /* reading embedded options */
+#define AF_STATEMASK 0x000fu /* mask of option origin codes */
+#define AF_BOGUS 0x0010u /* invalid command-line syntax */
+#define AF_SETCONF 0x0020u /* explicit configuration */
+#define AF_NOEMBED 0x0040u /* don't read embedded options */
+#define AF_DRYRUN 0x0080u /* don't actually do it */
+#define AF_VANILLA 0x0100u /* don't use custom images */
+
+/*----- Main code ---------------------------------------------------------*/
+
+/* Return the `struct lispsys' entry for the given N-byte NAME. */
+static struct lispsys *ensure_lispsys(const char *name, size_t n)
+{
+ struct lispsys *lisp;
+ struct treap_path path;
+
+ lisp = treap_probe(&lispsys, name, n, &path);
+ if (!lisp) {
+ lisp = xmalloc(sizeof(*lisp));
+ lisp->f = 0; lisp->sect = 0;
+ treap_insert(&lispsys, &path, &lisp->_node, name, n);
+ }
+ return (lisp);
+}
+
+/* Add Lisp systems from the comma- or space-sparated list P to LIST.
+ *
+ * WHAT is an adjective describing the list flavour; FLAG is a bit to set in
+ * the node's flags word; LINKOFF is the offset of the list's link member.
+ */
+static void add_lispsys(const char *p, const char *what,
+ struct lispsys_list *list,
+ unsigned flag, size_t linkoff)
+{
+ struct lispsys *lisp, **link;
+ const char *q;
+
+ if (!*p) return;
+ for (;;) {
+ while (ISSPACE(*p)) p++;
+ if (!*p) break;
+ q = p; while (*p && !ISSPACE(*p) && *p != ',') p++;
+ lisp = ensure_lispsys(q, p - q);
+ if (lisp->f&flag) {
+ if (verbose >= 1)
+ moan("ignoring duplicate %s Lisp `%.*s'", what, (int)(p - q), q);
+ } else {
+ link = LISP_LINK(lisp, linkoff);
+ lisp->f |= flag; *link = 0;
+ *list->tail = lisp; list->tail = link;
+ }
+ while (ISSPACE(*p)) p++;
+ if (!*p) break;
+ if (*p == ',') p++;
+ }
+}
+
+/* Check that the Lisp systems on LIST (linked through LINKOFF) are real.
+ *
+ * That is, `LF_KNOWN' is set in their flags.
+ */
+static void check_lisps(const char *what,
+ struct lispsys_list *list, size_t linkoff)
+{
+ struct lispsys *lisp;
+
+ for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff))
+ if (!(lisp->f&LF_KNOWN))
+ lose("unknown Lisp implementation `%s'", LISPSYS_NAME(lisp));
+}
+
+/* Dump the names of the Lisp systems on LIST (linked through LINKOFF).
+ *
+ * WHAT is an adjective describing the list.
+ */
+static void dump_lisps(const char *what,
+ struct lispsys_list *list, size_t linkoff)
+{
+ struct dstr d = DSTR_INIT;
+ struct lispsys *lisp;
+ int first;
+
+ first = 1;
+ for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) {
+ if (first) first = 0;
+ else dstr_puts(&d, ", ");
+ dstr_puts(&d, LISPSYS_NAME(lisp));
+ }
+ if (first) dstr_puts(&d, "(none)");
+ dstr_putz(&d);
+ moan("%s: %s", what, d.p);
+ dstr_release(&d);
+}
+
+/* Add an eval-mode operation to the `argv_tail' vector.
+ *
+ * OP is the operation character (see `eval.lisp' for these) and `val' is the
+ * argument (filename or expression).
+ */
+static void push_eval_op(char op, const char *val)
+{
+ char *p;
+ size_t n;
+
+ if ((flags&AF_STATEMASK) != AF_CMDLINE) {
+ moan("must use `-e', `-p', or `-l' on command line");
+ flags |= AF_BOGUS;
+ return;
+ }
+
+ n = strlen(val) + 1;
+ p = xmalloc(n + 1);
+ p[0] = op; memcpy(p + 1, val, n);
+ argv_append(&argv_tail, p);
+}
+
+/* Help and related functions. */
+static void version(FILE *fp)
+ { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
+
+static void usage(FILE *fp)
+{
+ fprintf(fp, "\
+usage:\n\
+ %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\
+ %s [OPTIONS] [-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n\
+OPTIONS:\n\
+ [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n",
+ progname, progname);
+}
+
+static void help(FILE *fp)
+{
+ version(fp); fputc('\n', fp); usage(fp);
+ fputs("\n\
+Help options:\n\
+ -h, --help Show this help text and exit successfully.\n\
+ -V, --version Show version number and exit successfully.\n\
+\n\
+Diagnostics:\n\
+ -n, --dry-run Don't run run anything (useful with `-v').\n\
+ -q, --quiet Don't print warning messages.\n\
+ -v, --verbose Print informational messages (repeatable).\n\
+\n\
+Configuration:\n\
+ -E, --command-line-only Don't read embedded options from script.\n\
+ -c, --config-file=CONF Read configuration from CONF (repeatable).\n\
+ -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
+\n\
+Lisp implementation selection:\n\
+ -D, --vanilla-image Run vanilla Lisp images, not custom ones.\n\
+ -L, --accept-lisp=SYS,SYS,... Only use the listed Lisp systems.\n\
+\n\
+Evaluation mode:\n\
+ -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\
+ -l, --load-file=FILE Load FILE (repeatable).\n\
+ -p, --print-expression=EXPR Print (`prin1') EXPR (repeatable).\n",
+ fp);
+}
+
+/* Complain about options which aren't permitted as embedded options. */
+static void check_command_line(int ch)
+{
+ if ((flags&AF_STATEMASK) != AF_CMDLINE) {
+ moan("`%c%c' is not permitted as embedded option",
+ ch&OPTF_NEGATED ? '+' : '-',
+ ch&~OPTF_NEGATED);
+ flags |= AF_BOGUS;
+ }
+}
+
+/* Parse the options in the argument vector. */
+static void parse_options(int argc, char *argv[])
+{
+ int i;
+
+ static const struct option opts[] = {
+ { "help", 0, 0, 'h' },
+ { "version", 0, 0, 'V' },
+ { "vanilla-image", OPTF_NEGATE, 0, 'D' },
+ { "command-line-only", OPTF_NEGATE, 0, 'E' },
+ { "accept-lisp", OPTF_ARGREQ, 0, 'L' },
+ { "config-file", OPTF_ARGREQ, 0, 'c' },
+ { "evaluate-expression", OPTF_ARGREQ, 0, 'e' },
+ { "load-file", OPTF_ARGREQ, 0, 'l' },
+ { "dry-run", OPTF_NEGATE, 0, 'n' },
+ { "set-option", OPTF_ARGREQ, 0, 'o' },
+ { "print-expression", OPTF_ARGREQ, 0, 'p' },
+ { "quiet", 0, 0, 'q' },
+ { "verbose", 0, 0, 'v' },
+ { 0, 0, 0, 0 }
+ };
+
+#define FLAGOPT(ch, f, extra) \
+ case ch: \
+ extra \
+ flags |= f; \
+ break; \
+ case ch | OPTF_NEGATED: \
+ extra \
+ flags &= ~f; \
+ break
+#define CMDL do { check_command_line(i); } while (0)
+
+ optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname;
+ for (;;) {
+ i = mdwopt(argc, argv, "+hVD+E+L:c:e:l:n+o:p:qv", opts, 0, 0,
+ OPTF_NEGATION | OPTF_NOPROGNAME);
+ if (i < 0) break;
+ switch (i) {
+ case 'h': CMDL; help(stdout); exit(0);
+ case 'V': CMDL; version(stdout); exit(0);
+ FLAGOPT('D', AF_VANILLA, ; );
+ FLAGOPT('E', AF_NOEMBED, { CMDL; });
+ case 'L':
+ add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT,
+ offsetof(struct lispsys, next_accept));
+ break;
+ case 'c': CMDL; read_config_path(optarg, 0); flags |= AF_SETCONF; break;
+ case 'e': CMDL; push_eval_op('!', optarg); break;
+ case 'l': CMDL; push_eval_op('<', optarg); break;
+ FLAGOPT('n', AF_DRYRUN, { CMDL; });
+ case 'o': CMDL; if (set_config_var(optarg)) flags |= AF_BOGUS; break;
+ case 'p': CMDL; push_eval_op('?', optarg); break;
+ case 'q': CMDL; if (verbose) verbose--; break;
+ case 'v': CMDL; verbose++; break;
+ default: flags |= AF_BOGUS; break;
+ }
+ }
+}
+
+/* Extract and process the embedded options from a SCRIPT. */
+static void handle_embedded_args(const char *script)
+{
+ struct dstr d = DSTR_INIT;
+ struct argv av = ARGV_INIT;
+ char *p, *q, *r; const char *l;
+ size_t n;
+ int qstate = 0;
+ FILE *fp = 0;
+
+ /* Open the script. If this doesn't work, then we have no hope. */
+ fp = fopen(script, "r");
+ if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
+
+ /* Read the second line. */
+ if (dstr_readline(&d, fp)) goto end;
+ dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
+
+ /* Check to find the magic marker. */
+ p = strstr(d.p, "@RUNLISP:"); if (!p) goto end;
+ p += 9; q = p; l = d.p + d.len;
+
+ /* Split the line into words.
+ *
+ * Do this by hand because we have strange things to support, such as Emacs
+ * turds and the early `--' exit.
+ *
+ * We work in place: `p' is the input cursor and advances through the
+ * string as we parse, until it meets the limit pointer `l'; `q' is the
+ * output cursor which will always be no further forward than `p'.
+ */
+ for (;;) {
+ /* Iterate over the words. */
+
+ /* Skip spaces. */
+ while (p < l && ISSPACE(*p)) p++;
+
+ /* If we've reached the end then we're done. */
+ if (p >= l) break;
+
+ /* Check for an Emacs local-variables `-*-' turd.
+ *
+ * If we find one, find the matching end marker and move past it.
+ */
+ if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') {
+ p = strstr(p + 3, "-*-");
+ if (!p || p + 3 > l)
+ lose("%s:2: unfinished local-variables list", script);
+ p += 3;
+ continue;
+ }
+
+ /* If we find a `--' marker then stop immediately. */
+ if (l - p >= 2 && p[0] == '-' && p[1] == '-' &&
+ (l == p + 2 || ISSPACE(p[2])))
+ break;
+
+ /* Push the output cursor position onto the output, because this is where
+ * the next word will start.
+ */
+ argv_append(&av, q);
+
+ /* Collect characters until we find an unquoted space. */
+ while (p < l && (qstate || !ISSPACE(*p))) {
+
+ if (*p == '"')
+ /* A quote. Skip past, and toggle quotedness. */
+
+ { p++; qstate = !qstate; }
+
+ else if (*p == '\\') {
+ /* A backslash. Just emit the following character. */
+
+ p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script);
+ *q++ = *p++;
+
+ } else if (*p == '\'') {
+ /* A single quote. Find its matching end quote, and emit everything
+ * in between.
+ */
+
+ p++; r = strchr(p, '\'');
+ if (!r || r > l) lose("%s:2: missing `''", script);
+ n = r - p; memmove(q, p, n); q += n; p = r + 1;
+
+ } else {
+ /* An ordinary constituent. Gather a bunch of these up and emit them
+ * all.
+ */
+ n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v");
+ if (n > l - p) n = l - p;
+ memmove(q, p, n); q += n; p += n;
+ }
+ }
+
+ /* Check that we're not still inside quotes. */
+ if (qstate) lose("%s:2: missing `\"'", script);
+
+ /* Finish off this word and prepare to start the next. */
+ *q++ = 0; if (p < l) p++;
+ }
+
+ /* Parse the arguments we've collected as options. Object if we find
+ * positional arguments.
+ */
+ flags = (flags&~AF_STATEMASK) | AF_EMBED;
+ parse_options(av.n, (char * /*unconst*/*)av.v);
+ if (optind < av.n)
+ lose("%s:2: positional argument `%s' not permitted here",
+ script, av.v[optind]);
+
+end:
+ /* Tidy up. */
+ if (fp) {
+ if (ferror(fp))
+ lose("error reading script `%s': %s", script, strerror(errno));
+ fclose(fp);
+ }
+ dstr_release(&d); argv_release(&av);
+}
+
+/* Main program. */
+int main(int argc, char *argv[])
+{
+ struct config_section_iter si;
+ struct config_section *sect;
+ struct config_var *var;
+ struct lispsys_list order;
+ struct lispsys *lisp, **tail;
+ const char *p;
+ const char *script;
+ struct dstr d = DSTR_INIT;
+ struct argv av = ARGV_INIT;
+
+ /* initial setup. */
+ set_progname(argv[0]);
+ init_config();
+
+ /* Parse the command-line options. */
+ flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
+ parse_options(argc - 1, argv + 1); optind++;
+
+ /* We now know enough to decide whether we're in eval or script mode. In
+ * the former case, don't check for embedded options (it won't work because
+ * we don't know where the `eval.lisp' script is yet, and besides, there
+ * aren't any). In the latter case, pick out the script name, leaving the
+ * remaining positional arguments for later.
+ */
+ if (argv_tail.n) { flags |= AF_NOEMBED; script = 0; }
+ else if (optind < argc) script = argv[optind++];
+ else flags |= AF_BOGUS;
+
+ /* Check that everything worked. */
+ if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+
+ /* Reestablish ARGC/ARGV to refer to the tail of positional arguments to be
+ * passed onto the eventual script. For eval mode, that includes the
+ * operations already queued up, so we'll have to accumulate everything in
+ * `argv_tail'.
+ */
+ argc -= optind; argv += optind;
+ if (argv_tail.n) {
+ argv_append(&argv_tail, "--");
+ argv_appendn(&argv_tail, argv, argc);
+ argc = argv_tail.n; argv = argv_tail.v;
+ }
+
+ /* Fetch embedded options. */
+ if (!(flags&AF_NOEMBED)) handle_embedded_args(script);
+
+ /* Load default configuration if no explicit files were requested. */
+ if (!(flags&AF_SETCONF)) load_default_config();
+
+ /* Determine the preferred Lisp systems. Check the environment first;
+ * otherwise use the configuration file.
+ */
+ p = my_getenv("RUNLISP_PREFER", 0);
+ if (!p) {
+ var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
+ if (var) {
+ dstr_reset(&d);
+ config_subst_var(&config, toplevel, var, &d); p = d.p;
+ }
+ }
+ if (p)
+ add_lispsys(p, "preferred", &prefer, LF_PREFER,
+ offsetof(struct lispsys, next_prefer));
+
+ /* If we're in eval mode, then find the `eval.lisp' script. */
+ if (!script)
+ script = config_subst_string_alloc(&config, common, "<internal>",
+ "${@ENV:RUNLISP_EVAL?"
+ "${@CONFIG:eval-script?"
+ "${@data-dir}/eval.lisp}}");
+
+ /* We now have the script name, so publish it for `uiop'.
+ *
+ * As an aside, this is a terrible interface. It's too easy to forget to
+ * set it. (To illustrate this, `cl-launch -x' indeed forgets to set it.)
+ * If you're lucky, the script just thinks that its argument is `nil', in
+ * which case maybe it can use `*load-pathname*' as a fallback. If you're
+ * unlucky, your script was invoked (possibly indirectly) by another
+ * script, and now you've accidentally inherited the calling script's name.
+ *
+ * It would have been far better simply to repeat the script name as the
+ * first user argument, if nothing else had come readily to mind.
+ */
+ if (setenv("__CL_ARGV0", script, 1))
+ lose("failed to set script-name environment variable");
+
+ /* And publish it in the configuration for the `run-script' commands. */
+ config_set_var(&config, builtin, CF_LITERAL, "@script", script);
+
+ /* Dump the final configuration if we're being very verbose. */
+ if (verbose >= 5) dump_config();
+
+ /* Identify the configuration sections which correspond to actual Lisp
+ * system definitions, and gather them into the `known' list.
+ */
+ tail = lisps.tail;
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); ) {
+ var = config_find_var(&config, sect, CF_INHERIT, "run-script");
+ if (!var) continue;
+ lisp = ensure_lispsys(CONFIG_SECTION_NAME(sect),
+ CONFIG_SECTION_NAMELEN(sect));
+ lisp->f |= LF_KNOWN; lisp->sect = sect; lisp->var = var;
+ *tail = lisp; tail = &lisp->next_lisp;
+ }
+ *tail = 0; lisps.tail = tail;
+
+ /* Make sure that the acceptable and preferred Lisps actually exist. */
+ check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept));
+ check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer));
+
+ /* If there are no acceptable Lisps, then we'll take all of them. */
+ if (!accept.head) {
+ if (verbose >= 2)
+ moan("no explicitly acceptable implementations: allowing all");
+ tail = accept.tail;
+ for (lisp = lisps.head; lisp; lisp = lisp->next_lisp)
+ { lisp->f |= LF_ACCEPT; *tail = lisp; tail = &lisp->next_accept; }
+ *tail = 0; accept.tail = tail;
+ }
+
+ /* Build the final list of Lisp systems in the order in which we'll try
+ * them: first, preferred Lisps which are acceptable, and then acceptable
+ * Lisps which aren't preferred.
+ */
+ tail = &order.head;
+ for (lisp = prefer.head; lisp; lisp = lisp->next_prefer)
+ if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; }
+ for (lisp = accept.head; lisp; lisp = lisp->next_accept)
+ if (!(lisp->f&LF_PREFER)) { *tail = lisp; tail = &lisp->next_order; }
+ *tail = 0;
+
+ /* Maybe dump out the various lists of Lisp systems we've collected. */
+ if (verbose >= 4)
+ dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp));
+ if (verbose >= 3) {
+ dump_lisps("acceptable Lisps", &accept,
+ offsetof(struct lispsys, next_accept));
+ dump_lisps("preferred Lisps", &prefer,
+ offsetof(struct lispsys, next_prefer));
+ dump_lisps("overall preference order", &order,
+ offsetof(struct lispsys, next_order));
+ }
+
+ /* Try to actually run the script. */
+ for (lisp = order.head; lisp; lisp = lisp->next_order) {
+ /* Try each of the selected systems in turn. */
+
+ /* See whether there's a custom image file. If so, set `@image' in the
+ * system's configuration section.
+ */
+ if (!(flags&AF_VANILLA) &&
+ config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
+ var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path");
+ if (!var)
+ lose("variable `image-path' not defined for Lisp `%s'",
+ LISPSYS_NAME(lisp));
+ dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d);
+ if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0))
+ config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t");
+ }
+
+ /* Build the command line from `run-script'. */
+ argv_reset(&av);
+ config_subst_split_var(&config, lisp->sect, lisp->var, &av);
+ if (!av.n) {
+ moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp));
+ continue;
+ }
+
+ /* Append our additional positional arguments. */
+ argv_appendn(&av, argv, argc);
+
+ /* Try to run the Lisp system. */
+ if (!try_exec(&av,
+ (flags&AF_DRYRUN ? TEF_DRYRUN : 0) |
+ (verbose >= 2 ? TEF_VERBOSE : 0)))
+ return (0);
+ }
+
+ /* No. Much errors. So failure. Very sadness. */
+ lose("no acceptable Lisp systems found");
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+;;; -*-conf-windows-*-
+
+;;;--------------------------------------------------------------------------
+;;; Top-level configuration.
+
+;; Lisp implementations for which custom images should be dumped by
+;; `dump-runlisp-image -a'. Defaults to all installed Lisp implementations.
+; dump = sbcl, cmucl, ccl, clisp
+
+;; Lisp implementations to use by preference. Defaults to the order read
+;; from the configuration file. Overridden by `$RUNLISP_PREFER' in
+;; environment.
+; prefer = sbcl, ccl, clisp, ecl, cmucl, sbcl
+
+;; Directory to look for or dump custom images. Defaults to hardcoded
+;; directory; overridden by `$RUNLISP_IMAGEDIR' in environment.
+; image-dir = /path/to/things
+
+;; Directory to look for additional scripts. Defaults to hardcoded
+;; directory; overridden by `$RUNLISP_DATADIR' in environment.
+; data-dir = /path/to/things
+
+;; Script to support eval-mode operation. Defaults to
+;; `${data-dir}/eval.lisp'; opverridden by `$RUNLISP_EVAL' in environment.
+; eval-script = /path/to/script
+
+;;;--------------------------------------------------------------------------
--- /dev/null
+.\" -*-nroff-*-
+.\"
+.\" Manual for `runlisp' configuration files
+.\"
+.\" (c) 2020 Mark Wooding
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+.\"
+.\" Runlisp is free software: you can redistribute it and/or modify it
+.\" under the terms of the GNU General Public License as published by the
+.\" Free Software Foundation; either version 3 of the License, or (at your
+.\" option) any later version.
+.\"
+.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
+.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+.\" for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+.
+.ie t \{\
+. ds o \(bu
+. if \n(.g \{\
+. fam P
+. ev an-1
+. fam P
+. ev
+. \}
+.\}
+.el \{\
+. ds o o
+.\}
+.
+.de hP
+.IP
+\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
+..
+.ds , \h'.16667m'
+.
+.\"--------------------------------------------------------------------------
+.TH runlisp.conf 5 "27 August 2020" "Mark Wooding"
+.SH NAME
+runlisp.conf \- configuration files for runlisp
+.
+.\"--------------------------------------------------------------------------
+.SH DESCRIPTION
+.
+.SS "Default configuration files"
+By default, the
+.B runlisp
+programs read configuration from the following files.
+(Note that if a
+.RB ` \-c '
+command-line option is given, then
+these default files are
+.I not
+read.)
+.TP
+.B @etcdir@/runlisp.d/*.conf
+If a directory named
+.B @etcdir@/runlisp.d
+exists,
+then all of the files within
+whose names end in
+.RB ` .conf '
+are read,
+in ascending lexicographical order by name.
+This directory name can be overridden by setting the
+.B RUNLISP_SYSCONFIG_DIR
+environment variable.
+.TP
+.B @etcdir@/runlisp.conf
+The file named
+.B @etcdir@/runlisp.conf
+is read; the file must exist.
+This filename can be overridden by setting the
+.B RUNLISP_SYSCONFIG
+environment variable.
+.TP
+.B ~/.runlisp.conf
+If there is a file named
+.B .runlisp.conf
+in the user's home directory,
+then it is read.
+The home directory is determined to be
+the value of the
+.B HOME
+environment variable, or, if that is not set,
+the home directory associated with the process's real uid
+in the system password database.
+This filename can be overridden by setting the
+.B RUNLISP_USERCONFIG
+environment variable.
+.TP
+.B ~/.config/runlisp.conf
+If there is a file named
+.B runlisp.conf
+in the user's XDG configuration directory,
+then it is read.
+The XDG configuration directory is determined to be the value of the
+.B XDG_CONFIG_HOME
+environment variable, or the
+.B .config
+directory in the user's home directory
+(as determined above).
+This filename can be overridden by setting the
+.B RUNLISP_USERCONFIG
+environment variable.
+(Note, therefore, that this variable overrides
+.I both
+of the user configuration files.)
+.
+.SS "General syntax"
+In summary,
+a configuration file is structured as a collection of assignments
+.I variable
+.B =
+.IR value ,
+gathered into named sections by header lines
+.BI [ section ]\fR.
+.PP
+Comments are indicated by a semicolon
+.RB ` ; '
+in the leftmost column,
+and extend to the end of the line;
+comments and lines consisting only of whiteapace are ignored
+and have no effect whatever.
+Semicolons not in the first column do
+.I not
+introduce comments,
+and have no special meaning.
+.PP
+A
+.I name
+is a non-empty sequence of ASCII alphanumeric characters,
+or the special constituent characters
+.RB ` \- ',
+.RB ` _ ',
+.RB ` . ',
+.RB ` / ',
+.RB ` * ',
+.RB ` + ',
+.RB ` *% ',
+or
+.RB ` @ '.
+For example,
+.RB ` foo ',
+.RB ` 12345 ',
+.RB ` \-2.718 ',
+.RB ` 113/355 ',
+.RB ` image-dir ',
+.RB ` @%IMAGEDIR ',
+and
+.RB ` *organa-solo* '
+are all names, but
+.RB ` foo:bar '
+.RB ` happy? '
+and
+.RB ` $3.95 '
+are not.
+Names beginning with
+.RB ` @ '
+are reserved for use by the
+.B runlisp
+programs;
+names beginning with
+.RB ` % '
+or
+.RB ` @% '
+are by convention private.
+.PP
+A
+.I section header
+is a line of the form
+.IP
+.BI [ section ]
+.PP
+where
+.I section
+is a name, as defined above.
+There may be whitespace before and after the
+.I name
+or after the
+.RB ` ] '.
+Section headers need not have distinct names.
+Subsequent assignments are applied to the section called
+.IR name ,
+up until the next section header, or the end of the file.
+Assignments prior to the first section header in a file
+are applied to the
+.B @CONFIG
+section.
+.PP
+An
+.I assignment
+begins with a line of the form
+.IP
+.I variable
+.B =
+.I rest
+.PP
+where
+.I variable
+is a name, as defined above,
+and it includes all subsequent
+(non-empty, non-comment)
+lines up to, but not including,
+the next line which does
+.I not
+begin with whitespace or a semicolon,
+or the end of the input file.
+There may be space before or after the
+.RB ` = '.
+The
+.I value
+assigned consists of the text of the initial line following the
+.RB ` = '
+character
+(shown as
+.I rest
+above),
+together with the contents of the subsequent lines;
+initial and trailing whitespace is removed from each piece,
+and the (nonempty) pieces are joined,
+separated by single spaces.
+We say that a assignment
+assigns a value to the variable
+in some section \(en
+namely, the section in which the assignment is applied.
+.PP
+For example,
+consider the following file.
+.IP
+.ft B
+.nf
+long =
+ one
+
+ two
+; this line is a comment
+ ; not a comment
+ three
+
+short = just a quick note
+.fi
+.ft P
+.PP
+Then
+.B long
+is assigned the value
+.RB ` "one two ; not a comment three" ',
+and
+.B short is assigned
+.RB ` "just a quick note" '.
+.PP
+The assignments applied to a section
+need not have distinct variable names.
+Only the last assignment to a particular variable name in a section is
+.IR effective ;
+the earlier assignments are simply ignored.
+If an effective assignment assigns a value to a variable in a section,
+we say that the variable is
+.I set
+to that value in the section.
+.
+.SS "Lookup and inheritance"
+A section may have zero or more
+.I parent
+sections.
+.PP
+The
+.B @BUILTIN
+and
+.B @ENV
+sections have no parents.
+The
+.B @CONFIG
+section has one parent, namely
+.BR @BUILTIN .
+.PP
+If the variable
+.B @parents
+is set in a section other than one of those named above,
+then it must consist of a space- or comma-separated list
+of names,
+which name the section's parents.
+Currently, the parents need not be distinct,
+though duplicates have no effect other than slowing down lookup.
+The order in which parents are listed is not significant.
+If
+.B @parents
+is not set in a section other than one of those named above,
+then by default it has one parent, namely
+.BR @COMMON .
+.PP
+It is currently possible to build a cyclic structure of parent links.
+This is not recommended.
+If lookup (explained below) detects a cycle
+then it will report a fatal error,
+but cycles may exist without being detected.
+.PP
+A variable is
+.I "looked up"
+in a section as follows.
+.hP 1.
+If there is an effective assignment
+of a value to that variable in the section
+then lookup finds that assignment.
+.hP 2.
+If the section has no parents,
+then lookup fails.
+.hP 3.
+Otherwise, the variable is looked up in each of the section's parents.
+If none of these lookups succeeds, then the lookup fails.
+If all of the successful lookups found the
+.I "same assignment"
+(not just the same value!)
+then lookup finds that assignment.
+Otherwise, the lookup reports an error.
+.
+.SS "Expansion and word-splitting"
+A value can be
+.I expanded
+relative to some home section,
+and optionally split into words.
+.PP
+Not all values are
+.IR expandable .
+Values set by assignments in a configuration file are always expandable.
+Values set on the command line \(en in
+.B \-o
+options \(en are not expandable.
+Values in the
+.B @ENV
+section from environment variables (see below) are not expandable.
+Some values set in the
+.B @BUILTIN
+section are expandable and some are not.
+Applying expansion to a value that is not expandable
+simply results in that same value, unchanged.
+.PP
+Applying expansion to an expandable value
+produces a result string as follows.
+The value is scanned from start to end.
+.hP \*o
+A backslash
+.RB ` \e '
+is discarded, but the immediately following character
+is copied to the output without further inspection.
+.hP \*o
+A
+.I variable substitution
+takes the form
+.BR ${ [ \c
+.IB sect : \c
+.RI ] var \c
+.RB [ | \c
+.IR filter ]... \c
+.RB [ ? \c
+.IR alt ] \c
+.BR } .
+A variable named
+.I var
+is looked up in the section named
+.IR sect ,
+or, if omitted, in the home section.
+If the lookup succeeds,
+then the value is expanded,
+processed by the
+.IR filter s
+(explained below),
+and appended to the output.
+If the lookup failed,
+and
+.BI ? alt
+is present,
+then
+.I alt
+is expanded and appended to the output.
+Otherwise,
+if the lookup fails and there is no
+.I alt
+text, then an error is reported.
+.IP
+A filter
+.B u
+causes the expanded value to be converted to uppercase;
+similarly,
+.B l
+causes the expanded value to be converted to lowercase.
+A filter
+.B q
+causes a backslash to be inserted before each
+backslash or double-quote character in the expanded value,
+so that this can be used as part of a quoted Common Lisp string.
+.hP \*o
+A
+.I conditional
+takes the form
+.BR $? [ \c
+.IB sect : \c
+.RI ] var \c
+.BI { conseq \c
+.RB [ | \c
+.IR alt ] \c
+.BR } .
+A variable named
+.I var
+is looked up in the section named
+.IR sect ,
+or, if omitted, in the home section.
+If the lookup succeeds, then
+.I conseq
+is expanded and appended to the output;
+otherwise, if
+.I alt
+is present, then it is expanded and appended to the output;
+otherwise, nothing happens.
+.hP \*o
+A dollar sign which doesn't introduce one of the forms above
+is invalid, and a fatal error is reported.
+.hP \*o
+Any other characters are simply appended to the output.
+.PP
+Word-splitting is similar but more complex.
+The result is not a string, but a sequence of strings.
+At any given point in this procedure,
+there may be a partially constructed word,
+or there might not.
+.hP \*o
+Outside of quotes (see below),
+whitespace serves to separate words.
+When a whitespace character is encountered,
+if there is a word under construction,
+then it is finished and added to the output list;
+otherwise it is simply ignored.
+.hP \*o
+If a backslash is encountered,
+then a word is started if there is none currently under construction,
+and the character following the backslash is added to the current word.
+.hP \*o
+If a single-quote character
+.RB ` ' '
+is encountered,
+then a word is started if there is none currently under construction,
+and
+.I all
+characters up to the next single quote
+are added to the current word.
+This includes double quotes, dollar signs, and backslashes.
+(Neither of the two single quotes is appended to the current word.)
+.hP \*o
+If a double-quote character
+.RB ` """" '
+is encountered,
+then a word is started if there is none currently under construction.
+Until the next double quote is encountered,
+whitespace and single quotes treated literally,
+and simply added to the current word;
+backslashes can be used to escape characters,
+such as double quotes,
+as usual.
+.hP \*o
+If a
+.BR $ -expansion
+\(en a variable substitution or conditional (as described above) \(en
+is encountered
+and there is a current word under construction,
+then the result of the
+.BR $ -expansion
+is appended to the current word.
+If there is no current word,
+then the variable value, or consequent or alternative text,
+is subjected to word splitting in addition to expansion,
+and the resulting words appended to the output sequence.
+.hP \*o
+If any other character is encountered,
+then a word is started if there is none currently under construction,
+and the character is appended to the current word.
+.PP
+One case which deserves attention:
+if a
+.BR $ -expansion
+is encountered outside of a word,
+so that the result is subject to word splitting,
+then an error is reported if a new word is started
+without there being whitespace between the closing brace of the
+.B $ -expansion
+and the character which started the new word.
+For example,
+.IP
+.B "bad = one ${x}two"
+.PP
+would be invalid in a word-splitting context.
+.
+.SS "Other special variables"
+In every section, the section's name
+is automatically assigned to the variable
+.BR @name .
+This variable
+.I can
+be overridden by an explicit assignment,
+but this is not recommended.
+.
+.SS "Predefined variables in @BUILTIN"
+The
+.B @BULITIN
+Section has no parents.
+You should not override its settings in configuration files.
+it holds a number of variables set by the
+.B runlisp
+programs.
+.
+.TP
+.B @data-dir
+The directory in which
+.BR runlisp 's
+auxiliary data files and scripts are located.
+This is determined by the
+.B RUNLISP_DATADIR
+environment variable,
+the
+.B data-dir
+variable in the
+.B @CONFIG
+section,
+or a value determined at compile time.
+.
+.TP
+.B @ecl-opt
+The preferred option prefix for ECL, either
+.RB ` \- '
+or
+.RB ` \-\- '.
+(For some reason,
+the ECL developers are changing
+the way ECL recognizes command-line options,
+because they think that the minor aesthetic improvement
+is worth breaking everyone's scripts.)
+This is determined by the
+.B ecl-opt
+variable in the
+.B @CONFIG
+section,
+or a value determined at compile time.
+.
+.TP
+.B @image-dir
+The directory in which
+.B runlisp
+looks for, and
+.B dump-runlisp-image
+stores, custom Lisp images.
+This is determined by the
+.B RUNLISP_IMAGEDIR
+environment variable,
+the
+.B image-dir
+variable in the
+.B @CONFIG
+section,
+or a value determined at compile time.
+.
+.TP
+.B @image-new
+Set by
+.BR dump-runlisp-image (1)
+to the filename that a
+.B dump-image
+command should create.
+.RB ( dump-runlisp-image
+will rename the image into place itself,
+if the command completes successfully.)
+.
+.TP
+.B @image-out
+Set by
+.BR dump-runlisp-image (1)
+to the filename of the intended output image.
+(Don't use this in
+.B dump-image
+commands: use
+.B @image-new
+instread.)
+.
+.TP
+.B @script
+Set by
+.BR runlisp (1)
+to the name of the script being invoked.
+.
+.TP
+.B @tmp-dir
+Set by
+.BR dump-runlisp-image (1)
+to be the name of a directory in which a
+.B dump-image
+command can put temporary files.
+.
+.SS "Environment variables in @ENV"
+The
+.B @ENV
+section is special,
+and is used to hold a copy of the system environment.
+At startup,
+it contains an assignment for every environment variable.
+The
+.B @ENV
+section has no parents.
+The values are not expandable.
+It is possible to override
+.B @ENV
+settings in configuration files
+or on the command line,
+but this is not recommended.
+.
+.SS "The @COMMON section"
+The
+.B @COMMON section
+is the default parent for nearly all other configuration sections
+(the exceptions being
+.B @BUILTIN
+and
+.BR @ENV ,
+which have no parents, and
+.B @COMMON
+itself, whose parent is
+.BR @BUILTIN ).
+It is used in the provided configuration
+to hold various common snippets of Lisp code and other settings,
+but the
+.B runlisp
+programs themselves make no direct use of it.
+.
+.SS "Overall configuration in @CONFIG"
+Variable settings in
+.B @CONFIG
+are consulted for various administrative reasons.
+.PP
+Because of the open-ended nature of this configuration mechanism,
+users can easily invent new configuration variables
+for any purpose they can imagine.
+The following variables are used by the
+.B runlisp
+programs directly, or its default configuration.
+All values are expanded before use;
+the
+.B @CONFIG
+section's parent is
+.BR @COMMON ,
+as usual.
+.
+.TP
+.B data-dir
+The directory in which
+.BR runlisp 's
+auxiliary data files and scripts are located.
+There is a hardcoded default
+determined at compile-time,
+which is probably correct.
+Overridden by the
+.B RUNLISP_DATADIR
+environment variable.
+Don't refer to this setting directly:
+expand
+.B @data-dir
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B dump
+A comma-separated list of Lisp implementation names
+which should have custom images dumped by
+.BR "dump-runlisp-image \-a" .
+The order is not especially significant.
+The default is all of the configured implementations
+which define a
+.B dump-image
+variable
+and whose command can be found.
+.
+.TP
+.B ecl-opt
+The preferred option prefix for ECL, either
+.RB ` \- '
+or
+.RB ` \-\- '.
+There is a hardcoded default
+determined at compile-time,
+which was correct for the system on which
+.B runlisp
+was built.
+Don't refer to this setting directly:
+expand
+.B @ecl-opt
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B @image-dir
+The directory in which
+.B runlisp
+looks for, and
+.B dump-runlisp-image
+stores, custom Lisp images.
+Overridden by the
+.B RUNLISP_IMAGEDIR
+environment variable.
+Don't refer to this setting directly:
+expand
+.B @image-dir
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B prefer
+A comma-separated list of names of
+.I preferred
+Lisp implementations,
+Overridden by the
+.B RUNLISP_PREFER
+environment variable.
+.
+.SS "Lisp implementation definitions"
+A Lisp implementation is described to
+.B runlisp
+by a configuration section.
+The section's name is used to refer to the implementation,
+e.g., in
+.BR runlisp 's
+.B \-L
+option,
+or in the
+.B dump
+and
+.B prefer
+lists described above.
+.PP
+The following variable settings are used directly;
+of course, a Lisp implementation definition may contain other settings
+for internal purposes.
+.
+.TP
+.B command
+The name of the program used to invoke the Lisp implementation.
+.BR dump-runlisp-image
+looks to see whether this program is installed when invoked with the
+.B \-i
+option:
+it will fail if there is no
+.B command
+setting.
+It is also commonly
+(but not universally)
+used in the
+.B run-script
+and
+.B dump-image
+variables.
+It's conventional to set this to
+.B ${@ENV:FOO?foo}
+so that the command name can be overridden from the environment.
+.
+.TP
+.B dump-image
+The complete command to use to dump a custom image
+for this Lisp implementation.
+The value is subjected to expansion and word-splitting before use.
+It should write the newly created image to the file named by the
+.B @image-new
+setting in the
+.B @BUILTIN
+section.
+.
+.TP
+.B image-file
+The basename of the custom image file
+(i.e., not containing any
+.BR ` / '
+characters)
+to use when invoking this Lisp implementation.
+.BR runlisp (1)
+and
+.BR dump-runlisp-image (1)
+use the presence of this setting to decide
+whether the implementation supports custom images.
+.
+.TP
+.B image-path
+The complete (but not necessarily absolute) pathname
+of the custom image file for this Lisp implementation.
+It is the (expanded) value of this variable
+which is used by
+.BR runlisp (1)
+when it checks whether a custom image exists.
+It's set to
+.B ${@image-dir}/${image-file}
+in the standard configuration file's
+.B @COMMON
+section,
+and there is probably no need to override it;
+.B @image-dir
+is set in the
+.B @BUILTIN
+section
+.RB ( @image-dir
+is set in the
+.N @BUILTIN
+section \(en see above \(en and
+.B image-file
+must be set in this section
+(or one of its ancestors)
+before
+.BR runlisp (1)
+would not attempt to check for an image file.
+.
+.TP
+.B run-script
+The complete command to use
+to get this Lisp implementation to execute a script.
+The value is subjected to expansion and word-splitting before use.
+The script name is available as
+.B @script
+in the
+.B @BUILTIN
+section \(en see above.
+If a custom image is available, then
+.B @image
+is defined
+(to the value
+.BR t )
+.I "in this section"
+(not in
+.BR @BUILTIN );
+the full path to the image file to use is given by
+.B ${image-path}
+\(en see above.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH SEE ALSO
+.BR dump-runlisp-image (1),
+.BR query-runlisp-config (1),
+.BR runlisp (1).
+.
+.SH AUTHOR
+Mark Wooding, <mdw@distorted.org.uk>
+.
+.\"----- That's all, folks --------------------------------------------------
--- /dev/null
+/* -*-c-*-
+ *
+ * The SHA256 hash function (compact edition)
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <string.h>
+
+#include "sha256.h"
+
+/*----- Preliminary definitions -------------------------------------------*/
+
+/* The initial values of the state variables. These are in reverse order --
+ * see the note in `compress'.
+ */
+static const u32 iv[8] = {
+ 0x5be0cd19, 0x1f83d9ab, 0x9b05688c, 0x510e527f,
+ 0xa54ff53a, 0x3c6ef372, 0xbb67ae85, 0x6a09e667
+};
+
+/* The round constants. */
+static const u32 rc[64] = {
+ 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5,
+ 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5,
+ 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,
+ 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174,
+ 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc,
+ 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,
+ 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7,
+ 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967,
+ 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13,
+ 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
+ 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3,
+ 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,
+ 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5,
+ 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3,
+ 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,
+ 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
+};
+
+/* Standard bithacking operations on 32-bit words.
+ *
+ * Note that this code assumes that a `u32' is /at least/ 32 bits wide, but
+ * may be longer, so we must do some work to keep cruft in the top bits from
+ * messing things up.
+ */
+#define M32 0xffffffff
+#define LSL32(x, n) ((x) << ((n)))
+#define LSR32(x, n) (((x)&M32) >> ((n)))
+#define ROR32(x, n) (LSL32((x), 32 - (n)) | LSR32((x), (n)))
+
+/* Reading and writing 32-bit words. */
+#define LOAD32_B(p) \
+ (((u32)(((const unsigned char *)(p))[0]&0xff) << 24) | \
+ ((u32)(((const unsigned char *)(p))[1]&0xff) << 16) | \
+ ((u32)(((const unsigned char *)(p))[2]&0xff) << 8) | \
+ ((u32)(((const unsigned char *)(p))[3]&0xff) << 0))
+#define STORE32_B(p, x) do { \
+ (void)sizeof(memmove((p), (p), 1)); \
+ ((unsigned char *)(p))[0] = ((x) >> 24)&0xff; \
+ ((unsigned char *)(p))[1] = ((x) >> 16)&0xff; \
+ ((unsigned char *)(p))[2] = ((x) >> 8)&0xff; \
+ ((unsigned char *)(p))[3] = ((x) >> 0)&0xff; \
+} while (0)
+
+/* SHA256's balanced ternary operators. */
+#define CH(x, y, z) (((x)&(y)) | (~(x)&(z)))
+#define MAJ(x, y, z) (((x)&(y)) | ((y)&(z)) | ((z)&(x)))
+
+/* The SHA256 Σ and σ functions. */
+#define S0(x) (ROR32((x), 2) ^ ROR32((x), 13) ^ ROR32((x), 22))
+#define S1(x) (ROR32((x), 6) ^ ROR32((x), 11) ^ ROR32((x), 25))
+#define s0(x) (ROR32((x), 7) ^ ROR32((x), 18) ^ LSR32((x), 3))
+#define s1(x) (ROR32((x), 17) ^ ROR32((x), 19) ^ LSR32((x), 10))
+
+/*----- Main code ---------------------------------------------------------*/
+
+/* Compress a 64-byte buffer at P, updating the hash state S. */
+static void compress(struct sha256_state *s, const unsigned char *p)
+{
+ u32 t, u, a[8], m[16];
+ const u32 *r = rc;
+ size_t i;
+
+ /* This is a mostly straightforward implementation of the specification, as
+ * a rolled-up loop, one iteration per round. The only wrinkle is that the
+ * vector of state variables, conventionally named a, b, ..., h, are
+ * maintained in our state structure in reverse order, so h is in S->a[0],
+ * b is in S->a[6], and a is in S->a[7]. We do this so that we advance
+ * through our vector in the correct direction from round to round: this
+ * avoids making the indexing arithmetic too complicated.
+ */
+
+ /* Move the state and message data into our internal vectors. */
+ for (i = 0; i < 8; i++) a[i] = s->a[i];
+ for (i = 0; i < 16; i++, p += 4) m[i] = LOAD32_B(p);
+
+ /* Perform 64 rounds of update. Update the message schedule as we go. The
+ * last 16 rounds of message-schedule update are pointless: doing the
+ * message-schedule update conditionally would make the loop messier, and
+ * running the message schedule separately would add a second loop and
+ * require more intermediate storage.
+ */
+ for (i = 0; i < 64; i++) {
+#define A(j) (a[(i + (j))%8])
+#define M(j) (m[(i + (j))%16])
+ t = A(0) + S1(A(3)) + CH(A(3), A(2), A(1)) + M(0) + *r++;
+ u = S0(A(7)) + MAJ(A(7), A(6), A(5));
+ A(4) += t; A(0) = t + u;
+ M(0) += s1(M(14)) + M(9) + s0(M(1));
+#undef A
+#undef M
+ }
+
+ /* Write out the updated state. */
+ for (i = 0; i < 8; i++) s->a[i] += a[i];
+}
+
+/* Initialize the hash state S. */
+void sha256_init(struct sha256_state *s)
+ { size_t i; s->n = s->nblk = 0; for (i = 0; i < 8; i++) s->a[i] = iv[i]; }
+
+/* Append SZ bytes of data starting at M to the hash state S. */
+void sha256_hash(struct sha256_state *s, const void *m, size_t sz)
+{
+ const unsigned char *p = m;
+ size_t r = SHA256_BLKSZ - s->n;
+
+ /* Feed the input data into the hash function. Our buffer-management
+ * policy is to empty the buffer by calling the compression function as
+ * soon as the buffer fills completely.
+ */
+ if (sz < r) {
+ /* The whole input will fit into the buffer, with space to spare. We
+ * just copy it in and update the occupancy counter.
+ */
+
+ memcpy(s->buf + s->n, p, sz);
+ s->n += sz;
+ } else {
+ /* We're going to fill the buffer at least once. */
+
+ /* If the buffer contains any data already then copy the initial portion
+ * of the new input chunk into the buffer and compress it there.
+ * Otherwise, if the buffer is entirely empty, then we can compress the
+ * initial block from the input directly.
+ */
+ if (!s->n) { compress(s, p); p += SHA256_BLKSZ; sz -= SHA256_BLKSZ; }
+ else { memcpy(s->buf + s->n, p, r); compress(s, s->buf); p += r; sz -= r; }
+ s->nblk++;
+
+ /* Continue compressing complete blocks from the input while enough
+ * material remains.
+ */
+ while (sz >= SHA256_BLKSZ)
+ { compress(s, p); s->nblk++; p += SHA256_BLKSZ; sz -= SHA256_BLKSZ; }
+
+ /* Copy the tail end into the buffer and record how much there is. */
+ s->n = sz; if (sz) memcpy(s->buf, p, sz);
+ }
+}
+
+/* Write the final hash of state S to buffer H. */
+void sha256_done(struct sha256_state *s, unsigned char *h)
+{
+ size_t i, n, r;
+ u32 lo, hi;
+
+ /* Add the end-of-data marker to the buffer. There must be at least one
+ * byte spare, or we'd have compressed already.
+ */
+ n = s->n; s->buf[n++] = 0x80; r = SHA256_BLKSZ - n;
+
+ /* If there's enough space for the message length, then fill the gap
+ * between with zeros. Otherwise, fill the whole of the remaining space,
+ * compress, and then refill the initial portion of the buffer. Either
+ * way, after this, there's just eight bytes left at the end of the buffer,
+ * into which we can drop the length.
+ */
+ if (r >= 8)
+ memset(s->buf + n, 0, r - 8);
+ else {
+ if (r) memset(s->buf + n, 0, r);
+ compress(s, s->buf);
+ memset(s->buf, 0, SHA256_BLKSZ - 8);
+ }
+
+ /* Convert the length into two 32-bit halves measuring the total input
+ * length in bits, and run the compression function one last time. There
+ * can be no carry, since S->n is always less than 64.
+ */
+ lo = ((s->nblk << 9) | (s->n << 3))&M32; hi = (s->nblk >> 23)&M32;
+ STORE32_B(s->buf + 56, hi); STORE32_B(s->buf + 60, lo);
+ compress(s, s->buf);
+
+ /* Write out the final hash value. We must compensate here because the
+ * state variables are in reverse order.
+ */
+ for (i = 8; i-- > 0; h += 4) STORE32_B(h, s->a[i]);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+/* -*-c-*-
+ *
+ * The SHA256 hash function
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef SHA256_H
+#define SHA256_H
+
+#ifdef __cplusplus
+ extern "C" {
+#endif
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <limits.h>
+
+/*----- Data types --------------------------------------------------------*/
+
+/* Select a suitable type for 32-bit words. */
+#if UINT_MAX >= 0xffffffff
+ typedef unsigned u32;
+#else
+ typedef unsigned long u32;
+#endif
+
+#define SHA256_BLKSZ 64 /* input block size in bytes */
+#define SHA256_HASHSZ 32 /* output hash size in bytes */
+
+struct sha256_state {
+ unsigned n; /* number of live bytes in buffer */
+ size_t nblk; /* number of blocks hashed so far */
+ u32 a[8]; /* hash state */
+ unsigned char buf[SHA256_BLKSZ]; /* input buffer */
+};
+
+/*----- Functions provided ------------------------------------------------*/
+
+extern void sha256_init(struct sha256_state */**/);
+ /* Initialize the hash state S. */
+
+extern void sha256_hash(struct sha256_state */*s*/,
+ const void */*m*/, size_t /*sz*/);
+ /* Append SZ bytes of data starting at M to the hash state S. */
+
+extern void sha256_done(struct sha256_state */*s*/, unsigned char */*h*/);
+ /* Write the final hash of state S to buffer H. */
+
+/*----- That's all, folks -------------------------------------------------*/
+
+#ifdef __cplusplus
+ }
+#endif
+
+#endif
--- /dev/null
+### -*-makefile-*-
+###
+### Build script for tests
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+include autotest.am
+autotest_TESTS =
+TEST_ARGS = -j8
+
+autotest_TESTS += $(top_srcdir)/tests.at
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+### -*-sh-*-
+###
+### Configuration variables interesting to the test suite
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+###--------------------------------------------------------------------------
+### Configuration snippets.
+
+## Lisp systems.
+SBCL=@SBCL@
+CCL=@CCL@
+CLISP=@CLISP@
+ECL=@ECL@
+CMUCL=@CMUCL@
+ABCL=@ABCL@
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+../.ext/cfd/build/autotest.am
\ No newline at end of file
--- /dev/null
+### package information
+m4_define([AT_PACKAGE_NAME], [runlisp])
+m4_define([AT_PACKAGE_TARNAME], [runlisp])
+m4_define([AT_PACKAGE_VERSION], [UNKNOWN])
+m4_define([AT_PACKAGE_STRING], [runlisp UNKNOWN])
+m4_define([AT_PACKAGE_BUGREPORT], [mdw@distorted.org.uk])
--- /dev/null
+TESTS([..], [tests.at])
--- /dev/null
+../.ext/cfd/build/testsuite.at
\ No newline at end of file
--- /dev/null
+### -*-autotest-*-
+###
+### Test script for `runlisp'
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+m4_define([RUNLISP_PATH], [$abs_top_builddir/runlisp])
+
+m4_define([_FOREACH], [dnl
+m4_if([$#], [1], [_foreach_func($1)],
+ [_foreach_func($1)[]_FOREACH(m4_shift($@))])])
+m4_define([FOREACH], [dnl
+m4_pushdef([_foreach_func], [$2])dnl
+_FOREACH($1)[]dnl
+m4_popdef([_foreach_func])])
+
+m4_define([LISP_SYSTEMS],
+ [sbcl, sbcl/noimage,
+ ccl, ccl/noimage,
+ clisp, clisp/noimage,
+ ecl, ecl/noimage,
+ cmucl, cmucl/noimage,
+ abcl, abcl/noimage])
+
+m4_define([SETUP_RUNLISP_ENV],
+[RUNLISP_SYSCONFIG=$abs_top_srcdir/runlisp-base.conf; export RUNLISP_SYSCONFIG
+RUNLISP_SYSCONFIG_DIR=/notexist; export RUNLISP_SYSCONFIG_DIR
+RUNLISP_IMAGEDIR=$abs_top_builddir; export RUNLISP_IMAGEDIR
+RUNLISP_EVAL=$abs_top_srcdir/eval.lisp; export RUNLISP_EVAL
+unset RUNLISP_USERCONFIG
+])
+
+m4_define([PREPARE_LISP_TEST],
+[SETUP_RUNLISP_ENV
+lisp=$1
+LISP=$m4_translit(m4_bpatsubst([$1], [/.*$], []), [a-z], [A-Z])
+AT_SKIP_IF([test "x$LISP" = x])
+case $lisp in
+ */*) opt=${lisp#*/} lisp=${lisp%%/*} ;;
+ *) opt="" ;;
+esac
+case /$opt/ in */noimage/*) RUNLISP_IMAGEDIR=./notexist ;; esac])
+
+m4_define([WHICH_LISP],
+[(or #+sbcl "sbcl" #+ccl "ccl" #+clisp "clisp"
+ #+ecl "ecl" #+cmu "cmucl" #+abcl "abcl"
+ "unknown")])
+
+m4_define([NL], [
+])
+
+###--------------------------------------------------------------------------
+### A basic smoke test.
+
+## Check that the system basically works, by running a trivial test program.
+## Also try to verify that we're not running user or site startup code,
+## though this is hard to do in general.
+FOREACH([LISP_SYSTEMS],
+[AT_SETUP([$1 smoke])
+AT_KEYWORDS([script smoke $1])
+PREPARE_LISP_TEST([$1])
+
+## Prepare a user-init file which will break the test if it's run by printing
+## something unexpected.
+mkdir HOME
+case $lisp in
+ sbcl) initfile=.sbclrc ;;
+ ccl) initfile=.ccl-init.lisp ;;
+ clisp) initfile=.clisprc.lisp ;;
+ ecl) initfile=.eclrc ;;
+ cmucl) initfile=.cmucl-init.lisp ;;
+ abcl) initfile=.abclrc ;;
+esac
+cat >HOME/$initfile <<EOF
+(format t "*** I should not be seen~%")
+EOF
+HOME=$(pwd)/HOME; export HOME
+
+## Prepare the script.
+cat >test-script <<EOF
+[#!] RUNLISP_PATH -L$lisp
+
+;; Print a greeting to \`*standard-output*', identifying the Lisp system, so
+;; that we can tell whether we called the right one.
+(format t "Hello from ~A (~A)!~%" (lisp-implementation-type) WHICH_LISP)
+
+#! this should be a comment everywhere
+
+;; Make sure that \`*error-output*' is hooked up properly.
+(format *error-output* "to stderr~%")
+
+;; Make sure that \`*standard-input*' is hooked up properly, by reading a line
+;; and echoing it.
+(format t "from stdin: ~S~%" (read-line))
+
+;; Check that \`:runlisp-script' is set in \`*features*'. If not, \`assert'
+;; will at least write a complaint to some stream, which will fail the test.
+(assert (member :runlisp-script *features*))
+
+;; Check that there are no symbols present (interned or imported) in the
+;; \`common-lisp-user' package. Obviously, we must avoid interning any
+;; ourselves. Alas, ABCL and ECL pollute \`cl-user' out of the box. (ECL
+;; does this deliberately; ABCL's ``adjoin.lisp' lacks an \`in-package'
+;; form.)
+(let ((#1=#:syms (sort (loop :for #2=#:s :being :the :present-symbols
+ :of *package*
+ :collect #2#)
+ #'string<)))
+ (format t "package \`~A' [~:[ok~;has unexpected symbols ~:*~S~]]~%"
+ (package-name *package*) #1#))
+
+;; Print the program name and command-line arguments.
+(format t "program name = ~S~%~
+ arguments = ~:S~%"
+ (uiop:argv0)
+ uiop:*command-line-arguments*)
+EOF
+chmod +x test-script
+
+case $lisp in
+ sbcl) impl="SBCL" ;;
+ ccl) impl="Clozure Common Lisp" ;;
+ clisp) impl="CLISP" ;;
+ ecl) impl="ECL" ;;
+ cmucl) impl="CMU Common Lisp" ;;
+ abcl) impl="Armed Bear Common Lisp" ;;
+ *) AT_FAIL_IF([:]) ;;
+esac
+
+## Prepare an input file.
+echo some random text >stdin
+
+## Prepare the reference stdout and stderr.
+cat >stdout.ref <<EOF
+Hello from $impl ($lisp)!
+from stdin: "some random text"
+package \`COMMON-LISP-USER' ok
+program name = "./test-script"
+arguments = ("--eval" "nonsense" "--" "more" "args" "here")
+EOF
+cat >stderr.ref <<EOF
+to stderr
+EOF
+
+AT_CHECK([echo "lisp=$lisp opt=$opt"; env | grep RUNLISP | sort],, [stdout])
+AT_CHECK([./test-script --eval nonsense -- more args here <stdin],,
+ [stdout], [stderr])
+AT_CHECK([diff -u stdout.ref stdout])
+AT_CHECK([diff -u stderr.ref stderr])
+AT_CLEANUP])
+
+###--------------------------------------------------------------------------
+### Check error handling.
+
+FOREACH([LISP_SYSTEMS],
+[AT_SETUP([$1 errors])
+AT_KEYWORDS([script error $1])
+PREPARE_LISP_TEST([$1])
+
+## A simple script which signals an error without catching it.
+cat >test <<EOF
+[#!] RUNLISP_PATH -L$lisp
+(error "just kill me now")
+EOF
+chmod +x test
+
+## As long as it exits with a nonzero status, I'm happy. Some Lisps
+## desperately want to drop the user into an interactive debugger, which is
+## possibly useful for a developer, but an end user is now faced with a
+## confusing internal error message /and/ a confusing prompt which won't go
+## away. The output may still be confusing and (certainly in CCL's case)
+## voluminous, but that's not significantly worse than Tcl or Java.
+./test >out >err; rc=$?
+AT_FAIL_IF([test $rc = 0])
+
+AT_CLEANUP])
+
+###--------------------------------------------------------------------------
+### Check eval mode.
+
+### Eval mode is implemented centrally through a script, so we don't need to
+### test it separately for each Lisp implementation.
+
+AT_SETUP([eval mode])
+AT_KEYWORDS([eval common])
+SETUP_RUNLISP_ENV
+
+## A very basic smoke test.
+AT_CHECK([RUNLISP_PATH -e '(format t "Just another Lisp hacker!~%")'],,
+[Just another Lisp hacker!
+])
+
+## The `:runlisp-script' keyword should /not/ be in `*features*'.
+traceon
+AT_CHECK([RUNLISP_PATH -p '(find :runlisp-script *features*)'],, [NIL
+])
+
+## Check a mixture of all the kinds of evaluation. We'll need a stunt script
+## to make this work. Also check that the individual forms are read and
+## evaluated one at a time, so that each one can affect the way the reader
+## interprets the next.
+cat >script.lisp <<EOF
+#! just want to check that Lisp doesn't choke on a shebang line here
+(format t "And we're running the script...~%~
+ Command-line arguments: ~:S~%~
+ Symbols in package \`~A': ~:S~%"
+ uiop:*command-line-arguments*
+ (package-name *package*)
+ (sort (loop :for #2=#:s :being :the :present-symbols :of *package*
+ :collect #2#)
+ #'string<))
+EOF
+AT_CHECK([RUNLISP_PATH \
+ -e '(defpackage [#:]runlisp-test (:export [#:]foo))
+ (defvar runlisp-test:foo 1)' \
+ -p runlisp-test:foo \
+ -e '(incf runlisp-test:foo)' \
+ -l script.lisp \
+ -p runlisp-test:foo \
+ -- -e one two three],,
+[1
+And we're running the script...
+Command-line arguments: ("-e" "one" "two" "three")
+Symbols in package `COMMON-LISP-USER': ()
+2
+])
+
+AT_CLEANUP
+
+###--------------------------------------------------------------------------
+### Check Lisp system selection and preference work.
+
+AT_SETUP([preferences])
+AT_KEYWORDS([prefs common])
+SETUP_RUNLISP_ENV
+
+## Before we can make this happen, we need to decide on three Lisp systems,
+## two of which actually work, and one other. These are ordered by startup
+## speed.
+unset lisp0 lisp1 badlisp; win=nil
+set -- cmucl sbcl ccl clisp ecl abcl
+while :; do
+ case $# in 0) break ;; esac
+ lisp=$1; shift
+ if RUNLISP_PATH -L$lisp -enil 2>/dev/null; then good=t; else good=nil; fi
+ case ${lisp0+t},${badlisp+t},$good in
+ ,*,t) lisp0=$lisp ;;
+ t,*,t) lisp1=$lisp win=t; break ;;
+ *,,nil) badlisp=$lisp ;;
+ esac
+done
+AT_CHECK([case $win in nil) exit 77 ;; esac])
+case ${badlisp+t} in t) ;; *) badlisp=$1 ;; esac
+BADLISP=$(echo $badlisp | tr a-z A-Z)
+eval $BADLISP=/notexist/definitely-wrong
+export $BADLISP
+echo Primary Lisp = $lisp0
+echo Secondary Lisp = $lisp1
+echo Bad Lisp = $badlisp
+
+## Check that our selection worked.
+AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp0 -p 'WHICH_LISP'],, ["$lisp0"NL])
+AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp1 -p 'WHICH_LISP'],, ["$lisp1"NL])
+AT_CHECK([RUNLISP_PATH -L$badlisp -p 'WHICH_LISP'], [127],,
+[runlisp: no acceptable Lisp systems found[]NL])
+
+## Unset all of the user preference mechanisms.
+here=$(pwd)
+mkdir HOME config
+HOME=$here/HOME XDG_CONFIG_HOME=$here/config; export HOME XDG_CONFIG_HOME
+
+## We generally take the first one listed that exists.
+AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp0,$lisp1 -p 'WHICH_LISP'],, ["$lisp0"NL])
+AT_CHECK_UNQUOTED([RUNLISP_PATH -L$lisp1,$lisp0 -p 'WHICH_LISP'],, ["$lisp1"NL])
+AT_CHECK_UNQUOTED([RUNLISP_PATH -L$badlisp,$lisp0,$lisp1 -p 'WHICH_LISP'],,
+ ["$lisp0"NL])
+
+## Check parsing of embedded options.
+for i in 0 1; do
+ j=$(( 1 - $i )); eval lisp=\$lisp$i olisp=\$lisp$j
+ cat >script$i <<EOF
+[#!] RUNLISP_PATH
+;;; -z @RUNLISP: -L$lisp -*- -z -*- -L$olisp -- -z
+(prin1 WHICH_LISP) (terpri)
+EOF
+ chmod +x script$i
+ AT_CHECK_UNQUOTED([./script$i],, ["$lisp"NL])
+done
+
+## Preferences will override the order of acceptable implementations.
+AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp,$lisp0 ./script0],, ["$lisp0"NL])
+AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp,$lisp0 ./script1],, ["$lisp0"NL])
+
+## But doesn't affect the preference order of unmentioned Lisps.
+AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp ./script0],, ["$lisp0"NL])
+AT_CHECK_UNQUOTED([RUNLISP_PREFER=$badlisp ./script1],, ["$lisp1"NL])
+
+## Test configuration files and interactions with the environment.
+for conf in HOME/.runlisp.conf config/runlisp.conf; do
+ for i in 0 1; do
+ j=$(( 1 - $i )); eval lisp=\$lisp$i olisp=\$lisp$j
+ cat >$conf <<EOF
+;;; -*-conf-*-
+prefer = $lisp
+EOF
+
+ ## Basic check.
+ AT_CHECK_UNQUOTED([./script0],, ["$lisp"NL])
+ AT_CHECK_UNQUOTED([./script1],, ["$lisp"NL])
+
+ ## Environment variable overrides.
+ AT_CHECK_UNQUOTED([RUNLISP_PREFER=$olisp ./script0],, ["$olisp"NL])
+ AT_CHECK_UNQUOTED([RUNLISP_PREFER=$olisp ./script1],, ["$olisp"NL])
+
+ done
+ rm -f $conf
+done
+
+
+
+AT_CLEANUP
+
+###----- That's all, folks --------------------------------------------------
--- /dev/null
+#! /bin/sh -e
+
+case $# in
+ 0 | 1) echo >&2 "usage: $0 LISP SCRIPT [ARGS ...]"; exit 127 ;;
+esac
+lisp=$1 script=$2; shift 2
+
+__CL_ARGV0=$script; export __CL_ARGV0 # this is stupid
+
+lispscript=$(printf "%s" "$script" | sed 's/[\"]/\\&/g')
+
+load_asdf_rune="\
+(let ((*load-verbose* nil)
+ #+cmu (ext:*require-verbose* nil))
+ (require \"asdf\"))"
+
+ignore_shebang_rune="\
+(set-dispatch-macro-character
+ #\# #\!
+ (lambda (stream char arg)
+ (declare (ignore char arg))
+ (values (read-line stream))))"
+
+clisp_startup_rune="\
+(progn
+ $ignore_shebang_rune
+ $load_asdf_rune
+ (setf *standard-input* (ext:make-stream :input))
+ (load \"$lispscript\" :verbose nil :print nil)
+ (ext:quit))"
+
+abcl_startup_rune="\
+(let ((script \"$lispscript\"))
+ $load_asdf_rune
+ $ignore_shebang_rune
+ (setf *error-output*
+ (java:jnew \"org.armedbear.lisp.Stream\"
+ 'sys::system-stream
+ (java:jfield \"java.lang.System\" \"err\")
+ 'character
+ java:+true+))
+ (handler-case (load script :verbose nil :print nil)
+ (error (error)
+ (format *error-output* \"~A (unhandled error): ~A~%\" script error)
+ (ext:quit :status 255))))"
+
+#set -x
+case $lisp in
+
+ sbcl)
+ exec sbcl --noinform --eval "$load_asdf_rune" --script "$script" "$@"
+ ;;
+
+ ecl)
+ exec ecl --norc --eval "$load_asdf_rune" --shell "$script" -- "$@"
+ ;;
+
+ clisp)
+ exec clisp -norc -q -x "$clisp_startup_rune" -- "$@"
+ ;;
+
+ cmucl)
+ exec cmucl -batch -noinit -nositeinit -quiet \
+ -eval "$load_asdf_rune" \
+ -eval "$ignore_shebang_rune" \
+ -load "$script" -eval "(ext:quit)" -- "$@"
+ ;;
+
+ ccl)
+ exec ccl -b -n -Q \
+ -e "$load_asdf_rune" \
+ -e "$ignore_shebang_rune" \
+ -l "$script" -e "(ccl:quit)" -- "$@"
+ ;;
+
+ abcl)
+ exec abcl --batch --noinform --noinit --nosystem \
+ --eval "$abcl_startup_rune" -- "$@"
+ ;;
+
+ *)
+ echo >&2 "$0: unsupported Lisp \`$lisp'"
+ exit 127
+ ;;
+esac
--- /dev/null
+### -*-makefile-*-
+###
+### Common build-system definitions
+###
+### (c) 2020 Mark Wooding
+###
+
+###----- Licensing notice ---------------------------------------------------
+###
+### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+###
+### Runlisp is free software: you can redistribute it and/or modify it
+### under the terms of the GNU General Public License as published by the
+### Free Software Foundation; either version 3 of the License, or (at your
+### option) any later version.
+###
+### Runlisp is distributed in the hope that it will be useful, but WITHOUT
+### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+### for more details.
+###
+### You should have received a copy of the GNU General Public License
+### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+
+###--------------------------------------------------------------------------
+### Initial values for common variables.
+
+EXTRA_DIST =
+CLEANFILES =
+SUFFIXES =
+
+bin_PROGRAMS =
+bin_SCRIPTS =
+nodist_bin_SCRIPTS =
+
+man_MANS =
+doc_DATA =
+
+pkgdata_DATA =
+pkgdata_SCRIPTS =
+
+pkgconfdir = $(sysconfdir)/$(PACKAGE_NAME)
+pkgconf_DATA =
+
+noinst_DATA =
+noinst_LIBRARIES =
+noinst_PROGRAMS =
+
+###--------------------------------------------------------------------------
+### Standard configuration substitutions.
+
+## Substitute tags in files.
+confsubst = $(top_srcdir)/config/confsubst
+
+SUBSTITUTIONS = \
+ prefix=$(prefix) exec_prefix=$(exec_prefix) \
+ libdir=$(libdir) includedir=$(includedir) \
+ bindir=$(bindir) sbindir=$(sbindir) \
+ etcdir=$(sysconfdir) imagedir=$(imagedir) \
+ PACKAGE=$(PACKAGE) VERSION=$(VERSION) \
+ ECLOPT=$(ECLOPT)
+
+v_subst = $(v_subst_@AM_V@)
+v_subst_ = $(v_subst_@AM_DEFAULT_V@)
+v_subst_0 = @echo " SUBST $@";
+SUBST = $(v_subst)$(confsubst)
+
+###--------------------------------------------------------------------------
+### Manpages.
+
+v_man = $(v_man_@AM_V@)
+v_man_ = $(v_man_@AM_DEFAULT_V@)
+v_man_0 = @echo " MAN $@";
+MAN = man
+
+SUFFIXES += .1 .5 .1.in .5.in .pdf
+.1.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
+.5.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
+.1.in.1: Makefile; $(SUBST) $< $(SUBSTITUTIONS) >$@.new && mv $@.new $@
+.5.in.5: Makefile; $(SUBST) $< $(SUBSTITUTIONS) >$@.new && mv $@.new $@
+CLEANFILES += *.1 *.5 *.pdf
+
+###--------------------------------------------------------------------------
+### List of Lisp systems.
+
+LISPS =
+
+LISPS += sbcl
+LISPS += ccl
+LISPS += clisp
+LISPS += ecl
+LISPS += cmucl
+LISPS += abcl
+
+###----- That's all, folks --------------------------------------------------
~mdw / runlisp / commitdiff