From 10427eb21d77a0edeb2f17e434515b91b420cdfb Mon Sep 17 00:00:00 2001 From: Mark Wooding Date: Sun, 13 Sep 2020 10:36:27 +0100 Subject: [PATCH] @@@ more wip --- Makefile.am | 17 +- common.c | 3 +- dump-runlisp-image.1 | 267 ------ dump-runlisp-image.1.in | 366 ++++++++ dump-runlisp-image.c | 490 +++++++--- dump-runlisp-image.in | 390 -------- lib.c | 18 +- lib.h | 2 +- old-runlisp.c | 985 --------------------- ...y-runlisp-config.1 => query-runlisp-config.1.in | 57 +- query-runlisp-config.c | 2 +- runlisp-base.conf | 4 + runlisp.1 => runlisp.1.in | 459 ++++------ runlisp.c | 52 +- runlisp.conf.5 => runlisp.conf.5.in | 334 ++++++- sha256.c | 223 +++++ sha256.h | 74 ++ vars.am | 11 +- 18 files changed, 1666 insertions(+), 2088 deletions(-) delete mode 100644 dump-runlisp-image.1 create mode 100644 dump-runlisp-image.1.in delete mode 100644 dump-runlisp-image.in delete mode 100644 old-runlisp.c rename query-runlisp-config.1 => query-runlisp-config.1.in (73%) rename runlisp.1 => runlisp.1.in (65%) rename runlisp.conf.5 => runlisp.conf.5.in (65%) create mode 100644 sha256.c create mode 100644 sha256.h diff --git a/Makefile.am b/Makefile.am index 9bb717c..c2f643a 100644 --- a/Makefile.am +++ b/Makefile.am @@ -42,6 +42,7 @@ librunlisp_a_SOURCES = librunlisp_a_SOURCES += common.c common.h librunlisp_a_SOURCES += lib.c lib.h librunlisp_a_SOURCES += mdwopt.c mdwopt.h +librunlisp_a_SOURCES += sha256.c sha256.h ###-------------------------------------------------------------------------- ### The main driver program. @@ -51,15 +52,7 @@ runlisp_SOURCES = runlisp.c 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. @@ -67,7 +60,7 @@ toy_SOURCES += lib.c lib.h 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 @@ -75,9 +68,11 @@ query_runlisp_config_SOURCES = query-runlisp-config.c query_runlisp_config_LDADD = librunlisp.a man_MANS += query-runlisp-config.1 doc_DATA += query-runlisp-config.pdf +EXTRA_DIST += query-runlisp-config.1.in man_MANS += runlisp.conf.5 doc_DATA += runlisp.conf.pdf +EXTRA_DIST += runlisp.conf.5.in EXTRA_DIST += runlisp-base.conf install-data-hook:: @@ -104,7 +99,7 @@ dump_runlisp_image_SOURCES = dump-runlisp-image.c dump_runlisp_image_LDADD = librunlisp.a man_MANS += dump-runlisp-image.1 doc_DATA += dump-runlisp-image.pdf -EXTRA_DIST += dump-runlisp-image.1 +EXTRA_DIST += dump-runlisp-image.1.in DUMP_RUNLISP_IMAGE = $(v_dump)./dump-runlisp-image \ -f -c$(srcdir)/runlisp-base.conf -O$@ diff --git a/common.c b/common.c index 1c0b0ce..98438e4 100644 --- a/common.c +++ b/common.c @@ -292,7 +292,7 @@ int try_exec(struct argv *av, unsigned f) execvp(av->v[0], av->v); if (errno != ENOENT) { moan("failed to exec `%s': %s", av->v[0], strerror(errno)); - _exit(2); + _exit(127); } } @@ -322,7 +322,6 @@ void init_config(void) 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, diff --git a/dump-runlisp-image.1 b/dump-runlisp-image.1 deleted file mode 100644 index 61f06e4..0000000 --- a/dump-runlisp-image.1 +++ /dev/null @@ -1,267 +0,0 @@ -.\" -*-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 . -. -.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, -. -.\"----- That's all, folks -------------------------------------------------- diff --git a/dump-runlisp-image.1.in b/dump-runlisp-image.1.in new file mode 100644 index 0000000..6c433f4 --- /dev/null +++ b/dump-runlisp-image.1.in @@ -0,0 +1,366 @@ +.\" -*-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 . +. +.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, +. +.\"----- That's all, folks -------------------------------------------------- diff --git a/dump-runlisp-image.c b/dump-runlisp-image.c index 1c6cb55..50bfb3f 100644 --- a/dump-runlisp-image.c +++ b/dump-runlisp-image.c @@ -23,7 +23,7 @@ * along with Runlisp. If not, see . */ -/*----- Header files ------------------------------------------------------*/ +/*----- Header files ---------------------------------------------------------*/ #include "config.h" @@ -70,6 +70,7 @@ struct linebuf { /* 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 @@ -79,6 +80,7 @@ enum { 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_...') */ @@ -90,8 +92,12 @@ struct job { #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' */ @@ -108,6 +114,9 @@ static unsigned flags = 0; /* flags for the application */ #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 --------------------------------------------------------*/ @@ -490,60 +499,112 @@ static void prefix_lines(struct job *job, struct linebuf *buf, char marker) /*----- 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); @@ -557,17 +618,35 @@ static void add_job(struct job ***tail_inout, unsigned f, * 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, "", "${@image-new}"); @@ -577,11 +656,11 @@ static void add_job(struct job ***tail_inout, unsigned f, /* 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; } } @@ -589,15 +668,21 @@ static void add_job(struct job ***tail_inout, unsigned f, * 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. */ @@ -606,6 +691,20 @@ end: 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. @@ -613,6 +712,7 @@ end: 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); @@ -621,6 +721,7 @@ static void release_job(struct job *job) 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); } @@ -761,6 +862,22 @@ static void start_jobs(void) 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)) { @@ -926,6 +1043,10 @@ static void run_jobs(void) * 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); } @@ -942,7 +1063,7 @@ static void version(FILE *fp) 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); } @@ -966,13 +1087,33 @@ Configuration:\n\ \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[]) { @@ -980,16 +1121,22 @@ 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' }, @@ -998,6 +1145,7 @@ int main(int argc, char *argv[]) { "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 } }; @@ -1008,30 +1156,41 @@ int main(int argc, char *argv[]) /* 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; @@ -1084,6 +1243,10 @@ int main(int argc, char *argv[]) "@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); @@ -1093,83 +1256,166 @@ int main(int argc, char *argv[]) /* 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); } diff --git a/dump-runlisp-image.in b/dump-runlisp-image.in deleted file mode 100644 index a4bf87e..0000000 --- a/dump-runlisp-image.in +++ /dev/null @@ -1,390 +0,0 @@ -#! /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 . - -###-------------------------------------------------------------------------- -### 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" <"$tmp/ecl-run.lisp" < $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 &2 "$tmp/log" ;; esac; exit=2 ;; - esac -done - -## All done. -exit $exit - -###----- That's all, folks -------------------------------------------------- diff --git a/lib.c b/lib.c index 523ca23..36751ab 100644 --- a/lib.c +++ b/lib.c @@ -436,7 +436,7 @@ void *treap_lookup(const struct treap *t, const char *k, size_t kn) * 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) @@ -509,7 +509,7 @@ void treap_insert(struct treap *t, const struct treap_path *p, * subtree of U, then we rotate like this: * * | | - * U N + * U (N) * / \ / \ * (N) Z ---> X U * / \ / \ @@ -519,7 +519,7 @@ void treap_insert(struct treap *t, const struct treap_path *p, * of U, then we do the opposite rotation: * * | | - * U N + * U (N) * / \ / \ * X (N) ---> U Z * / \ / \ @@ -594,7 +594,7 @@ void *treap_remove(struct treap *t, const char *k, size_t kn) * / \ / \ * L R ---> X (N) * / \ / \ - * X Y Y Z + * X Y Y R * * or * @@ -608,8 +608,10 @@ void *treap_remove(struct treap *t, const char *k, size_t kn) * 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); @@ -691,9 +693,9 @@ void *treap_next(struct treap_iter *i) * * * 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. diff --git a/lib.h b/lib.h index 97d8a96..e7db07c 100644 --- a/lib.h +++ b/lib.h @@ -439,7 +439,7 @@ extern void *treap_probe(struct treap */*t*/, * 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*/, diff --git a/old-runlisp.c b/old-runlisp.c deleted file mode 100644 index eea8c42..0000000 --- a/old-runlisp.c +++ /dev/null @@ -1,985 +0,0 @@ -/* -*-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 . - */ - -/*----- Header files ------------------------------------------------------*/ - -#include "config.h" - -#include -#include -#include -#include -#include -#include -#include - -#include -#include - -#include - -#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 -------------------------------------------------*/ diff --git a/query-runlisp-config.1 b/query-runlisp-config.1.in similarity index 73% rename from query-runlisp-config.1 rename to query-runlisp-config.1.in index 48bf0dd..7887127 100644 --- a/query-runlisp-config.1 +++ b/query-runlisp-config.1.in @@ -58,7 +58,7 @@ query-runlisp-config \- inspect and debug runlisp configuration files .IB var = \c .IR value ] .br - + \& .RB [ \-l .IR sect ] .RB [ \-p @@ -144,13 +144,58 @@ The value is unexpandable, and overrides any similarly named setting from the configuration file(s). . - - +.TP +.BI "\-p" "\fR, " "\-\-print-variable=\fR[" sect :\fR] var +Print the raw (unexpanded) result of looking up the variable +.I var +in configuration section +.I sect +(defaulting to +.BR @CONFIG ). . -.\"-------------------------------------------------------------------------- +.TP +.BR "\-q" ", " "\-\-quiet" +Don't print warning messages. +This option may be repeated: +each use reduces verbosity by one step, +counteracting one +.RB ` \-v ' +option. +The default verbosity level is 1, +which prints only warning measages. +. +.TP +.BR "\-v" ", " "\-\-verbose" +Print informational or debugging messages. +This option may be repeated: +each use increases verbosity by one step, +counteracting one +.RB ` \-q ' +option. +The default verbosity level is 1, +which prints only warning measages. +Higher verbosity levels print informational and debugging messages. . -.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), diff --git a/query-runlisp-config.c b/query-runlisp-config.c index bbfb150..ed8e6ce 100644 --- a/query-runlisp-config.c +++ b/query-runlisp-config.c @@ -94,7 +94,7 @@ static void find_var(const char *arg, { 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. */ diff --git a/runlisp-base.conf b/runlisp-base.conf index 692faa7..00bfa91 100644 --- a/runlisp-base.conf +++ b/runlisp-base.conf @@ -111,8 +111,12 @@ dump-image-prelude = ${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] diff --git a/runlisp.1 b/runlisp.1.in similarity index 65% rename from runlisp.1 rename to runlisp.1.in index 51d470a..00b06fb 100644 --- a/runlisp.1 +++ b/runlisp.1.in @@ -49,15 +49,14 @@ runlisp \- run Common Lisp programs as scripts .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 @@ -65,9 +64,25 @@ runlisp \- run Common Lisp programs as scripts .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 @@ -84,114 +99,37 @@ It can be used in build scripts 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 @@ -205,29 +143,33 @@ There's not usually any good reason to prefer the vanilla image, except for performance comparisons, or debugging .B runlisp itself. +Negate with +.B +D +or +.BR \-\-no-vanilla-image . . .TP -.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. @@ -236,31 +178,23 @@ a warning is issued (at verbosity level 1 or higher), 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. @@ -271,7 +205,7 @@ to execute in mode. . .TP -.BI "\-l " file +.BI "\-l" "\fR, " "\-\-load-file=" file Read and evaluate forms from the .IR file . This option causes @@ -281,15 +215,19 @@ to execute in 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) @@ -308,7 +246,7 @@ to execute in mode. . .TP -.B "\-q" +.BR "\-q" ", " "\-\-quiet" Don't print warning messages. This option may be repeated: each use reduces verbosity by one step, @@ -319,7 +257,7 @@ The default verbosity level is 1, 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, @@ -339,11 +277,7 @@ and 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 @@ -354,14 +288,15 @@ instead, use 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 @@ -389,7 +324,7 @@ and runs in .I script mode. -.PP +.hP 2. In .I script mode, @@ -401,6 +336,8 @@ If so, then the following text is parsed for .IR "embedded options" , as follows. +.RS +.PP The text is split into words separated by sequences of whitespace characters. Whitespace, @@ -436,18 +373,41 @@ before processing quoting and escaping, then everything up to and including the next occurrence of .RB ` \-*\- ' is ignored. +.PP The resulting list of words is processed as if it held further command-line options. -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 @@ -459,78 +419,32 @@ since many operating systems pass the text following the interpreter name on a .RB ` #! ' line as a single argument, without further splitting it at spaces.) -.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 ' @@ -549,40 +463,39 @@ If no 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 @@ -591,11 +504,41 @@ in the preferred implementations list; 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; @@ -616,29 +559,15 @@ just simulates the behaviour of 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 diff --git a/runlisp.c b/runlisp.c index 9ef809c..b2708d7 100644 --- a/runlisp.c +++ b/runlisp.c @@ -234,6 +234,17 @@ Evaluation mode:\n\ fp); } +/* Complain about options which aren't permitted as embedded options. */ +static void check_command_line(int ch) +{ + if ((flags&AF_STATEMASK) != AF_CMDLINE) { + moan("`%c%c' is not permitted as embedded option", + ch&OPTF_NEGATED ? '+' : '-', + ch&~OPTF_NEGATED); + flags |= AF_BOGUS; + } +} + /* Parse the options in the argument vector. */ static void parse_options(int argc, char *argv[]) { @@ -256,31 +267,39 @@ 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; } } @@ -565,6 +584,9 @@ int main(int argc, char *argv[]) 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"); diff --git a/runlisp.conf.5 b/runlisp.conf.5.in similarity index 65% rename from runlisp.conf.5 rename to runlisp.conf.5.in index e7773de..64cbe38 100644 --- a/runlisp.conf.5 +++ b/runlisp.conf.5.in @@ -49,6 +49,71 @@ runlisp.conf \- configuration files for runlisp .\"-------------------------------------------------------------------------- .SH DESCRIPTION . +.SS "Default configuration files" +By default, the +.B runlisp +programs read configuration from the following files. +(Note that if a +.RB ` \-c ' +command-line option is given, then +these default files are +.I not +read.) +.TP +.B @etcdir@/runlisp.d/*.conf +If a directory named +.B @etcdir@/runlisp.d +exists, +then all of the files within +whose names end in +.RB ` .conf ' +are read, +in ascending lexicographical order by name. +This directory name can be overridden by setting the +.B RUNLISP_SYSCONFIG_DIR +environment variable. +.TP +.B @etcdir@/runlisp.conf +The file named +.B @etcdir@/runlisp.conf +is read; the file must exist. +This filename can be overridden by setting the +.B RUNLISP_SYSCONFIG +environment variable. +.TP +.B ~/.runlisp.conf +If there is a file named +.B .runlisp.conf +in the user's home directory, +then it is read. +The home directory is determined to be +the value of the +.B HOME +environment variable, or, if that is not set, +the home directory associated with the process's real uid +in the system password database. +This filename can be overridden by setting the +.B RUNLISP_USERCONFIG +environment variable. +.TP +.B ~/.config/runlisp.conf +If there is a file named +.B runlisp.conf +in the user's XDG configuration directory, +then it is read. +The XDG configuration directory is determined to be the value of the +.B XDG_CONFIG_HOME +environment variable, or the +.B .config +directory in the user's home directory +(as determined above). +This filename can be overridden by setting the +.B RUNLISP_USERCONFIG +environment variable. +(Note, therefore, that this variable overrides +.I both +of the user configuration files.) +. .SS "General syntax" In summary, a configuration file is structured as a collection of assignments @@ -208,8 +273,7 @@ A section may have zero or more sections. .PP The -.BR @BUILTIN , -.BR @CONFIG , +.B @BUILTIN and .B @ENV sections have no parents. @@ -433,6 +497,15 @@ For example, .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 @@ -441,6 +514,7 @@ You should not override its settings in configuration files. it holds a number of variables set by the .B runlisp programs. +. .TP .B @data-dir The directory in which @@ -455,6 +529,7 @@ variable in the .B @CONFIG section, or a value determined at compile time. +. .TP .B @ecl-opt The preferred option prefix for ECL, either @@ -472,6 +547,7 @@ variable in the .B @CONFIG section, or a value determined at compile time. +. .TP .B @image-dir The directory in which @@ -488,6 +564,7 @@ variable in the .B @CONFIG section, or a value determined at compile time. +. .TP .B @image-new Set by @@ -498,6 +575,7 @@ command should create. .RB ( dump-runlisp-image will rename the image into place itself, if the command completes successfully.) +. .TP .B @image-out Set by @@ -508,11 +586,13 @@ to the filename of the intended output image. commands: use .B @image-new instread.) +. .TP .B @script Set by .BR runlisp (1) to the name of the script being invoked. +. .TP .B @tmp-dir Set by @@ -521,19 +601,249 @@ to be the name of a directory in which a .B dump-image command can put temporary files. . -.SS "Other special variables" -In every section, the section's name -is automatically assigned to the variable -.BR @name . -This variable -.I can -be overridden by an explicit assignment, +.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), diff --git a/sha256.c b/sha256.c new file mode 100644 index 0000000..56a5bc4 --- /dev/null +++ b/sha256.c @@ -0,0 +1,223 @@ +/* -*-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 . + */ + +/*----- Header files ------------------------------------------------------*/ + +#include + +#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 -------------------------------------------------*/ diff --git a/sha256.h b/sha256.h new file mode 100644 index 0000000..6b04d20 --- /dev/null +++ b/sha256.h @@ -0,0 +1,74 @@ +/* -*-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 . + */ + +#ifndef SHA256_H +#define SHA256_H + +#ifdef __cplusplus + extern "C" { +#endif + +/*----- Header files ------------------------------------------------------*/ + +#include + +/*----- 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 diff --git a/vars.am b/vars.am index 151a75d..f970aff 100644 --- a/vars.am +++ b/vars.am @@ -37,6 +37,8 @@ man_MANS = doc_DATA = pkgdata_DATA = +pkgdata_SCRIPTS = + pkgconfdir = $(sysconfdir)/$(PACKAGE_NAME) pkgconf_DATA = @@ -54,7 +56,7 @@ SUBSTITUTIONS = \ 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) @@ -68,12 +70,15 @@ SUBST = $(v_subst)$(confsubst) 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. -- 2.11.0