lib.c (config_set_var_n): Return a pointer even if we don't change the var.
[runlisp] / dump-runlisp-image.c
index 8e2d86f..7bd9eba 100644 (file)
 #include "common.h"
 #include "lib.h"
 #include "mdwopt.h"
+#include "sha256.h"
 
 /*----- Static data -------------------------------------------------------*/
 
-#define MAXLINE 16384u
+/* The state required to break an output stream from a subprocess into lines
+ * so we can prefix them appropriately.  Once our process starts, the `buf'
+ * points to a buffer of `MAXLINE' bytes.  This is arranged as a circular
+ * buffer, containing `len' bytes starting at offset `off', and wrapping
+ * around to the start of the buffer if it runs off the end.
+ *
+ * The descriptor `fd' is reset to -1 after it's seen end-of-file.
+ */
 struct linebuf {
-  int fd;
-  char *buf;
-  unsigned off, len;
+  int fd;                              /* our file descriptor (or -1) */
+  char *buf;                           /* line buffer, or null */
+  unsigned off, len;                   /* offset */
 };
+#define MAXLINE 16384u                 /* maximum acceptable line length */
 
+/* Job-state constants. */
 enum {
-  JST_READY,
-  JST_RUN,
-  JST_DEAD,
+  JST_INTERN,                          /* not that kind of job */
+  JST_VERSION,                         /* hashing the Lisp version number */
+  JST_DUMP,                            /* dumping the custom image */
   JST_NSTATE
 };
 
+/* The state associated with an image-dumping job. */
 struct job {
-  struct treap_node _node;
-  struct job *next;
-  struct argv av;
-  unsigned st;
-  FILE *log;
-  pid_t kid;
-  int exit;
-  struct linebuf out, err;
+  struct treap_node _node;             /* treap intrusion */
+  struct job *next;                    /* next job in whichever list */
+  unsigned st;                         /* job state (`JST_...') */
+  struct config_section *sect;         /* the system-definition section */
+  struct config_var *dumpvar;          /* the `dump-image' variable */
+  struct argv av_version, av_dump;     /* argument vectors to execute */
+  char *imgnew, *imghash, *imgnewlink, *imglink; /* link and final outputs */
+  char *oldimg;                                /* old image name */
+  FILE *log;                           /* log output file (`stdout'?) */
+  pid_t kid;                           /* process id of child (or -1) */
+  int exit;                            /* exit status from child */
+  struct sha256_state h;               /* hash context for version */
+  struct linebuf out, err;             /* line buffers for stdout, stderr */
 };
 #define JOB_NAME(job) TREAP_NODE_KEY(job)
 #define JOB_NAMELEN(job) TREAP_NODE_KEYLEN(job)
 
-static struct treap jobs = TREAP_INIT;
-static struct job *job_ready, *job_run, *job_dead;
-static unsigned nrun, maxrun = 1;
-static int rc = 0;
-static int nullfd;
-
-static int sig_pipe[2] = { -1, -1 };
-static sigset_t caught, pending;
-static int sigloss = -1;
-
-static unsigned flags = 0;
-#define AF_BOGUS 0x0001u
-#define AF_SETCONF 0x0002u
-#define AF_DRYRUN 0x0004u
-#define AF_ALL 0x0008u
-#define AF_FORCE 0x0010u
-#define AF_CHECKINST 0x0020u
-
-/*----- Main code ---------------------------------------------------------*/
-
+static struct treap jobs = TREAP_INIT, /* Lisp systems seen so far */
+  good = TREAP_INIT;                   /* files ok to be in image dir */
+static struct job                      /* lists of jobs */
+  *job_ready, **job_ready_tail = &job_ready, /* queue of jobs to start */
+  *job_delete, **job_delete_tail = &job_delete, /* queue of delete jobs */
+  *job_run;                            /* list of active jobs */
+static unsigned nrun, maxrun = 1;      /* running and maximum job counts */
+static int rc = 0;                     /* code that we should return */
+static int nullfd;                     /* file descriptor for `/dev/null' */
+static const char *tmpdir;             /* temporary directory path */
+
+static int sig_pipe[2] = { -1, -1 };   /* pipe for reporting signals */
+static sigset_t caught, pending;       /* signals we catch; have caught */
+static int sigloss = -1;               /* signal that caused us to lose */
+
+static unsigned flags = 0;             /* flags for the application */
+#define AF_BOGUS 0x0001u               /*   invalid comand-line syntax */
+#define AF_SETCONF 0x0002u             /*   explicit configuration */
+#define AF_DRYRUN 0x0004u              /*   don't actually do it */
+#define AF_ALL 0x0008u                 /*   dump all known Lisps */
+#define AF_FORCE 0x0010u               /*   dump even if images exist */
+#define AF_CHECKINST 0x0020u           /*   check Lisp exists before dump */
+#define AF_REMOVE 0x0040u              /*   remove selected Lisp images */
+#define AF_CLEAN 0x0080u               /*   remove other Lisp images */
+#define AF_JUNK 0x0100u                        /*   remove unrecognized files */
+
+/*----- Miscellany --------------------------------------------------------*/
+
+/* Report a (printf(3)-style) message MSG, and remember to fail later. */
 static PRINTF_LIKE(1, 2) void bad(const char *msg, ...)
-  { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 2; }
-
-static const char *tmpdir;
+  { va_list ap; va_start(ap, msg); vmoan(msg, ap); va_end(ap); rc = 127; }
 
-static void set_tmpdir(void)
+/* Answer whether a string consists entirely of hex digits. */
+static int hex_digits_p(const char *p, size_t sz)
 {
-  struct dstr d = DSTR_INIT;
-  size_t n;
-  unsigned i;
+  const char *l;
 
-  dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
-  i = 0; n = d.len;
-  for (;;) {
-    d.len = n; dstr_putf(&d, "%d", rand());
-    if (!mkdir(d.p, 0700)) break;
-    else if (errno != EEXIST)
-      lose("failed to create temporary directory `%s': %s",
-          d.p, strerror(errno));
-    else if (++i >= 32) {
-      dstr_puts(&d, "???");
-      lose("failed to create temporary directory `%s': too many attempts",
-          d.p);
-    }
-  }
-  tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
+  for (l = p + sz; p < l; p++) if (!ISXDIGIT(*p)) return (0);
+  return (1);
 }
 
+/*----- File utilities ----------------------------------------------------*/
+
+/* Main recursive subroutine for `recursive_delete'.
+ *
+ * The string DD currently contains the pathname of a directory, without a
+ * trailing `/' (though there is /space/ for a terminating zero or whatever).
+ * Recursively delete all of the files and directories within it.  Appending
+ * further text to DD is OK, but clobbering the characters which are there
+ * already isn't allowed.
+ */
 static void recursive_delete_(struct dstr *dd)
 {
-  size_t n = dd->len;
   DIR *dir;
   struct dirent *d;
+  size_t n = dd->len;
 
-  dd->p[n] = 0;
-  dir = opendir(dd->p);
+  /* Open the directory. */
+  dd->p[n] = 0; dir = opendir(dd->p);
   if (!dir)
     lose("failed to open directory `%s' for cleanup: %s",
         dd->p, strerror(errno));
 
+  /* We'll need to build pathnames for the files inside the directory, so add
+   * the separating `/' character.  Remember the length of this prefix
+   * because this is the point we'll be rewinding to for each filename we
+   * find.
+   */
   dd->p[n++] = '/';
+
+  /* Now go through each file in turn. */
   for (;;) {
+
+    /* Get a filename.  If we've run out then we're done.  Skip the special
+     * `.' and `..' entries.
+     */
     d = readdir(dir); if (!d) break;
     if (d->d_name[0] == '.' && (!d->d_name[1] ||
                                (d->d_name[1] == '.' && !d->d_name[2])))
       continue;
+
+    /* Rewind the string offset and append the new filename. */
     dd->len = n; dstr_puts(dd, d->d_name);
+
+    /* Try to delete it the usual way.  If it was actually a directory then
+     * recursively delete it instead.  (We could lstat(2) it first, but this
+     * should be at least as quick to identify a directory, and it'll save a
+     * lstat(2) call in the (common) case that it's not a directory.
+     */
     if (!unlink(dd->p));
     else if (errno == EISDIR) recursive_delete_(dd);
     else lose("failed to delete file `%s': %s", dd->p, strerror(errno));
   }
+
+  /* We're done.  Try to delete the directory.  (It's possible that there was
+   * some problem with enumerating the directory, but we'll ignore that: if
+   * it matters then the directory won't be empty and the rmdir(2) will
+   * fail.)
+   */
   closedir(dir);
   dd->p[--n] = 0;
   if (rmdir(dd->p))
     lose("failed to delete directory `%s': %s", dd->p, strerror(errno));
 }
 
