librunlisp_a_SOURCES += common.c common.h
librunlisp_a_SOURCES += lib.c lib.h
librunlisp_a_SOURCES += mdwopt.c mdwopt.h
+librunlisp_a_SOURCES += sha256.c sha256.h
###--------------------------------------------------------------------------
### The main driver program.
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_LDADD = librunlisp.a
-
-noinst_PROGRAMS += toy
-toy_SOURCES = toy.c
-toy_SOURCES += lib.c lib.h
+EXTRA_DIST += runlisp.1.in
###--------------------------------------------------------------------------
### Additional machinery.
pkgdata_DATA += eval.lisp
EXTRA_DIST += eval.lisp
-pkgdata_DATA += dump-ecl
+pkgdata_SCRIPTS += dump-ecl
EXTRA_DIST += dump-ecl
bin_PROGRAMS += query-runlisp-config
query_runlisp_config_LDADD = librunlisp.a
man_MANS += query-runlisp-config.1
doc_DATA += query-runlisp-config.pdf
+EXTRA_DIST += query-runlisp-config.1.in
man_MANS += runlisp.conf.5
doc_DATA += runlisp.conf.pdf
+EXTRA_DIST += runlisp.conf.5.in
EXTRA_DIST += runlisp-base.conf
install-data-hook::
dump_runlisp_image_LDADD = librunlisp.a
man_MANS += dump-runlisp-image.1
doc_DATA += dump-runlisp-image.pdf
-EXTRA_DIST += dump-runlisp-image.1
+EXTRA_DIST += dump-runlisp-image.1.in
DUMP_RUNLISP_IMAGE = $(v_dump)./dump-runlisp-image \
-f -c$(srcdir)/runlisp-base.conf -O$@
execvp(av->v[0], av->v);
if (errno != ENOENT) {
moan("failed to exec `%s': %s", av->v[0], strerror(errno));
- _exit(2);
+ _exit(127);
}
}
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,
+++ /dev/null
-.\" -*-nroff-*-
-.\"
-.\" Manual for `dump-runlisp-image'
-.\"
-.\" (c) 2020 Mark Wooding
-.\"
-.
-.\"----- Licensing notice ---------------------------------------------------
-.\"
-.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
-.\"
-.\" Runlisp is free software: you can redistribute it and/or modify it
-.\" under the terms of the GNU General Public License as published by the
-.\" Free Software Foundation; either version 3 of the License, or (at your
-.\" option) any later version.
-.\"
-.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
-.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-.\" for more details.
-.\"
-.\" You should have received a copy of the GNU General Public License
-.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
-.
-.ie t \{\
-. ds o \(bu
-. if \n(.g \{\
-. fam P
-. ev an-1
-. fam P
-. ev
-. \}
-.\}
-.el \{\
-. ds o o
-.\}
-.
-.de hP
-.IP
-\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
-..
-.ds , \h'.16667m'
-.
-.\"--------------------------------------------------------------------------
-.TH dump-runlisp-image 1 "12 August 2020" "Mark Wooding"
-.SH NAME
-dump-runlisp-image \- dump Lisp images for faster script execution
-.
-.\"--------------------------------------------------------------------------
-.SH SYNOPSIS
-.
-.B dump-runlisp-image
-.RB [ \-acluv ]
-.RB [ \-o
-.IR output ]
-.RI [ lisp
-\&...]
-.
-.\"--------------------------------------------------------------------------
-.SH DESCRIPTION
-.
-The
-.B dump-runlisp-image
-program builds custom images for use by
-.BR runlisp (1).
-For many Lisp implementation,
-a custom image,
-with ASDF already loaded,
-can start scripts much more quickly
-than the `vanilla' images installed by deafult.
-The downside is that custom images may be rather large.
-.
-.SS "Supperted Common Lisp implementations"
-The following Lisp implementations are currently supported.
-.TP
-.B "ccl"
-Clozure Common Lisp.
-The default image name is
-.BR ccl+asdf.image ;
-a typical image can be 20\(en30\*,MB in size.
-.TP
-.B "clisp"
-GNU CLisp.
-The default image name is
-.BR clisp+asdf.mem ;
-a typical image is about 10\*,MB in size.
-.TP
-.B "cmucl"
-Carnegie\(enMellon University Common Lisp.
-The default image name is
-.BR cmucl+asdf.core ;
-a typical image is about 35\*,MB in size.
-.TP
-.B "ecl"
-Embeddable Common Lisp.
-The default image name is
-.BR ecl+asdf ;
-images comparatively very small
-\(en about 4\*,MB \(en
-but, sadly, not very effective.
-.TP
-.B "sbcl"
-Steel Bank Common Lisp.
-The default image name is
-.BR sbcl+asdf.core ;
-a typical image is nearly 45\*,MB in size.
-.PP
-(Although
-.BR runlisp (3)
-also supports Armed Bear Common Lisp,
-.B dump-runlisp-image
-currently doesn't.)
-.
-.SS "Options"
-The following options are accepted on the command line.
-.
-.TP
-.B "\-h"
-Write a synopsis of
-.BR dump-runlisp-image 's
-command-line syntax
-and a description of the command-line options
-to standard output
-and immediately exit with status 0.
-.
-.TP
-.B "\-v"
-Write
-.BR dump-runlisp-image 's
-version number
-to standard output
-and immediately exit with status 0.
-.
-.TP
-.B "\-a"
-Dump images for all Lisp supported implementations
-which are installed .
-This implies
-.BR \-c ,
-described below.
-You can't set
-.B \-a
-and also list implementations explicitly on the command line.
-.
-.TP
-.B "\-c"
-Only dump images for Lisp implementations
-which are actually installed
-(and can be found).
-.
-.TP
-.B "\-l"
-List the supported implementations
-and the names of the image files for each
-to standard output,
-and immediately exit with status 0.
-.
-.TP
-.BI "\-o " output
-If
-.I output
-names a directory,
-then write images to that directory
-with their default names
-(as listed above).
-Otherwise,
-exactly one Lisp implementation may be named, and
-the image is written to a file named
-.IR output .
-By default,
-images are written to the directory which
-.BR runlisp (1)
-will look in when checking for custom images
-(shown in
-.B "runlisp \-\-help"
-or
-.BR "dump-runlisp-image \-h" ),
-unless overridden by the
-.B RUNLISP_IMAGEDIR
-environment variable.
-.
-.TP
-.BI "\-u"
-Don't create Lisp images
-if a file with the appropriate name
-already exists.
-.
-.TP
-.BI "\-v"
-Be more verbose about the process of creating images.
-Lisp implementations can be rather noisy:
-by default,
-.B dump-runlisp-image
-runs silently unless something goes wrong,
-in which case it prints the failed Lisp command line
-and its output.
-If you set
-.B \-v
-then
-.B dump-runlisp-image
-will show Lisp implementation's noise immediately,
-without waiting to see whether it succeeds or fails.
-.PP
-The
-.B dump-runlisp-image
-program will dump an image for each of the named
-.I lisp
-implementations in turn,
-or all Lisp implementations, if
-.B \-a
-is set.
-.PP
-This involves invoking the Lisp implementations.
-The
-.B dump-runlisp-image
-program expects, by default,
-to be able to run a Lisp system
-as a program with the same name,
-found by searching as directed by the
-.B PATH
-environment variable.
-This can be overridden by setting an environment variable,
-with the same name but in
-.IR "upper case" ,
-to the actual name \(en
-either a bare filename to be searched for on the
-.BR PATH ,
-or a pathname containing a
-.RB ` / ',
-relative to the working directory or absolute,
-to the program.
-Note that the entire variable value is used as the program name:
-it's not possible to provide custom arguments to a Lisp system
-using this mechanism.
-If you want to do that,
-you must write a shell script to do the necessary work,
-and point the environment variable
-(or the
-.BR PATH )
-at your script.
-(This is the same convention as
-.BR runlisp (1).)
-.PP
-If
-.B \-a
-or
-.B \-c
-is set,
-then
-.B dump-runlisp-image
-will skip Lisp implementations
-which can't actually be found
-(by searching the
-.B PATH
-for its command name).
-.
-.\"--------------------------------------------------------------------------
-.
-.SH SEE ALSO
-.BR query-runlisp-config (1),
-.BR runlisp (1),
-.BR runlisp.conf (5).
-.
-.SH AUTHOR
-Mark Wooding, <mdw@distorted.org.uk>
-.
-.\"----- That's all, folks --------------------------------------------------
--- /dev/null
+.\" -*-nroff-*-
+.\"
+.\" Manual for `dump-runlisp-image'
+.\"
+.\" (c) 2020 Mark Wooding
+.\"
+.
+.\"----- Licensing notice ---------------------------------------------------
+.\"
+.\" This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+.\"
+.\" Runlisp is free software: you can redistribute it and/or modify it
+.\" under the terms of the GNU General Public License as published by the
+.\" Free Software Foundation; either version 3 of the License, or (at your
+.\" option) any later version.
+.\"
+.\" Runlisp is distributed in the hope that it will be useful, but WITHOUT
+.\" ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+.\" FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+.\" for more details.
+.\"
+.\" You should have received a copy of the GNU General Public License
+.\" along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+.
+.ie t \{\
+. ds o \(bu
+. if \n(.g \{\
+. fam P
+. ev an-1
+. fam P
+. ev
+. \}
+.\}
+.el \{\
+. ds o o
+.\}
+.
+.de hP
+.IP
+\h'-\w'\fB\\$1\ \fP'u'\fB\\$1\ \fP\c
+..
+.ds , \h'.16667m'
+.
+.\"--------------------------------------------------------------------------
+.TH dump-runlisp-image 1 "12 August 2020" "Mark Wooding"
+.SH NAME
+dump-runlisp-image \- dump Lisp images for faster script execution
+.
+.\"--------------------------------------------------------------------------
+.SH SYNOPSIS
+.
+.B dump-runlisp-image
+.RB [ \-RUafinqrv ]
+.RB [ +RUfinr ]
+.RB [ \-O
+.IR output ]
+.br
+ \&
+.RB [ \-c
+.IR conf ]
+.RB [ \-o
+.RI [ sect \c
+.BR : ] \c
+.IB var = \c
+.IR value ]
+.RB [ \-j
+.IR njobs ]
+.RI [ lisp
+\&...]
+.
+.\"--------------------------------------------------------------------------
+.SH DESCRIPTION
+.
+The
+.B dump-runlisp-image
+program builds custom images for use by
+.BR runlisp (1).
+For many Lisp implementation,
+a custom image,
+with ASDF already loaded,
+can start scripts much more quickly
+than the `vanilla' images installed by default.
+The downside is that custom images may be rather large.
+.
+.SS "Options"
+The following options are accepted on the command line.
+.
+.TP
+.BR "\-h" ", " "\-\-help"
+Write a synopsis of
+.BR dump-runlisp-image 's
+command-line syntax
+and a description of the command-line options
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-V" ", " "\-\-version"
+Write
+.BR dump-runlisp-image 's
+version number
+to standard output
+and immediately exit with status 0.
+.
+.TP
+.BR "\-R" ", " "\-\-remove-other"
+After processing the selected Lisp implementations,
+delete all of the image files corresponding to other Lisps
+defined in the configuration.
+Negate with
+.B +R
+or
+.BR \-\-no-remove-other .
+.
+.TP
+.BR "\-U" ", " "\-\-remove-unknown"
+After processing the selected Lisp implementations,
+delete all of the files in the image directory which
+.I aren't
+image files of a configured Lisp implementation.
+Negate with
+.B +U
+or
+.BR \-\-no-remove-unknown .
+.
+.TP
+.BI "\-O" "\fR, " "\-\-output=" output
+If
+.I output
+names a directory,
+then write images to that directory
+with their default names as specified in the configuration file.
+Otherwise,
+exactly one Lisp implementation must be explicitly named,
+the
+.RB ` \-R '
+and
+.RB `\-U '
+options must not be set,
+and
+the image is written to a file named
+.IR output .
+By default,
+images are written to the directory in which
+.BR runlisp (1)
+will look in when checking for custom images:
+run
+.B query-runlisp-config -x@image-dir
+to see the default setting.
+.
+.TP
+.BR "\-a" ", " "\-\-all-configured"
+Select all configured Lisp implementations.
+You must either list Lisp implementations explicitly on the command line
+or set the
+.RB ` \- a'
+option,
+but not both.
+.
+.TP
+.BI "\-c" "\fR, " "\-\-config-file=" conf
+Read configuration from
+.IR conf .
+If
+.I conf
+is a directory, then all of the files within
+whose names end with
+.RB ` .conf ',
+are loaded, in ascending lexicographical order;
+otherwise,
+.I conf
+is opened as a file.
+All of the files are expected to as described in
+.BR runlisp.conf (5).
+.
+.TP
+.BR "\-f" ", " "\-\-force"
+Create fresh Lisp images
+even if a file with the appropriate name
+already exists.
+Negate with
+.B +f
+or
+.BR \-\-no-force .
+.
+.TP
+.BR "\-i" ", " "\-\-check-installed"
+Only select those Lisp implementations
+which are actually installed
+(and can be found).
+To count as `installed',
+the program named by
+.B command
+must exist and be executable in one of the directories listed in the
+.B PATH
+environment variable,
+as must the command named in the first word of the
+.B dump-image
+command line.
+Note that a Lisp implementation which fails this check
+is not counted as `selected' for the purposes of the
+.RB ` \-R '
+option above.
+For example, the command
+.B "dump-runlisp-image \-Rai"
+will dump images for Lisps which have been installed since the last run,
+and delete images for Lisps which have been uninstalled since then.
+Negate with
+.B +i
+or
+.BR \-\-no-check-installed .
+.
+.TP
+.BI "\-j" "\fR, " "\-\-jobs=" njobs
+Dump image for up to
+.I njobs
+Lisp implementations in parallel.
+The default is to run the jobs sequentially.
+.
+.TP
+.BR "\-n" ", " "-\-dry-run"
+Don't actually run any commands to dump images.
+This may be helpful for the curious,
+in conjunction with
+.RB ` \-v '
+to increase the verbosity.
+Negate with
+.B +n
+or
+.BR "\-\-no-dry-run" .
+.
+.TP
+.BR "\-q" ", " "\-\-quiet"
+Don't print warning messages.
+This option may be repeated:
+each use reduces verbosity by one step,
+counteracting one
+.RB ` \-v '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+.
+.TP
+.BR "\-r" ", " "\-\-remove-image"
+Delete image files for the selected Lisp implementations,
+rather than dumping them.
+Negate with
+.B +r
+or
+.BR \-\-no-remove-image .
+.
+.TP
+.BR "\-v" ", " "\-\-verbose"
+Be more verbose about the process of creating images.
+Lisp implementations can be rather noisy:
+by default,
+.B dump-runlisp-image
+runs silently unless something goes wrong,
+in which case it prints the failed Lisp command line
+and its output.
+If you set
+.B \-v
+then
+.B dump-runlisp-image
+will show Lisp implementation's noise immediately,
+without waiting to see whether it succeeds or fails.
+.
+.SS "Operation"
+The
+.B dump-runlisp-image
+program first determines a collection of
+.I selected
+Lisp implementations.
+If the
+.RB ` \-a '
+option is not set,
+then the selected Lisps are those named on the command line.
+If
+.RB ` \-a '
+is set,
+and the configuration contains a setting for
+.B dump
+in the
+.B @CONFIG
+section,
+then its (expanded) value is taken to be
+a list of Lisp implementation names
+separated by commas and/or one or more whitespace characters,
+and these named Lisp implementations are selected;
+if there is no
+.B dump
+setting, then
+.I all
+configured Lisp implementations which claim support for custom images
+\(en i.e., configuration sections with settings for
+.B run-script
+and
+.B image-file
+\(en are selected, and the
+.RB ` \-i '
+option is forced on.
+If the
+.RB ` \-i '
+option is set,
+then only those Lisp implementations which are actually installed
+are selected.
+.PP
+Having established the selected Lisps,
+.B dump-runlisp-image
+proceeds to act on them:
+in the absence of the
+.RB ` \-r '
+option,
+it attempts to dump a custom image
+for each selected Lisp implementation,
+unless an image file already exists
+or the
+.RB ` \-f '
+option is set.
+(Note that
+.RB ` \-f '
+is an optimization of image dumping,
+and does not affect selection.)
+On the other hand, if
+.RB ` \-r '
+is set,
+then the custom image files of the selected Lisp implementations
+are deleted.
+.PP
+Next, if the
+.RB ` \-R '
+option is set,
+then all the images for Lisp implementations
+which are defined in the configuration
+but were
+.I not
+selected
+are deleted.
+.PP
+Finally, if the
+.RB ` \-U '
+option is set,
+then all files in the image directory
+which aren't recognized as being
+the custom image of some Lisp implementation
+are deleted.
+.PP
+If all of these operations are successfully performed
+then
+.B dump-runlisp-image
+exits with status 0;
+if there was a problem with the command line,
+or if any jobs fail,
+then it exits with status 127.
+.
+.\"--------------------------------------------------------------------------
+.
+.SH SEE ALSO
+.BR query-runlisp-config (1),
+.BR runlisp (1),
+.BR runlisp.conf (5).
+.
+.SH AUTHOR
+Mark Wooding, <mdw@distorted.org.uk>
+.
+.\"----- That's all, folks --------------------------------------------------
* along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
*/
-/*----- Header files ------------------------------------------------------*/
+/*----- Header files ---------------------------------------------------------*/
#include "config.h"
/* Job-state constants. */
enum {
JST_READY, /* not yet started */
+ JST_DELETE, /* just delete the image file */
JST_RUN, /* currently running */
JST_DEAD, /* process exited */
JST_NSTATE
struct job {
struct treap_node _node; /* treap intrusion */
struct job *next; /* next job in whichever list */
+ unsigned op; /* operation (`JOP_...') */
struct argv av; /* argument vector to execute */
char *imgnew, *imgout; /* staging and final output files */
unsigned st; /* job state (`JST_...') */
#define JOB_NAME(job) TREAP_NODE_KEY(job)
#define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job)
-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 struct treap jobs = TREAP_INIT, /* Lisp systems seen so far */
+ good = TREAP_INIT; /* files ok to be in image dir */
+static struct job /* lists of jobs by state */
+ *job_ready, **job_ready_tail = &job_ready, /* some have tail pointers... */
+ *job_delete, **job_delete_tail = &job_delete,
+ *job_run, *job_dead; /* ... and some don't */
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' */
#define AF_ALL 0x0008u /* dump all known Lisps */
#define AF_FORCE 0x0010u /* dump even if images exist */
#define AF_CHECKINST 0x0020u /* check Lisp exists before dump */
+#define AF_REMOVE 0x0040u /* remove selected Lisp images */
+#define AF_CLEAN 0x0080u /* remove other Lisp images */
+#define AF_JUNK 0x0100u /* remove unrecognized files */
/*----- Miscellany --------------------------------------------------------*/
/*----- Job management ----------------------------------------------------*/
-/* Add a new job to the `ready' queue.
+/* Consider a Lisp system description and maybe add a job to the right 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.
+ * The Lisp system is described by the configuration section SECT. Most of
+ * the function is spent on inspecting this section for suitability and
+ * deciding what to do about it.
*
- * 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.)
+ * The precise behaviour depends on F, which should be the bitwise-OR of a
+ * `JQ_...' constant and zero or more flags, as follows.
+ *
+ * * The bits covered by `JMASK_QUEUE' identify which queue the job should
+ * be added to if the section defines a cromulent Lisp system:
+ *
+ * -- `JQ_NONE' -- don't actually make a job at all;
+ * -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or
+ * -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue.
+ *
+ * * `JF_PICKY': The user identified this Lisp system explicitly, so
+ * complain if the configuration section doesn't look right. This is
+ * clear if the caller is just enumerating all of the configuration
+ * sections: without this feature, we'd be checking everything twice,
+ * which (a) is inefficient, and -- more importantly -- (b) could lead to
+ * problems if the two checks are inconsistent.
+ *
+ * * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not
+ * actually installed. (This is usually set for `JQ_READY' calls, so
+ * that we don't try to dump Lisps which aren't there, but clear for
+ * `JQ_DELETE' calls so that we clear out Lisps which have gone away.)
+ *
+ * * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists.
+ *
+ * * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so
+ * that we can identify everything else we find in the image directory as
+ * junk.
*/
-#define JF_QUIET 1u
-static void add_job(struct job ***tail_inout, unsigned f,
- const char *name, size_t len)
+#define JMASK_QUEUE 3u /* which queue to add good Lisp to */
+#define JQ_NONE 0u /* don't add to any queue */
+#define JQ_READY 1u /* `job_ready' */
+#define JQ_DELETE 2u /* `job_delete' */
+#define JF_PICKY 4u /* lose if section isn't Lisp defn */
+#define JF_CHECKINST 8u /* maybe check Lisp is installed */
+#define JF_CHECKEXIST 16u /* skip if image already exists */
+#define JF_NOTICE 32u /* record Lisp's image basename */
+
+#define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST)
+#define JADD_DEFAULT (JQ_READY | JF_CHECKINST)
+#define JADD_CLEANUP (JQ_DELETE)
+#define JADD_NOTICE (JQ_NONE)
+static void add_job(unsigned f, struct config_section *sect)
{
- struct job *job;
- struct treap_path path;
- struct config_section *sect;
+ const char *name;
+ struct job *job, ***tail;
+ struct treap_path path, jobpath;
struct config_var *dumpvar, *cmdvar, *imgvar;
+ struct treap_node *n;
struct dstr d = DSTR_INIT;
struct argv av = ARGV_INIT;
char *imgnew = 0, *imgout = 0;
- size_t i;
+ size_t i, len;
unsigned fef;
- /* Check to see whether this Lisp system is already queued up. */
- job = treap_probe(&jobs, name, len, &path);
+ /* We'll want the section's name for all sorts of things. */
+ name = CONFIG_SECTION_NAME(sect);
+ len = CONFIG_SECTION_NAMELEN(sect);
+
+ /* Check to see whether this Lisp system is already queued up.
+ *
+ * We'll get around to adding the new job node to the treap right at the
+ * end, so use a separate path object to keep track of where to put it.
+ */
+ job = treap_probe(&jobs, name, len, &jobpath);
if (job) {
- if (verbose >= 2) {
+ if ((f&JF_PICKY) && verbose >= 1)
moan("ignoring duplicate Lisp `%s'", JOB_NAME(job));
- return;
- }
+ goto end;
}
- /* Find the configuration for this Lisp system and check that it can be
- * dumped.
+ /* Check that the section defines a Lisp, and that it can be dumped.
+ *
+ * It's not obvious that this is right. Maybe there should be some
+ * additional flag so that we don't check dumpability if we're planning to
+ * delete the image. But it /is/ right: since the thing which tells us
+ * whether we can dump is that the section tells us the image's name, if
+ * it can't be dumped then we won't know what file to delete! So we have
+ * no choice.
*/
- sect = config_find_section_n(&config, 0, name, len);
- if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
- name = CONFIG_SECTION_NAME(sect);
- 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);
+ if (!config_find_var(&config, sect, CF_INHERIT, "run-script")) {
+ if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name);
+ else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name);
+ goto end;
+ }
+ imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file");
+ if (!imgvar) {
+ if (f&JF_PICKY)
+ lose("Lisp implementation `%s' doesn't use custom images", name);
+ else if (verbose >= 3)
+ moan("skipping Lisp `%s': no custom image support", name);
goto end;
}
/* Check that the other necessary variables are present. */
- 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);
+ dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image");
+ if (!dumpvar)
+ lose("variable `dump-image' not defined for Lisp `%s'", name);
+ cmdvar = config_find_var(&config, sect, CF_INHERIT, "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);
* because that would cause us to spam the user with redundant
* diagnostics.)
*/
- if (flags&AF_CHECKINST) {
+ if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) {
dstr_reset(&d);
- fef = (verbose >= 2 ? FEF_VERBOSE : 0);
+ fef = (verbose >= 3 ? FEF_VERBOSE : 0);
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);
+ if (!found_in_path_p(d.p, fef)) {
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': can't find Lisp command `%s'",
+ name, d.p);
+ goto end;
+ }
+ if (STRCMP(d.p, !=, av.v[0]) && !found_in_path_p(av.v[0], fef)) {
+ moan("skipping Lisp `%s': can't find dump command `%s'",
+ av.v[0], d.p);
goto end;
}
}
+ /* If we're supposed to, then notice that this is the name of a good Lisp
+ * image.
+ */
+ if (f&JF_NOTICE) {
+ dstr_reset(&d); config_subst_var(&config, sect, imgvar, &d);
+ n = treap_probe(&good, d.p, d.len, &path);
+ if (!n) {
+ n = xmalloc(sizeof(*n));
+ treap_insert(&good, &path, n, d.p, d.len);
+ }
+ }
+
/* Collect the output image file names. */
imgnew =
config_subst_string_alloc(&config, sect, "<internal>", "${@image-new}");
/* If we're supposed to check whether the image file exists, then we should
* do that.
*/
- if (!(flags&AF_FORCE)) {
+ if ((f&JF_CHECKEXIST) && !(flags&AF_FORCE)) {
if (!access(imgout, F_OK)) {
- if (verbose >= 2)
- moan("image `%s' already exists: skipping `%s'", d.p, name);
- goto end;
+ if (verbose >= 3)
+ moan("skipping Lisp `%s': image `%s' already exists", name, imgout);
+ f = (f&~JMASK_QUEUE) | JQ_NONE;
}
}
* of the list. (Steal the command-line vector so that we don't try to
* free it during cleanup.)
*/
+ switch (f&JMASK_QUEUE) {
+ case JQ_NONE: tail = 0; break;
+ case JQ_READY: tail = &job_ready_tail; break;
+ case JQ_DELETE: tail = &job_delete_tail; break;
+ default: assert(0);
+ }
job = xmalloc(sizeof(*job));
job->st = JST_READY;
- job->kid = -1;
+ job->kid = -1; job->log = 0;
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;
+ treap_insert(&jobs, &jobpath, &job->_node, name, len);
+ if (tail) { **tail = job; *tail = &job->next; }
end:
/* All done. Cleanup time. */
dstr_release(&d); argv_release(&av);
}
+/* As `add_job' above, but look the Lisp implementation up by name.
+ *
+ * The flags passed to `add_job' are augmented with `JF_PICKY' because this
+ * is an explicitly-named Lisp implementation.
+ */
+static void add_named_job(unsigned f, const char *name, size_t len)
+{
+ struct config_section *sect;
+
+ sect = config_find_section_n(&config, 0, name, len);
+ if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
+ add_job(f | JF_PICKY, sect);
+}
+
/* Free the JOB and all the resources it holds.
*
* Close the pipes; kill the child process. Everything must go.
static void release_job(struct job *job)
{
size_t i;
+ struct job *j;
if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */
if (job->log && job->log != stdout) fclose(job->log);
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);
+ j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job);
free(job);
}
job = job_ready; job_ready = job->next;
p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
+ /* If we're not actually going to do anything, now is the time to not do
+ * that.
+ */
+ if (flags&AF_DRYRUN) {
+ if (try_exec(&job->av,
+ TEF_DRYRUN |
+ (verbose >= 2 && !(flags&AF_CHECKINST) ?
+ TEF_VERBOSE : 0)))
+ rc = 127;
+ else if (verbose >= 2)
+ printf("%-13s > not dumping `%s' (dry run)\n",
+ JOB_NAME(job), JOB_NAME(job));
+ release_job(job);
+ continue;
+ }
+
/* 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)) {
* output.
*/
for (link = &job_dead, job = *link; 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, '*');
next = job->next;
if (job->out.fd >= 0 || job->err.fd >= 0) link = &job->next;
else { *link = next; finish_job(job); }
static void usage(FILE *fp)
{
fprintf(fp, "\
-usage: %s [-afnqv] [-c CONF] [-o [SECT:]VAR=VAL]\n\
+usage: %s [-RUadfinqrv] [+RUdfinr] [-c CONF] [-o [SECT:]VAR=VAL]\n\
[-O FILE|DIR] [-j NJOBS] [LISP ...]\n",
progname);
}
\n\
Image dumping:\n\
-O, --output=FILE|DIR Store image(s) in FILE or DIR.\n\
- -a, --all-configured Dump all implementations configured.\n\
+ -R, --remove-other Delete image files for other Lisp systems.\n\
+ -U, --remove-unknown Delete unrecognized files in image dir.\n\
+ -a, --all-configured Select all configured implementations.\n\
+ -d, --cleanup Delete images which are no longer wanted.\n\
-f, --force Dump images even if they already exist.\n\
- -i, --check-installed Check Lisp systems exist before invoking.\n\
- -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n",
+ -i, --check-installed Check Lisp systems exist before dumping.\n\
+ -j, --jobs=NJOBS Run up to NJOBS jobs in parallel.\n\
+ -r, --remove-image Delete image files, instead of creating.\n",
fp);
}
+static void show_job_list(const char *what, struct job *job)
+{
+ struct dstr d = DSTR_INIT;
+ int first;
+
+ first = 1;
+ for (; job; job = job->next) {
+ if (first) first = 0;
+ else dstr_puts(&d, ", ");
+ dstr_putf(&d, "`%s'", JOB_NAME(job));
+ }
+ if (first) dstr_puts(&d, "(none)");
+ dstr_putz(&d);
+ moan("%s: %s", what, d.p);
+}
+
/* Main program. */
int main(int argc, char *argv[])
{
struct config_section *sect;
struct config_var *var;
const char *out = 0, *p, *q, *l;
- struct job *job, **tail;
+ struct job *job;
struct stat st;
struct dstr d = DSTR_INIT;
- int i, fd, first;
+ DIR *dir;
+ struct dirent *de;
+ int i, fd;
+ size_t n, o;
+ unsigned f;
/* Command-line options. */
static const struct option opts[] = {
{ "help", 0, 0, 'h' },
{ "version", 0, 0, 'V' },
{ "output", OPTF_ARGREQ, 0, 'O' },
+ { "remove-other", OPTF_NEGATE, 0, 'R' },
+ { "remove-unknown", OPTF_NEGATE, 0, 'U' },
{ "all-configured", 0, 0, 'a' },
{ "config-file", OPTF_ARGREQ, 0, 'c' },
{ "force", OPTF_NEGATE, 0, 'f' },
{ "dry-run", OPTF_NEGATE, 0, 'n' },
{ "set-option", OPTF_ARGREQ, 0, 'o' },
{ "quiet", 0, 0, 'q' },
+ { "remove-image", OPTF_NEGATE, 0, 'r' },
{ "verbose", 0, 0, 'v' },
{ 0, 0, 0, 0 }
};
/* Parse the options. */
optprog = (/*unconst*/ char *)progname;
+
+#define FLAGOPT(ch, f) \
+ case ch: \
+ flags |= f; \
+ break; \
+ case ch | OPTF_NEGATED: \
+ flags &= ~f; \
+ break
+
for (;;) {
- i = mdwopt(argc - 1, argv + 1, "hVO:ac:f+i+j:n+o:qv", opts, 0, 0,
+ i = mdwopt(argc - 1, argv + 1, "hVO:R+U+ac:d+f+i+j:n+o:qr+v", opts, 0, 0,
OPTF_NEGATION | OPTF_NOPROGNAME);
if (i < 0) break;
switch (i) {
case 'h': help(stdout); exit(0);
case 'V': version(stdout); exit(0);
case 'O': out = optarg; break;
+ FLAGOPT('R', AF_CLEAN);
+ FLAGOPT('U', AF_JUNK);
case 'a': flags |= AF_ALL; break;
case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break;
- case 'f': flags |= AF_FORCE; break;
- case 'f' | OPTF_NEGATED: flags &= ~AF_FORCE; break;
- case 'i': flags |= AF_CHECKINST; break;
- case 'i' | OPTF_NEGATED: flags &= ~AF_CHECKINST; break;
+ FLAGOPT('f', AF_FORCE);
+ FLAGOPT('i', AF_CHECKINST);
case 'j': maxrun = parse_int("number of jobs", optarg, 1, 65535); break;
- case 'n': flags |= AF_DRYRUN; break;
- case 'n' | OPTF_NEGATED: flags &= ~AF_DRYRUN; break;
+ FLAGOPT('n', AF_DRYRUN);
case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break;
case 'q': if (verbose) verbose--; break;
+ FLAGOPT('r', AF_REMOVE);
case 'v': verbose++; break;
default: flags |= AF_BOGUS; break;
}
}
+#undef FLAGOPT
+
/* CHeck that everything worked. */
optind++;
if ((flags&AF_ALL) ? optind < argc : optind >= argc) flags |= AF_BOGUS;
"@image-out", "${@BUILTIN:@%out-dir}/${image-file}");
} else if (argc - optind != 1)
lose("can't dump multiple Lisps to a single output file");
+ else if (flags&AF_JUNK)
+ lose("can't clear junk in a single output file");
+ else if (flags&AF_CLEAN)
+ lose("can't clean other images with a single output file");
else
config_set_var(&config, builtin, CF_LITERAL, "@image-out", out);
/* 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'
+ /* There are a number of different strategies we might employ, depending on
+ * the exact request.
+ *
+ * queue queue clear
+ * REMOVE CLEAN JUNK selected others junk?
+ *
+ * * nil nil ready/delete -- no
+ * * nil t ready/delete none yes
+ * nil t nil ready delete no
+ * nil t t ready -- yes
+ * t t nil -- delete no
+ * t t t -- -- yes
+ */
+
+ /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan
+ * the selected Lisp systems and add them to the appropriate queue.
+ *
+ * Bit-hack: if they are not both set, then their complements are not both
+ * clear.
+ */
+ if (~flags&(AF_REMOVE | AF_CLEAN)) {
+
+ /* Determine the flags for `add_job' when we select the Lisp systems. If
+ * we intend to clear junk then we must notice the image names we
+ * encounter. If we're supposed to check that Lisps exist before dumping
+ * then do that -- but it doesn't make any sense for deletion.
+ */
+ f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY;
+ if (flags&AF_JUNK) f |= JF_NOTICE;
+ if (flags&AF_CHECKINST) f |= JF_CHECKINST;
+ if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST;
+
+ /* If we have named Lisps, then process them. */
+ if (!(flags&AF_ALL))
+ for (i = optind; i < argc; i++)
+ add_named_job(f, argv[i], strlen(argv[i]));
+
+ /* Otherwise we're supposed to dump `all' of them. If there's a `dump'
* configuration setting then we need to parse that. Otherwise we just
* try all of them.
*/
- var = config_find_var(&config, toplevel, 0, "dump");
- 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 {
- /* Parse the `dump' list. */
-
- p = var->val; l = p + var->n;
- for (;;) {
- while (p < l && ISSPACE(*p)) p++;
- if (p >= l) break;
- q = p;
- while (p < l && !ISSPACE(*p) && *p != ',') p++;
- add_job(&tail, 0, q, p - q);
- while (p < l && ISSPACE(*p)) p++;
- if (p < l && *p == ',') p++;
+ else {
+ var = config_find_var(&config, toplevel, CF_INHERIT, "dump");
+ if (!var) {
+ /* No setting. Just do all of the Lisps which look available. */
+
+ f |= JF_CHECKINST;
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
+ } else {
+ /* Parse the `dump' list. */
+
+ dstr_reset(&d); config_subst_var(&config, toplevel, var, &d);
+ p = d.p; l = p + d.len;
+ for (;;) {
+ while (p < l && ISSPACE(*p)) p++;
+ if (p >= l) break;
+ q = p;
+ while (p < l && !ISSPACE(*p) && *p != ',') p++;
+ add_named_job(f, q, p - q);
+ while (p < l && ISSPACE(*p)) p++;
+ if (p < l && *p == ',') p++;
+ }
}
}
}
- *tail = 0;
+
+ /* Second step: if exactly one of `AF_CLEAN' and `AF_JUNK' is set, then we
+ * need to scan all of the remaining Lisps and add them to the `delete'
+ * queue.
+ */
+ if (!(flags&AF_CLEAN) != !(flags&AF_JUNK)) {
+
+ /* Determine the flag settings. If we're junking, then we're not
+ * cleaning -- we just want to mark images belonging to other Lisps as
+ * off-limits to the junking scan.
+ */
+ f = flags&AF_CLEAN ? JQ_DELETE : JQ_NONE | JF_NOTICE;
+
+ /* Now scan the Lisp systems. */
+ for (config_start_section_iter(&config, &si);
+ (sect = config_next_section(&si)); )
+ add_job(f, sect);
+ }
+
+ /* Terminate the job queues. */
+ *job_ready_tail = 0;
+ *job_delete_tail = 0;
/* Report on what it is we're about to do. */
if (verbose >= 3) {
- dstr_reset(&d);
- first = 1;
- for (job = job_ready; job; job = job->next) {
- if (first) first = 0;
- else dstr_puts(&d, ", ");
- dstr_putf(&d, "`%s'", JOB_NAME(job));
- }
- if (first) dstr_puts(&d, "(none)");
- dstr_putz(&d);
- moan("dumping Lisps: %s", d.p);
+ show_job_list("dumping Lisp images", job_ready);
+ show_job_list("deleting Lisp images", job_delete);
}
- /* 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,
- TEF_DRYRUN |
- (verbose >= 2 && !(flags&AF_CHECKINST) ?
- TEF_VERBOSE : 0)))
- rc = 2;
- else if (verbose >= 2)
- printf("%-13s > (not dumping `%s': dry run)\n",
- JOB_NAME(job), JOB_NAME(job));
- }
- return (rc);
- }
+ /* If there turns out to be nothing to do, then mention this. */
+ if (!(flags&AF_REMOVE) && verbose >= 2 && !job_ready)
+ moan("no Lisp images to dump");
- /* Run the jobs. */
+ /* Run the dumping 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 for any last signals. If we hit any fatal signals then we should
+ * kill ourselves so that the exit status will be right.
*/
check_signals();
if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); }
+ /* Now delete Lisps which need deleting. */
+ while (job_delete) {
+ job = job_delete; job_delete = job->next;
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->imgout);
+ } else {
+ if (verbose >= 2)
+ moan("deleting `%s' image `%s' (dry run)",
+ JOB_NAME(job), job->imgout);
+ if (unlink(job->imgout) && errno != ENOENT)
+ bad("failed to delete `%s' image `%s': %s",
+ JOB_NAME(job), job->imgout, strerror(errno));
+ }
+ }
+
+ /* Finally, maybe delete all of the junk files in the image directory. */
+ if (flags&AF_JUNK) {
+ if (!out) {
+ var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir");
+ assert(var); out = config_subst_var_alloc(&config, builtin, var);
+ }
+ dir = opendir(out);
+ if (!dir)
+ lose("failed to open image directory `%s': %s", out, strerror(errno));
+ dstr_reset(&d);
+ dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len;
+ if (verbose >= 2)
+ moan("cleaning up junk in image directory `%s'", out);
+ for (;;) {
+ de = readdir(dir); if (!de) break;
+ if (de->d_name[0] == '.' &&
+ (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2])))
+ continue;
+ n = strlen(de->d_name);
+ d.len = o; dstr_putm(&d, de->d_name, n + 1);
+ if (!treap_lookup(&good, de->d_name, n)) {
+ if (flags&AF_DRYRUN) {
+ if (verbose >= 2)
+ moan("not deleting junk file `%s' (dry run)", d.p);
+ } else {
+ if (verbose >= 2)
+ moan("deleting junk file `%s'", d.p);
+ if (unlink(d.p) && errno != ENOENT)
+ bad("failed to delete junk file `%s': %s", d.p, strerror(errno));
+ }
+ }
+ }
+ }
+
/* All done! */
return (rc);
}
+++ /dev/null
-#! /bin/sh -e
-###
-### Dump Lisp images for faster script execution
-###
-### (c) 2020 Mark Wooding
-###
-
-###----- Licensing notice ---------------------------------------------------
-###
-### This file is part of Runlisp, a tool for invoking Common Lisp scripts.
-###
-### Runlisp is free software: you can redistribute it and/or modify it
-### under the terms of the GNU General Public License as published by the
-### Free Software Foundation; either version 3 of the License, or (at your
-### option) any later version.
-###
-### Runlisp is distributed in the hope that it will be useful, but WITHOUT
-### ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
-### FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-### for more details.
-###
-### You should have received a copy of the GNU General Public License
-### along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
-
-###--------------------------------------------------------------------------
-### Build-time configuration.
-
-VERSION=@VERSION@
-imagedir=@imagedir@
-eclopt=@ECLOPT@
-
-###--------------------------------------------------------------------------
-### Random utilities.
-
-prog=${0##*/}
-
-## Report a fatal error.
-lose () { echo >&2 "$prog: $*"; exit 2; }
-
-## Quote a string so that Lisp will understand it.
-lisp_quote () { printf "%s\n" "$1" | sed 's/[\\"]/\\&/g'; }
-
-## Mention that we're running a program.
-run () { echo "$*"; $lbuf "$@"; }
-
-## Figure out whether we can force line-buffering.
-if stdbuf --version >/dev/null 2>&1; then lbuf="stdbuf -oL --"
-else lbuf=""; fi
-
-## Copy stdin to stdout, one line at a time. This is important in the shell
-## game below, to prevent lines from two incoming streams being interleaved
-## in the log file.
-copy () { while IFS= read -r line; do printf "%s %s\n" "$1" "$line"; done; }
-
-###--------------------------------------------------------------------------
-### Lisp runes.
-
-## Load and upgrade ASDF.
-load_asdf_rune="(require \"asdf\")"
-upgrade_asdf_rune="(asdf:upgrade-asdf)"
-
-## Ignore `#!' lines. (We force this so as to provide a uniform environment,
-## even though some Lisp implementations take special action when they know
-## they're running scripts.)
-ignore_shebang_rune="\
-(set-dispatch-macro-character
- #\\# #\\!
- (lambda (stream #1=#:char #2=#:arg)
- (declare (ignore #1# #2#))
- (values (read-line stream))))"
-
-## Push `:runlisp-script' into the `*features*' list.
-set_script_feature_rune="(pushnew :runlisp-script *features*)"
-
-## All of the above.
-common_prelude_rune="\
-(progn
- $upgrade_asdf_rune
- $ignore_shebang_rune
- $set_script_feature_rune)"
-
-###--------------------------------------------------------------------------
-### Explain how to dump the various Lisp systems.
-
-## Maintain the master tables.
-unset lisps
-deflisp () { lisps=${lisps+$lisps }$1; eval ${1}_image=\$2; }
-
-## Steel Bank Common Lisp.
-deflisp sbcl sbcl+asdf.core
-dump_sbcl () {
- image=$(lisp_quote "$1")
- run "${SBCL-sbcl}" --noinform --no-userinit --no-sysinit \
- --disable-debugger \
- --eval "$load_asdf_rune" \
- --eval "$common_prelude_rune" \
- --eval "(sb-ext:save-lisp-and-die \"$image\")"
-}
-
-## Clozure Common Lisp.
-deflisp ccl ccl+asdf.image
-dump_ccl () {
- image=$(lisp_quote "$1")
- ## 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...
-
- run "${CCL-ccl}" -b -n -Q \
- -e "$load_asdf_rune" \
- -e "$common_prelude_rune" \
- -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\"
- :init-file nil
- :error-handler :quit)"
-}
-
-## GNU CLisp.
-deflisp clisp clisp+asdf.mem
-dump_clisp () {
- image=$(lisp_quote "$1")
- run "${CLISP-clisp}" -norc -q -q \
- -x "$load_asdf_rune" \
- -x "$common_prelude_rune" \
- -x "(ext:saveinitmem \"$image\"
- :norc t
- :script t)" \
- -- wrong arguments
-}
-
-## Embeddable Common Lisp.
-deflisp ecl ecl+asdf
-dump_ecl () {
- image=$1
- set -e
-
- ## Start by compiling a copy of ASDF.
- cat >"$tmp/ecl-build.lisp" <<EOF
-(require "asdf")
-
-(defparameter *asdf* (asdf:find-system "asdf"))
-
-(defun right-here (pathname pattern)
- (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))
-
-(asdf:operate 'asdf:lib-op *asdf*)
-(si:quit 0)
-EOF
- (cd "$tmp" && run "${ECL-ecl}" ${eclopt}norc ${eclopt}load "ecl-build.lisp")
-
- ## And now compile our driver code.
- cat >"$tmp/ecl-run.lisp" <<EOF
-(cl:defpackage #:runlisp
- (:use #:common-lisp))
-(cl:in-package #:runlisp)
-
-(defun main ()
- $ignore_shebang_rune
- (asdf:register-immutable-system "asdf")
- (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
- (let ((winning t) (script nil) (marker nil)
- (prog (file-namestring (si:argv 0))) (i 1) (argc (si:argc)))
- (labels ((lose (msg &rest args)
- (format *error-output* "~&~A: ~?~%" prog msg args)
- (setf winning nil))
- (quit (rc)
- (si:quit rc))
- (usage (stream)
- (format stream "~&usage: ~A -s SCRIPT -- ARGS~%"
- prog))
- (getarg ()
- (and (< i argc) (prog1 (si:argv i) (incf i)))))
- (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"))
- (unless marker (lose "unexpected end of options (missing \`--'?)"))
- (unless winning (usage *error-output*) (quit 255))
- (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)))
- (quit 0))))
-(main)
-EOF
- (cd "$tmp" && run "${ECL-ecl}" ${eclopt}norc ${eclopt}load "ecl-asdf.fas" \
- -s -o "ecl-run.o" ${eclopt}compile "ecl-run.lisp")
-
- ## Finally link everything together.
- run "${ECL-ecl}" ${eclopt}norc -o "$image"\
- ${eclopt}link "$tmp/ecl-asdf.o" "$tmp/ecl-run.o"
-}
-
-## Carnegie--Mellon University Common Lisp.
-deflisp cmucl cmucl+asdf.core
-dump_cmucl () {
- image=$(lisp_quote "$1")
- run "${CMUCL-cmucl}" -batch -noinit -nositeinit -quiet \
- -eval "$load_asdf_rune" \
- -eval "$common_prelude_rune" \
- -eval "(ext:save-lisp \"$image\"
- :batch-mode t :print-herald nil
- :site-init nil :load-init-file nil)"
-}
-
-###--------------------------------------------------------------------------
-### Command-line processing.
-
-usage () { echo "usage: $prog [-acluv] [-o FILE] [LISP ...]"; }
-version () { echo "$prog, runlisp version $VERSION"; }
-help () {
- version; echo; usage; cat <<EOF
-
-Options:
- -h Show this help text and exit successfully.
- -V Show the version number and exit successfully.
- -a Dump all installed Lisp implementations.
- -c Check that Lisp systems are installed before
- trying to dump.
- -l List known Lisp systems and default image filenames.
- -o OUT Store images in OUT (file or directory); default
- is \`\$RUNLISP_IMAGEDIR' or \`$imagedir'
- -u Only dump images which don't exist already.
- -v Be verbose, even if things go well.
-EOF
-}
-
-unset outfile; dir=${RUNLISP_IMAGEDIR-$imagedir}; dir=${dir%/}/
-all=nil checkinst=nil bogus=nil out=nil update=nil verbose=nil
-
-## Parse the options.
-while getopts "hVaclo:uv" opt; do
- case $opt in
- h) help; exit 0 ;;
- V) version; exit 0 ;;
- a) all=t checkinst=t ;;
- l)
- for i in $lisps; do
- eval out=\$${i}_image
- echo "$i -> $out"
- done
- exit 0
- ;;
- o) outfile=$OPTARG out=t; dir= ;;
- u) update=t ;;
- v) verbose=t ;;
- *) bogus=t ;;
- esac
-done
-shift $(( $OPTIND - 1 ))
-
-## If the destination is a directory then notice this.
-case $out in
- t) if [ -d "$outfile" ]; then dir=${outfile%/}/; out=nil; fi ;;
-esac
-
-## Check that everything matches.
-case $#,$all,$out in
- 0,nil,*) lose "no Lisp systems to dump" ;;
- 0,t,nil) set -- $lisps ;;
- *,t,*) lose "\`-a' makes no sense with explicit list" ;;
- 1,nil,t) ;;
- *,*,t) lose "can't name explicit output file for multiple Lisp systems" ;;
-esac
-
-## Check that the Lisp systems named are actually known.
-for lisp in "$@"; do
- case " $lisps " in
- *" $lisp "*) ;;
- *) echo >&2 "$prog: unknown Lisp \`$lisp'"; exit 2 ;;
- esac
-done
-
-## Complain if there were problems.
-case $bogus in t) usage >&2; exit 2 ;; esac
-
-###--------------------------------------------------------------------------
-### Dump the images.
-
-## Establish a temporary directory to work in.
-i=0
-while :; do
- tmp=${TMPDIR-/tmp}/runlisp-tmp.$$.
- if mkdir "$tmp" >/dev/null 2>&1; then break; fi
- case $i in 64) lose "failed to create temporary directory" ;; esac
- i=$(expr $i + 1)
-done
-trap 'rm -rf "$tmp"' EXIT INT TERM HUP
-
-## Send stdout to stderr or the log, depending on verbosity.
-output () {
- case $verbose in
- nil) $lbuf cat -u >"$tmp/log" ;;
- t) $lbuf cat >&2 ;;
- esac
-}
-
-## Work through each requested Lisp system.
-exit=0
-for lisp in "$@"; do
-
- ## Figure out the output file to use.
- case $out in nil) eval outfile=\$dir\$${lisp}_image ;; esac
-
- ## Maybe we skip this one if the output already exists.
- case $update in
- t)
- if [ -f "$outfile" ]; then
- case $verbose in
- t)
- echo >&2 "$prog: \`$outfile' already exists: skipping \`$lisp'"
- ;;
- esac
- continue
- fi
- ;;
- esac
-
- ## If we're doing all the Lisps, then skip systems which aren't actually
- ## installed.
- case $checkinst in
- t)
- LISP=$(echo $lisp | tr a-z A-Z)
- eval lispprog=\${$LISP-$lisp}
- if ! type >/dev/null 2>&1 $lispprog; then
- case $verbose in
- t)
- echo >&2 "$prog: command \`$LISP' not found: skipping \`$lisp'"
- ;;
- esac
- continue
- fi
- ;;
- esac
-
- ## Dump the Lisp, capturing its potentially drivellous output in a log
- ## (unless we're being verbose). Be careful to keep stdout and stderr
- ## separate.
- rc=$(
- { { { { echo "dumping $lisp to \`$outfile'..."
- set +e; dump_$lisp "$outfile" 4>&- 5>&-
- echo $? >&5; } |
- copy "|" >&4; } 2>&1 |
- copy "*" >&4; } 4>&1 |
- output; } 5>&1 </dev/null
- )
-
- ## If it failed, and we didn't already spray the output to the terminal,
- ## then do that now; also record that we encountered a problem.
- case $rc in
- 0) ;;
- *) case $verbose in nil) cat >&2 "$tmp/log" ;; esac; exit=2 ;;
- esac
-done
-
-## All done.
-exit $exit
-
-###----- That's all, folks --------------------------------------------------
* 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.
+ * given key if it's not there already.
*/
void *treap_probe(struct treap *t, const char *k, size_t kn,
struct treap_path *p)
* subtree of U, then we rotate like this:
*
* | |
- * U N
+ * U (N)
* / \ / \
* (N) Z ---> X U
* / \ / \
* of U, then we do the opposite rotation:
*
* | |
- * U N
+ * U (N)
* / \ / \
* X (N) ---> U Z
* / \ / \
* / \ / \
* L R ---> X (N)
* / \ / \
- * X Y Y Z
+ * X Y Y R
*
* or
*
* 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; }
+ else if (l->wt > r->wt)
+ { *nn = l; nn = &l->right; l = n->left = l->right; }
+ else
+ { *nn = r; nn = &r->left; r = n->right = r->left; }
/* Release the key buffer, and return the node that we've now detached. */
free(n->k); return (n);
*
* * 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
+ * nodes on the stack are ancestors of the current node, and the right
* subtree consists of its descendants, so none of them are already on
- * the stack, and they're all greater than the current node, and
+ * 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.
* 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.
+ * insert a new node with the given key if it's not there already.
*/
extern void treap_insert(struct treap */*t*/, const struct treap_path */*p*/,
+++ /dev/null
-/* -*-c-*-
- *
- * Invoke a Lisp script
- *
- * (c) 2020 Mark Wooding
- */
-
-/*----- Licensing notice --------------------------------------------------*
- *
- * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
- *
- * Runlisp is free software: you can redistribute it and/or modify it
- * under the terms of the GNU General Public License as published by the
- * Free Software Foundation; either version 3 of the License, or (at your
- * option) any later version.
- *
- * Runlisp is distributed in the hope that it will be useful, but WITHOUT
- * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
- * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
- * for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
- */
-
-/*----- Header files ------------------------------------------------------*/
-
-#include "config.h"
-
-#include <assert.h>
-#include <ctype.h>
-#include <errno.h>
-#include <stdarg.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include <unistd.h>
-#include <sys/stat.h>
-
-#include <pwd.h>
-
-#include "lib.h"
-
-/*----- Common Lisp runes -------------------------------------------------*/
-
-/* A common preamble rune to do the necessary things.
- *
- * We need to ensure that `asdf' (and therefore `uiop') is loaded. And we
- * should arrange for `:runlisp-script' to find its way into the `*features*'
- * list so that scripts can notice that they're being invoked from the
- * command line rather than loaded into a resident session, and actually do
- * something useful.
- */
-#define COMMON_PRELUDE_RUNE \
- "(progn " \
- "(setf *load-verbose* nil *compile-verbose* nil) " \
- "(require \"asdf\") " \
- "(funcall (intern \"REGISTER-IMMUTABLE-SYSTEM\" " \
- "(find-package \"ASDF\")) " \
- "\"asdf\") " \
- "(set-dispatch-macro-character " \
- "#\\# #\\! " \
- "(lambda (#1=#:stream #2=#:char #3=#:arg) " \
- "(declare (ignore #2# #3#)) " \
- "(values (read-line #1#)))) " \
- "(pushnew :runlisp-script *features*))"
-
-/* Get `uiop' to re-check the command-line arguments following an image
- * restore.
- */
-#define IMAGE_RESTORE_RUNE \
- "(uiop:call-image-restore-hook)"
-
-/* Some Lisps leave crud in the `COMMON-LISP-USER' package. Clear it out. */
-#define CLEAR_CL_USER_RUNE \
- "(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#)))))"
-
-/*----- The Lisp implementation table -------------------------------------*/
-
-/* The systems, in decreasing order of (not quite my personal) preference.
- * This list is used to initialize various tables and constants.
- */
-#define LISP_SYSTEMS(_) \
- _(sbcl) \
- _(ccl) \
- _(clisp) \
- _(ecl) \
- _(cmucl) \
- _(abcl)
-
-enum {
-#define DEFSYS(sys) sys##_INDEX,
- LISP_SYSTEMS(DEFSYS)
-#undef DEFSYS
- NSYS
-};
-
-enum {
-#define DEFFLAG(sys) sys##_FLAG = 1 << sys##_INDEX,
- LISP_SYSTEMS(DEFFLAG)
-#undef DEFFLAG
- ALL_SYSTEMS = 0
-#define SETFLAG(sys) | sys##_FLAG
- LISP_SYSTEMS(SETFLAG)
-#undef SETFLAG
-};
-
-struct argstate;
-struct argv;
-
-#define DECLENTRY(sys) \
-static void run_##sys(struct argstate *, const char *);
- LISP_SYSTEMS(DECLENTRY)
-#undef DECLENTRY
-
-static const struct systab {
- const char *name;
- unsigned f;
- void (*run)(struct argstate *, const char *);
-} systab[] = {
-#define SYSENTRY(sys) { #sys, sys##_FLAG, run_##sys },
- LISP_SYSTEMS(SYSENTRY)
-#undef SYSENTRY
-};
-
-static const struct systab *find_system(const char *name)
-{
- const struct systab *sys;
- size_t i;
-
- for (i = 0; i < NSYS; i++) {
- sys = &systab[i];
- if (STRCMP(name, ==, sys->name)) return (sys);
- }
- lose("unknown Lisp system `%s'", name);
-}
-
-static void lisp_quote_string(struct dstr *d, const char *p)
-{
- size_t n;
-
- for (;;) {
- n = strcspn(p, "\"\\");
- if (n) { dstr_putm(d, p, n); p += n; }
- if (!*p) break;
- dstr_putc(d, '\\'); dstr_putc(d, *p++);
- }
- dstr_putz(d);
-}
-
-static const char *expand_rune(struct dstr *d, const char *rune, ...)
-{
- const struct argv *av;
- va_list ap;
- size_t i, n;
-
- va_start(ap, rune);
- for (;;) {
- n = strcspn(rune, "%");
- if (n) { dstr_putm(d, rune, n); rune += n; }
- if (!*rune) break;
- switch (*++rune) {
- case '%': dstr_putc(d, '%'); break;
- case 'e': lisp_quote_string(d, va_arg(ap, const char *)); break;
- case 'E':
- av = va_arg(ap, const struct argv *);
- for (i = 0; i < av->n; i++) {
- if (i) dstr_putc(d, ' ');
- dstr_putc(d, '"');
- lisp_quote_string(d, av->v[i]);
- dstr_putc(d, '"');
- }
- break;
- default: lose("*** BUG unknown expansion `%%%c'", *rune);
- }
- rune++;
- }
- dstr_putz(d);
- return (d->p);
-}
-
-/*----- Argument processing -----------------------------------------------*/
-
-struct syslist {
- const struct systab *sys[NSYS];
- size_t n;
- unsigned f;
-};
-#define SYSLIST_INIT { { 0 }, 0, 0 }
-
-struct argstate {
- unsigned f;
-#define F_BOGUS 1u
-#define F_NOEMBED 2u
-#define F_NOACT 4u
-#define F_NODUMP 8u
-#define F_AUX 16u
- int verbose;
- char *imagedir;
- struct syslist allow, pref;
- struct argv av;
-};
-#define ARGSTATE_INIT { 0, 1, 0, SYSLIST_INIT, SYSLIST_INIT, ARGV_INIT }
-
-/*----- Running programs --------------------------------------------------*/
-
-#define FEF_EXEC 1u
-static int file_exists_p(const struct argstate *arg, const char *path,
- unsigned f)
-{
- struct stat st;
-
- if (stat(path, &st)) {
- if (arg && arg->verbose > 2) moan("file `%s' not found", path);
- return (0);
- } else if (!(S_ISREG(st.st_mode))) {
- if (arg && arg->verbose > 2) moan("`%s' is not a regular file", path);
- return (0);
- } else if ((f&FEF_EXEC) && access(path, X_OK)) {
- if (arg && arg->verbose > 2) moan("file `%s' is not executable", path);
- return (0);
- } else {
- if (arg && arg->verbose > 2) moan("found file `%s'", path);
- return (1);
- }
-}
-
-static int found_in_path_p(const struct argstate *arg, const char *prog)
-{
- struct dstr p = DSTR_INIT, d = DSTR_INIT;
- const char *path;
- char *q;
- size_t n, avail, proglen;
- int i;
-
- if (strchr(prog, '/')) return (file_exists_p(arg, prog, 0));
- path = getenv("PATH");
- if (path)
- dstr_puts(&p, path);
- else {
- dstr_puts(&p, ".:");
- i = 0;
- again:
- avail = p.sz - p.len;
- n = confstr(_CS_PATH, p.p + p.len, avail);
- if (avail > n) { i++; assert(i < 2); dstr_ensure(&p, n); goto again; }
- }
-
- q = p.p; proglen = strlen(prog);
- for (;;) {
- n = strcspn(q, ":");
- dstr_reset(&d);
- if (q[n]) dstr_putm(&d, q, n);
- else dstr_putc(&d, '.');
- dstr_putc(&d, '/');
- dstr_putm(&d, prog, proglen);
- dstr_putz(&d);
- if (file_exists_p(arg, d.p, FEF_EXEC)) {
- if (arg->verbose == 2) moan("found program `%s'", d.p);
- return (1);
- }
- q += n; if (!*q) break; else q++;
- }
- return (0);
-}
-
-static void try_exec(const struct argstate *arg, struct argv *av)
-{
- struct dstr d = DSTR_INIT;
- size_t i;
-
- assert(av->n); argv_appendz(av);
- if (arg->verbose > 1) {
- for (i = 0; i < av->n; i++) {
- if (i) { dstr_putc(&d, ','); dstr_putc(&d, ' '); }
- dstr_putc(&d, '"');
- lisp_quote_string(&d, av->v[i]);
- dstr_putc(&d, '"');
- }
- dstr_putz(&d);
- moan("trying %s...", d.p);
- }
- if (arg->f&F_NOACT)
- { if (found_in_path_p(arg, av->v[0])) exit(0); }
- else {
- execvp(av->v[0], (/*unconst*/ char **)av->v);
- if (errno != ENOENT)
- lose("failed to exec `%s': %s", av->v[0], strerror(errno));
- }
- if (arg->verbose > 1) moan("`%s' not found", av->v[0]);
- dstr_release(&d);
-}
-
-static char *getenv_or_default(const char *var, char *dflt)
- { char *p = getenv(var); return (p ? p : dflt); }
-
-/*----- Invoking Lisp systems ---------------------------------------------*/
-
-/* Steel Bank Common Lisp. */
-
-static void run_sbcl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, "--script", script, END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "sbcl+asdf.core");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av,
- "--core", d.p,
- "--eval", IMAGE_RESTORE_RUNE,
- END);
- else
- argv_prependl(&arg->av, "--eval", COMMON_PRELUDE_RUNE, END);
-
- argv_prependl(&arg->av, getenv_or_default("SBCL", "sbcl"),
- "--noinform",
- END);
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* Clozure Common Lisp. */
-
-#define CCL_QUIT_RUNE \
- "(ccl:quit)"
-
-static void run_ccl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, "-b", "-n", "-Q",
- "-l", script,
- "-e", CCL_QUIT_RUNE,
- "--",
- END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "ccl+asdf.image");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-I", d.p, "-e", IMAGE_RESTORE_RUNE, END);
- else
- argv_prependl(&arg->av, "-e", COMMON_PRELUDE_RUNE, END);
-
- argv_prepend(&arg->av, getenv_or_default("CCL", "ccl"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* GNU 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 an `-i' option which will load a file without any of this
- * stupidity, but nothing analogous for immediate expressions.
- */
-
-#define CLISP_COMMON_STARTUP_RUNES \
- "(setf *standard-input* (ext:make-stream :input)) " \
- "(load \"%e\" :verbose nil :print nil) " \
- "(ext:quit)"
-
-#define CLISP_STARTUP_RUNE \
- "(progn " \
- COMMON_PRELUDE_RUNE " " \
- CLISP_COMMON_STARTUP_RUNES ")"
-
-#define CLISP_STARTUP_IMAGE_RUNE \
- "(progn " \
- IMAGE_RESTORE_RUNE " " \
- CLISP_COMMON_STARTUP_RUNES ")"
-
-static void run_clisp(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT, dd = DSTR_INIT;
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "clisp+asdf.mem");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-M", d.p, "-q",
- "-x", expand_rune(&dd, CLISP_STARTUP_IMAGE_RUNE, script),
- "--",
- END);
- else
- argv_prependl(&arg->av, "-norc", "-q",
- "-x", expand_rune(&dd, CLISP_STARTUP_RUNE, script),
- "--",
- END);
-
- argv_prepend(&arg->av, getenv_or_default("CLISP", "clisp"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
- dstr_release(&dd);
-
-#undef f
-}
-
-/* Embeddable Common Lisp. *
- *
- * ECL is changing its command-line option syntax in version 16. I have no
- * idea why they think the result can ever be worth the pain of a transition.
- */
-
-#if ECL_OPTIONS_GNU
-# define ECLOPT "--"
-#else
-# define ECLOPT "-"
-#endif
-
-#define ECL_STARTUP_RUNE \
- "(progn " \
- COMMON_PRELUDE_RUNE " " \
- CLEAR_CL_USER_RUNE ")"
-
-static void run_ecl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "ecl+asdf");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, FEF_EXEC)) {
- argv_prependl(&arg->av, "-s", script, "--", END);
- argv_prependl(&arg->av, d.p, END);
- } else {
- argv_prependl(&arg->av, ECLOPT "shell", script, "--", END);
- argv_prependl(&arg->av, getenv_or_default("ECL", "ecl"), ECLOPT "norc",
- ECLOPT "eval", ECL_STARTUP_RUNE,
- END);
- }
- try_exec(arg, &arg->av);
-}
-
-/* Carnegie--Mellon University Common Lisp. */
-
-#define CMUCL_STARTUP_RUNE \
- "(progn " \
- "(setf ext:*require-verbose* nil) " \
- COMMON_PRELUDE_RUNE ")"
-#define CMUCL_QUIT_RUNE \
- "(ext:quit)"
-
-static void run_cmucl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av,
- "-load", script,
- "-eval", CMUCL_QUIT_RUNE,
- "--",
- END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "cmucl+asdf.core");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-core", d.p, "-eval", IMAGE_RESTORE_RUNE, END);
- else
- argv_prependl(&arg->av, "-batch", "-noinit", "-nositeinit", "-quiet",
- "-eval", CMUCL_STARTUP_RUNE,
- END);
-
- argv_prepend(&arg->av, getenv_or_default("CMUCL", "cmucl"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* Armed Bear Common Lisp. *
- *
- * CLisp made a worthy effort, but ABCL still manages to take the price.
- *
- * * 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.
- */
-
-#define ABCL_STARTUP_RUNE \
- "(let ((#9=#:script \"%e\")) " \
- COMMON_PRELUDE_RUNE " " \
- CLEAR_CL_USER_RUNE " " \
- \
- /* Replace the broken `*error-output*' stream with a working \
- * copy of `stderr'. \
- */ \
- "(setf *error-output* " \
- "(java:jnew \"org.armedbear.lisp.Stream\" " \
- "'sys::system-stream " \
- "(java:jfield \"java.lang.System\" \"err\") " \
- "'character " \
- "java:+true+)) " \
- \
- /* Trap errors signalled by the script and arrange for them \
- * to actually kill the process rather than ending up in the \
- * interactive debugger. \
- */ \
- "(handler-case (load #9# :verbose nil :print nil) " \
- "(error (error) " \
- "(format *error-output* \"~A (unhandled error): ~A~%%\" " \
- "#9# error) " \
- "(ext:quit :status 255))))"
-
-static void run_abcl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, getenv_or_default("ABCL", "abcl"),
- "--batch", "--noinform", "--noinit", "--nosystem",
- "--eval", expand_rune(&d, ABCL_STARTUP_RUNE, script),
- "--",
- END);
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/*----- Main code ---------------------------------------------------------*/
-
-static void version(FILE *fp)
- { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
-
-static void usage(FILE *fp)
-{
- fprintf(fp, "usage: %s [-CDEnqv] [-I IMAGEDIR] "
- "[-L SYS,SYS,...] [-P SYS,SYS,...]\n"
- "\t[--] SCRIPT [ARGUMENTS ...] |\n"
- "\t[-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n",
- progname);
-}
-
-static void help(FILE *fp)
-{
- version(fp); fputc('\n', fp); usage(fp);
- fputs("\n\
-Options:\n\
- --help Show this help text and exit successfully.\n\
- --version Show the version number and exit successfully.\n\
- -C Clear the list of preferred Lisp systems.\n\
- -D Run system Lisp images, rather than custom images.\n\
- -E Don't read embedded options from the script.\n\
- -I IMAGEDIR Look for custom images in IMAGEDIR rather than\n\
- `" IMAGEDIR "'.\n\
- -L SYS,SYS,... Only use the listed Lisp systems.the script.\n\
- -P SYS,SYS,... Prefer the listed Lisp systems.\n\
- -e EXPR Evaluate EXPR (can be repeated).\n\
- -l FILE Load FILE (can be repeated).\n\
- -n Don't actually run the script (useful with `-v')\n\
- -p EXPR Print (`prin1') EXPR (can be repeated).\n\
- -q Don't print warning messages.\n\
- -v Print informational messages (repeat for even more).\n",
- fp);
-}
-
-static void push_eval_op(struct argstate *arg, char op, const char *val)
-{
- char *p;
- size_t n;
-
- if (arg->f&F_AUX) {
- moan("must use `-e', `-p', or `-l' on command line");
- arg->f |= F_BOGUS;
- return;
- }
-
- n = strlen(val) + 1;
- p = xmalloc(n + 1);
- p[0] = op; memcpy(p + 1, val, n);
- argv_append(&arg->av, p);
-}
-
-/* Parse a comma-separated list of system names SPEC, and add the named
- * systems to LIST.
- */
-static void parse_syslist(const char *spec, const struct argstate *arg,
- struct syslist *list, const char *what)
-{
- char *copy = xstrdup(spec), *p = copy, *q;
- const struct systab *sys;
- size_t n;
-
- for (;;) {
- n = strcspn(p, ",");
- if (p[n]) q = p + n + 1;
- else q = 0;
- p[n] = 0; sys = find_system(p);
- if (list->f&sys->f) {
- if (arg->verbose > 0)
- moan("ignoring duplicate system `%s' in %s list", p, what);
- } else {
- list->sys[list->n++] = sys;
- list->f |= sys->f;
- }
- if (!q) break;
- p = q;
- }
- free(copy);
-}
-
-/* Parse a vector ARGS of command-line arguments. Update ARG with the
- * results. NARG is the number of arguments, and *I_INOUT is the current
- * index into the vector, to be updated on exit to identify the first
- * non-option argument (or the end of the vector).
- */
-static void parse_arguments(struct argstate *arg, const char *const *args,
- size_t nargs, size_t *i_inout)
-{
- const char *o, *a;
- char opt;
-
- for (;;) {
- if (*i_inout >= nargs) break;
- o = args[*i_inout];
- if (STRCMP(o, ==, "--help")) { help(stdout); exit(0); }
- else if (STRCMP(o, ==, "--version")) { version(stdout); exit(0); }
- if (!*o || *o != '-' || !o[1]) break;
- (*i_inout)++;
- if (STRCMP(o, ==, "--")) break;
- o++;
- while (o && *o) {
- opt = *o++;
- switch (opt) {
-
-#define GETARG do { \
- if (*o) \
- { a = o; o = 0; } \
- else { \
- if (*i_inout >= nargs) goto noarg; \
- a = args[(*i_inout)++]; \
- } \
-} while (0)
-
- case 'C': arg->pref.n = 0; arg->pref.f = 0; break;
- case 'D': arg->f |= F_NODUMP; break;
- case 'E': arg->f |= F_NOEMBED; break;
- case 'e': GETARG; push_eval_op(arg, '!', a); break;
- case 'p': GETARG; push_eval_op(arg, '?', a); break;
- case 'l': GETARG; push_eval_op(arg, '<', a); break;
- case 'n': arg->f |= F_NOACT; break;
- case 'q': if (arg->verbose) arg->verbose--; break;
- case 'v': arg->verbose++; break;
-
- case 'I':
- free(arg->imagedir);
- GETARG; arg->imagedir = xstrdup(a);
- break;
-
- case 'L':
- GETARG;
- parse_syslist(a, arg, &arg->allow, "allowed");
- break;
-
- case 'P':
- GETARG;
- parse_syslist(a, arg, &arg->pref, "preferred");
- break;
-
- default:
- moan("unknown option `%c'", opt);
- arg->f |= F_BOGUS;
- break;
-
-#undef GETARG
-
- }
- }
- }
- goto end;
-
-noarg:
- moan("missing argument for `-%c'", opt);
- arg->f |= F_BOGUS;
-end:
- return;
-}
-
-/* Parse a string P into words (destructively), and process them as
- * command-line options, updating ARG. Non-option arguments are not
- * permitted. If `SOSF_EMACS' is set in FLAGS, then ignore `-*- ... -*-'
- * editor turds. If `SOSF_ENDOK' is set, then accept `--' and ignore
- * whatever comes after; otherwise, reject all positional arguments.
- */
-#define SOSF_EMACS 1u
-#define SOSF_ENDOK 2u
-static void scan_options_from_string(char *p, struct argstate *arg,
- unsigned flags,
- const char *what, const char *file)
-{
- struct argv av = ARGV_INIT;
- char *q;
- size_t i;
- int st = 0;
- unsigned f = 0;
-#define f_escape 1u
-
- for (;;) {
- while (ISSPACE(*p)) p++;
- if (!*p) break;
- if ((flags&SOSF_EMACS) && p[0] == '-' && p[1] == '*' && p[2] == '-') {
- p = strstr(p + 3, "-*-");
- if (!p) lose("unfinished local-variables list in %s `%s'", what, file);
- p += 3; continue;
- }
- if ((flags&SOSF_ENDOK) &&
- p[0] == '-' && p[1] == '-' && (!p[2] || ISSPACE(p[2])))
- break;
- argv_append(&av, p); q = p;
- for (;;) {
- if (!*p) break;
- else if (f&f_escape) { *q++ = *p; f &= ~f_escape; }
- else if (st && *p == st) st = 0;
- else if (st != '\'' && *p == '\\') f |= f_escape;
- else if (!st && (*p == '"' || *p == '\'')) st = *p;
- else if (!st && ISSPACE(*p)) break;
- else *q++ = *p;
- p++;
- }
-
- if (*p) p++;
- *q = 0;
- if (f&f_escape) lose("unfinished escape in %s `%s'", what, file);
- if (st) lose("unfinished `%c' string in %s `%s'", st, what, file);
- }
-
- 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);
-
-#undef f_escape
-}
-
-/* Read SCRIPT, and check for a `@RUNLISP:' marker in the second line. If
- * there is one, parse options from it, and update ARG.
- */
-static void check_for_embedded_args(const char *script, struct argstate *arg)
-{
- struct dstr d = DSTR_INIT;
- char *p;
- FILE *fp = 0;
-
- fp = fopen(script, "r");
- if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
-
- if (dstr_readline(&d, fp)) goto end;
- dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
-
- p = strstr(d.p, "@RUNLISP:");
- if (p)
- scan_options_from_string(p + 9, arg, SOSF_EMACS | SOSF_ENDOK,
- "embedded options in script", script);
-
-end:
- if (fp) {
- if (ferror(fp))
- lose("error reading script `%s': %s", script, strerror(errno));
- fclose(fp);
- }
- dstr_release(&d);
-}
-
-/* Read the file PATH (if it exists) and update ARG with the arguments parsed
- * from it. Ignore blank lines and (Unix- or Lisp-style) comments.
- */
-static void read_config_file(const char *path, struct argstate *arg)
-{
- FILE *fp = 0;
- struct dstr d = DSTR_INIT;
- char *p;
-
- fp = fopen(path, "r");
- if (!fp) {
- if (errno == ENOENT) {
- if (arg->verbose > 2)
- moan("ignoring nonexistent configuration file `%s'", path);
- goto end;
- }
- lose("failed to open configuration file `%s': %s",
- path, strerror(errno));
- }
- if (arg->verbose > 1)
- moan("reading configuration file `%s'", path);
- for (;;) {
- dstr_reset(&d);
- if (dstr_readline(&d, fp)) break;
- p = d.p;
- while (ISSPACE(*p)) p++;
- if (!*p || *p == ';' || *p == '#') continue;
- scan_options_from_string(p, arg, 0, "configuration file `%s'", path);
- }
- if (arg->f&F_BOGUS)
- lose("invalid options in configuration file `%s'", path);
-
-end:
- if (fp) {
- if (ferror(fp))
- lose("error reading configuration file `%s': %s",
- path, strerror(errno));
- fclose(fp);
- }
- dstr_release(&d);
-}
-
-int main(int argc, char *argv[])
-{
- struct dstr d = DSTR_INIT;
- const char *script, *p;
- const char *home;
- struct passwd *pw;
- char *t;
- size_t i, n;
- struct argstate arg = ARGSTATE_INIT;
-
- /* Scan the command line. This gets low priority, since it's probably
- * from the script shebang.
- */
- set_progname(argv[0]); i = 1;
- parse_arguments(&arg, (const char *const *)argv, argc, &i);
- arg.f |= F_AUX;
- if ((i >= argc && !arg.av.n) || (arg.f&F_BOGUS))
- { usage(stderr); exit(255); }
-
- /* Prepare the argument vector. Keep track of the number of arguments
- * here: we'll need to refer to this later.
- */
- if (!arg.av.n) {
- script = argv[i++];
- if (!(arg.f&F_NOEMBED)) check_for_embedded_args(script, &arg);
- if (arg.f&F_BOGUS)
- lose("invalid options in `%s' embedded option list", script);
- } else {
- script = getenv("RUNLISP_EVAL");
- if (!script) script = DATADIR "/eval.lisp";
- argv_append(&arg.av, "--");
- }
- argv_appendn(&arg.av, argv + i, argc - i);
- n = arg.av.n;
-
- /* Find the user's home directory. (Believe them if they set something
- * strange.)
- */
- home = getenv("HOME");
- if (!home) {
- pw = getpwuid(getuid());
- if (!pw) lose("can't find user in password database");
- home = pw->pw_dir;
- }
-
- /* Check user configuration file `~/.runlisprc'. */
- dstr_reset(&d);
- dstr_puts(&d, home); dstr_putc(&d, '/'); dstr_puts(&d, ".runlisprc");
- read_config_file(d.p, &arg);
-
- /* Check user configuration file `~/.config/runlisprc'. */
- dstr_reset(&d);
- p = getenv("XDG_CONFIG_HOME");
- if (p)
- dstr_puts(&d, p);
- else
- { dstr_puts(&d, home); dstr_putc(&d, '/'); dstr_puts(&d, ".config"); }
- dstr_putc(&d, '/'); dstr_puts(&d, "runlisprc");
- read_config_file(d.p, &arg);
-
- /* Finally, check the environment variables. */
- p = getenv("RUNLISP_OPTIONS");
- if (p) {
- t = xstrdup(p);
- scan_options_from_string(t, &arg, 0,
- "environment variable", "RUNLISP_OPTIONS");
- free(t);
- }
- if (arg.f&F_BOGUS)
- lose("invalid options in environment variable `RUNLISP_OPTIONS'");
- if (!arg.imagedir) {
- arg.imagedir = getenv("RUNLISP_IMAGEDIR");
- if (!arg.imagedir) arg.imagedir = IMAGEDIR;
- }
-
- /* If no systems are listed as acceptable, try them all. */
- if (!arg.allow.n) {
- if (arg.verbose > 1)
- moan("no explicitly allowed implementations: allowing all");
- for (i = 0; i < NSYS; i++) arg.allow.sys[i] = &systab[i];
- arg.allow.n = NSYS; arg.allow.f = (1u << NSYS) - 1;
- }
-
- /* Print what we're going to do. */
- if (arg.verbose > 2) {
- dstr_reset(&d); p = "";
- for (i = 0; i < arg.allow.n; i++)
- { dstr_puts(&d, p); p = ", "; dstr_puts(&d, arg.allow.sys[i]->name); }
- dstr_putz(&d); moan("permitted Lisps: %s", d.p);
-
- dstr_reset(&d); p = "";
- for (i = 0; i < arg.pref.n; i++)
- { dstr_puts(&d, p); p = ", "; dstr_puts(&d, arg.pref.sys[i]->name); }
- dstr_putz(&d); moan("preferred Lisps: %s", d.p);
-
- dstr_reset(&d); p = "";
- for (i = 0; i < arg.pref.n; i++)
- if (arg.pref.sys[i]->f&arg.allow.f)
- { dstr_puts(&d, p); p = ", "; dstr_puts(&d, arg.pref.sys[i]->name); }
- for (i = 0; i < arg.allow.n; i++)
- if (!(arg.allow.sys[i]->f&arg.pref.f))
- { dstr_puts(&d, p); p = ", "; dstr_puts(&d, arg.allow.sys[i]->name); }
- moan("overall preference order: %s", d.p);
- }
-
- /* Inform `uiop' of the script name.
- *
- * 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");
-
- /* Work through the list of preferred Lisp systems, trying the ones which
- * are allowed.
- */
- for (i = 0; i < arg.pref.n; i++)
- if (arg.pref.sys[i]->f&arg.allow.f) {
- arg.av.o += arg.av.n - n; arg.av.v += arg.av.n - n; arg.av.n = n;
- arg.pref.sys[i]->run(&arg, script);
- }
-
- /* That didn't work. Try the remaining allowed systems, in the given
- * order.
- */
- for (i = 0; i < arg.allow.n; i++)
- if (!(arg.allow.sys[i]->f&arg.pref.f)) {
- arg.av.o += arg.av.n - n; arg.av.v += arg.av.n - n; arg.av.n = n;
- arg.allow.sys[i]->run(&arg, script);
- }
-
- /* No joy. Give up. */
- argv_release(&arg.av);
- lose("no supported Lisp systems found");
-}
-
-/*----- That's all, folks -------------------------------------------------*/
.IB var = \c
.IR value ]
.br
-
+ \&
.RB [ \-l
.IR sect ]
.RB [ \-p
and overrides any similarly named setting
from the configuration file(s).
.
-
-
+.TP
+.BI "\-p" "\fR, " "\-\-print-variable=\fR[" sect :\fR] var
+Print the raw (unexpanded) result of looking up the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
.
-.\"--------------------------------------------------------------------------
+.TP
+.BR "\-q" ", " "\-\-quiet"
+Don't print warning messages.
+This option may be repeated:
+each use reduces verbosity by one step,
+counteracting one
+.RB ` \-v '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+.
+.TP
+.BR "\-v" ", " "\-\-verbose"
+Print informational or debugging messages.
+This option may be repeated:
+each use increases verbosity by one step,
+counteracting one
+.RB ` \-q '
+option.
+The default verbosity level is 1,
+which prints only warning measages.
+Higher verbosity levels print informational and debugging messages.
.
-.SH BUGS
-.hP \*o
+.TP
+.BI "\-w" "\fR, " "\-\-split-variable=\fR[" sect :\fR] var
+Print the result of looking up, expanding, and word-splitting the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
+The words are quoted in shell-style, and separated by spaces.
+.
+.TP
+.BI "\-x" "\fR, " "\-\-expand-variable=\fR[" sect :\fR] var
+Print the result of looking up and expanding the variable
+.I var
+in configuration section
+.I sect
+(defaulting to
+.BR @CONFIG ).
+.
+.\"--------------------------------------------------------------------------
.
.SH SEE ALSO
.BR dump-runlisp-image (1),
{ 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);
+ else *var_out = config_find_var(&config, sect, CF_INHERIT, p);
}
/* Help and related functions. */
${ignore-shebang}
${set-script-feature})
+;; Full pathname to custom image.
image-path = ${@image-dir}/${image-file}
+;; Command to delete image.
+delete-image = rm -f ${image-path}
+
;;;--------------------------------------------------------------------------
[sbcl]
.SH SYNOPSIS
.
.B runlisp
-.RB [ \-CDEnqv ]
-.RB [ \-I
-.IR imagedir ]
-.RB [ \-L
-.IB sys , sys , \fR...]
-.RB [ \-P
-.IB sys , sys , \fR...]
+.RI [ options ]
+.RB [ \-\- ]
+.I script
+.RI [ arguments
+\&...]
.br
-\h'8n'
+.B runlisp
+.RI [ options ]
.RB [ \-e
.IR form ]
.RB [ \-l
.RB [ \-p
.IR form ]
.RB [ \-\- ]
-.RI [ script ]
.RI [ arguments
\&...]
+.PP
+where
+.I options
+is
+.br
+ \&
+.RB [ \-CDEnqv ]
+.RB [ +DEn ]
+.RB [ \-L
+.IB sys , sys , \fR...]
+.RB [ \-c
+.IR conf ]
+.RB [ \-o
+.RI [ sect \c
+.BR : ] \c
+.IB var = \c
+.IR value ]
.
.\"--------------------------------------------------------------------------
.SH DESCRIPTION
to invoke a Common Lisp system,
e.g., to build a standalone program.
.
-.SS "Supported Common Lisp implementations"
-The following Lisp implementations are currently supported.
-.TP
-.B "abcl"
-Armed Bear Common Lisp.
-.TP
-.B "ccl"
-Clozure Common Lisp.
-.TP
-.B "clisp"
-GNU CLisp.
-.TP
-.B "cmucl"
-Carnegie\(enMellon University Common Lisp.
-.TP
-.B "ecl"
-Embeddable Common Lisp.
-.TP
-.B "sbcl"
-Steel Bank Common Lisp.
-.PP
-The
-.B runlisp
-program expects, by default,
-to be able to run a Lisp system
-as a program with the same name,
-found by searching as directed by the
-.B PATH
-environment variable.
-This can be overridden by setting an environment variable,
-with the same name but in
-.IR "upper case" ,
-to the actual name \(en
-either a bare filename to be searched for on the
-.BR PATH ,
-or a pathname containing a
-.RB ` / ',
-relative to the working directory or absolute,
-to the program.
-Note that the entire variable value is used as the program name:
-it's not possible to provide custom arguments to a Lisp system
-using this mechanism.
-If you want to do that,
-you must write a shell script to do the necessary work,
-and point the environment variable
-(or the
-.BR PATH )
-at your script.
-.
.SS "Options"
Options are read from the command line, as usual,
-but also from a number of other sources;
-these are, in order:
-.hP \*o
-If a
-.I script
-is named,
-and the script's second line contains a
+but also (by default) from the script's second line,
+following a
.RB ` @RUNLISP: '
-marker,
-then text following the marker is parsed as options.
-.hP \*o
-If files named
-.B ~/.runlisprc
-and/or
-.B ~/.config/runlisprc
-exist,
-then their contents are parsed as options.
-.hP \*o
-If an environment variable
-.B RUNLISP_OPTIONS
-is defined,
-then its contents is parsed as options.
-.PP
-A simple quoting and escaping system is implemented
-to allow spaces and other special characters
-to be included in argument words
-in the script, configuration files, and environment variable.
-The details of all of this are given in the section
+marker: see
.B Operation
-below.
+below for the details.
.
.PP
The options accepted are as follows.
.
.TP
-.B "\-\-help"
+.BR "\-h" ", " "\-\-help"
Write a synopsis of
-.BR runlisp 's
+.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
-.B "\-\-version"
+.BR "\-V" ", " "\-\-version"
Write
-.BR runlisp 's
+.BR query-runlisp-config 's
version number
to standard output
and immediately exit with status 0.
.
.TP
-.B "\-C"
-Clear the list of preferred Lisp implementations.
-.
-.TP
-.B "\-D"
+.BR "\-D" ", " "\-\-vanilla-image"
Don't check for a custom Lisp image.
Usually,
.B runlisp
except for performance comparisons, or debugging
.B runlisp
itself.
+Negate with
+.B +D
+or
+.BR \-\-no-vanilla-image .
.
.TP
-.B "\-E"
+.BR "\-E" ", " "\-\-command-line-only"
Don't read embedded options from the
second line of the
.I script
file.
+Negate with
+.B +E
+or
+.BR \-\-no-command-line-only .
This has no effect in eval mode.
-.
-.TP
-.BI "\-I " imagedir
-Look in
-.I imagedir
-for custom Lisp images.
-This option overrides the default image directory,
which is set at compile time.
.
.TP
-.BI "\-L " sys , sys ,\fR...
+.BI "\-L" "\fR, " "\-\-accept-lisp=" sys , sys ,\fR...
Use one of the named Lisp systems.
Each
.I sys
-must name a supported Lisp system.
+must name a supported Lisp system;
+the names are separated by a comma
+.RB ` , '
+and/or one or more whitespace characters.
This option may be given more than once:
the effect is the same as a single option
listing all of the systems named, in the same order.
and all but the first occurrence is ignored.
.
.TP
-.BI "\-P " sys , sys ,\fR...
-Set the relative preference order of Lisp systems:
-systems listed earlier are more preferred.
-Each
-.I sys
-must name a supported Lisp system.
-This option may be given more than once:
-the effect is the same as a single option
-listing all of the systems named, in the same order.
-If a system is named more than once,
-a warning is issued (at verbosity level 1 or higher),
-and all but the first occurrence is ignored.
-Unmentioned systems are assigned lowest preference:
-if a
-.RB ` \-L '
-option is given,
-then this provides a default preference ordering;
-otherwise, an ordering hardcoded into the program is used.
-The first acceptable Lisp system,
-according to the preference order just described,
-which actually exists,
-is the one selected.
+.BI "\-c" "\fR, " "\-\-config-file=" conf
+Read configuration from
+.IR conf .
+If
+.I conf
+is a directory, then all of the files within
+whose names end with
+.RB ` .conf ',
+are loaded, in ascending lexicographical order;
+otherwise,
+.I conf
+is opened as a file.
+All of the files are expected to as described in
+.BR runlisp.conf (5).
.
.TP
-.BI "\-e " expr
+.BI "\-e" "\fR, " "\-\-evaluate-expression=" expr
Evaluate the expression(s)
.I expr
and discard the resulting values.
mode.
.
.TP
-.BI "\-l " file
+.BI "\-l" "\fR, " "\-\-load-file=" file
Read and evaluate forms from the
.IR file .
This option causes
mode.
.
.TP
-.B "\-n"
+.BR "\-n" ", " "-\-dry-run"
Don't actually start the Lisp environment.
This may be helpful for the curious,
in conjunction with
.RB ` \-v '
to increase the verbosity.
+Negate with
+.B +n
+or
+.BR "\-\-no-dry-run" .
.
.TP
-.BI "\-p " expr
+.BI "\-p" "\fR, " "\-\-print-expressin=" expr
Evaluate the expression(s)
.I expr
and print the resulting value(s)
mode.
.
.TP
-.B "\-q"
+.BR "\-q" ", " "\-\-quiet"
Don't print warning messages.
This option may be repeated:
each use reduces verbosity by one step,
which prints only warning measages.
.
.TP
-.B "\-v"
+.BR "\-v" ", " "\-\-verbose"
Print informational or debugging messages.
This option may be repeated:
each use increases verbosity by one step,
options may only be given on the command-line itself,
not following a
.RB `@ RUNLISP: '
-marker in a script,
-in a configuration file,
-or in the
-.B RUNLISP_OPTIONS
-environment variable.
+marker in a script.
These options may be given multiple times:
they will be processed in the order given.
If any of these options is given, then no
to load code from files.
The
.IR arguments ,
-if any,
+ppif any,
are still made available to the evaluated forms and loaded files.
.
.SS "Operation"
The
.B runlisp
program behaves as follows.
-.PP
+.
+.hP 1.
The first thing it does is parse its command line.
Options must precede positional arguments,
though the boundary may be marked explicitly using
runs in
.I script
mode.
-.PP
+.hP 2.
In
.I script
mode,
for
.IR "embedded options" ,
as follows.
+.RS
+.PP
The text is split into words
separated by sequences of whitespace characters.
Whitespace,
then everything up to and including the next occurrence of
.RB ` \-*\- '
is ignored.
+.PP
The resulting list of words
is processed as if it held further command-line options.
-However,
+Currently, only
+.RB ` \-D '
+and
+.RB ` \-L '
+options are permitted in embedded option lists:
+.RB ` \-h '
+and
+.RB ` \-v '
+are clearly only useful in interactive use;
+setting
+.RB ` \-q '
+or
+.RB ` \-v '
+would just be annoying;
+setting
+.RB ` \-c '
+or
+.RB ` \-o '
+would override the user's command-line settings;
+it's clearly too late to set
+.RB ` \-E ';
+and
.B runlisp
is now committed to
.I script
-mode, so
+mode, so it's too late for
.RB ` \-e ',
.RB ` \-l ',
and
.RB ` \-p '
-options may not appear in a script file's embedded options list.
+too.
+.PP
(This feature allows scripts to provide options even if they use
.BR env (1)
to find
the interpreter name on a
.RB ` #! '
line as a single argument, without further splitting it at spaces.)
-.PP
-If a file named
-.B .runlisprc
-exists in the user's home directory,
-then this file is read to discover more options.
-(If the variable
-.B HOME
-is set in the environment,
-then its value is assumed to name the user's home directory;
-otherwise, the home directory is determined by looking up
-the process's real uid in the password database.)
-Lines consisting entirely of whitespace,
-and lines whose first whitespace character is either
-.RB ` # '
-or
-.RB ` ; '
-are ignored in this file.
-Other lines are split into words,
-and processed as additional command-line options,
-as described for embedded options above,
-except that:
-a
-.RB ` \-\- '
-marker does not terminate word splitting; and
-Emacs-style
-.RB ` \-*\- ... \-*\- '
-local variable lists are not ignored.
-Each line is processed separately,
-so an option and its argument must be written on the same line.
-By this point
-.B runlisp
-will have committed to
-.I script
-or
-.I eval
-mode,
-so
-.RB ` \-e ',
-.RB ` \-l ',
+.RE
+.
+.hP 3.
+If no
+.RB ` \-c '
+options were given,
+then the default configuration files are read:
+the system configuration from
+.B @etcdir@/runlisp.conf
and
-.RB ` \-p '
-options may not appear in a configuration file.
-.PP
-If a file
-.B runlisprc
-exists in the user's
-.I "configuration home"
-directory,
-then it is processed as for
-.B .runlisprc
-above.
-If a variable
-.B XDG_CONFIG_HOME
-is set in the environment,
-then its value is assumed to name the configuration home;
-otherwise, the configuration home is the directory
-.B .config
-in the user's home directory, as determined above.
-.PP
-If the variable
-.B RUNLISP_OPTIONS
-is set in the environment,
-then its value is split into words
-and processed as additional command-line options,
-as for a line of a configuration file as described above.
-.PP
+.BR @etcdir@/runlisp.d/*.conf ,
+and the user configuration from
+.B ~/.runlisp.conf
+and/or
+.BR ~/.config/runlisp.conf :
+see
+.RB runlisp.conf (5)
+for the details.
+.
+.hP 4.
The list of
.I "acceptable Lisp implementations"
is determined.
If any
.RB ` \-L '
-options have been issued,
+options have been found,
then the list of acceptable implementations
consists of all of the implementations mentioned in
.RB ` -L '
option is given, then
.B runlisp
uses a default list,
-which consists of all of the supported Lisp implementations
-in an hardcoded order which reflects
-the author's arbitrary preferences.
-.PP
+which consists of all of the Lisp implementations
+defined in its configuration,
+in the order in which they were defined.
+.
+.hP 5.
The list of
.I "preferred Lisp implementations"
is determined.
-If any
-.RB ` \-P '
-options have been issued
-.I "since the last"
-.IB ` \-C '
-.IR "option" ,
-then the list of preferred implementations
-consists of all of the implementations mentioned in
-.RB ` \-P '
-options after the last occurrence of
-.RB ` \-C ',
-in the order of their first occurrences.
-(If an implementation is named more than once,
-then
+If the environment variable
+.B RUNLISP_PREFER
+is set,
+then its value should be a list of names of Lisp implementations
+separated by a comma and/or one or more whitespace characters.
+Otherwise, if there is a setting for the variable
+.B prefer
+in the
+.B @CONFIG
+configuration section,
+then its (expanded) value should be a list of Lisp implementations,
+in the same way.
+Otherwise, the list of preferred implementations is empty.
+.
+.hP 6.
+If
.B runlisp
-prints a warning to stderr
-and ignores all but the first occurrence.)
-If no
-.RB ` \-P '
-option is given,
-or a
-.RB ` \-C '
-option appears after all of the
-.RB ` \-P '
-options,
-then the list of preferred implementations is empty.
-.PP
+is running in
+.I eval
+mode, then a new command line is built,
+which invokes an internal script,
+instructing it to evaluate and print the requested expressions,
+and load the requested files.
+.
+.hP 7.
Acceptable Lisp implementations are tried in turn.
First, the preferred implementations
which are also listed as acceptable implementations
then, the remaining acceptable implementations are tried
in the order in which they appear
in the acceptable implementations list.
-To
-.I try
-a Lisp implementation means to construct a command line
-(whose effect will be described below)
-and pass it to the
+.RS
+.PP
+A Lisp implementation is defined by a configuration section
+which defines a variable
+.BR run-script .
+The name of the configuration section
+is the name of the Lisp implementation,
+as used in the acceptable and preferred lists described above.
+.hP (a)
+The variable
+.B image-file
+is looked up in the configuration section.
+If a value is found, then
+.B runlisp
+looks up and expands
+.BR image-path ,
+and checks to see if a file exists with the resulting name.
+If so, it sets the variable
+.B @image
+to
+.B t
+in the configuration section.
+.hP (b)
+The variable
+.B run-script
+is expanded and word-split.
+The
+.I script
+(an internal script, in
+.I eval
+mode)
+and
+.IR argument s
+are appended, and
+the entire list is passed to the
.BR execvp (3)
function.
If that succeeds, the Lisp implementation runs;
printing messages to stderr
if the verbosity level is sufficiently high,
and exits.
-.PP
-In
-.I script
-mode,
-the script is invoked.
-In
-.I eval
-mode,
-the instructions given in
-.RB ` \-e ',
-.RB ` \-l ',
-and
-.RB ` \-p '
-options are carried out,
-in the order in which the appeared in the command line.
-The details of the environment
-in which Lisp code is executed
-are described next.
.
.SS "Script environment"
-Code in scripts and forms invoked by
+Many Lisp implementations don't provide a satisfactory environment
+for scripts to run in.
+The actual task of invoking a Lisp implementation
+is left to configuration,
+but the basic configuration supplied with
.B runlisp
-may assume the following facts about their environment.
+ensures the following facts about their environment.
.hP \*o
The keyword
.B :runlisp-script
fp);
}
+/* Complain about options which aren't permitted as embedded options. */
+static void check_command_line(int ch)
+{
+ if ((flags&AF_STATEMASK) != AF_CMDLINE) {
+ moan("`%c%c' is not permitted as embedded option",
+ ch&OPTF_NEGATED ? '+' : '-',
+ ch&~OPTF_NEGATED);
+ flags |= AF_BOGUS;
+ }
+}
+
/* Parse the options in the argument vector. */
static void parse_options(int argc, char *argv[])
{
{ 0, 0, 0, 0 }
};
+#define FLAGOPT(ch, f, extra) \
+ case ch: \
+ extra \
+ flags |= f; \
+ break; \
+ case ch | OPTF_NEGATED: \
+ extra \
+ flags &= ~f; \
+ break
+#define CMDL do { check_command_line(i); } while (0)
+
optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname;
for (;;) {
i = mdwopt(argc, argv, "+hVD+E+L:c:e:l:n+o:p:qv", opts, 0, 0,
OPTF_NEGATION | OPTF_NOPROGNAME);
if (i < 0) break;
switch (i) {
- case 'h': help(stdout); exit(0);
- case 'V': version(stdout); exit(0);
- case 'D': flags |= AF_VANILLA; break;
- case 'D' | OPTF_NEGATED: flags &= ~AF_VANILLA; break;
- case 'E': flags |= AF_NOEMBED; break;
- case 'E' | OPTF_NEGATED: flags &= ~AF_NOEMBED; break;
+ case 'h': CMDL; help(stdout); exit(0);
+ case 'V': CMDL; version(stdout); exit(0);
+ FLAGOPT('D', AF_VANILLA, ; );
+ FLAGOPT('E', AF_NOEMBED, { CMDL; });
case 'L':
add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT,
offsetof(struct lispsys, next_accept));
break;
- case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break;
- case 'e': push_eval_op('!', optarg); break;
- case 'l': push_eval_op('<', optarg); break;
- case 'n': flags |= AF_DRYRUN; break;
- case 'n' | OPTF_NEGATED: flags &= ~AF_DRYRUN; break;
- case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break;
- case 'p': push_eval_op('?', optarg); break;
- case 'q': if (verbose) verbose--; break;
- case 'v': verbose++; break;
+ case 'c': CMDL; read_config_path(optarg, 0); flags |= AF_SETCONF; break;
+ case 'e': CMDL; push_eval_op('!', optarg); break;
+ case 'l': CMDL; push_eval_op('<', optarg); break;
+ FLAGOPT('n', AF_DRYRUN, { CMDL; });
+ case 'o': CMDL; if (set_config_var(optarg)) flags |= AF_BOGUS; break;
+ case 'p': CMDL; push_eval_op('?', optarg); break;
+ case 'q': CMDL; if (verbose) verbose--; break;
+ case 'v': CMDL; verbose++; break;
default: flags |= AF_BOGUS; break;
}
}
if (!(flags&AF_VANILLA) &&
config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path");
+ if (!var)
+ lose("variable `image-path' not defined for Lisp `%s'",
+ LISPSYS_NAME(lisp));
dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d);
if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0))
config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t");
.\"--------------------------------------------------------------------------
.SH DESCRIPTION
.
+.SS "Default configuration files"
+By default, the
+.B runlisp
+programs read configuration from the following files.
+(Note that if a
+.RB ` \-c '
+command-line option is given, then
+these default files are
+.I not
+read.)
+.TP
+.B @etcdir@/runlisp.d/*.conf
+If a directory named
+.B @etcdir@/runlisp.d
+exists,
+then all of the files within
+whose names end in
+.RB ` .conf '
+are read,
+in ascending lexicographical order by name.
+This directory name can be overridden by setting the
+.B RUNLISP_SYSCONFIG_DIR
+environment variable.
+.TP
+.B @etcdir@/runlisp.conf
+The file named
+.B @etcdir@/runlisp.conf
+is read; the file must exist.
+This filename can be overridden by setting the
+.B RUNLISP_SYSCONFIG
+environment variable.
+.TP
+.B ~/.runlisp.conf
+If there is a file named
+.B .runlisp.conf
+in the user's home directory,
+then it is read.
+The home directory is determined to be
+the value of the
+.B HOME
+environment variable, or, if that is not set,
+the home directory associated with the process's real uid
+in the system password database.
+This filename can be overridden by setting the
+.B RUNLISP_USERCONFIG
+environment variable.
+.TP
+.B ~/.config/runlisp.conf
+If there is a file named
+.B runlisp.conf
+in the user's XDG configuration directory,
+then it is read.
+The XDG configuration directory is determined to be the value of the
+.B XDG_CONFIG_HOME
+environment variable, or the
+.B .config
+directory in the user's home directory
+(as determined above).
+This filename can be overridden by setting the
+.B RUNLISP_USERCONFIG
+environment variable.
+(Note, therefore, that this variable overrides
+.I both
+of the user configuration files.)
+.
.SS "General syntax"
In summary,
a configuration file is structured as a collection of assignments
sections.
.PP
The
-.BR @BUILTIN ,
-.BR @CONFIG ,
+.B @BUILTIN
and
.B @ENV
sections have no parents.
.PP
would be invalid in a word-splitting context.
.
+.SS "Other special variables"
+In every section, the section's name
+is automatically assigned to the variable
+.BR @name .
+This variable
+.I can
+be overridden by an explicit assignment,
+but this is not recommended.
+.
.SS "Predefined variables in @BUILTIN"
The
.B @BULITIN
it holds a number of variables set by the
.B runlisp
programs.
+.
.TP
.B @data-dir
The directory in which
.B @CONFIG
section,
or a value determined at compile time.
+.
.TP
.B @ecl-opt
The preferred option prefix for ECL, either
.B @CONFIG
section,
or a value determined at compile time.
+.
.TP
.B @image-dir
The directory in which
.B @CONFIG
section,
or a value determined at compile time.
+.
.TP
.B @image-new
Set by
.RB ( dump-runlisp-image
will rename the image into place itself,
if the command completes successfully.)
+.
.TP
.B @image-out
Set by
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
.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,
+.SS "Environment variables in @ENV"
+The
+.B @ENV
+section is special,
+and is used to hold a copy of the system environment.
+At startup,
+it contains an assignment for every environment variable.
+The
+.B @ENV
+section has no parents.
+The values are not expandable.
+It is possible to override
+.B @ENV
+settings in configuration files
+or on the command line,
but this is not recommended.
.
-.\"--------------------------------------------------------------------------
+.SS "The @COMMON section"
+The
+.B @COMMON section
+is the default parent for nearly all other configuration sections
+(the exceptions being
+.B @BUILTIN
+and
+.BR @ENV ,
+which have no parents, and
+.B @COMMON
+itself, whose parent is
+.BR @BUILTIN ).
+It is used in the provided configuration
+to hold various common snippets of Lisp code and other settings,
+but the
+.B runlisp
+programs themselves make no direct use of it.
.
-.SH BUGS
-.hP \*o
+.SS "Overall configuration in @CONFIG"
+Variable settings in
+.B @CONFIG
+are consulted for various administrative reasons.
+.PP
+Because of the open-ended nature of this configuration mechanism,
+users can easily invent new configuration variables
+for any purpose they can imagine.
+The following variables are used by the
+.B runlisp
+programs directly, or its default configuration.
+All values are expanded before use;
+the
+.B @CONFIG
+section's parent is
+.BR @COMMON ,
+as usual.
+.
+.TP
+.B data-dir
+The directory in which
+.BR runlisp 's
+auxiliary data files and scripts are located.
+There is a hardcoded default
+determined at compile-time,
+which is probably correct.
+Overridden by the
+.B RUNLISP_DATADIR
+environment variable.
+Don't refer to this setting directly:
+expand
+.B @data-dir
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B dump
+A comma-separated list of Lisp implementation names
+which should have custom images dumped by
+.BR "dump-runlisp-image \-a" .
+The order is not especially significant.
+The default is all of the configured implementations
+which define a
+.B dump-image
+variable
+and whose command can be found.
+.
+.TP
+.B ecl-opt
+The preferred option prefix for ECL, either
+.RB ` \- '
+or
+.RB ` \-\- '.
+There is a hardcoded default
+determined at compile-time,
+which was correct for the system on which
+.B runlisp
+was built.
+Don't refer to this setting directly:
+expand
+.B @ecl-opt
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B @image-dir
+The directory in which
+.B runlisp
+looks for, and
+.B dump-runlisp-image
+stores, custom Lisp images.
+Overridden by the
+.B RUNLISP_IMAGEDIR
+environment variable.
+Don't refer to this setting directly:
+expand
+.B @image-dir
+from the
+.B @BUILTIN
+section instead.
+.
+.TP
+.B prefer
+A comma-separated list of names of
+.I preferred
+Lisp implementations,
+Overridden by the
+.B RUNLISP_PREFER
+environment variable.
+.
+.SS "Lisp implementation definitions"
+A Lisp implementation is described to
+.B runlisp
+by a configuration section.
+The section's name is used to refer to the implementation,
+e.g., in
+.BR runlisp 's
+.B \-L
+option,
+or in the
+.B dump
+and
+.B prefer
+lists described above.
+.PP
+The following variable settings are used directly;
+of course, a Lisp implementation definition may contain other settings
+for internal purposes.
+.
+.TP
+.B command
+The name of the program used to invoke the Lisp implementation.
+.BR dump-runlisp-image
+looks to see whether this program is installed when invoked with the
+.B \-i
+option:
+it will fail if there is no
+.B command
+setting.
+It is also commonly
+(but not universally)
+used in the
+.B run-script
+and
+.B dump-image
+variables.
+It's conventional to set this to
+.B ${@ENV:FOO?foo}
+so that the command name can be overridden from the environment.
+.
+.TP
+.B dump-image
+The complete command to use to dump a custom image
+for this Lisp implementation.
+The value is subjected to expansion and word-splitting before use.
+It should write the newly created image to the file named by the
+.B @image-new
+setting in the
+.B @BUILTIN
+section.
+.
+.TP
+.B image-file
+The basename of the custom image file
+(i.e., not containing any
+.BR ` / '
+characters)
+to use when invoking this Lisp implementation.
+.BR runlisp (1)
+and
+.BR dump-runlisp-image (1)
+use the presence of this setting to decide
+whether the implementation supports custom images.
+.
+.TP
+.B image-path
+The complete (but not necessarily absolute) pathname
+of the custom image file for this Lisp implementation.
+It is the (expanded) value of this variable
+which is used by
+.BR runlisp (1)
+when it checks whether a custom image exists.
+It's set to
+.B ${@image-dir}/${image-file}
+in the standard configuration file's
+.B @COMMON
+section,
+and there is probably no need to override it;
+.B @image-dir
+is set in the
+.B @BUILTIN
+section
+.RB ( @image-dir
+is set in the
+.N @BUILTIN
+section \(en see above \(en and
+.B image-file
+must be set in this section
+(or one of its ancestors)
+before
+.BR runlisp (1)
+would not attempt to check for an image file.
+.
+.TP
+.B run-script
+The complete command to use
+to get this Lisp implementation to execute a script.
+The value is subjected to expansion and word-splitting before use.
+The script name is available as
+.B @script
+in the
+.B @BUILTIN
+section \(en see above.
+If a custom image is available, then
+.B @image
+is defined
+(to the value
+.BR t )
+.I "in this section"
+(not in
+.BR @BUILTIN );
+the full path to the image file to use is given by
+.B ${image-path}
+\(en see above.
+.
+.\"--------------------------------------------------------------------------
.
.SH SEE ALSO
.BR dump-runlisp-image (1),
--- /dev/null
+/* -*-c-*-
+ *
+ * The SHA256 hash function (compact edition)
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <string.h>
+
+#include "sha256.h"
+
+/*----- Preliminary definitions -------------------------------------------*/
+
+/* The initial values of the state variables. These are in reverse order --
+ * see the note in `compress'.
+ */
+static const u32 iv[8] = {
+ 0x5be0cd19, 0x1f83d9ab, 0x9b05688c, 0x510e527f,
+ 0xa54ff53a, 0x3c6ef372, 0xbb67ae85, 0x6a09e667
+};
+
+/* The round constants. */
+static const u32 rc[64] = {
+ 0x428a2f98, 0x71374491, 0xb5c0fbcf, 0xe9b5dba5,
+ 0x3956c25b, 0x59f111f1, 0x923f82a4, 0xab1c5ed5,
+ 0xd807aa98, 0x12835b01, 0x243185be, 0x550c7dc3,
+ 0x72be5d74, 0x80deb1fe, 0x9bdc06a7, 0xc19bf174,
+ 0xe49b69c1, 0xefbe4786, 0x0fc19dc6, 0x240ca1cc,
+ 0x2de92c6f, 0x4a7484aa, 0x5cb0a9dc, 0x76f988da,
+ 0x983e5152, 0xa831c66d, 0xb00327c8, 0xbf597fc7,
+ 0xc6e00bf3, 0xd5a79147, 0x06ca6351, 0x14292967,
+ 0x27b70a85, 0x2e1b2138, 0x4d2c6dfc, 0x53380d13,
+ 0x650a7354, 0x766a0abb, 0x81c2c92e, 0x92722c85,
+ 0xa2bfe8a1, 0xa81a664b, 0xc24b8b70, 0xc76c51a3,
+ 0xd192e819, 0xd6990624, 0xf40e3585, 0x106aa070,
+ 0x19a4c116, 0x1e376c08, 0x2748774c, 0x34b0bcb5,
+ 0x391c0cb3, 0x4ed8aa4a, 0x5b9cca4f, 0x682e6ff3,
+ 0x748f82ee, 0x78a5636f, 0x84c87814, 0x8cc70208,
+ 0x90befffa, 0xa4506ceb, 0xbef9a3f7, 0xc67178f2
+};
+
+/* Standard bithacking operations on 32-bit words.
+ *
+ * Note that this code assumes that a `u32' is /at least/ 32 bits wide, but
+ * may be longer, so we must do some work to keep cruft in the top bits from
+ * messing things up.
+ */
+#define M32 0xffffffff
+#define LSL32(x, n) ((x) << ((n)))
+#define LSR32(x, n) (((x)&M32) >> ((n)))
+#define ROR32(x, n) (LSL32((x), 32 - (n)) | LSR32((x), (n)))
+
+/* Reading and writing 32-bit words. */
+#define LOAD32_B(p) \
+ (((u32)(((const unsigned char *)(p))[0]&0xff) << 24) | \
+ ((u32)(((const unsigned char *)(p))[1]&0xff) << 16) | \
+ ((u32)(((const unsigned char *)(p))[2]&0xff) << 8) | \
+ ((u32)(((const unsigned char *)(p))[3]&0xff) << 0))
+#define STORE32_B(p, x) do { \
+ (void)sizeof(memmove((p), (p), 1)); \
+ ((unsigned char *)(p))[0] = ((x) >> 24)&0xff; \
+ ((unsigned char *)(p))[1] = ((x) >> 16)&0xff; \
+ ((unsigned char *)(p))[2] = ((x) >> 8)&0xff; \
+ ((unsigned char *)(p))[3] = ((x) >> 0)&0xff; \
+} while (0)
+
+/* SHA256's balanced ternary operators. */
+#define CH(x, y, z) (((x)&(y)) | (~(x)&(z)))
+#define MAJ(x, y, z) (((x)&(y)) | ((y)&(z)) | ((z)&(x)))
+
+/* The SHA256 Σ and σ functions. */
+#define S0(x) (ROR32((x), 2) ^ ROR32((x), 13) ^ ROR32((x), 22))
+#define S1(x) (ROR32((x), 6) ^ ROR32((x), 11) ^ ROR32((x), 25))
+#define s0(x) (ROR32((x), 7) ^ ROR32((x), 18) ^ LSR32((x), 3))
+#define s1(x) (ROR32((x), 17) ^ ROR32((x), 19) ^ LSR32((x), 10))
+
+/*----- Main code ---------------------------------------------------------*/
+
+/* Compress a 64-byte buffer at P, updating the hash state S. */
+static void compress(struct sha256_state *s, const unsigned char *p)
+{
+ u32 t, u, a[8], m[16];
+ const u32 *r = rc;
+ size_t i;
+
+ /* This is a mostly straightforward implementation of the specification, as
+ * a rolled-up loop, one iteration per round. The only wrinkle is that the
+ * vector of state variables, conventionally named a, b, ..., h, are
+ * maintained in our state structure in reverse order, so h is in S->a[0],
+ * b is in S->a[6], and a is in S->a[7]. We do this so that we advance
+ * through our vector in the correct direction from round to round: this
+ * avoids making the indexing arithmetic too complicated.
+ */
+
+ /* Move the state and message data into our internal vectors. */
+ for (i = 0; i < 8; i++) a[i] = s->a[i];
+ for (i = 0; i < 16; i++, p += 4) m[i] = LOAD32_B(p);
+
+ /* Perform 64 rounds of update. Update the message schedule as we go. The
+ * last 16 rounds of message-schedule update are pointless: doing the
+ * message-schedule update conditionally would make the loop messier, and
+ * running the message schedule separately would add a second loop and
+ * require more intermediate storage.
+ */
+ for (i = 0; i < 64; i++) {
+#define A(j) (a[(i + (j))%8])
+#define M(j) (m[(i + (j))%16])
+ t = A(0) + S1(A(3)) + CH(A(3), A(2), A(1)) + M(0) + *r++;
+ u = S0(A(7)) + MAJ(A(7), A(6), A(5));
+ A(4) += t; A(0) = t + u;
+ M(0) += s1(M(14)) + M(9) + s0(M(1));
+#undef A
+#undef M
+ }
+
+ /* Write out the updated state. */
+ for (i = 0; i < 8; i++) s->a[i] += a[i];
+}
+
+/* Initialize the hash state S. */
+void sha256_init(struct sha256_state *s)
+ { size_t i; s->n = s->nblk = 0; for (i = 0; i < 8; i++) s->a[i] = iv[i]; }
+
+/* Append SZ bytes of data starting at M to the hash state S. */
+void sha256_hash(struct sha256_state *s, const void *m, size_t sz)
+{
+ const unsigned char *p = m;
+ size_t r = SHA256_BLKSZ - s->n;
+
+ /* Feed the input data into the hash function. Our buffer-management
+ * policy is to empty the buffer by calling the compression function as
+ * soon as the buffer fills completely.
+ */
+ if (sz < r) {
+ /* The whole input will fit into the buffer, with space to spare. We
+ * just copy it in and update the occupancy counter.
+ */
+
+ memcpy(s->buf + s->n, p, sz);
+ s->n += sz;
+ } else {
+ /* We're going to fill the buffer at least once. */
+
+ /* If the buffer contains any data already then copy the initial portion
+ * of the new input chunk into the buffer and compress it there.
+ * Otherwise, if the buffer is entirely empty, then we can compress the
+ * initial block from the input directly.
+ */
+ if (!s->n) { compress(s, p); p += SHA256_BLKSZ; sz -= SHA256_BLKSZ; }
+ else { memcpy(s->buf + s->n, p, r); compress(s, s->buf); p += r; sz -= r; }
+ s->nblk++;
+
+ /* Continue compressing complete blocks from the input while enough
+ * material remains.
+ */
+ while (sz >= SHA256_BLKSZ)
+ { compress(s, p); s->nblk++; p += SHA256_BLKSZ; sz -= SHA256_BLKSZ; }
+
+ /* Copy the tail end into the buffer and record how much there is. */
+ s->n = sz; if (sz) memcpy(s->buf, p, sz);
+ }
+}
+
+/* Write the final hash of state S to buffer H. */
+void sha256_done(struct sha256_state *s, unsigned char *h)
+{
+ size_t i, n, r;
+ u32 lo, hi;
+
+ /* Add the end-of-data marker to the buffer. There must be at least one
+ * byte spare, or we'd have compressed already.
+ */
+ n = s->n; s->buf[n++] = 0x80; r = SHA256_BLKSZ - n;
+
+ /* If there's enough space for the message length, then fill the gap
+ * between with zeros. Otherwise, fill the whole of the remaining space,
+ * compress, and then refill the initial portion of the buffer. Either
+ * way, after this, there's just eight bytes left at the end of the buffer,
+ * into which we can drop the length.
+ */
+ if (r >= 8)
+ memset(s->buf + n, 0, r - 8);
+ else {
+ if (r) memset(s->buf + n, 0, r);
+ compress(s, s->buf);
+ memset(s->buf, 0, SHA256_BLKSZ - 8);
+ }
+
+ /* Convert the length into two 32-bit halves measuring the total input
+ * length in bits, and run the compression function one last time. There
+ * can be no carry, since S->n is always less than 64.
+ */
+ lo = ((s->nblk << 9) | (s->n << 3))&M32; hi = (s->nblk >> 23)&M32;
+ STORE32_B(s->buf + 56, hi); STORE32_B(s->buf + 60, lo);
+ compress(s, s->buf);
+
+ /* Write out the final hash value. We must compensate here because the
+ * state variables are in reverse order.
+ */
+ for (i = 8; i-- > 0; h += 4) STORE32_B(h, s->a[i]);
+}
+
+/*----- That's all, folks -------------------------------------------------*/
--- /dev/null
+/* -*-c-*-
+ *
+ * The SHA256 hash function
+ *
+ * (c) 2020 Mark Wooding
+ */
+
+/*----- Licensing notice --------------------------------------------------*
+ *
+ * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
+ *
+ * Runlisp is free software: you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the
+ * Free Software Foundation; either version 3 of the License, or (at your
+ * option) any later version.
+ *
+ * Runlisp is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ * for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Runlisp. If not, see <https://www.gnu.org/licenses/>.
+ */
+
+#ifndef SHA256_H
+#define SHA256_H
+
+#ifdef __cplusplus
+ extern "C" {
+#endif
+
+/*----- Header files ------------------------------------------------------*/
+
+#include <limits.h>
+
+/*----- Data types --------------------------------------------------------*/
+
+/* Select a suitable type for 32-bit words. */
+#if UINT_MAX >= 0xffffffff
+ typedef unsigned u32;
+#else
+ typedef unsigned long u32;
+#endif
+
+#define SHA256_BLKSZ 64 /* input block size in bytes */
+#define SHA256_HASHSZ 32 /* output hash size in bytes */
+
+struct sha256_state {
+ unsigned n; /* number of live bytes in buffer */
+ size_t nblk; /* number of blocks hashed so far */
+ u32 a[8]; /* hash state */
+ unsigned char buf[SHA256_BLKSZ]; /* input buffer */
+};
+
+/*----- Functions provided ------------------------------------------------*/
+
+extern void sha256_init(struct sha256_state */**/);
+ /* Initialize the hash state S. */
+
+extern void sha256_hash(struct sha256_state */*s*/,
+ const void */*m*/, size_t /*sz*/);
+ /* Append SZ bytes of data starting at M to the hash state S. */
+
+extern void sha256_done(struct sha256_state */*s*/, unsigned char */*h*/);
+ /* Write the final hash of state S to buffer H. */
+
+/*----- That's all, folks -------------------------------------------------*/
+
+#ifdef __cplusplus
+ }
+#endif
+
+#endif
doc_DATA =
pkgdata_DATA =
+pkgdata_SCRIPTS =
+
pkgconfdir = $(sysconfdir)/$(PACKAGE_NAME)
pkgconf_DATA =
prefix=$(prefix) exec_prefix=$(exec_prefix) \
libdir=$(libdir) includedir=$(includedir) \
bindir=$(bindir) sbindir=$(sbindir) \
- imagedir=$(imagedir) \
+ etcdir=$(sysconfdir) imagedir=$(imagedir) \
PACKAGE=$(PACKAGE) VERSION=$(VERSION) \
ECLOPT=$(ECLOPT)
v_man = $(v_man_@AM_V@)
v_man_ = $(v_man_@AM_DEFAULT_V@)
-v_man_0 = @echo " MAN $@";
+v_man_0 = @echo " MAN $@";
MAN = man
-SUFFIXES += .1 .5 .pdf
+SUFFIXES += .1 .5 .1.in .5.in .pdf
.1.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
.5.pdf:; $(v_man)$(MAN) -Tpdf -l >$@.new $< && mv $@.new $@
+.1.in.1: Makefile; $(SUBST) $< $(SUBSTITUTIONS) >$@.new && mv $@.new $@
+.5.in.5: Makefile; $(SUBST) $< $(SUBSTITUTIONS) >$@.new && mv $@.new $@
+CLEANFILES += *.1 *.5 *.pdf
###--------------------------------------------------------------------------
### List of Lisp systems.
~mdw / runlisp / commitdiff