SUBDIRS =
-pkgdata_DATA =
image_DATA =
image_SCRIPTS =
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
+
+###--------------------------------------------------------------------------
### The main driver program.
bin_PROGRAMS += runlisp
runlisp_SOURCES = runlisp.c
-runlisp_SOURCES += common.c common.h
-runlisp_SOURCES += lib.c lib.h
-runlisp_SOURCES += mdwopt.c mdwopt.h
+runlisp_LDADD = librunlisp.a
man_MANS += runlisp.1
+doc_DATA += runlisp.pdf
+EXTRA_DIST += runlisp.1
noinst_PROGRAMS += old-runlisp
old_runlisp_SOURCES = old-runlisp.c
-old_runlisp_SOURCES += lib.c lib.h
+old_runlisp_LDADD = librunlisp.a
noinst_PROGRAMS += toy
toy_SOURCES = toy.c
pkgdata_DATA += eval.lisp
EXTRA_DIST += eval.lisp
+pkgdata_DATA += 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
+
+man_MANS += runlisp.conf.5
+doc_DATA += runlisp.conf.pdf
+
+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_SOURCES += common.c common.h
-dump_runlisp_image_SOURCES += lib.c lib.h
-dump_runlisp_image_SOURCES += mdwopt.c mdwopt.h
+dump_runlisp_image_LDADD = librunlisp.a
man_MANS += dump-runlisp-image.1
+doc_DATA += dump-runlisp-image.pdf
+EXTRA_DIST += dump-runlisp-image.1
DUMP_RUNLISP_IMAGE = $(v_dump)./dump-runlisp-image \
- -f -c$(srcdir)/runlisp.conf -O$@
+ -f -c$(srcdir)/runlisp-base.conf -O$@
v_dump = $(v_dump_@AM_V@)
v_dump_ = $(v_dump_@AM_DEFAULT_V@)
if DUMP_SBCL
image_DATA += sbcl+asdf.core
CLEANFILES += sbcl+asdf.core
-sbcl+asdf.core: dump-runlisp-image runlisp.conf
+sbcl+asdf.core: dump-runlisp-image runlisp-base.conf
$(DUMP_RUNLISP_IMAGE) sbcl
endif
if DUMP_CCL
image_DATA += ccl+asdf.image
CLEANFILES += ccl+asdf.image
-ccl+asdf.image: dump-runlisp-image runlisp.conf
+ccl+asdf.image: dump-runlisp-image runlisp-base.conf
$(DUMP_RUNLISP_IMAGE) ccl
endif
if DUMP_CLISP
image_DATA += clisp+asdf.mem
CLEANFILES += clisp+asdf.mem
-clisp+asdf.mem: dump-runlisp-image runlisp.conf
+clisp+asdf.mem: dump-runlisp-image runlisp-base.conf
$(DUMP_RUNLISP_IMAGE) clisp
endif
if DUMP_ECL
image_SCRIPTS += ecl+asdf
CLEANFILES += ecl+asdf
-ecl+asdf: dump-runlisp-image runlisp.conf
+ecl+asdf: dump-runlisp-image runlisp-base.conf dump-ecl
$(DUMP_RUNLISP_IMAGE) -odata-dir=$(srcdir) ecl
endif
if DUMP_CMUCL
image_DATA += cmucl+asdf.core
CLEANFILES += cmucl+asdf.core
-cmucl+asdf.core: dump-runlisp-image runlisp.conf
+cmucl+asdf.core: dump-runlisp-image runlisp-base.conf
$(DUMP_RUNLISP_IMAGE) cmucl
endif
###--------------------------------------------------------------------------
-### Benchmarking and testing.
+### Other subdirectories.
+## Documentation.
+SUBDIRS += doc
+
+## Testing.
+SUBDIRS += t
+
+## Benchmarking.
if BENCHMARK
SUBDIRS += bench
endif
-SUBDIRS += t
-
###--------------------------------------------------------------------------
### Distribution.
+ Embeddable Common Lisp (~ecl~), and
+ Steel Bank Common Lisp (~sbcl~).
-I'm happy to take patches to support additional free Lisp
-implementations. I'm not interested in supporting non-free Lisp
-systems.
+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 Lisp
+
+* Writing scripts in Common Lisp
** Basic use
** Where =runlisp= looks for configuration
You can influence which Lisp implementations are chosen by ~runlisp~ by
-writing a configuration file, and/or setting an environment variable.
+writing configuration files, and/or setting environment variables.
-~runlisp~ looks for configuration in ~~/.runlisprc~, and in
-~~/.config/runlisprc~. You could put configuration in both, but that
-doesn't seem like a great idea. A configuration file just contains
-blank lines, comments, and command-line options, just as you'd write
-them to the shell. Simple quoting and escaping is provided: see the
-manual page for the full details. Each line is processed independently,
-so it doesn't work to write an option on one line and then its argument
-on the next.
+The ~runlisp~ program looks for configuration in a number of places.
-The environment variable ~RUNLISP_OPTIONS~ is processed /after/ reading
-the configuration file(s), if any. Again, it should contain
-command-line options, as you'd write them to the shell.
+ + 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.
-** Deciding which Lisp implementation to use
+ + 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.
-The most useful option to use here is ~-P~, which builds up a
-/preference list/, in order. The argument to ~-P~ is a comma-separated
-list of Lisp implementation names, just like you'd give to ~-L~.
+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
-If you provide multiple ~-P~ options (e.g., on different lines of your
-configuration file, or separately in the configuration file and
-environment variable, then the lists are concatenated. Since the
-environment variable is processed after the configuration file, this
-means that
+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~ options, and a list of /preferred/ Lisp implementations from the
-~-P~ options. If there aren't any ~-L~ options, then it assumes that
-/all/ Lisp implementations are acceptable; but if there are no ~-P~
-options 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.
-
-** Clearing the preferred list
-
-Since the environment variable is processed after the configuration
-files, it can only append more Lisp implementations to the end of the
-preferred list, which may well not be so helpful. There's an additional
-option ~-C~, which completely clears the preferred list. The idea is
-that you can write ~-C~ at the start of your ~RUNLISP_OPTIONS~
-environment variable to temporarily override your usual configuration
-for some special effect.
+~-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=?
|------------------+-------------------+-----------------+----------------------|
| *Implementation* | *~cl-launch~ (s)* | *~runlisp~ (s)* | *~runlisp~ (factor)* |
|------------------+-------------------+-----------------+----------------------|
-| ABCL | 7.3036 | 2.6027 | 2.806 |
-| Clozure CL | 1.2769 | 0.9678 | 1.319 |
-| GNU CLisp | 1.2498 | 0.2659 | 4.700 |
-| CMU CL | 0.9665 | 0.3065 | 3.153 |
-| ECL | 0.8025 | 0.3173 | 2.529 |
-| SBCL | 0.3266 | 0.0739 | 4.419 |
+| 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
|------------------+-------------------+-----------------+----------------------|
| *Implementation* | *~cl-launch~ (s)* | *~runlisp~ (s)* | *~runlisp~ (factor)* |
|------------------+-------------------+-----------------+----------------------|
-| ABCL | 7.3036 | 2.5873 | 2.823 |
-| Clozure CL | 1.2769 | 0.0088 | 145.102 |
-| GNU CLisp | 1.2498 | 0.0146 | 85.603 |
-| CMU CL | 0.9665 | 0.0063 | 153.413 |
-| ECL | 0.8025 | 0.3185 | 2.520 |
-| SBCL | 0.3266 | 0.0077 | 42.416 |
+| 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
|------------------------------+-------------|
| *Implementation* | *Time (ms)* |
|------------------------------+-------------|
-| Clozure CL | 8.8 |
-| GNU CLisp | 14.6 |
-| CMU CL | 6.3 |
-| SBCL | 7.7 |
+| Clozure CL | 37.1 |
+| GNU CLisp | 19.1 |
+| CMU CL | 6.0 |
+| SBCL | 6.4 |
|------------------------------+-------------|
-| Perl | 1.2 |
-| Python | 10.3 |
+| Perl | 1.1 |
+| Python | 6.8 |
|------------------------------+-------------|
-| Debian Almquist shell (dash) | 1.4 |
-| GNU Bash | 2.0 |
-| Z Shell | 4.1 |
+| Debian Almquist shell (dash) | 1.2 |
+| GNU Bash | 1.5 |
+| Z Shell | 3.1 |
|------------------------------+-------------|
-| Tiny C (compile & run) | 1.2 |
-| GCC (precompiled) | 0.5 |
+| Tiny C (compile & run) | 1.6 |
+| GCC (precompiled) | 0.6 |
|------------------------------+-------------|
#+CAPTION: Comparison of ~runlisp~ and other script interpreters
`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 ~-P~ option
-with which users can express their own preferences (e.g., in the
-environment or a configuration file): ~runlisp~ will never choose a Lisp
-system which the script can't deal with, but it will respect the user's
-relative preferences.
+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
### Lisp systems using `runlisp'.
RUNLISP = $(top_builddir)/runlisp \
- -c$(top_srcdir)/runlisp.conf \
+ -c$(top_srcdir)/runlisp-base.conf \
-oimage-dir=$(top_builddir)
EXTRA_DIST += t.lisp
/*----- Public variables --------------------------------------------------*/
-struct config config = CONFIG_INIT;
-struct config_section *toplevel, *builtin, *common, *env;
-unsigned verbose = 1;
+struct config config = CONFIG_INIT; /* main configuration */
+struct config_section *toplevel, *builtin, *common, *env; /* well-known
+ * sections */
+unsigned verbose = 1; /* verbosity level */
-/*----- Internal utilities ------------------------------------------------*/
+/*----- 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;
-static void escapify(struct dstr *d, const char *p)
+ 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, "\"'\\");
+ n = strcspn(p, q);
if (n) { dstr_putm(d, p, n); p += n; }
if (!*p) break;
- dstr_putc(d, '\\'); dstr_putc(d, *p++);
+ 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;
struct passwd *pw;
if (!home) {
+
p = my_getenv("HOME", 0);
if (p) home = p;
else {
dstr_puts(d, home);
}
+/* Append the user's XDG configuration directory to D. */
static void user_config_dir(struct dstr *d)
{
const char *p;
else { homedir(d); dstr_puts(d, "/.config"); }
}
-/*----- Miscellany --------------------------------------------------------*/
-
-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);
-}
-
-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);
-}
-
-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, ','); dstr_putc(d, ' '); }
- dstr_putc(d, '`'); escapify(d, av->v[i]); dstr_putc(d, '\'');
- }
- dstr_putz(d);
-}
-
/*----- 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;
}
}
+/* 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;
int i, rc;
if (strchr(prog, '/'))
- return (file_exists_p(prog, f));
+ return (file_exists_p(prog, f | FEF_EXEC));
path = my_getenv("PATH", 0);
if (path)
dstr_puts(&p, path);
dstr_putc(&d, '/');
dstr_putm(&d, prog, proglen);
dstr_putz(&d);
- if (file_exists_p(d.p, verbose >= 4 ? f : f&~FEF_VERBOSE)) {
+ 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;
}
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;
if (found_in_path_p(av->v[0], f&TEF_VERBOSE ? FEF_VERBOSE : 0))
{ rc = 0; goto end; }
} else {
- execvp(av->v[0], (/*unconst*/ char **)av->v);
+ execvp(av->v[0], av->v);
if (errno != ENOENT) {
moan("failed to exec `%s': %s", av->v[0], strerror(errno));
_exit(2);
/*----- 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_set_parent(toplevel, 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)) {
}
}
+/* 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;
read_config_file(what, dd.p, f&~CF_NOENTOK);
}
- for (i = 0; i < av.n; i++) free((/*unconst*/ char *)av.v[i]);
+ 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;
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;
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);
}
-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(toplevel, 0);
- config_read_env(&config, env);
-
- config_set_var(&config, toplevel, CF_LITERAL, "data-dir",
- my_getenv("RUNLISP_DATADIR", DATADIR));
- config_set_var(&config, toplevel, CF_LITERAL, "image-dir",
- my_getenv("RUNLISP_IMAGEDIR", IMAGEDIR));
-
-#ifdef ECL_OPTIONS_GNU
- config_set_var(&config, builtin, CF_LITERAL, "@ECLOPT", "--");
-#else
- config_set_var(&config, builtin, CF_LITERAL, "@ECLOPT", "-");
-#endif
-}
-
+/* 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", ETCDIR "/runlisp.conf");
- read_config_file("system", p, 0);
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);
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;
- struct dstr d = DSTR_INIT;
for (config_start_section_iter(&config, &si);
(sect = config_next_section(&si)); )
- for (config_start_var_iter(sect, &vi);
- (var = config_next_var(&vi)); ) {
- dstr_reset(&d); escapify(&d, var->val);
- moan("config %s:%s = `%s'",
- CONFIG_SECTION_NAME(sect), CONFIG_VAR_NAME(var), d.p);
- }
- dstr_release(&d);
+ 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 -------------------------------------------------*/
/*----- 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
-extern int file_exists_p(const char */*path*/, unsigned /*f*/);
+ /* 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
-extern int try_exec(struct argv */*av*/, unsigned /*f*/);
+ /* 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*/);
-extern void init_config(void);
+ /* 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 -------------------------------------------------*/
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--------------------------------------------------------------------------
imagedir=$localstatedir/$PACKAGE_NAME; AC_SUBST(imagedir)
mdw_DEFINE_PATHS([
mdw_DEFINE_PATH([IMAGEDIR], [$imagedir])
- mdw_DEFINE_PATH([ETCDIR], [$sysconfdir])
+ mdw_DEFINE_PATH([ETCDIR], [$sysconfdir/$PACKAGE_NAME])
mdw_DEFINE_PATH([DATADIR], [$datadir/$PACKAGE_NAME])])
AC_ARG_ENABLE([imagedump],
#> lisp
"Lisp system" "\\texttt{cl-launch}" "\\texttt{runlisp} (vanilla image)" "\\texttt{runlisp} (custom image)"
-"ABCL" 7.3036 2.6027 2.5873
-"Clozure CL" 1.2769 0.9678 0.0088
-"GNU CLisp" 1.2498 0.2659 0.0146
-"CMU CL" 0.9665 0.3065 0.0063
-"ECL" 0.8025 0.3173 0.3185
-"SBCL" 0.3266 0.0739 0.0077
+"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.0088
-"GNU CLisp" 0.0146
-"CMU CL" 0.0063
-"SBCL" 0.0077
-"Perl" 0.0012
-"Python" 0.0103
-"dash" 0.0014
-"GNU Bash" 0.0020
-"Z Shell" 0.0041
-"Tiny C" 0.0012
-"GCC" 0.0005
+"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
\begin{tikzpicture}[gnuplot]
%% generated with GNUPLOT 5.2p6 (Lua 5.3; terminal rev. Nov 2018, script rev. 107)
-%% Sat 15 Aug 2020 14:07:28 BST
+%% 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}
\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) {$2$};
+\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) {$4$};
+\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) {$6$};
+\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) {$8$};
+\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) {$10$};
+\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) {$12$};
+\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) {$14$};
+\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) {$16$};
+\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 (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,5.257)--(1.812,5.257)--cycle;
+\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,5.256)--(2.262,5.256)--(2.262,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (2.713,1.363)--(3.164,1.363)--(3.164,7.823)--(2.713,7.823)--cycle;
-\draw[gp path] (2.713,1.363)--(2.713,7.822)--(3.163,7.822)--(3.163,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (3.614,1.363)--(4.065,1.363)--(4.065,4.151)--(3.614,4.151)--cycle;
-\draw[gp path] (3.614,1.363)--(3.614,4.150)--(4.064,4.150)--(4.064,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (4.514,1.363)--(4.966,1.363)--(4.966,4.770)--(4.514,4.770)--cycle;
-\draw[gp path] (4.514,1.363)--(4.514,4.769)--(4.965,4.769)--(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.895)--(5.415,1.895)--cycle;
-\draw[gp path] (5.415,1.363)--(5.415,1.894)--(5.866,1.894)--(5.866,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (6.316,1.363)--(6.768,1.363)--(6.768,5.920)--(6.316,5.920)--cycle;
-\draw[gp path] (6.316,1.363)--(6.316,5.919)--(6.767,5.919)--(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.983)--(7.217,1.983)--cycle;
-\draw[gp path] (7.217,1.363)--(7.217,1.982)--(7.668,1.982)--(7.668,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (8.118,1.363)--(8.570,1.363)--(8.570,2.249)--(8.118,2.249)--cycle;
-\draw[gp path] (8.118,1.363)--(8.118,2.248)--(8.569,2.248)--(8.569,1.363)--cycle;
-\gpfill{rgb color={0.580,0.000,0.827}} (9.019,1.363)--(9.470,1.363)--(9.470,3.178)--(9.019,3.178)--cycle;
-\draw[gp path] (9.019,1.363)--(9.019,3.177)--(9.469,3.177)--(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.895)--(9.920,1.895)--cycle;
-\draw[gp path] (9.920,1.363)--(9.920,1.894)--(10.370,1.894)--(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.585)--(10.821,1.585)--cycle;
-\draw[gp path] (10.821,1.363)--(10.821,1.584)--(11.271,1.584)--(11.271,1.363)--cycle;
+\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
\begin{tikzpicture}[gnuplot]
%% generated with GNUPLOT 5.2p6 (Lua 5.3; terminal rev. Nov 2018, script rev. 107)
-%% Sat 15 Aug 2020 14:07:24 BST
+%% 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}
\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.826)--(2.209,7.826)--cycle;
-\draw[gp path] (2.209,1.363)--(2.209,7.825)--(2.523,7.825)--(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.494)--(3.779,2.494)--cycle;
-\draw[gp path] (3.779,1.363)--(3.779,2.493)--(4.093,2.493)--(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.470)--(5.350,2.470)--cycle;
-\draw[gp path] (5.350,1.363)--(5.350,2.469)--(5.664,2.469)--(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.219)--(6.921,2.219)--cycle;
-\draw[gp path] (6.921,1.363)--(6.921,2.218)--(7.235,2.218)--(7.235,1.363)--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.653)--(10.062,1.653)--cycle;
-\draw[gp path] (10.062,1.363)--(10.062,1.652)--(10.376,1.652)--(10.376,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.667)--(2.523,3.667)--cycle;
-\draw[gp path] (2.523,1.363)--(2.523,3.666)--(2.837,3.666)--(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.220)--(4.093,2.220)--cycle;
-\draw[gp path] (4.093,1.363)--(4.093,2.219)--(4.408,2.219)--(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.599)--(5.664,1.599)--cycle;
-\draw[gp path] (5.664,1.363)--(5.664,1.598)--(5.978,1.598)--(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.635)--(7.235,1.635)--cycle;
-\draw[gp path] (7.235,1.363)--(7.235,1.634)--(7.549,1.634)--(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.645)--(8.806,1.645)--cycle;
-\draw[gp path] (8.806,1.363)--(8.806,1.644)--(9.120,1.644)--(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.429)--(10.376,1.429)--cycle;
-\draw[gp path] (10.376,1.363)--(10.376,1.428)--(10.690,1.428)--(10.690,1.363)--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.653)--(2.837,3.653)--cycle;
-\draw[gp path] (2.837,1.363)--(2.837,3.652)--(3.151,3.652)--(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.372)--(4.408,1.372)--cycle;
-\draw[gp path] (4.408,1.363)--(4.408,1.371)--(4.722,1.371)--(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.377)--(5.978,1.377)--cycle;
-\draw[gp path] (5.978,1.363)--(5.978,1.376)--(6.292,1.376)--(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.370)--(7.549,1.370)--cycle;
-\draw[gp path] (7.549,1.363)--(7.549,1.369)--(7.863,1.369)--(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.646)--(9.120,1.646)--cycle;
-\draw[gp path] (9.120,1.363)--(9.120,1.645)--(9.434,1.645)--(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.371)--(10.690,1.371)--cycle;
-\draw[gp path] (10.690,1.363)--(10.690,1.370)--(11.005,1.370)--(11.005,1.363)--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
run () { echo "$*"; "$@"; }
## Start by compiling a copy of ASDF.
-cat >"$tmp/ecl-build.lisp" <<EOF
+cat >"$tmp/ecl-build.lisp" <<'EOF'
(require "asdf")
-(defparameter *asdf* (asdf:find-system "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 (concatenate 'string
- (string-downcase
- (lisp-implementation-type))
- "-"
- (pathname-name pathname))
- :type nil
- :version nil
- :defaults *default-pathname-defaults*)
- pathname))
-(asdf:initialize-output-translations '(:output-translations
- ((#p"/" :**/ :*.*.*)
- (:function right-here))
- :ignore-inherited-configuration))
+ (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
+cat >"$tmp/ecl-run.lisp" <<'EOF'
(cl:defpackage #:runlisp
(:use #:common-lisp))
(cl:in-package #:runlisp)
(defun main ()
- $ignore_shebang_rune
+ "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)))))
- $set_script_feature_rune
+
+ ;; 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 ((null arg) (return))
- ((string= arg "--") (setf marker t) (return))
- ((string= arg "-s") (setf script (getarg)))
- ((string= arg "-h") (usage *standard-output*) (quit 0))
- (t (lose "unrecognized option \`~A'" arg)))))
- (unless script (lose "nothing to do"))
+ (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 "ecl-asdf.fas" \
+(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/ecl-asdf.o" "$tmp/ecl-run.o"
+ ${eclopt}link "$tmp/asdf.o" "$tmp/ecl-run.o"
###----- That's all, folks --------------------------------------------------
.ds , \h'.16667m'
.
.\"--------------------------------------------------------------------------
-.TH runlisp 1 "12 August 2020" "Mark Wooding"
+.TH dump-runlisp-image 1 "12 August 2020" "Mark Wooding"
.SH NAME
dump-runlisp-image \- dump Lisp images for faster script execution
.
.
.\"--------------------------------------------------------------------------
.
-.SH "BUGS"
-.hP \*o
-There's no support for making images for ABCL.
-I don't really know what this would look like,
-but I suspect it wouldn't help very much.
-ABCL is terribly slow to start up anyway.
+.SH SEE ALSO
+.BR query-runlisp-config (1),
+.BR runlisp (1),
+.BR runlisp.conf (5).
.
-.SH "SEE ALSO"
-.BR runlisp (1).
-.
-.SH "AUTHOR"
+.SH AUTHOR
Mark Wooding, <mdw@distorted.org.uk>
.
.\"----- That's all, folks --------------------------------------------------
/*----- Static data -------------------------------------------------------*/
-#define MAXLINE 16384u
+/* 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;
- char *buf;
- unsigned off, len;
+ 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_READY,
- JST_RUN,
- JST_DEAD,
+ JST_READY, /* not yet started */
+ JST_RUN, /* currently running */
+ JST_DEAD, /* process exited */
JST_NSTATE
};
+/* The state associated with an image-dumping job. */
struct job {
- struct treap_node _node;
- struct job *next;
- struct argv av;
- unsigned st;
- FILE *log;
- pid_t kid;
- int exit;
- struct linebuf out, err;
+ struct treap_node _node; /* treap intrusion */
+ struct job *next; /* next job in whichever list */
+ struct argv av; /* argument vector to execute */
+ char *imgnew, *imgout; /* staging and final output files */
+ unsigned st; /* job state (`JST_...') */
+ FILE *log; /* log output file (`stdout'?) */
+ pid_t kid; /* process id of child (or -1) */
+ int exit; /* exit status from child */
+ 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;
-static struct job *job_ready, *job_run, *job_dead;
-static unsigned nrun, maxrun = 1;
-static int rc = 0;
-static int nullfd;
+static struct treap jobs = TREAP_INIT; /* Lisp systems scheduled to dump */
+static struct job *job_ready, *job_run, *job_dead; /* list jobs by state */
+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 };
-static sigset_t caught, pending;
-static int sigloss = -1;
+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;
-#define AF_BOGUS 0x0001u
-#define AF_SETCONF 0x0002u
-#define AF_DRYRUN 0x0004u
-#define AF_ALL 0x0008u
-#define AF_FORCE 0x0010u
-#define AF_CHECKINST 0x0020u
+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 */
-/*----- Main code ---------------------------------------------------------*/
+/*----- 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 = 2; }
+ { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 127; }
-static const char *tmpdir;
-
-static void set_tmpdir(void)
-{
- struct dstr d = DSTR_INIT;
- size_t n;
- unsigned i;
-
- dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
- i = 0; n = d.len;
- for (;;) {
- d.len = n; dstr_putf(&d, "%d", rand());
- 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) {
- dstr_puts(&d, "???");
- lose("failed to create temporary directory `%s': too many attempts",
- d.p);
- }
- }
- tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
-}
+/*----- 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)
{
- size_t n = dd->len;
DIR *dir;
struct dirent *d;
+ size_t n = dd->len;
- dd->p[n] = 0;
- dir = opendir(dd->p);
+ /* 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);
}
-static void cleanup(void)
- { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
-
+/* 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;
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);
+}
+
+/* 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.
+ */
+static void prefix_lines(struct job *job, struct linebuf *buf, char marker)
+{
+ 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) {
+ /* 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));
+ }
+
+ /* 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;
+ }
+
+ 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");
+ }
+}
+
+/*----- Job management ----------------------------------------------------*/
+
+/* Add a new job to the `ready' queue.
+ *
+ * The job will be to dump the Lisp system with the given LEN-byte NAME. On
+ * entry, *TAIL_INOUT should point to the `next' link of the last node in the
+ * list (or the list head pointer), and will be updated on exit.
+ *
+ * This function reports (fatal) errors for most kinds of problems. If
+ * `JF_QUIET' is set in F then silently ignore a well-described Lisp system
+ * which nonetheless isn't suitable. (This is specifically intended for the
+ * case where we try to dump all known Lisp systems, but some don't have a
+ * `dump-image' command.)
+ */
#define JF_QUIET 1u
static void add_job(struct job ***tail_inout, unsigned f,
const char *name, size_t len)
struct job *job;
struct treap_path path;
struct config_section *sect;
- struct config_var *dump_var, *cmd_var;
+ struct config_var *dumpvar, *cmdvar, *imgvar;
struct dstr d = DSTR_INIT;
struct argv av = ARGV_INIT;
+ char *imgnew = 0, *imgout = 0;
+ size_t i;
unsigned fef;
+ /* Check to see whether this Lisp system is already queued up. */
job = treap_probe(&jobs, name, len, &path);
if (job) {
if (verbose >= 2) {
}
}
+ /* Find the configuration for this Lisp system and check that it can be
+ * dumped.
+ */
sect = config_find_section_n(&config, 0, name, len);
if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
name = CONFIG_SECTION_NAME(sect);
- dump_var = config_find_var(&config, sect, 0, "dump-image");
- if (!dump_var) {
+ dumpvar = config_find_var(&config, sect, 0, "dump-image");
+ if (!dumpvar) {
if (!(f&JF_QUIET))
lose("don't know how to dump images for Lisp implementation `%s'",
name);
goto end;
}
- cmd_var = config_find_var(&config, sect, 0, "command");
- if (!cmd_var)
- lose("no `command' defined for Lisp implementation `%s'", name);
-
- config_subst_split_var(&config, sect, dump_var, &av);
- if (!av.n) lose("empty command for Lisp implementation `%s'", name);
+ /* Check that the other necessary variables are present. */
+ imgvar = config_find_var(&config, sect, 0, "image-file");
+ if (!imgvar) lose("variable `image-file' not defined for Lisp `%s'", name);
+ cmdvar = config_find_var(&config, sect, 0, "command");
+ if (!cmdvar) lose("variable `command' not defined for Lisp `%s'", name);
+
+ /* Build the job's command line. */
+ config_subst_split_var(&config, sect, dumpvar, &av);
+ if (!av.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 (flags&AF_CHECKINST) {
dstr_reset(&d);
fef = (verbose >= 2 ? FEF_VERBOSE : 0);
- config_subst_var(&config, sect, cmd_var, &d);
+ config_subst_var(&config, sect, cmdvar, &d);
if (!found_in_path_p(d.p, fef) ||
(STRCMP(d.p, !=, av.v[0]) && !found_in_path_p(av.v[0], fef))) {
if (verbose >= 2) moan("skipping Lisp implementation `%s'", name);
}
}
+ /* Collect the output image file names. */
+ imgnew =
+ config_subst_string_alloc(&config, sect, "<internal>", "${@image-new}");
+ imgout =
+ config_subst_string_alloc(&config, sect, "<internal>", "${@image-out}");
+
+ /* If we're supposed to check whether the image file exists, then we should
+ * do that.
+ */
if (!(flags&AF_FORCE)) {
- dstr_reset(&d);
- config_subst_string(&config, sect, "<internal>", "${@IMAGE}", &d);
- if (!access(d.p, F_OK)) {
+ if (!access(imgout, F_OK)) {
if (verbose >= 2)
moan("image `%s' already exists: skipping `%s'", d.p, name);
goto end;
}
}
+ /* 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.)
+ */
job = xmalloc(sizeof(*job));
job->st = JST_READY;
job->kid = -1;
job->out.fd = -1; job->out.buf = 0;
job->err.fd = -1; job->err.buf = 0;
job->av = av; argv_init(&av);
+ job->imgnew = imgnew; job->imgout = imgout; imgnew = imgout = 0;
treap_insert(&jobs, &path, &job->_node, name, len);
**tail_inout = job; *tail_inout = &job->next;
+
end:
+ /* All done. Cleanup time. */
+ for (i = 0; i < av.n; i++) free(av.v[i]);
+ free(imgnew); free(imgout);
dstr_release(&d); argv_release(&av);
}
+/* 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;
+
if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */
if (job->log && job->log != stdout) fclose(job->log);
+ free(job->imgnew); free(job->imgout);
+ for (i = 0; i < job->av.n; i++) free(job->av.v[i]);
+ argv_release(&job->av);
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);
free(job);
}
+/* Do all the necessary things when JOB finishes (successfully or not).
+ *
+ * Eventually the job is freed (using `release_job').
+ */
static void finish_job(struct job *job)
{
char buf[16483];
size_t 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))
WCOREDUMP(job->exit) ? "; core dumped" :
#endif
"");
- else
- fprintf(job->log, "exited with incomprehensible status %06o\n",
- job->exit);
-
- 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;
- }
- }
-
- release_job(job);
-}
-
-static int find_newline(struct linebuf *buf, size_t *linesz_out)
-{
- char *nl;
-
- if (buf->off + buf->len <= MAXLINE) {
- nl = memchr(buf->buf + buf->off, '\n', buf->len);
- if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
- } else {
- 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);
-}
-
-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);
-}
-
-static void prefix_lines(struct job *job, struct linebuf *buf, char marker)
-{
- struct iovec iov[2]; int niov;
- ssize_t n;
- size_t linesz;
+ else
+ fprintf(job->log, "exited with incomprehensible status %06o\n",
+ job->exit);
- 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;
+ /* If it succeeded, then try to rename the completed image file into place.
+ *
+ * If that caused trouble then mark the job as failed after all.
+ */
+ if (ok && rename(job->imgnew, job->imgout)) {
+ fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
+ "output image `%s' to `%s': %s",
+ JOB_NAME(job), JOB_NAME(job),
+ job->imgnew, job->imgout, strerror(errno));
+ ok = 0;
}
- n = readv(buf->fd, iov, niov);
- if (n < 0) {
- if (errno == EAGAIN || errno == EWOULDBLOCK) return;
- lose("failed to read job `%s' output stream: %s",
- JOB_NAME(job), strerror(errno));
+ /* 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;
+ }
}
- 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)
- buf->off = 0;
- else if (buf->len == MAXLINE) {
- write_line(job, buf, MAXLINE, marker, " [...]\n");
- buf->off = buf->len = 0;
- }
+ /* 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));
- if (!n) {
- close(buf->fd); buf->fd = -1;
- if (buf->len)
- write_line(job, buf, buf->len, marker, " [missing final newline]\n");
- }
+ /* Finally free the job control block. */
+ release_job(job);
}
+/* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */
static void reap_children(void)
{
struct job *job, **link;
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 (link = &job_run; (job = *link); link = &job->next)
if (job->kid == kid) goto found;
- moan("unexpected child process %d exited with status %06o", kid, st);
continue;
+
found:
+ /* Mark the job as dead, save its exit status, and move it into the dead
+ * list.
+ */
job->exit = st; job->st = JST_DEAD; job->kid = -1; nrun--;
*link = job->next; job->next = job_dead; job_dead = job;
}
+
+ /* 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));
}
-static void check_signals(void)
-{
- sigset_t old, pend;
- char buf[32];
- ssize_t n;
-
- 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);
-
- 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();
-}
-
-#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));
-}
-
+/* Execute the handler for some JOB. */
static NORETURN void job_child(struct job *job)
{
try_exec(&job->av,
!(flags&AF_CHECKINST) && verbose >= 2 ? TEF_VERBOSE : 0);
moan("failed to run `%s': %s", job->av.v[0], strerror(errno));
- _exit(2);
+ _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;
struct job *job;
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;
p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
+
+ /* 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 {
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));
configure_fd("job stderr pipe", p_err[1], 0, 1) ||
configure_fd("log file", fileno(job->log), 1, 1))
goto fail;
+
+ /* Initialize the line-buffer structures ready for use. */
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;
dstr_reset(&d); argv_string(&d, &job->av);
+
+ /* Print a note to the top of the log. */
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));
job_child(job);
}
+
+ /* 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->st = JST_RUN; 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 && !job_dead) 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);
+ }
+ for (job = job_dead; 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); }
+ for (job = job_dead; job; job = next)
+ { next = job->next; release_job(job); }
+ break;
+ }
+ }
+
+ /* Log any new output from the running jobs. */
+ for (job = job_run; job; job = job->next) {
+ if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
+ prefix_lines(job, &job->out, '|');
+ if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
+ prefix_lines(job, &job->err, '*');
+ }
+
+ /* Finally, clear away any dead jobs once we've collected all their
+ * output.
+ */
+ for (link = &job_dead, job = *link; job; job = next) {
+ next = job->next;
+ if (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); }
fp);
}
+/* 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, **tail, **link, *next;
+ struct job *job, **tail;
struct stat st;
struct dstr d = DSTR_INIT;
- int i, fd, nfd, first;
- fd_set fd_in;
+ int i, fd, first;
+ /* Command-line options. */
static const struct option opts[] = {
{ "help", 0, 0, 'h' },
{ "version", 0, 0, 'V' },
{ 0, 0, 0, 0 }
};
+ /* Initial setup. */
set_progname(argv[0]);
init_config();
+ /* Parse the options. */
optprog = (/*unconst*/ char *)progname;
for (;;) {
i = mdwopt(argc - 1, argv + 1, "hVO:ac:f+i+j:n+o:qv", opts, 0, 0,
}
}
+ /* CHeck that everything worked. */
optind++;
if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS;
- if (flags&AF_BOGUS) { usage(stderr); exit(2); }
+ if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+ /* Load default configuration if no explicit files were requested. */
if (!(flags&AF_SETCONF)) load_default_config();
- if (!out)
- config_set_var(&config, builtin, 0,
- "@IMAGE", "${@CONFIG:image-dir}/${image-file}");
- else if (stat(out, &st) || !S_ISDIR(st.st_mode))
- config_set_var(&config, builtin, CF_LITERAL, "@IMAGE", out);
- else {
- config_set_var(&config, builtin, CF_LITERAL, "@%OUTDIR", out);
- config_set_var(&config, builtin, 0,
- "@IMAGE", "${@BUILTIN:@%OUTDIR}/${image-file}");
+ /* 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));
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, "@%TMPDIR", tmpdir);
+ config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir);
config_set_var(&config, builtin, 0,
- "@TMPDIR", "${@BUILTIN:@%TMPDIR}/${@NAME}");
+ "@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-out", "${@image-dir}/${image-file}");
+ 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-out", "${@BUILTIN:@%out-dir}/${image-file}");
+ } else if (argc - optind != 1)
+ lose("can't dump multiple Lisps to a single output file");
+ else
+ config_set_var(&config, builtin, CF_LITERAL, "@image-out", out);
+ /* Set the staging file. */
+ config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new");
+
+ /* Dump the final configuration if we're being very verbose. */
if (verbose >= 5) dump_config();
+ /* Create jobs for the Lisp systems we're supposed to be dumping. */
tail = &job_ready;
if (!(flags&AF_ALL))
for (i = optind; i < argc; i++)
add_job(&tail, 0, argv[i], strlen(argv[i]));
else {
+ /* So 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.
+ */
var = config_find_var(&config, toplevel, 0, "dump");
- if (!var)
+ if (!var) {
+ /* No setting. Just do all of the Lisps which look available. */
+
+ flags |= AF_CHECKINST;
for (config_start_section_iter(&config, &si);
(sect = config_next_section(&si)); )
add_job(&tail, JF_QUIET,
CONFIG_SECTION_NAME(sect),
CONFIG_SECTION_NAMELEN(sect));
- else {
+ } else {
+ /* Parse the `dump' list. */
+
p = var->val; l = p + var->n;
for (;;) {
while (p < l && ISSPACE(*p)) p++;
q = p;
while (p < l && !ISSPACE(*p) && *p != ',') p++;
add_job(&tail, 0, q, p - q);
- if (p < l) p++;
+ while (p < l && ISSPACE(*p)) p++;
+ if (p < l && *p == ',') p++;
}
}
}
*tail = 0;
+ /* Report on what it is we're about to do. */
if (verbose >= 3) {
dstr_reset(&d);
first = 1;
moan("dumping Lisps: %s", d.p);
}
+ /* If we're not actually going to do anything after all then now's the time
+ * to, err, not do that.
+ */
if (flags&AF_DRYRUN) {
for (job = job_ready; job; job = job->next) {
if (try_exec(&job->av,
return (rc);
}
- 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);
-
- for (;;) {
- start_jobs();
- if (!job_run && !job_dead) break;
-
-#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);
- }
- for (job = job_dead; 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
-
- if (select(nfd, &fd_in, 0, 0, 0) < 0) {
- if (errno == EINTR) continue;
- else lose("select failed: %s", strerror(errno));
- }
-
- if (FD_ISSET(sig_pipe[0], &fd_in)) {
- check_signals();
- if (sigloss >= 0) {
- 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); }
- for (job = job_dead; job; job = next)
- { next = job->next; release_job(job); }
- break;
- }
- }
-
- for (job = job_run; job; job = job->next) {
- if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
- prefix_lines(job, &job->out, '|');
- if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
- prefix_lines(job, &job->err, '*');
- }
- for (link = &job_dead, job = *link; job; job = next) {
- next = job->next;
- if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
- prefix_lines(job, &job->out, '|');
- if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
- prefix_lines(job, &job->err, '*');
- if (job->out.fd >= 0 || job->err.fd >= 0) link = &job->next;
- else { *link = next; finish_job(job); }
- }
- }
+ /* Run the jobs. */
+ run_jobs();
+ /* Finally, 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); }
+ /* All done! */
return (rc);
}
#include "lib.h"
-/*----- Miscellany --------------------------------------------------------*/
-
-int str_lt(const char *a, size_t an, const char *b, size_t bn)
-{
- if (an < bn) return (MEMCMP(a, <=, b, an));
- else return (MEMCMP(a, <, b, bn));
-}
-
/*----- 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;
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);
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;
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); }
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);
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;
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);
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;
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;
/*----- 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 =
- (const char **)xrealloc(av->v - av->o, newsz*sizeof(const char *)) +
- av->o;
+ av->v = xrealloc(av->v - av->o, newsz*sizeof(char *)) + 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;
newoff = 16;
while (newoff < n) newoff *= 2;
argv_ensure(av, newoff - av->o);
- memmove(av->v + newoff - av->o, av->v, av->n*sizeof(const char *));
+ 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); }
-void argv_append(struct argv *av, const char *p)
+/* 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; }
-void argv_appendn(struct argv *av, const char *const *v, size_t n)
+/* 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)
{
- const char *p;
-
- for (;;)
- { p = va_arg(ap, const char *); if (!p) break; argv_append(av, p); }
+ 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); }
-void argv_prepend(struct argv *av, const char *p)
+/* 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++; }
-void argv_prependn(struct argv *av, const char *const *v, size_t 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)
{
- const char *p, **v;
+ char *p, **v;
size_t n = 0;
for (;;) {
- p = va_arg(ap, const char *); if (!p) break;
+ p = va_arg(ap, char *); if (!p) break;
argv_prepend(av, p); n++;
}
v = av->v;
}
}
+/* 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;
- while (n) {
+ /* 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 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;
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)
{
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;
- while (*nn) {
+ /* 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);
- n = *candidate; l = n->left; r = n->right;
- for (;;) {
- if (l && (!r || l->wt > r->wt)) { nn = &l->right; l = l->right; }
- else if (r) { nn = &r->left; r = r->left; }
- else break;
- }
- *nn = 0;
- free(n->k);
- return (n);
+ /* 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 Z
+ *
+ * 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; n->left = l->right; nn = &l->right; }
+ else { *nn = r; n->right = r->left; nn = &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 nodes, 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) {
return (n);
}
-static void check_node(struct treap_node *n, unsigned maxwt,
- const char *klo, const char *khi)
+/* 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));
- if (n->left) check_node(n->left, n->wt, klo, n->k);
- if (n->right) check_node(n->right, n->wt, 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_node(t->root, t->root->wt, 0, 0); }
+ { 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);
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 ----------------------------------------*/
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)
{
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);
+ 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)
-{
- if (sect->nparents == SIZE_MAX) sect->nparents = 0;
- conf->fallback = 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)
{
}
}
+/* 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;
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;
- struct argv av = ARGV_INIT;
+ const char *file; unsigned line;
size_t i, n;
- char *p, *q;
+ 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;
- var = treap_lookup(§->vars, "@PARENTS", 8);
+ /* Look up `@parents', without recursion! */
+ var = treap_lookup(§->vars, "@parents", 8);
if (!var) {
- if (!conf->fallback)
+ /* 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 = xmalloc(sizeof(*sect->parents)); sect->nparents = 1;
sect->parents[0] = conf->fallback;
}
} else {
- p = var->val;
- for (;;) {
- while (ISSPACE(*p)) p++;
- if (!*p) break;
- q = p; while (*q && *q != ',' && !ISSPACE(*q)) q++;
- argv_append(&av, p); argv_append(&av, q);
- p = q; if (*p == ',') p++;
+ /* 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) {
parent = config_find_section_n(conf, 0, av.v[i], n);
if (!parent)
lose("%s:%u: unknown parent section `%.*s'",
- var->file, var->line, (int)n, av.v[i]);
+ file, line, (int)n, av.v[i]);
sect->parents[i/2] = parent;
}
- argv_release(&av);
}
+
+ /* 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_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;
else
return (cache->var);
- set_config_section_parents(conf, sect);
-
- var = treap_lookup(§->vars, name, sz);
- if (!var) {
- 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]));
- }
+ /* 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)
return (var);
}
-void config_start_var_iter(struct config_section *sect,
- struct config_var_iter *i)
- { treap_start_iter(§->vars, &i->i); }
-
-struct config_var *config_next_var(struct config_var_iter *i)
- { return (treap_next(&i->i)); }
-
+/* 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.
+ *
+ * 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.
+ */
void config_set_var(struct config *conf, struct config_section *sect,
- unsigned f,
- const char *name, const char *value)
+ unsigned f, const char *name, const char *value)
{
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.
+ */
void config_set_var_n(struct config *conf, struct config_section *sect,
unsigned f,
const char *name, size_t namelen,
var->f = f;
}
+/* 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;
- char *p, *q;
+ 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);
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++;
- if (d.p[0] && !ISSPACE(d.p[0])) {
+ /* 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;
}
- if (d.p[0] == ';')
- ;
- else if (d.p[0] == '[') {
- p = d.p + 1; q = strchr(p, ']');
- if (!q) lose("%s:%u: missing `]' in section header", file, line);
+
+ /* 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);
- q++; while (ISSPACE(*q)) q++;
- if (*q) lose("%s:%u: trailing junk after `]' in section header",
- file, line);
+
} else {
- p = d.p;
- while (*p && !ISSPACE(*p) && *p != '{' && *p != '}' && *p != '=')
- p++;
+ /* 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);
}
- } else {
- p = d.p; while (ISSPACE(*p)) p++;
- if (*p) {
- if (!var)
- lose("%s:%u: continuation line, but no variable", file, line);
- if (dd.len) dstr_putc(&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; }
- dstr_release(&d); dstr_release(&dd);
+ /* 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;
/*----- 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;
- struct config_section *home, *fallback;
- struct argv *av;
- struct dstr *d;
+ 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 */
};
-static const char *scan_name(const char *p, const char *l)
-{
- while (p < l &&
- (ISALNUM(*p) || *p == '-' || *p == '_' || *p == '.' || *p == '/' ||
- *p == '*' || *p == '+' || *p == '%' || *p == '@'))
- p++;
- return (p);
-}
-
-static void filter_string(const char *p, const char *l, struct subst *sb,
- unsigned qfilt)
+/* 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)
+ 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 (;;) {
- r = l - p; n = strcspn(p, "\"\\");
+ /* 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;
- dstr_putm(sb->d, p, n);
+
+ 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;
- dstr_putcn(sb->d, '\\', qfilt); dstr_putc(sb->d, p[n]);
- p += n + 1;
+
+ /* 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,
- struct subst *sb,
- struct config_var **var_out)
+ 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(p, l);
+ 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(p, l);
+ p = t + 1; t = scan_name("variable", p, l, file, line);
}
if (!sect) *var_out = 0;
return (t);
}
-#define SF_SPLIT 0x0001u
-#define SF_QUOT 0x0002u
-#define SF_SUBST 0x0004u
-#define SF_SUBEXPR 0x0008u
-#define SF_SPANMASK 0x00ffu
-#define SF_WORD 0x0100u
-#define SF_SKIP 0x0200u
-#define SF_LITERAL 0x0400u
-
-static const char *subst(const char *p, const char *l, struct subst *sb,
+/* 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)
{
unsigned subqfilt, ff;
size_t n;
-#define ESCAPE "\\"
-#define SUBST "$"
-#define WORDSEP " \f\r\n\t\v'\""
-#define QUOT "\""
-#define DELIM "|}"
-
- static const char *const delimtab[] =
- { 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 };
+ /* 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);
+ 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));
}
f &= ~SF_WORD;
}
+
+ /* Skip over further whitespace at high speed. */
do p++; while (p < l && ISSPACE(*p));
} else if (*p == '\\') {
- p++;
- if (p >= l) lose("%s:%u: unfinished `\\' escape", file, line);
+ /* 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);
- dstr_putc(sb->d, *p);
+
+ /* 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);
}
- 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 == '\'') {
- t = strchr(p, '\''); if (!t) lose("%s:%u: missing `''", file, line);
- if (!(f&SF_SKIP)) filter_string(p, t, sb, qfilt);
+ /* 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 '?':
- p = retrieve_varspec(p + 1, l, sb, &var);
+ /* 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 '{':
- q0 = p + 1; p = retrieve_varspec(q0, l, sb, &var); q1 = p;
+ /* 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;
- while (p < l) {
- if (*p != '|') break;
- p++; t = scan_name(p, l);
- if (t - p == 1 && *p == 'q') subqfilt = 2*subqfilt + 1;
+ 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'",
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:
- lose("%s:%u: unexpected substitution `%c'", file, line, *p);
+ /* 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 "
}
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);
+ 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)
{
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)
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)
{
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)
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)
/*----- 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)))
#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 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)
-#define DISCARD(x) do if (x); while (0)
-
-#define END ((const char *)0)
-
#ifndef SIZE_MAX
# define SIZE_MAX (-(size_t)1)
#endif
-
-/*----- Miscellany --------------------------------------------------------*/
-
-extern int str_lt(const char */*a*/, size_t /*an*/,
- const char */*b*/, size_t /*bn*/);
+ /* 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;
- size_t len, sz;
+ 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 {
- const char **v;
- size_t o, n, sz;
+ 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*/);
-extern void argv_append(struct argv */*av*/, const char */*p*/);
+ /* 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*/,
- const char *const */*v*/, size_t /*n*/);
+ 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*/, ...);
-extern void argv_prepend(struct argv */*av*/, const char */*p*/);
+ /* 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*/,
- const char *const */*v*/, size_t /*n*/);
+ 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;
- struct treap_node *left, *right;
- char *k; size_t kn;
+ 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 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;
- struct config_section *head, **tail;
- struct config_section *fallback;
+ 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;
- struct config_section *next;
- struct config_section **parents; size_t nparents;
- struct treap vars;
- struct treap cache;
+ 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;
- unsigned f;
-#define CF_OPEN 1u
- struct config_var *var;
+ 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;
- char *file; unsigned line;
- char *val; size_t n;
- unsigned f;
+ 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)
-#define CF_LITERAL 1u
-#define CF_EXPAND 2u
-#define CF_OVERRIDE 4u
+/* A section iterator.
+ *
+ * (Sections are visited in the order in which they were created.)
+ */
struct config_section_iter {
- struct config_section *sect;
+ 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*/);
-#define CF_CREAT 1u
+ /* 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*/);
-#define CF_INHERIT 2u
+ /* 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 void 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.
+ *
+ * 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 void 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*/);
-extern void config_start_var_iter(struct config_section */*sect*/,
+ /* 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*/);
-extern int config_read_dir(struct config */*conf*/,
- const char */*dir*/, 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*/);
-#define CF_NOENTOK 1u
+ /* 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 -------------------------------------------------*/
dstr_release(&d);
}
-static const char *getenv_or_default(const char *var, const char *dflt)
- { const char *p = getenv(var); return (p ? p : dflt); }
+static char *getenv_or_default(const char *var, char *dflt)
+ { char *p = getenv(var); return (p ? p : dflt); }
/*----- Invoking Lisp systems ---------------------------------------------*/
if (st) lose("unfinished `%c' string in %s `%s'", st, what, file);
}
- i = 0; parse_arguments(arg, av.v, av.n, &i);
+ i = 0; parse_arguments(arg, (const char **)av.v, av.n, &i);
if (i < av.n)
lose("positional argument `%s' in %s `%s'", av.v[i], what, file);
argv_release(&av);
if (!script) script = DATADIR "/eval.lisp";
argv_append(&arg.av, "--");
}
- argv_appendn(&arg.av, (const char *const *)argv + i, argc - i);
+ argv_appendn(&arg.av, argv + i, argc - i);
n = arg.av.n;
/* Find the user's home directory. (Believe them if they set something
--- /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).
+.
+
+
+.
+.\"--------------------------------------------------------------------------
+.
+.SH BUGS
+.hP \*o
+.
+.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, 0, 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})
+
+image-path = ${@image-dir}/${image-file}
+
+;;;--------------------------------------------------------------------------
+[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 --------------------------------------------------
.
.\"--------------------------------------------------------------------------
.
-.SH "BUGS"
+.SH BUGS
.hP \*o
Loading ASDF systems is irritatingly noisy
with some Lisp implementations.
I don't know how to fix this:
suggestions are welcome.
.
-.SH "SEE ALSO"
-.BR dump-runlisp-image (1).
+.SH SEE ALSO
+.BR dump-runlisp-image (1),
+.BR query-runlisp-config (1),
+.BR runlisp.conf (5).
.
-.SH "AUTHOR"
+.SH AUTHOR
Mark Wooding, <mdw@distorted.org.uk>
.
.\"----- That's all, folks --------------------------------------------------
/*----- Static data -------------------------------------------------------*/
+/* The state we need for a Lisp system. */
struct lispsys {
- struct treap_node _node;
- struct lispsys *next_lisp, *next_accept, *next_prefer, *next_order;
- unsigned f;
-#define LF_KNOWN 1u
-#define LF_ACCEPT 2u
-#define LF_PREFER 4u
- struct config_section *sect;
- struct config_var *var;
+ 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;
+ struct lispsys *head, **tail; /* list head and tail */
};
-static struct argv argv_tail = ARGV_INIT;
-const char *script = 0;
-
-static unsigned flags = 0;
-#define AF_CMDLINE 0x0000u
-#define AF_EMBED 0x0001u
-#define AF_ENV 0x0002u
-#define AF_CONF 0x0003u
-#define AF_STATEMASK 0x000fu
-#define AF_BOGUS 0x0010u
-#define AF_SETCONF 0x0020u
-#define AF_NOEMBED 0x0040u
-#define AF_DRYRUN 0x0080u
-#define AF_VANILLA 0x0100u
-
-struct treap lispsys = TREAP_INIT;
-static struct lispsys_list
- lisps = { 0, &lisps.head },
- accept = { 0, &accept.head },
- prefer = { 0, &prefer.head };
+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 ---------------------------------------------------------*/
-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);
-}
-
+/* 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;
return (lisp);
}
-#define LISP_LINK(lisp, linkoff) \
- ((struct lispsys **)((unsigned char *)(lisp) + (linkoff)))
-
+/* 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)
if (!*p) return;
for (;;) {
+ while (ISSPACE(*p)) p++;
if (!*p) break;
- q = p; while (*p && *p != ',') p++;
+ q = p; while (*p && !ISSPACE(*p) && *p != ',') p++;
lisp = ensure_lispsys(q, p - q);
if (lisp->f&flag) {
if (verbose >= 1)
lisp->f |= flag; *link = 0;
*list->tail = lisp; list->tail = link;
}
+ while (ISSPACE(*p)) p++;
if (!*p) break;
- p++;
+ 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)
{
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)
{
for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) {
if (first) first = 0;
else dstr_puts(&d, ", ");
- dstr_putf(&d, "`%s'", LISPSYS_NAME(lisp));
+ dstr_puts(&d, LISPSYS_NAME(lisp));
}
if (first) dstr_puts(&d, "(none)");
dstr_putz(&d);
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;
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);
+}
+
+/* Parse the options in the argument vector. */
static void parse_options(int argc, char *argv[])
{
int i;
}
}
+/* Extract and process the embedded options from a SCRIPT. */
static void handle_embedded_args(const char *script)
{
struct dstr d = DSTR_INIT;
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)
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 == '"') { p++; qstate = !qstate; }
+
+ 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);
- if (p < l) p++;
- *q++ = 0;
+
+ /* 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)
script, av.v[optind]);
end:
+ /* Tidy up. */
if (fp) {
if (ferror(fp))
lose("error reading script `%s': %s", script, strerror(errno));
dstr_release(&d); argv_release(&av);
}
+/* Main program. */
int main(int argc, char *argv[])
{
struct config_section_iter si;
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();
- config_set_var(&config, toplevel, 0, "prefer", "${@ENV:RUNLISP_PREFER?}");
+ /* Parse the command-line options. */
flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
parse_options(argc - 1, argv + 1); optind++;
- if (argv_tail.n)
- flags |= AF_NOEMBED;
- else if (!script && !argv_tail.n) {
- if (optind < argc) script = argv[optind]++;
- else flags |= AF_BOGUS;
- }
-
+ /* 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, (const char *const *)argv, argc);
- argc = argv_tail.n; argv = (/*unconst*/ char */*unconst*/ *)argv_tail.v;
+ argv_appendn(&argv_tail, argv, argc);
+ argc = argv_tail.n; argv = argv_tail.v;
}
- if (flags&AF_BOGUS) { usage(stderr); exit(2); }
+ /* 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();
- if (verbose >= 5) dump_config();
- dstr_reset(&d);
- var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
- config_subst_var(&config, toplevel, var, &d);
- add_lispsys(d.p, "preferred", &prefer, LF_PREFER,
- offsetof(struct lispsys, next_prefer));
+ /* 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:data-dir}/eval.lisp}");
-
+ "${@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");
- config_set_var(&config, builtin, CF_LITERAL, "@SCRIPT", script);
+ /* 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)); ) {
}
*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 = 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; }
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) {
offsetof(struct lispsys, next_order));
}
+ /* Try to actually run the script. */
for (lisp = order.head; lisp; lisp = lisp->next_order) {
- if (config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
+ /* 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");
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");
+ 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;
}
- argv_appendn(&av, (const char *const *)argv, argc);
+
+ /* 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");
}
;;; -*-conf-windows-*-
-;; 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})
-
-image-path = ${@CONFIG:image-dir}/${image-file}
-
;;;--------------------------------------------------------------------------
-[sbcl]
-
-command = ${@ENV:SBCL?sbcl}
-image-file = sbcl+asdf.core
-
-run-script =
- ${command} --noinform
- $?@IMAGE{--core "${image-path}" --eval "${image-restore}" |
- --eval "${run-script-prelude}"}
- --script ${@SCRIPT}
+;;; Top-level configuration.
-dump-image =
- ${command} --noinform --no-userinit --no-sysinit --disable-debugger
- --eval "${dump-image-prelude}"
- --eval "(sb-ext:save-lisp-and-die \"${@IMAGE|q}\")"
+;; 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
-;;;--------------------------------------------------------------------------
-[ccl]
-
-command = ${@ENV:CCL?ccl}
-image-file = ccl+asdf.image
+;; Directory to look for or dump custom images. Defaults to hardcoded
+;; directory; overridden by `$RUNLISP_IMAGEDIR' in environment.
+; image-dir = /path/to/things
-run-script =
- ${command} -b -n -Q
- $?@IMAGE{-I "${image-path}" -e "${image-restore}" |
- -e "${run-script-prelude}"}
- -l ${@SCRIPT} -e "(ccl:quit)" --
+;; Directory to look for additional scripts. Defaults to hardcoded
+;; directory; overridden by `$RUNLISP_DATADIR' in environment.
+; data-dir = /path/to/things
-;; 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|q}\"
- :init-file nil
- :error-handler :quit)"
+;; Script to support eval-mode operation. Defaults to
+;; `${data-dir}/eval.lisp'; opverridden by `$RUNLISP_EVAL' in environment.
+; eval-script = /path/to/script
;;;--------------------------------------------------------------------------
-[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 = clisp+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|q}\" :norc t :script t)"
-
-;;;--------------------------------------------------------------------------
-[ecl]
-
-command = ${@ENV:ECL?ecl}
-image-file = ecl+asdf
-
-run-script =
- $?@IMAGE{"${image-path}" -s ${@SCRIPT} |
- ${@ENV:ECL?ecl} "${@ECLOPT}norc"
- "${@ECLOPT}eval" "(progn
- ${run-script-prelude}
- ${clear-cl-user})"
- "${@ECLOPT}shell" ${@SCRIPT}}
- --
-
-dump-image =
- "${@CONFIG:data-dir}/dump-ecl"
- "${@IMAGE}" "${command}" "${@ECLOPT}" "${@TMPDIR}"
-
-;;;--------------------------------------------------------------------------
-[cmucl]
-
-command = ${@ENV:CMUCL?cmucl}
-image-file = cmucl+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|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' 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 "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
+.BR @BUILTIN ,
+.BR @CONFIG ,
+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 "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 "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.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH BUGS
+.hP \*o
+.
+.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 --------------------------------------------------
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],
-[lisp=$1
+[SETUP_RUNLISP_ENV
+lisp=$1
LISP=$m4_translit(m4_bregexp([$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 ;;
- *) RUNLISP_IMAGEDIR=$abs_top_builddir ;;
-esac
-export RUNLISP_IMAGEDIR])
+case /$opt/ in */noimage/*) RUNLISP_IMAGEDIR=./notexist ;; esac])
m4_define([WHICH_LISP],
[(or #+sbcl "sbcl" #+ccl "ccl" #+clisp "clisp"
m4_define([NL], [
])
-m4_define([SETUP_RUNLISP_IMAGEDIR],
-[RUNLISP_IMAGEDIR=$abs_top_builddir; export RUNLISP_IMAGEDIR])
-
-m4_define([SETUP_RUNLISP_EVAL],
-[RUNLISP_EVAL=$abs_top_srcdir/eval.lisp; export RUNLISP_EVAL])
-
###--------------------------------------------------------------------------
### A basic smoke test.
;; 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.
+;; 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#)
AT_SETUP([eval mode])
AT_KEYWORDS([eval common])
-SETUP_RUNLISP_IMAGEDIR
-SETUP_RUNLISP_EVAL
+SETUP_RUNLISP_ENV
## A very basic smoke test.
AT_CHECK([RUNLISP_PATH -e '(format t "Just another Lisp hacker!~%")'],,
AT_SETUP([preferences])
AT_KEYWORDS([prefs common])
-SETUP_RUNLISP_IMAGEDIR
-SETUP_RUNLISP_EVAL
+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
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 supported Lisp systems found[]NL])
+[runlisp: no acceptable Lisp systems found[]NL])
## Unset all of the user preference mechanisms.
-unset RUNLISP_OPTIONS
here=$(pwd)
mkdir HOME config
HOME=$here/HOME XDG_CONFIG_HOME=$here/config; export HOME XDG_CONFIG_HOME
done
## Preferences will override the order of acceptable implementations.
-AT_CHECK_UNQUOTED([RUNLISP_OPTIONS=-P$badlisp,$lisp0 ./script0],, ["$lisp0"NL])
-AT_CHECK_UNQUOTED([RUNLISP_OPTIONS=-P$badlisp,$lisp0 ./script1],, ["$lisp0"NL])
+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_OPTIONS=-P$badlisp ./script0],, ["$lisp0"NL])
-AT_CHECK_UNQUOTED([RUNLISP_OPTIONS=-P$badlisp ./script1],, ["$lisp1"NL])
+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/.runlisprc config/runlisprc; do
+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-*-
--P$lisp
+;;; -*-conf-*-
+prefer = $lisp
EOF
## Basic check.
AT_CHECK_UNQUOTED([./script0],, ["$lisp"NL])
AT_CHECK_UNQUOTED([./script1],, ["$lisp"NL])
- ## Environment variable only appends.
- AT_CHECK_UNQUOTED([RUNLISP_OPTIONS=-P$olisp ./script0],, ["$lisp"NL])
- AT_CHECK_UNQUOTED([RUNLISP_OPTIONS=-P$olisp ./script1],, ["$lisp"NL])
-
- ## But we can clear the preferred list.
- AT_CHECK_UNQUOTED([RUNLISP_OPTIONS="-C -P$olisp" ./script0],, ["$olisp"NL])
- AT_CHECK_UNQUOTED([RUNLISP_OPTIONS="-C -P$olisp" ./script1],, ["$olisp"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
EXTRA_DIST =
CLEANFILES =
+SUFFIXES =
bin_PROGRAMS =
bin_SCRIPTS =
nodist_bin_SCRIPTS =
man_MANS =
+doc_DATA =
+
+pkgdata_DATA =
+pkgconfdir = $(sysconfdir)/$(PACKAGE_NAME)
+pkgconf_DATA =
-noinst_PROGRAMS =
noinst_DATA =
+noinst_LIBRARIES =
+noinst_PROGRAMS =
###--------------------------------------------------------------------------
### Standard configuration substitutions.
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 .pdf
+.1.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
+.5.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
+
+###--------------------------------------------------------------------------
### List of Lisp systems.
LISPS =
~mdw / runlisp / commitdiff