+/* Recursively delete the thing named PATH. */
 static void recursive_delete(const char *path)
 {
   struct dstr d = DSTR_INIT;
   dstr_puts(&d, path); recursive_delete_(&d); dstr_release(&d);
 }
 
-static void cleanup(void)
-  { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
-
+/* Configure a file descriptor FD.
+ *
+ * Set its nonblocking state to NONBLOCK and close-on-exec state to CLOEXEC.
+ * In both cases, -1 means to leave it alone, zero means to turn it off, and
+ * any other nonzero value means to turn it on.
+ */
 static int configure_fd(const char *what, int fd, int nonblock, int cloexec)
 {
   int fl, nfl;
@@ -190,103 +238,658 @@ fail:
   return (-1);
 }
 
+/* Create a temporary directory and remember where we put it. */
+static void set_tmpdir(void)
+{
+  struct dstr d = DSTR_INIT;
+  size_t n;
+  unsigned i;
+
+  /* Start building the path name.  Remember the length: we'll rewind to
+   * here and try again if our first attempt doesn't work.
+   */
+  dstr_putf(&d, "%s/runlisp.%d.", my_getenv("TMPDIR", "/tmp"), getpid());
+  i = 0; n = d.len;
+
+  /* Keep trying until it works. */
+  for (;;) {
+
+    /* Build a complete name. */
+    d.len = n; dstr_putf(&d, "%d", rand());
+
+    /* Try to create the directory.  If it worked, we're done.  If it failed
+     * with `EEXIST' then we'll try again for a while, but give up it it
+     * doesn't look like we're making any progress.  If it failed for some
+     * other reason then there's probably not much hope so give up.
+     */
+    if (!mkdir(d.p, 0700)) break;
+    else if (errno != EEXIST)
+      lose("failed to create temporary directory `%s': %s",
+          d.p, strerror(errno));
+    else if (++i >= 32) {
+      d.len = n; dstr_puts(&d, "???");
+      lose("failed to create temporary directory `%s': too many attempts",
+          d.p);
+    }
+  }
+
+  /* Remember the directory name. */
+  tmpdir = xstrndup(d.p, d.len); dstr_release(&d);
+}
+
+/*----- Signal handling ---------------------------------------------------*/
+
+/* Forward reference into job management. */
+static void reap_children(void);
+
+/* Clean things up on exit.
+ *
+ * Currently this just means to delete the temporary directory if we've made
+ * one.
+ */
+static void cleanup(void)
+  { if (tmpdir) { recursive_delete(tmpdir); tmpdir = 0; } }
+
+/* Check to see whether any signals have arrived, and do the sensible thing
+ * with them.
+ */
+static void check_signals(void)
+{
+  sigset_t old, pend;
+  char buf[32];
+  ssize_t n;
+
+  /* Ensure exclusive access to the signal-handling machinery, drain the
+   * signal pipe, and take a copy of the set of caught signals.
+   */
+  sigprocmask(SIG_BLOCK, &caught, &old);
+  pend = pending; sigemptyset(&pending);
+  for (;;) {
+    n = read(sig_pipe[0], buf, sizeof(buf));
+    if (!n) lose("(internal) signal pipe closed!");
+    if (n < 0) break;
+  }
+  if (errno != EAGAIN && errno != EWOULDBLOCK)
+    lose("failed to read signal pipe: %s", strerror(errno));
+  sigprocmask(SIG_SETMASK, &old, 0);
+
+  /* Check for each signal of interest to us.
+   *
+   * Interrupty signals just set `sigloss' -- the `run_jobs' loop will know
+   * to unravel everything if this happens.  If `SIGCHLD' happened, then
+   * check on job process status.
+   */
+  if (sigismember(&pend, SIGINT)) sigloss = SIGINT;
+  else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP;
+  else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM;
+  if (sigismember(&pend, SIGCHLD)) reap_children();
+}
+
+/* The actual signal handler.
+ *
+ * Set the appropriate signal bit in `pending', and a byte (of any value)
+ * down the signal pipe to wake up the select(2) loop.
+ */
 static void handle_signal(int sig)
 {
   sigset_t old;
   char x = '!';
 
+  /* Ensure exclusive access while we fiddle with the `caught' set. */
   sigprocmask(SIG_BLOCK, &caught, &old);
   sigaddset(&pending, sig);
   sigprocmask(SIG_SETMASK, &old, 0);
 
+  /* Wake up the select(2) loop.  If this fails, there's not a lot we can do
+   * about it.
+   */
   DISCARD(write(sig_pipe[1], &x, 1));
 }
 
-#define JF_QUIET 1u
-static void add_job(struct job ***tail_inout, unsigned f,
-                   const char *name, size_t len)
+/* Install our signal handler to catch SIG.
+ *
+ * If `SIGF_IGNOK' is set in F then don't trap the signal if it's currently
+ * ignored.  (This is used for signals like `SIGINT', which usually should
+ * interrupt us; but if the caller wants us to ignore them, we should do as
+ * it wants.)
+ *
+ * WHAT describes the signal, for use in diagnostic messages.
+ */
+#define SIGF_IGNOK 1u
+static void set_signal_handler(const char *what, int sig, unsigned f)
 {
-  struct job *job;
+  struct sigaction sa, sa_old;
+
+  sigaddset(&caught, sig);
+
+  if (f&SIGF_IGNOK) {
+    if (sigaction(sig, 0, &sa_old)) goto fail;
+    if (sa_old.sa_handler == SIG_IGN) return;
+  }
+
+  sa.sa_handler = handle_signal;
+  sigemptyset(&sa.sa_mask);
+  sa.sa_flags = SA_NOCLDSTOP;
+  if (sigaction(sig, &sa, 0)) goto fail;
+
+  return;
+
+fail:
+  lose("failed to set %s signal handler: %s", what, strerror(errno));
+}
+
+/*----- Line buffering ----------------------------------------------------*/
+
+/* Find the next newline in the line buffer BUF.
+ *
+ * The search starts at `BUF->off', and potentially covers the entire buffer
+ * contents.  Set *LINESZ_OUT to the length of the line, in bytes.  (Callers
+ * must beware that the text of the line may wrap around the ends of the
+ * buffer.)  Return zero if we found a newline, or nonzero if the search
+ * failed.
+ */
+static int find_newline(struct linebuf *buf, size_t *linesz_out)
+{
+  char *nl;
+
+  if (buf->off + buf->len <= MAXLINE) {
+    /* The buffer contents is in one piece.  Just search it. */
+
+    nl = memchr(buf->buf + buf->off, '\n', buf->len);
+    if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+
+  } else {
+    /* The buffer contents is in two pieces.  We must search both of them. */
+
+    nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off);
+    if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
+    nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off));
+    if (nl)
+      { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); }
+  }
+
+  return (-1);
+}
+
+/* Write a completed line out to the JOB's log file.
+ *
+ * The line starts at BUF->off, and continues for N bytes, not including the
+ * newline (which, in fact, might not exist at all).  Precede the actual text
+ * of the line with the JOB's name, and the MARKER character, and follow it
+ * with the TAIL text (which should include an actual newline character).
+ */
+static void write_line(struct job *job, struct linebuf *buf,
+                      size_t n, char marker, const char *tail)
+{
+  fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker);
+  if (buf->off + n <= MAXLINE)
+    fwrite(buf->buf + buf->off, 1, n, job->log);
+  else {
+    fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log);
+    fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log);
+  }
+  fputs(tail, job->log);
+}
+
+/* Hash N bytes freshly added to the buffer BUF. */
+static void hash_input(struct linebuf *buf, size_t n, struct sha256_state *h)
+{
+  size_t start = (buf->off + buf->len)%MAXLINE;
+
+  if (start + n <= MAXLINE)
+    sha256_hash(h, buf->buf + start, n);
+  else {
+    sha256_hash(h, buf->buf + start, MAXLINE - start);
+    sha256_hash(h, buf->buf, n - (MAXLINE - start));
+  }
+}
+
+/* Collect output lines from JOB's process and write them to the log.
+ *
+ * Read data from BUF's file descriptor.  Output complete (or overlong) lines
+ * usng `write_line'.  On end-of-file, output any final incomplete line in
+ * the same way, close the descriptor, and set it to -1.
+ *
+ * As a rather unpleasant quirk, if the hash-state pointer H is not null,
+ * then also feed all the data received into it.
+ */
+static void prefix_lines(struct job *job, struct linebuf *buf, char marker,
+                        struct sha256_state *h)
+{
+  struct iovec iov[2]; int niov;
+  ssize_t n;
+  size_t linesz;
+
+  /* Read data into the buffer.  This fancy dance with readv(2) is probably
+   * overkill.
+   *
+   * We can't have BUF->len = MAXLINE because we'd have flushed out a
+   * maximum-length buffer as an incomplete line last time.
+   */
+  assert(buf->len < MAXLINE);
+  if (!buf->off) {
+    iov[0].iov_base = buf->buf + buf->len;
+    iov[0].iov_len = MAXLINE - buf->len;
+    niov = 1;
+  } else if (buf->off + buf->len >= MAXLINE) {
+    iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE;
+    iov[0].iov_len = MAXLINE - buf->len;
+    niov = 1;
+  } else {
+    iov[0].iov_base = buf->buf + buf->off + buf->len;
+    iov[0].iov_len = MAXLINE - (buf->off + buf->len);
+    iov[1].iov_base = buf->buf;
+    iov[1].iov_len = buf->off;
+    niov = 1;
+  }
+  n = readv(buf->fd, iov, niov);
+
+  if (n < 0) {
+    /* An error occurred.  If there's no data to read after all then just
+     * move on.  Otherwise we have a problem.
+     */
+
+    if (errno == EAGAIN || errno == EWOULDBLOCK) return;
+    lose("failed to read job `%s' output stream: %s",
+        JOB_NAME(job), strerror(errno));
+  } else if (!n) {
+    /* We've hit end-of-file.  Close the stream, and write out any
+     * unterminated partial line.
+     */
+
+    close(buf->fd); buf->fd = -1;
+    if (buf->len)
+      write_line(job, buf, buf->len, marker, " [missing final newline]\n");
+  } else {
+    /* We read some fresh data.  Output any new complete lines. */
+
+    /* If we're supposed to hash data as it comes in then we should do that
+     * now.
+     */
+    if (h) hash_input(buf, n, h);
+
+    /* Include the new material in the buffer length, and write out any
+     * complete lines we find.
+     */
+    buf->len += n;
+    while (!find_newline(buf, &linesz)) {
+      write_line(job, buf, linesz, marker, "\n");
+      buf->len -= linesz + 1;
+      buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE;
+    }
+
+    if (!buf->len)
+      /* If there's nothing left then we might as well reset the buffer
+       * offset to the start of the buffer.
+       */
+      buf->off = 0;
+    else if (buf->len == MAXLINE) {
+      /* We've filled the buffer with stuff that's not a whole line.  Flush
+       * it out anyway.
+       */
+      write_line(job, buf, MAXLINE, marker, " [...]\n");
+      buf->off = buf->len = 0;
+    }
+  }
+}
+
+/*----- Job management ----------------------------------------------------*/
+
+/* Record the SZ-byte leafname at P as being legitimate, so that it doesn't
+ * get junked.
+ */
+static void notice_filename(const char *p, size_t sz)
+{
+  struct treap_node *node;
   struct treap_path path;
-  struct config_section *sect;
-  struct config_var *dump_var, *cmd_var;
-  struct dstr d = DSTR_INIT;
-  struct argv av = ARGV_INIT;
+
+  node = treap_probe(&good, p, sz, &path);
+  if (!node) {
+    node = xmalloc(sizeof(*node));
+    treap_insert(&good, &path, node, p, sz);
+  }
+}
+
+/* There are basically two kinds of jobs.
+ *
+ * An `internal' job -- state `JST_INTERN' -- can be handled entirely within
+ * this process.  Internal jobs have trivial lifecycles: they're created, put
+ * on a queue, executed, and thrown away.  Jobs are executed when some code
+ * decides to walk the appropriate queue and do the work.  As a result, they
+ * don't need to have distinctive states: `JST_INTERN' only exists to
+ * distinguish internal jobs from active ones if they somehow manage to end
+ * up in the external-job machinery.
+ *
+ * External jobs all work in basically the same way: we fork and exec a
+ * sequence of subprocess to do the work.  The majority of handling external
+ * jobs is in the care and feeding of these subprocesses, so they end up on
+ * various lists primarily concerned with the state of the subprocesses, and
+ * the progress of the job through its sequence of subprocesses is recorded
+ * in the job's `st' field.
+ *
+ * External jobs have a comparatively complicated lifecycle.
+ *
+ *   * Initially, the job is on the `ready' queue by `add_job'.  It has no
+ *     child process or log file.
+ *
+ *   * At some point, `start_jobs' decides to start this job up: a log file
+ *     is created (if the job doesn't have one already), a child process is
+ *     forked, and pipes are set up to capture the child's output.  It gets
+ *     moved to the `run' list (which is not maintained in any particular
+ *     order).  Jobs on the `run' list participate in the main select(2)
+ *     loop.
+ *
+ *   * When the job's child process dies and the pipes capturing its output
+ *     streams finally dry up, the job is considered finished.  What happens
+ *     next depends on its state: either it gets updated somehow, and pushed
+ *     back onto the end of the `ready' queue so that another child can be
+ *     started, or the job is finished and dies.
+ *
+ * The counter `nrun' counts the number of actually running jobs, i.e., those
+ * with living child processes.  This doesn't simply count the number of jobs
+ * on the `run' list: remember that the latter also contains jobs whose child
+ * has died, but whose output has not yet been collected.
+ */
+
+/* Consider a Lisp system description and maybe add a job to the right queue.
+ *
+ * The Lisp system is described by the configuration section SECT.  Most of
+ * the function is spent on inspecting this section for suitability and
+ * deciding what to do about it.
+ *
+ * The precise behaviour depends on F, which should be the bitwise-OR of a
+ * `JQ_...' constant and zero or more flags, as follows.
+ *
+ *   * The bits covered by `JMASK_QUEUE' identify which queue the job should
+ *     be added to if the section defines a cromulent Lisp system:
+ *
+ *       -- `JQ_NONE' -- don't actually make a job at all;
+ *       -- `JQ_READY' -- add the Lisp to the `job_ready' queue, so we'll; or
+ *       -- `JQ_DELETE' -- add the Lisp to the `job_delete' queue.
+ *
+ *   * `JF_PICKY': The user identified this Lisp system explicitly, so
+ *     complain if the configuration section doesn't look right.  This is
+ *     clear if the caller is just enumerating all of the configuration
+ *     sections: without this feature, we'd be checking everything twice,
+ *     which (a) is inefficient, and -- more importantly -- (b) could lead to
+ *     problems if the two checks are inconsistent.
+ *
+ *   * `JF_CHECKINST': Ignore this Lisp if `AF_CHECKINST' is set and it's not
+ *     actually installed.  (This is usually set for `JQ_READY' calls, so
+ *     that we don't try to dump Lisps which aren't there, but clear for
+ *     `JQ_DELETE' calls so that we clear out Lisps which have gone away.)
+ *
+ *   * `JF_CHECKEXIST': Ignore this Lisp if its image file already exists.
+ *
+ *   * `JF_NOTICE': Record the Lisp's image basename in the `good' treap so
+ *     that we can identify everything else we find in the image directory as
+ *     junk.
+ */
+#define JMASK_QUEUE 3u                 /* which queue to add good Lisp to */
+#define JQ_NONE 0u                     /*   don't add to any queue */
+#define JQ_READY 1u                    /*   `job_ready' */
+#define JQ_DELETE 2u                   /*   `job_delete' */
+#define JF_PICKY 4u                    /* lose if section isn't Lisp defn */
+#define JF_CHECKINST 8u                        /* maybe check Lisp is installed */
+#define JF_CHECKEXIST 16u              /* skip if image already exists */
+#define JF_NOTICE 32u                  /* record Lisp's image basename */
+
+#define JADD_NAMED (JQ_READY | JF_PICKY | JF_CHECKINST)
+#define JADD_DEFAULT (JQ_READY | JF_CHECKINST)
+#define JADD_CLEANUP (JQ_DELETE)
+#define JADD_NOTICE (JQ_NONE)
+static void add_job(unsigned f, struct config_section *sect)
+{
+  const char *name;
+  struct job *job, ***tail;
+  struct treap_path jobpath;
+  struct config_var *dumpvar, *runvar, *imgvar;
+  struct dstr d = DSTR_INIT, dd = DSTR_INIT;
+  struct argv av_version = ARGV_INIT, av_dump = ARGV_INIT;
+  struct stat st;
+  char *imgnewlink = 0, *imglink = 0, *oldimg = 0, *p;
+  unsigned jst;
+  size_t i, len;
+  ssize_t n;
   unsigned fef;
 
-  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;
   }
 
-  sect = config_find_section_n(&config, 0, name, len);
-  if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
-  name = CONFIG_SECTION_NAME(sect);
-  dump_var = config_find_var(&config, sect, 0, "dump-image");
-  if (!dump_var) {
-    if (!(f&JF_QUIET))
-      lose("don't know how to dump images for Lisp implementation `%s'",
-          name);
+  /* Check that the section defines a Lisp, and that it can be dumped.
+   *
+   * It's not obvious that this is right.  Maybe there should be some
+   * additional flag so that we don't check dumpability if we're planning to
+   * delete the image.  But it /is/ right: since the thing which tells us
+   * whether we can dump is that the section tells us the image's name, if
+   * it can't be dumped then we won't know what file to delete!  So we have
+   * no choice.
+   */
+  runvar = config_find_var(&config, sect, CF_INHERIT, "run-script");
+  if (!runvar) {
+    if (f&JF_PICKY) lose("unknown Lisp implementation `%s'", name);
+    else if (verbose >= 3) moan("skipping non-Lisp section `%s'", name);
+    goto end;
+  }
+  imgvar = config_find_var(&config, sect, CF_INHERIT, "image-file");
+  if (!imgvar) {
+    if (f&JF_PICKY)
+      lose("Lisp implementation `%s' doesn't use custom images", name);
+    else if (verbose >= 3)
+      moan("skipping Lisp `%s': no custom image support", name);
     goto end;
   }
-  cmd_var = config_find_var(&config, sect, 0, "command");
-  if (!cmd_var)
-    lose("no `command' defined for Lisp implementation `%s'", name);
-
-  config_subst_split_var(&config, sect, dump_var, &av);
-  if (!av.n) lose("empty command for Lisp implementation `%s'", name);
 
-  if (flags&AF_CHECKINST) {
-    dstr_reset(&d);
-    fef = (verbose >= 2 ? FEF_VERBOSE : 0);
-    config_subst_var(&config, sect, cmd_var, &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);
+  /* Check that the other necessary variables are present. */
+  dumpvar = config_find_var(&config, sect, CF_INHERIT, "dump-image");
+  if (!dumpvar)
+    lose("variable `dump-image' not defined for Lisp `%s'", name);
+
+  /* Build the job's command lines. */
+  config_subst_split_var(&config, sect, runvar, &av_version);
+  if (!av_version.n)
+    lose("empty `run-script' command for Lisp implementation `%s'", name);
+  argv_append(&av_version, xstrdup("?(lisp-implementation-version)"));
+  config_subst_split_var(&config, sect, dumpvar, &av_dump);
+  if (!av_dump.n)
+    lose("empty `dump-image' command for Lisp implementation `%s'", name);
+
+  /* If we're supposed to check that the Lisp exists before proceeding then
+   * do that.  There are /two/ commands to check: the basic Lisp command,
+   * /and/ the command to actually do the dumping, which might not be the
+   * same thing.  (Be careful not to check the same command twice, though,
+   * because that would cause us to spam the user with redundant
+   * diagnostics.)
+   */
+  if ((f&JF_CHECKINST) && (flags&AF_CHECKINST)) {
+    fef = (verbose >= 3 ? FEF_VERBOSE : 0);
+    if (!found_in_path_p(av_version.v[0], fef)) {
+      if (verbose >= 3)
+       moan("skipping Lisp `%s': can't find Lisp command `%s'",
+            name, av_version.v[0]);
+      goto end;
+    }
+    if (STRCMP(av_version.v[0], !=, av_dump.v[0]) &&
+       !found_in_path_p(av_dump.v[0], fef)) {
+      if (verbose >= 3)
+       moan("skipping Lisp `%s': can't find dump command `%s'",
+            av_dump.v[0], d.p);
       goto end;
     }
   }
 
-  if (!(flags&AF_FORCE)) {
-    dstr_reset(&d);
-    config_subst_string(&config, sect, "<internal>", "${@IMAGE}", &d);
-    if (!access(d.p, F_OK)) {
-      if (verbose >= 2)
-       moan("image `%s' already exists: skipping `%s'", d.p, name);
-      goto end;
+  /* Collect the output image file names. */
+  imglink =
+    config_subst_string_alloc(&config, sect, "<internal>", "${@image-link}");
+  imgnewlink =
+    config_subst_string_alloc(&config, sect,
+                             "<internal>", "${@image-newlink}");
+
+  /* Determine the image link basename.  If necessary, record it so that it
+   * doesn't get junked.
+   */
+  dstr_reset(&dd); config_subst_var(&config, sect, imgvar, &dd);
+  if (f&JF_NOTICE) notice_filename(dd.p, dd.len);
+
+  /* Fill in the directory name for the output image. */
+  dstr_reset(&d);
+  p = strrchr(imglink, '/');
+  if (p) dstr_putm(&d, imglink, p + 1 - imglink);
+
+  /* Inspect the existing image link if there is one, and record its
+   * destination.
+   */
+  for (;;) {
+
+    /* Read the link destination.  The `lstat'/`readlink' two-step is
+     * suggested by the POSIX specification.
+     */
+    if (lstat(imglink, &st)) {
+      if (verbose >= (errno == ENOENT ? 3 : 1))
+       moan("failed to read metadata for Lisp `%s' image link `%s': %s",
+            name, imglink, strerror(errno));
+      break;
+    }
+    if (!S_ISLNK(st.st_mode)) {
+      if (verbose >= 1)
+       moan("Lisp `%s' image link `%s' isn't a symbolic link",
+            name, imglink);
+      break;
+    }
+    dstr_ensure(&d, st.st_size + 1);
+    n = readlink(imglink, d.p + d.len, d.sz - d.len);
+    if (n < 0) {
+       moan("failed to read Lisp `%s' image link `%s': %s",
+            name, imglink, strerror(errno));
+      break;
     }
+    if (n == d.sz - d.len) continue;
+
+    /* Check that the link has the right form.  (We don't want to delete the
+     * referent if it's not actually our image.)
+     *
+     * We expect the referent to look like ${image-file} followed by a hyphen
+     * and some hex digits.
+     */
+    if (n <= dd.len ||
+       STRNCMP(d.p + d.len, !=, dd.p, dd.len) ||
+       d.p[d.len + dd.len] != '-' ||
+       !hex_digits_p(d.p + (d.len + dd.len + 1), n - (dd.len + 1))) {
+      if (verbose >= 1)
+       moan("Lisp `%s' image link `%s' has unexpected referent `%s'",
+            name, imglink, d.p);
+      break;
+    }
+
+    /* OK, so it looks legit.  Protect it from being junked. */
+    if (f&JF_NOTICE) notice_filename(d.p + d.len, n);
+    d.p[d.len + n] = 0; d.len += n;
+    oldimg = xstrndup(d.p, d.len);
+    break;
   }
 
+  /* All preflight checks complete.  Build the job and hook it onto the end
+   * of the list.  (Steal the command-line vector so that we don't try to
+   * free it during cleanup.)
+   */
+  switch (f&JMASK_QUEUE) {
+    case JQ_NONE: jst = JST_INTERN; tail = 0; break;
+    case JQ_READY: jst = JST_VERSION; tail = &job_ready_tail; break;
+    case JQ_DELETE: jst = JST_INTERN; tail = &job_delete_tail; break;
+    default: assert(0);
+  }
   job = xmalloc(sizeof(*job));
-  job->st = JST_READY;
-  job->kid = -1;
+  job->st = jst; job->sect = sect; job->dumpvar = dumpvar;
+  job->kid = -1; job->log = 0;
   job->out.fd = -1; job->out.buf = 0;
   job->err.fd = -1; job->err.buf = 0;
-  job->av = av; argv_init(&av);
-  treap_insert(&jobs, &path, &job->_node, name, len);
-  **tail_inout = job; *tail_inout = &job->next;
+  job->av_version = av_version; argv_init(&av_version);
+  argv_init(&job->av_dump);
+  job->imgnew = 0; job->imghash = 0;
+  job->imgnewlink = imgnewlink; imgnewlink = 0;
+  job->imglink = imglink; imglink = 0;
+  job->oldimg = oldimg; oldimg = 0;
+  treap_insert(&jobs, &jobpath, &job->_node, name, len);
+  if (tail) { **tail = job; *tail = &job->next; }
+
 end:
-  dstr_release(&d); argv_release(&av);
+  /* All done.  Cleanup time. */
+  for (i = 0; i < av_version.n; i++) free(av_version.v[i]);
+  for (i = 0; i < av_dump.n; i++) free(av_dump.v[i]);
+  free(imgnewlink); free(imglink); free(oldimg);
+  dstr_release(&d); dstr_release(&dd);
+  argv_release(&av_version); argv_release(&av_dump);
 }
 
+/* As `add_job' above, but look the Lisp implementation up by name.
+ *
+ * The flags passed to `add_job' are augmented with `JF_PICKY' because this
+ * is an explicitly-named Lisp implementation.
+ */
+static void add_named_job(unsigned f, const char *name, size_t len)
+{
+  struct config_section *sect;
+
+  sect = config_find_section_n(&config, 0, name, len);
+  if (!sect) lose("unknown Lisp implementation `%.*s'", (int)len, name);
+  add_job(f | JF_PICKY, sect);
+}
+
+/* Free the JOB and all the resources it holds.
+ *
+ * Close the pipes; kill the child process.  Everything must go.
+ */
 static void release_job(struct job *job)
 {
+  size_t i;
+  struct job *j;
+
   if (job->kid > 0) kill(job->kid, SIGKILL); /* ?? */
   if (job->log && job->log != stdout) fclose(job->log);
+  free(job->imgnew); free(job->imghash);
+  free(job->imglink); free(job->imgnewlink);
+  free(job->oldimg);
+  for (i = 0; i < job->av_version.n; i++) free(job->av_version.v[i]);
+  for (i = 0; i < job->av_dump.n; i++) free(job->av_dump.v[i]);
+  argv_release(&job->av_version); argv_release(&job->av_dump);
   free(job->out.buf); if (job->out.fd >= 0) close(job->out.fd);
   free(job->err.buf); if (job->err.fd >= 0) close(job->err.fd);
+  j = treap_remove(&jobs, JOB_NAME(job), JOB_NAMELEN(job)); assert(j == job);
   free(job);
 }
 
+/* Do all the necessary things when JOB finishes (successfully or not).
+ *
+ * Eventually the job is either freed (using `release_job'), or updated and
+ * stuffed back into the `job_run' queue.  The caller is expected to have
+ * already unlinked the job from its current list.
+ */
 static void finish_job(struct job *job)
 {
-  char buf[16483];
-  size_t n;
+  char buf[16483], *p;
+  unsigned char *hbuf;
+  struct dstr d = DSTR_INIT;
+  size_t i, n;
   int ok = 0;
 
+  /* Start a final line to the job log describing its eventual fate.
+   *
+   * This is where we actually pick apart the exit status.  Set `ok' if it
+   * actually succeeded, because that's all anything else cares about.
+   */
   fprintf(job->log, "%-13s > ", JOB_NAME(job));
   if (WIFEXITED(job->exit)) {
     if (!WEXITSTATUS(job->exit))
@@ -311,196 +914,262 @@ static void finish_job(struct job *job)
     fprintf(job->log, "exited with incomprehensible status %06o\n",
            job->exit);
 
-  if (!ok && verbose < 2) {
-    rewind(job->log);
-    for (;;) {
-      n = fread(buf, 1, sizeof(buf), job->log);
-      if (n) fwrite(buf, 1, n, stdout);
-      if (n < sizeof(buf)) break;
-    }
-  }
+  /* What happens next depends on the state of the job.  This is the main
+   * place which advanced the job state machine.
+   */
+  if (ok) switch (job->st) {
 
-  release_job(job);
-}
+    case JST_VERSION:
+      /* We've retrieved the Lisp system's version string. */
 
-static int find_newline(struct linebuf *buf, size_t *linesz_out)
-{
-  char *nl;
+      /* Complete the hashing and convert to hex. */
+      hbuf = (unsigned char *)buf + 32; sha256_done(&job->h, hbuf);
+      for (i = 0; i < 8; i++) sprintf(buf + 2*i, "%02x", hbuf[i]);
+      if (verbose >= 2)
+       moan("Lisp `%s' version hash = %s", JOB_NAME(job), buf);
+
+      /* Determine the final version-qualified name for the image. */
+      config_set_var(&config, job->sect, CF_LITERAL, "@hash", buf);
+      job->imghash =
+       config_subst_string_alloc(&config, job->sect,
+                                 "<internal>", "${@image-out}");
+      job->imgnew =
+       config_subst_string_alloc(&config, job->sect,
+                                 "<internal>", "${@image-new}");
+
+      /* Determine the basename of the final image. */
+      p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+      /* Inspect the current link pointer to see if we have the right
+       * version.
+       */
+      if (!(flags&AF_FORCE) &&
+         job->oldimg &&
+         STRCMP(job->oldimg, ==, job->imghash) &&
+         !access(job->oldimg, F_OK)) {
+       if (verbose >= 2)
+         moan("Lisp `%s' image `%s' already up-to-date",
+              JOB_NAME(job), job->imghash);
+       break;
+      }
 
-  if (buf->off + buf->len <= MAXLINE) {
-    nl = memchr(buf->buf + buf->off, '\n', buf->len);
-    if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
-  } else {
-    nl = memchr(buf->buf + buf->off, '\n', MAXLINE - buf->off);
-    if (nl) { *linesz_out = (nl - buf->buf) - buf->off; return (0); }
-    nl = memchr(buf->buf, '\n', buf->len - (MAXLINE - buf->off));
-    if (nl)
-      { *linesz_out = (nl - buf->buf) + (MAXLINE - buf->off); return (0); }
-  }
-  return (-1);
-}
+      /* Make sure that there's a clear space for the new image to be
+       * written.
+       */
+      if (!(flags&AF_DRYRUN) && unlink(job->imgnew) && errno != ENOENT) {
+       bad("failed to clear Lisp `%s' image staging path `%s': %s",
+           JOB_NAME(job), job->imgnew, strerror(errno));
+       break;
+      }
 
-static void write_line(struct job *job, struct linebuf *buf,
-                      size_t n, char marker, const char *tail)
-{
-  fprintf(job->log, "%-13s %c ", JOB_NAME(job), marker);
-  if (buf->off + n <= MAXLINE)
-    fwrite(buf->buf + buf->off, 1, n, job->log);
-  else {
-    fwrite(buf->buf + buf->off, 1, MAXLINE - buf->off, job->log);
-    fwrite(buf->buf, 1, n - (MAXLINE - buf->off), job->log);
-  }
-  fputs(tail, job->log);
-}
+      /* If we're still here then we've decided to dump a new image.  Update
+       * the job state, and put it back on the run queue.
+       */
+      config_subst_split_var(&config, job->sect,
+                            job->dumpvar, &job->av_dump);
+      assert(job->av_dump.n);
+      job->st = JST_DUMP;
+      *job_ready_tail = job; job_ready_tail = &job->next; job->next = 0;
+      job = 0;
+      break;
+
+    case JST_DUMP:
+      /* We've finished dumping a custom image.  It's time to apply the
+       * finishing touches.
+       */
+
+      /* Rename the image into place.  If this fails, blame it on the dump
+       * job, because the chances are good that it failed to produce the
+       * image properly.
+       */
+      if (rename(job->imgnew, job->imghash)) {
+       fprintf(job->log, "%-13s > failed to rename Lisp `%s' "
+                         "output image `%s' to `%s': %s",
+               JOB_NAME(job), JOB_NAME(job),
+               job->imgnew, job->imghash, strerror(errno));
+       ok = 0; break;
+      }
+
+      /* Determine the basename of the final image. */
+      p = strrchr(job->imghash, '/'); if (p) p++; else p = job->imghash;
+
+      /* Build the symlink.  Start by setting the link in the staging path,
+       * and then rename, in order to ensure continuity.
+       */
+      if (unlink(job->imgnewlink) && errno != ENOENT) {
+       bad("failed to clear Lisp `%s' link staging path `%s': %s",
+           JOB_NAME(job), job->imgnewlink, strerror(errno));
+       break;
+      }
+      if (symlink(p, job->imgnewlink)) {
+       bad("failed to create Lisp `%s' image link `%s': %s",
+           JOB_NAME(job), job->imgnewlink, strerror(errno));
+       break;
+      }
+      if (rename(job->imgnewlink, job->imglink)) {
+       bad("failed to rename Lisp `%s' image link `%s' to `%s': %s",
+           JOB_NAME(job), job->imgnewlink, job->imglink, strerror(errno));
+       break;
+      }
+      if (job->oldimg && STRCMP(job->oldimg, !=, job->imghash) &&
+         unlink(job->oldimg) && errno != ENOENT) {
+       if (verbose >= 1)
+         moan("failed to delete old Lisp `%s' image `%s': %s",
+              JOB_NAME(job), job->oldimg, strerror(errno));
+      }
 
-static void prefix_lines(struct job *job, struct linebuf *buf, char marker)
-{
-  struct iovec iov[2]; int niov;
-  ssize_t n;
-  size_t linesz;
+      /* I think we're all done. */
+      break;
 
-  assert(buf->len < MAXLINE);
-  if (!buf->off) {
-    iov[0].iov_base = buf->buf + buf->len;
-    iov[0].iov_len = MAXLINE - buf->len;
-    niov = 1;
-  } else if (buf->off + buf->len >= MAXLINE) {
-    iov[0].iov_base = buf->buf + buf->off + buf->len - MAXLINE;
-    iov[0].iov_len = MAXLINE - buf->len;
-    niov = 1;
-  } else {
-    iov[0].iov_base = buf->buf + buf->off + buf->len;
-    iov[0].iov_len = MAXLINE - (buf->off + buf->len);
-    iov[1].iov_base = buf->buf;
-    iov[1].iov_len = buf->off;
-    niov = 1;
+    default:
+      assert(0);
   }
 
-  n = readv(buf->fd, iov, niov);
-  if (n < 0) {
-    if (errno == EAGAIN || errno == EWOULDBLOCK) return;
-    lose("failed to read job `%s' output stream: %s",
-        JOB_NAME(job), strerror(errno));
+  /* If the job failed and we're being quiet then write out the log that we
+   * made.
+   */
+  if (!ok && verbose < 2) {
+    rewind(job->log);
+    for (;;) {
+      n = fread(buf, 1, sizeof(buf), job->log);
+      if (n) fwrite(buf, 1, n, stdout);
+      if (n < sizeof(buf)) break;
+    }
   }
-  buf->len += n;
 
-  while (!find_newline(buf, &linesz)) {
-    write_line(job, buf, linesz, marker, "\n");
-    buf->len -= linesz + 1;
-    buf->off += linesz + 1; if (buf->off >= MAXLINE) buf->off -= MAXLINE;
-  }
-  if (!buf->len)
-    buf->off = 0;
-  else if (buf->len == MAXLINE) {
-    write_line(job, buf, MAXLINE, marker, " [...]\n");
-    buf->off = buf->len = 0;
-  }
+  /* Also make a node to stderr about what happened.  (Just to make sure
+   * that we've gotten someone's attention.)
+   */
+  if (!ok) bad("failed to dump Lisp `%s'", JOB_NAME(job));
 
-  if (!n) {
-    close(buf->fd); buf->fd = -1;
-    if (buf->len)
-      write_line(job, buf, buf->len, marker, " [missing final newline]\n");
-  }
+  /* Finally free the job control block. */
+  if (job) release_job(job);
+  dstr_release(&d);
 }
 
+/* Called after `SIGCHLD': collect exit statuses and mark jobs as dead. */
 static void reap_children(void)
 {
-  struct job *job, **link;
+  struct job *job;
   pid_t kid;
   int st;
 
   for (;;) {
+
+    /* Collect a child exit status.  If there aren't any more then we're
+     * done.
+     */
     kid = waitpid(0, &st, WNOHANG);
     if (kid <= 0) break;
-    for (link = &job_run; (job = *link); link = &job->next)
+
+    /* Try to find a matching job.  If we can't, then we should just ignore
+     * it.
+     */
+    for (job = job_run; job; job = job->next)
       if (job->kid == kid) goto found;
-    moan("unexpected child process %d exited with status %06o", kid, st);
     continue;
+
   found:
-    job->exit = st; job->st = JST_DEAD; job->kid = -1; nrun--;
-    *link = job->next; job->next = job_dead; job_dead = job;
+    /* Mark the job as dead, and save its exit status. */
+    job->exit = st; job->kid = -1; nrun--;
   }
+
+  /* If there was a problem with waitpid(2) then report it. */
   if (kid < 0 && errno != ECHILD)
     lose("failed to collect child process exit status: %s", strerror(errno));
 }
 
-static void check_signals(void)
-{
-  sigset_t old, pend;
-  char buf[32];
-  ssize_t n;
-
-  sigprocmask(SIG_BLOCK, &caught, &old);
-  pend = pending; sigemptyset(&pending);
-  for (;;) {
-    n = read(sig_pipe[0], buf, sizeof(buf));
-    if (!n) lose("(internal) signal pipe closed!");
-    if (n < 0) break;
-  }
-  if (errno != EAGAIN && errno != EWOULDBLOCK)
-    lose("failed to read signal pipe: %s", strerror(errno));
-  sigprocmask(SIG_SETMASK, &old, 0);
-
-  if (sigismember(&pend, SIGINT)) sigloss = SIGINT;
-  else if (sigismember(&pend, SIGHUP)) sigloss = SIGHUP;
-  else if (sigismember(&pend, SIGTERM)) sigloss = SIGTERM;
-  if (sigismember(&pend, SIGCHLD)) reap_children();
-}
-
-#define SIGF_IGNOK 1u
-static void set_signal_handler(const char *what, int sig, unsigned f)
-{
-  struct sigaction sa, sa_old;
-
-  sigaddset(&caught, sig);
-
-  if (f&SIGF_IGNOK) {
-    if (sigaction(sig, 0, &sa_old)) goto fail;
-    if (sa_old.sa_handler == SIG_IGN) return;
-  }
-
-  sa.sa_handler = handle_signal;
-  sigemptyset(&sa.sa_mask);
-  sa.sa_flags = SA_NOCLDSTOP;
-  if (sigaction(sig, &sa, 0)) goto fail;
-
-  return;
-
-fail:
-  lose("failed to set %s signal handler: %s", what, strerror(errno));
-}
-
-static NORETURN void job_child(struct job *job)
+/* Execute the handler for some JOB. */
+static NORETURN void job_child(struct job *job, struct argv *av)
 {
-  try_exec(&job->av,
-          !(flags&AF_CHECKINST) && verbose >= 2 ? TEF_VERBOSE : 0);
-  moan("failed to run `%s': %s", job->av.v[0], strerror(errno));
-  _exit(2);
+  try_exec(av, 0);
+  moan("failed to run `%s': %s", av->v[0], strerror(errno));
+  _exit(127);
 }
 
+/* Start up jobs while there are (a) jobs to run and (b) slots to run them
+ * in.
+ */
 static void start_jobs(void)
 {
   struct dstr d = DSTR_INIT;
   int p_out[2], p_err[2];
   struct job *job;
+  struct argv *av;
   pid_t kid;
 
+  /* Keep going until either we run out of jobs, or we've got enough running
+   * already.
+   */
   while (job_ready && nrun < maxrun) {
+
+    /* Set things up ready.  If things go wrong, we need to know what stuff
+     * needs to be cleaned up.
+     */
     job = job_ready; job_ready = job->next;
+    if (!job_ready) job_ready_tail = &job_ready;
     p_out[0] = p_out[1] = p_err[0] = p_err[1] = -1;
-    dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job));
-    if (mkdir(d.p, 0700)) {
-      bad("failed to create working directory for job `%s': %s",
-         JOB_NAME(job), strerror(errno));
-      goto fail;
+
+    /* Figure out what to do. */
+    switch (job->st) {
+      case JST_VERSION: av = &job->av_version; break;
+      case JST_DUMP: av = &job->av_dump; break;
+      default: assert(0);
     }
-    if (verbose >= 2)
-      job->log = stdout;
-    else {
-      dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+");
-      if (!job->log)
-       lose("failed to open log file `%s': %s", d.p, strerror(errno));
+
+    /* If we're not actually going to do anything, now is the time to not do
+     * that.  We should do the version-hashing step unconditionally.
+     */
+    switch (job->st) {
+      case JST_VERSION:
+       break;
+      case JST_DUMP:
+       if (flags&AF_DRYRUN) {
+         if (try_exec(av,
+                      TEF_DRYRUN |
+                      (verbose >= 2 && !(flags&AF_CHECKINST)
+                         ? TEF_VERBOSE : 0)))
+             rc = 127;
+           else if (verbose >= 2)
+             printf("%-13s > not dumping `%s' (dry run)\n",
+                    JOB_NAME(job), JOB_NAME(job));
+         release_job(job);
+         continue;
+       }
+       break;
+      default:
+       assert(0);
+    }
+
+    /* Do one-time setup for external jobs. */
+    if (!job->log) {
+
+      /* Make a temporary subdirectory for this job to use. */
+      dstr_reset(&d); dstr_putf(&d, "%s/%s", tmpdir, JOB_NAME(job));
+      if (mkdir(d.p, 0700)) {
+       bad("failed to create working directory for job `%s': %s",
+           JOB_NAME(job), strerror(errno));
+       goto fail;
+      }
+
+      /* Create the job's log file.  If we're being verbose then that's just
+       * our normal standard output -- /not/ stderr: it's likely that users
+       * will want to pipe this stuff through a pager or something, and
+       * that'll be easier if we use stdout.  Otherwise, make a file in the
+       * temporary directory.
+       */
+      if (verbose >= 2)
+       job->log = stdout;
+      else {
+       dstr_puts(&d, "/log"); job->log = fopen(d.p, "w+");
+       if (!job->log)
+         lose("failed to open log file `%s': %s", d.p, strerror(errno));
+      }
     }
+
+    /* Make the pipes to capture the child process's standard output and
+     * error streams.
+     */
     if (pipe(p_out) || pipe(p_err)) {
       bad("failed to create pipes for job `%s': %s",
          JOB_NAME(job), strerror(errno));
@@ -512,13 +1181,24 @@ static void start_jobs(void)
        configure_fd("job stderr pipe", p_err[1], 0, 1) ||
        configure_fd("log file", fileno(job->log), 1, 1))
       goto fail;
+
+    /* Initialize the output-processing structures ready for use. */
+    if (job->st == JST_VERSION) sha256_init(&job->h);
     job->out.buf = xmalloc(MAXLINE); job->out.off = job->out.len = 0;
     job->out.fd = p_out[0]; p_out[0] = -1;
     job->err.buf = xmalloc(MAXLINE); job->err.off = job->err.len = 0;
     job->err.fd = p_err[0]; p_err[0] = -1;
-    dstr_reset(&d); argv_string(&d, &job->av);
+
+    /* Print a note to the top of the log. */
+    dstr_reset(&d); argv_string(&d, av);
     fprintf(job->log, "%-13s > starting %s\n", JOB_NAME(job), d.p);
+
+    /* Flush the standard output stream.  (Otherwise the child might try to
+     * flush it too.)
+     */
     fflush(stdout);
+
+    /* Spin up the child process. */
     kid = fork();
     if (kid < 0) {
       bad("failed to fork process for job `%s': %s",
@@ -531,29 +1211,114 @@ static void start_jobs(void)
          dup2(p_err[1], 2) < 0)
        lose("failed to juggle job `%s' file descriptors: %s",
             JOB_NAME(job), strerror(errno));
-      job_child(job);
+      job_child(job, av);
     }
+
+    /* Close the ends of the pipes that we don't need.  Move the job into
+     * the running list.
+     */
     close(p_out[1]); close(p_err[1]);
-    job->kid = kid;
-    job->st = JST_RUN; job->next = job_run; job_run = job; nrun++;
+    job->kid = kid; job->next = job_run; job_run = job; nrun++;
     continue;
+
   fail:
+    /* Clean up the wreckage if it didn't work. */
     if (p_out[0] >= 0) close(p_out[0]);
     if (p_out[1] >= 0) close(p_out[1]);
     if (p_err[0] >= 0) close(p_err[0]);
     if (p_err[1] >= 0) close(p_err[1]);
     release_job(job);
   }
+
+  /* All done except for some final tidying up. */
   dstr_release(&d);
 }
 
+/* Take care of all of the jobs until they're all done. */
+static void run_jobs(void)
+{
+  struct job *job, *next, **link;
+  int nfd;
+  fd_set fd_in;
+
+  for (;;) {
+
+    /* If there are jobs still to be started and we have slots to spare then
+     * start some more up.
+     */
+    start_jobs();
+
+    /* If the queues are now all empty then we're done.  (No need to check
+     * `job_ready' here: `start_jobs' would have started them if `job_run'
+     * was empty.
+     */
+    if (!job_run) break;
+
+    /* Prepare for the select(2) call: watch for the signal pipe and all of
+     * the job pipes.
+     */
+#define SET_FD(dir, fd) do {                                           \
+  int _fd = (fd);                                                      \
+  FD_SET(_fd, &fd_##dir);                                              \
+  if (_fd >= nfd) nfd = _fd + 1;                                       \
+} while (0)
+
+    FD_ZERO(&fd_in); nfd = 0;
+    SET_FD(in, sig_pipe[0]);
+    for (job = job_run; job; job = job->next) {
+      if (job->out.fd >= 0) SET_FD(in, job->out.fd);
+      if (job->err.fd >= 0) SET_FD(in, job->err.fd);
+    }
+
+#undef SET_FD
+
+    /* Find out what's going on. */
+    if (select(nfd, &fd_in, 0, 0, 0) < 0) {
+      if (errno == EINTR) continue;
+      else lose("select failed: %s", strerror(errno));
+    }
+
+    /* If there were any signals then handle them. */
+    if (FD_ISSET(sig_pipe[0], &fd_in)) {
+      check_signals();
+      if (sigloss >= 0) {
+       /* We hit a fatal signal.  Kill off the remaining jobs and abort. */
+       for (job = job_ready; job; job = next)
+         { next = job->next; release_job(job); }
+       for (job = job_run; job; job = next)
+         { next = job->next; release_job(job); }
+       break;
+      }
+    }
+
+    /* Collect output from running jobs, and clear away any dead jobs once
+     * we've collected all their output.
+     */
+    for (link = &job_run, job = *link; job; job = next) {
+      if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
+       prefix_lines(job, &job->out, '|',
+                    job->st == JST_VERSION ? &job->h : 0);
+      if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
+       prefix_lines(job, &job->err, '*', 0);
+      next = job->next;
+      if (job->kid > 0 || job->out.fd >= 0 || job->err.fd >= 0)
+       link = &job->next;
+      else
+       { *link = next; finish_job(job); }
+    }
+  }
+}
+
+/*----- Main program ------------------------------------------------------*/
+
+/* Help and related functions. */
 static void version(FILE *fp)
   { fprintf(fp, "%s, runlisp version %s\n", progname, PACKAGE_VERSION); }
 
 static void usage(FILE *fp)
 {
   fprintf(fp, "\
-usage: %s [-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);
 }
@@ -577,29 +1342,56 @@ 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[])
 {
   struct config_section_iter si;
   struct config_section *sect;
   struct config_var *var;
   const char *out = 0, *p, *q, *l;
-  struct job *job, **tail, **link, *next;
+  struct job *job;
   struct stat st;
   struct dstr d = DSTR_INIT;
-  int i, fd, nfd, first;
-  fd_set fd_in;
+  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' },
@@ -608,55 +1400,74 @@ 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 }
   };
 
+  /* Initial setup. */
   set_progname(argv[0]);
   init_config();
 
+  /* 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;
-  if (flags&AF_BOGUS) { usage(stderr); exit(2); }
+  if (flags&AF_BOGUS) { usage(stderr); exit(127); }
 
+  /* Load default configuration if no explicit files were requested. */
   if (!(flags&AF_SETCONF)) load_default_config();
 
-  if (!out)
-    config_set_var(&config, builtin, 0,
-                  "@IMAGE", "${@CONFIG:image-dir}/${image-file}");
-  else if (stat(out, &st) || !S_ISDIR(st.st_mode))
-    config_set_var(&config, builtin, CF_LITERAL, "@IMAGE", out);
-  else {
-    config_set_var(&config, builtin, CF_LITERAL, "@%OUTDIR", out);
-    config_set_var(&config, builtin, 0,
-                  "@IMAGE", "${@BUILTIN:@%OUTDIR}/${image-file}");
+  /* OK, so we've probably got some work to do.  Let's set things up ready.
+   * It'll be annoying if our standard descriptors aren't actually set up
+   * properly, so we'll make sure those slots are populated.  We'll need a
+   * `/dev/null' descriptor anyway (to be stdin for the jobs).  We'll also
+   * need a temporary directory, and it'll be less temporary if we don't
+   * arrange to delete it when we're done.  And finally we'll need to know
+   * when a child process exits.
+   */
+  for (;;) {
+    fd = open("/dev/null", O_RDWR);
+    if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno));
+    if (fd > 2) { nullfd = fd; break; }
   }
-
+  configure_fd("null fd", nullfd, 0, 1);
   atexit(cleanup);
   if (pipe(sig_pipe))
     lose("failed to create signal pipe: %s", strerror(errno));
@@ -668,135 +1479,217 @@ int main(int argc, char *argv[])
   set_signal_handler("SIGHUP", SIGHUP, SIGF_IGNOK);
   set_signal_handler("SIGCHLD", SIGCHLD, 0);
 
+  /* Create the temporary directory and export it into the configuration. */
   set_tmpdir();
-  config_set_var(&config, builtin, CF_LITERAL, "@%TMPDIR", tmpdir);
+  config_set_var(&config, builtin, CF_LITERAL, "@%tmp-dir", tmpdir);
+  config_set_var(&config, builtin, 0,
+                "@tmp-dir", "${@BUILTIN:@%tmp-dir}/${@name}");
+
+  /* Work out where the image files are going to go.  If there's no `-O'
+   * option then we use the main `image-dir'.  Otherwise what happens depends
+   * on whether this is a file or a directory.
+   */
+  if (!out) {
+    config_set_var(&config, builtin, 0,
+                  "@image-link", "${@image-dir}/${image-file}");
+    var = config_find_var(&config, builtin, CF_INHERIT, "@image-dir");
+    assert(var); out = config_subst_var_alloc(&config, builtin, var);
+  } else if (!stat(out, &st) && S_ISDIR(st.st_mode))  {
+    config_set_var(&config, builtin, CF_LITERAL, "@%out-dir", out);
+    config_set_var(&config, builtin, 0,
+                  "@image-link", "${@BUILTIN:@%out-dir}/${image-file}");
+  } else if (argc - optind != 1)
+    lose("can't dump multiple Lisps to a single output file");
+  else if (flags&AF_JUNK)
+    lose("can't clear junk in a single output file");
+  else if (flags&AF_CLEAN)
+    lose("can't clean other images with a single output file");
+  else
+    config_set_var(&config, builtin, CF_LITERAL, "@image-link", out);
+
+  /* Set the staging and versioned filenames. */
+  config_set_var(&config, builtin, 0,
+                "@image-out", "${@image-link}-${@hash}");
+  config_set_var(&config, builtin, 0, "@image-new", "${@image-out}.new");
   config_set_var(&config, builtin, 0,
-                "@TMPDIR", "${@BUILTIN:@%TMPDIR}/${@NAME}");
+                "@image-newlink", "${@image-link}.new");
 
+  config_set_var(&config, builtin, 0, "@script",
+                "${@ENV:RUNLISP_EVAL?"
+                  "${@CONFIG:eval-script?"
+                    "${@data-dir}/eval.lisp}}");
+
+  /* Configure an initial value for `@hash'.  This is necessary so that
+   * `add_job' can expand `dump-image' to check that the command exists.
+   */
+  config_set_var(&config, builtin, CF_LITERAL, "@hash", "!!!unset!!!");
+
+  /* Dump the final configuration if we're being very verbose. */
   if (verbose >= 5) dump_config();
 
-  tail = &job_ready;
-  if (!(flags&AF_ALL))
-    for (i = optind; i < argc; i++)
-      add_job(&tail, 0, argv[i], strlen(argv[i]));
-  else {
-    var = config_find_var(&config, toplevel, 0, "dump");
-    if (!var)
-      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));
+  /* There are a number of different strategies we might employ, depending on
+   * the exact request.
+   *
+   *                           queue           queue           clear
+   *   REMOVE  CLEAN   JUNK    selected        others          junk?
+   *
+   *   *       nil     nil     ready/delete    --              no
+   *   *       nil     t       ready/delete    none            yes
+   *   nil     t       nil     ready           delete          no
+   *   nil     t       t       ready           --              yes
+   *   t       t       nil     --              delete          no
+   *   t       t       t       --              --              yes
+   */
+
+  /* First step: if `AF_REMOVE' and `AF_CLEAN' are not both set, then scan
+   * the selected Lisp systems and add them to the appropriate queue.
+   *
+   * Bit-hack: if they are not both set, then their complements are not both
+   * clear.
+   */
+  if (~flags&(AF_REMOVE | AF_CLEAN)) {
+
+    /* Determine the flags for `add_job' when we select the Lisp systems.  If
+     * we intend to clear junk then we must notice the image names we
+     * encounter.  If we're supposed to check that Lisps exist before dumping
+     * then do that -- but it doesn't make any sense for deletion.
+     */
+    f = flags&AF_REMOVE ? JQ_DELETE : JQ_READY;
+    if (flags&AF_JUNK) f |= JF_NOTICE;
+    if (flags&AF_CHECKINST) f |= JF_CHECKINST;
+    if (!(flags&(AF_FORCE | AF_REMOVE))) f |= JF_CHECKEXIST;
+
+    /* If we have named Lisps, then process them. */
+    if (!(flags&AF_ALL))
+      for (i = optind; i < argc; i++)
+       add_named_job(f, argv[i], strlen(argv[i]));
+
+    /* Otherwise we're supposed to dump `all' of them.  If there's a `dump'
+     * configuration setting then we need to parse that.  Otherwise we just
+     * try all of them.
+     */
     else {
-      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);
-       if (p < l) p++;
+      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;
 
-  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);
+  /* 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);
   }
 
-  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);
-  }
+  /* Terminate the job queues. */
+  *job_ready_tail = 0;
+  *job_delete_tail = 0;
 
-  for (;;) {
-    fd = open("/dev/null", O_RDWR);
-    if (fd < 0) lose("failed to open `/dev/null': %s", strerror(errno));
-    if (fd > 2) { nullfd = fd; break; }
+  /* Report on what it is we're about to do. */
+  if (verbose >= 3) {
+    show_job_list("dumping Lisp images", job_ready);
+    show_job_list("deleting Lisp images", job_delete);
   }
-  configure_fd("null fd", nullfd, 0, 1);
-
-  for (;;) {
-    start_jobs();
-    if (!job_run && !job_dead) break;
 
-#define SET_FD(dir, fd) do {                                           \
-  int _fd = (fd);                                                      \
-                                                                       \
-  FD_SET(_fd, &fd_##dir);                                              \
-  if (_fd >= nfd) nfd = _fd + 1;                                       \
-} while (0)
+  /* 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");
 
-    FD_ZERO(&fd_in); nfd = 0;
-    SET_FD(in, sig_pipe[0]);
-    for (job = job_run; job; job = job->next) {
-      if (job->out.fd >= 0) SET_FD(in, job->out.fd);
-      if (job->err.fd >= 0) SET_FD(in, job->err.fd);
-    }
-    for (job = job_dead; job; job = job->next) {
-      if (job->out.fd >= 0) SET_FD(in, job->out.fd);
-      if (job->err.fd >= 0) SET_FD(in, job->err.fd);
-    }
+  /* Run the dumping jobs. */
+  run_jobs();
 
-#undef SET_FD
+  /* 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); }
 
-    if (select(nfd, &fd_in, 0, 0, 0) < 0) {
-      if (errno == EINTR) continue;
-      else lose("select failed: %s", strerror(errno));
+  /* Now delete Lisps which need deleting. */
+  while (job_delete) {
+    job = job_delete; job_delete = job->next;
+    if (flags&AF_DRYRUN) {
+      if (verbose >= 2)
+       moan("not deleting `%s' image link `%s' (dry run)",
+            JOB_NAME(job), job->imglink);
+      if (job->oldimg && verbose >= 2)
+       moan("not deleting `%s' image `%s' (dry run)",
+            JOB_NAME(job), job->oldimg);
+    } else {
+      if (verbose >= 2)
+       moan("deleting `%s' image `%s' (dry run)",
+            JOB_NAME(job), job->imglink);
+      if (unlink(job->imglink) && errno != ENOENT)
+       bad("failed to delete `%s' image link `%s': %s",
+           JOB_NAME(job), job->imglink, strerror(errno));
+      if (job->oldimg && unlink(job->oldimg) && errno != ENOENT)
+       bad("failed to delete `%s' image `%s': %s",
+           JOB_NAME(job), job->oldimg, strerror(errno));
     }
+  }
 
-    if (FD_ISSET(sig_pipe[0], &fd_in)) {
-      check_signals();
-      if (sigloss >= 0) {
-       for (job = job_ready; job; job = next)
-         { next = job->next; release_job(job); }
-       for (job = job_run; job; job = next)
-         { next = job->next; release_job(job); }
-       for (job = job_dead; job; job = next)
-         { next = job->next; release_job(job); }
-       break;
+  /* Finally, maybe delete all of the junk files in the image directory. */
+  if (flags&AF_JUNK) {
+    dir = opendir(out);
+    if (!dir)
+      lose("failed to open image directory `%s': %s", out, strerror(errno));
+    dstr_reset(&d);
+    dstr_puts(&d, out); dstr_putc(&d, '/'); o = d.len;
+    if (verbose >= 2)
+      moan("cleaning up junk in image directory `%s'", out);
+    for (;;) {
+      de = readdir(dir); if (!de) break;
+      if (de->d_name[0] == '.' &&
+         (!de->d_name[1] || (de->d_name[1] == '.' && !de->d_name[2])))
+       continue;
+      n = strlen(de->d_name);
+      d.len = o; dstr_putm(&d, de->d_name, n + 1);
+      if (!treap_lookup(&good, de->d_name, n)) {
+       if (flags&AF_DRYRUN) {
+         if (verbose >= 2)
+           moan("not deleting junk file `%s' (dry run)", d.p);
+       } else {
+         if (verbose >= 2)
+           moan("deleting junk file `%s'", d.p);
+         if (unlink(d.p) && errno != ENOENT)
+           bad("failed to delete junk file `%s': %s", d.p, strerror(errno));
+       }
       }
     }
-
-    for (job = job_run; job; job = job->next) {
-      if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
-       prefix_lines(job, &job->out, '|');
-      if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
-       prefix_lines(job, &job->err, '*');
-    }
-    for (link = &job_dead, job = *link; job; job = next) {
-      next = job->next;
-      if (job->out.fd >= 0 && FD_ISSET(job->out.fd, &fd_in))
-       prefix_lines(job, &job->out, '|');
-      if (job->err.fd >= 0 && FD_ISSET(job->err.fd, &fd_in))
-       prefix_lines(job, &job->err, '*');
-      if (job->out.fd >= 0 || job->err.fd >= 0) link = &job->next;
-      else {  *link = next; finish_job(job); }
-    }
   }
 
-  check_signals();
-  if (sigloss) { cleanup(); signal(sigloss, SIG_DFL); raise(sigloss); }
-
+  /* All done! */
   return (rc);
 }