README.org: Clarify `free software' with a link to the FSF.

[runlisp] / runlisp.c

diff --git a/runlisp.c b/runlisp.c
index c555f13e94009602654cffd761a54701b6f017db..bdb71af719374e28c17d0392a050634abe4578f3 100644 (file)
--- a/runlisp.c
+++ b/runlisp.c
@@ -39,89 +39,52 @@
 
 /*----- Static data -------------------------------------------------------*/
 
 
 /*----- Static data -------------------------------------------------------*/
 

+/* The state we need for a Lisp system. */

 struct lispsys {
 struct lispsys {

-  struct treap_node _node;
-  struct lispsys *next_lisp, *next_accept, *next_prefer, *next_order;
-  unsigned f;
-#define LF_KNOWN 1u
-#define LF_ACCEPT 2u
-#define LF_PREFER 4u
-  struct config_section *sect;
-  struct config_var *var;
+  struct treap_node _node;             /* treap intrusion */
+  struct lispsys *next_lisp,           /* link in all-Lisps list */
+    *next_accept,                      /* link acceptable-Lisps list */
+    *next_prefer,                      /* link in preferred-Lisps list */
+    *next_order;                       /* link in overall-order list */
+  unsigned f;                          /* flags */
+#define LF_KNOWN 1u                    /*   this is actually a Lisp */
+#define LF_ACCEPT 2u                   /*   this is an acceptable Lisp */
+#define LF_PREFER 4u                   /*   this is a preferred Lisp */
+  struct config_section *sect;         /* configuration section */
+  struct config_var *var;              /* `run-script variable */

 };
 #define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp)
 #define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp)
 
 };
 #define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp)
 #define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp)
 

+/* Pick out a link from a `struct lispsys' object given its offset. */
+#define LISP_LINK(lisp, linkoff)                                       \
+       ((struct lispsys **)((unsigned char *)(lisp) + (linkoff)))
+
+/* A list of Lisp systems. */

 struct lispsys_list {
 struct lispsys_list {

-  struct lispsys *head, **tail;
+  struct lispsys *head, **tail;                /* list head and tail */

 };
 
 };
 

-static struct argv argv_tail = ARGV_INIT;
-const char *script = 0;
-
-static unsigned flags = 0;
-#define AF_CMDLINE 0x0000u
-#define AF_EMBED 0x0001u
-#define AF_ENV 0x0002u
-#define AF_CONF 0x0003u
-#define AF_STATEMASK 0x000fu
-#define AF_BOGUS 0x0010u
-#define AF_SETCONF 0x0020u
-#define AF_NOEMBED 0x0040u
-#define AF_DRYRUN 0x0080u
-#define AF_VANILLA 0x0100u
-
-struct treap lispsys = TREAP_INIT;
-static struct lispsys_list
-  lisps = { 0, &lisps.head },
-  accept = { 0, &accept.head },
-  prefer = { 0, &prefer.head };
+static struct argv argv_tail = ARGV_INIT; /* accumulates eval-mode args */
+struct treap lispsys = TREAP_INIT;     /* track duplicate Lisp systems */
+static struct lispsys_list             /* lists of Lisp systems */
+  lisps = { 0, &lisps.head },          /*   all known */
+  accept = { 0, &accept.head },                /*   acceptable */
+  prefer = { 0, &prefer.head };                /*   preferred */
+
+static unsigned flags = 0;             /* flags for the application */
+#define AF_CMDLINE 0x0000u             /*   options are from command-line */
+#define AF_EMBED 0x0001u               /*   reading embedded options */
+#define AF_STATEMASK 0x000fu           /*   mask of option origin codes */
+#define AF_BOGUS 0x0010u               /*   invalid command-line syntax */
+#define AF_SETCONF 0x0020u             /*   explicit configuration */
+#define AF_NOEMBED 0x0040u             /*   don't read embedded options */
+#define AF_DRYRUN 0x0080u              /*   don't actually do it */
+#define AF_VANILLA 0x0100u             /*   don't use custom images */

 
 /*----- Main code ---------------------------------------------------------*/
 
 
 /*----- Main code ---------------------------------------------------------*/
 

-static void version(FILE *fp)
-  { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
-
-static void usage(FILE *fp)
-{
-  fprintf(fp, "\
-usage:\n\
-       %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\
-       %s [OPTIONS] [-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n\
-OPTIONS:\n\
-       [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n",
-         progname, progname);
-}
-
-static void help(FILE *fp)
-{
-  version(fp); fputc('\n', fp); usage(fp);
-  fputs("\n\
-Help options:\n\
-  -h, --help                   Show this help text and exit successfully.\n\
-  -V, --version                        Show version number and exit successfully.\n\
-\n\
-Diagnostics:\n\
-  -n, --dry-run                        Don't run run anything (useful with `-v').\n\
-  -q, --quiet                  Don't print warning messages.\n\
-  -v, --verbose                        Print informational messages (repeatable).\n\
-\n\
-Configuration:\n\
-  -E, --command-line-only      Don't read embedded options from script.\n\
-  -c, --config-file=CONF       Read configuration from CONF (repeatable).\n\
-  -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
-\n\
-Lisp implementation selection:\n\
-  -D, --vanilla-image          Run vanilla Lisp images, not custom ones.\n\
-  -L, --accept-lisp=SYS,SYS,...        Only use the listed Lisp systems.\n\
-\n\
-Evaluation mode:\n\
-  -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\
-  -l, --load-file=FILE         Load FILE (repeatable).\n\
-  -p, --print-expression=EXPR  Print (`prin1') EXPR (repeatable).\n",
-       fp);
-}
-
+/* Return the `struct lispsys' entry for the given N-byte NAME. */

 static struct lispsys *ensure_lispsys(const char *name, size_t n)
 {
   struct lispsys *lisp;
 static struct lispsys *ensure_lispsys(const char *name, size_t n)
 {
   struct lispsys *lisp;


@@ -136,9 +99,11 @@ static struct lispsys *ensure_lispsys(const char *name, size_t n)
   return (lisp);
 }
 
   return (lisp);
 }
 

-#define LISP_LINK(lisp, linkoff)                                       \
-       ((struct lispsys **)((unsigned char *)(lisp) + (linkoff)))
-
+/* Add Lisp systems from the comma- or space-sparated list P to LIST.
+ *
+ * WHAT is an adjective describing the list flavour; FLAG is a bit to set in
+ * the node's flags word; LINKOFF is the offset of the list's link member.
+ */

 static void add_lispsys(const char *p, const char *what,
                        struct lispsys_list *list,
                        unsigned flag, size_t linkoff)
 static void add_lispsys(const char *p, const char *what,
                        struct lispsys_list *list,
                        unsigned flag, size_t linkoff)


@@ -148,8 +113,9 @@ static void add_lispsys(const char *p, const char *what,
 
   if (!*p) return;
   for (;;) {
 
   if (!*p) return;
   for (;;) {

+    while (ISSPACE(*p)) p++;

     if (!*p) break;
     if (!*p) break;

-    q = p; while (*p && *p != ',') p++;
+    q = p; while (*p && !ISSPACE(*p) && *p != ',') p++;

     lisp = ensure_lispsys(q, p - q);
     if (lisp->f&flag) {
       if (verbose >= 1)
     lisp = ensure_lispsys(q, p - q);
     if (lisp->f&flag) {
       if (verbose >= 1)


@@ -159,11 +125,16 @@ static void add_lispsys(const char *p, const char *what,
       lisp->f |= flag; *link = 0;
       *list->tail = lisp; list->tail = link;
     }
       lisp->f |= flag; *link = 0;
       *list->tail = lisp; list->tail = link;
     }

+    while (ISSPACE(*p)) p++;

     if (!*p) break;
     if (!*p) break;

-    p++;
+    if (*p == ',') p++;

   }
 }
 
   }
 }
 

+/* Check that the Lisp systems on LIST (linked through LINKOFF) are real.
+ *
+ * That is, `LF_KNOWN' is set in their flags.
+ */

 static void check_lisps(const char *what,
                        struct lispsys_list *list, size_t linkoff)
 {
 static void check_lisps(const char *what,
                        struct lispsys_list *list, size_t linkoff)
 {


@@ -174,6 +145,10 @@ static void check_lisps(const char *what,
       lose("unknown Lisp implementation `%s'", LISPSYS_NAME(lisp));
 }
 
       lose("unknown Lisp implementation `%s'", LISPSYS_NAME(lisp));
 }
 

+/* Dump the names of the Lisp systems on LIST (linked through LINKOFF).
+ *
+ * WHAT is an adjective describing the list.
+ */

 static void dump_lisps(const char *what,
                       struct lispsys_list *list, size_t linkoff)
 {
 static void dump_lisps(const char *what,
                       struct lispsys_list *list, size_t linkoff)
 {


@@ -185,7 +160,7 @@ static void dump_lisps(const char *what,
   for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) {
     if (first) first = 0;
     else dstr_puts(&d, ", ");
   for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) {
     if (first) first = 0;
     else dstr_puts(&d, ", ");

-    dstr_putf(&d, "`%s'", LISPSYS_NAME(lisp));
+    dstr_puts(&d, LISPSYS_NAME(lisp));

   }
   if (first) dstr_puts(&d, "(none)");
   dstr_putz(&d);
   }
   if (first) dstr_puts(&d, "(none)");
   dstr_putz(&d);


@@ -193,6 +168,11 @@ static void dump_lisps(const char *what,
   dstr_release(&d);
 }
 
   dstr_release(&d);
 }
 

+/* Add an eval-mode operation to the `argv_tail' vector.
+ *
+ * OP is the operation character (see `eval.lisp' for these) and `val' is the
+ * argument (filename or expression).
+ */

 static void push_eval_op(char op, const char *val)
 {
   char *p;
 static void push_eval_op(char op, const char *val)
 {
   char *p;


@@ -210,6 +190,64 @@ static void push_eval_op(char op, const char *val)
   argv_append(&argv_tail, p);
 }
 
   argv_append(&argv_tail, p);
 }
 

+/* Help and related functions. */
+static void version(FILE *fp)
+  { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
+
+static void usage(FILE *fp)
+{
+  fprintf(fp, "\
+usage:\n\
+       %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\
+       %s [OPTIONS] [-e EXPR] [-d EXPR] [-p EXPR] [-l FILE]\n\
+               [--] [ARGUMENTS ...]\n\
+OPTIONS:\n\
+       [-DEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n",
+         progname, progname);
+}
+
+static void help(FILE *fp)
+{
+  version(fp); fputc('\n', fp); usage(fp);
+  fputs("\n\
+Help options\n\
+  -h, --help                   Show this help text and exit successfully.\n\
+  -V, --version                        Show version number and exit successfully.\n\
+\n\
+Diagnostics\n\
+  -n, --dry-run                        Don't run run anything (useful with `-v').\n\
+  -q, --quiet                  Don't print warning messages.\n\
+  -v, --verbose                        Print informational messages (repeatable).\n\
+\n\
+Configuration\n\
+  -E, --command-line-only      Don't read embedded options from script.\n\
+  -c, --config-file=CONF       Read configuration from CONF (repeatable).\n\
+  -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
+\n\
+Lisp implementation selection\n\
+  -D, --vanilla-image          Run vanilla Lisp images, not custom ones.\n\
+  -L, --accept-lisp=SYS,SYS,...        Only use the listed Lisp systems.\n\
+\n\
+Evaluation mode\n\
+  -d, --dump-expression=EXPR   Print (`prin1') EXPR (repeatable).\n\
+  -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\
+  -l, --load-file=FILE         Load FILE (repeatable).\n\
+  -p, --print-expression=EXPR  Print (`princ') EXPR (repeatable).\n",
+       fp);
+}
+
+/* Complain about options which aren't permitted as embedded options. */
+static void check_command_line(int ch)
+{
+  if ((flags&AF_STATEMASK) != AF_CMDLINE) {
+    moan("`%c%c' is not permitted as embedded option",
+        ch&OPTF_NEGATED ? '+' : '-',
+        ch&~OPTF_NEGATED);
+    flags |= AF_BOGUS;
+  }
+}
+
+/* Parse the options in the argument vector. */

 static void parse_options(int argc, char *argv[])
 {
   int i;
 static void parse_options(int argc, char *argv[])
 {
   int i;


@@ -221,6 +259,7 @@ static void parse_options(int argc, char *argv[])
     { "command-line-only",     OPTF_NEGATE,    0,      'E' },
     { "accept-lisp",           OPTF_ARGREQ,    0,      'L' },
     { "config-file",           OPTF_ARGREQ,    0,      'c' },
     { "command-line-only",     OPTF_NEGATE,    0,      'E' },
     { "accept-lisp",           OPTF_ARGREQ,    0,      'L' },
     { "config-file",           OPTF_ARGREQ,    0,      'c' },

+    { "dump-expression",       OPTF_ARGREQ,    0,      'd' },

     { "evaluate-expression",   OPTF_ARGREQ,    0,      'e' },
     { "load-file",             OPTF_ARGREQ,    0,      'l' },
     { "dry-run",               OPTF_NEGATE,    0,      'n' },
     { "evaluate-expression",   OPTF_ARGREQ,    0,      'e' },
     { "load-file",             OPTF_ARGREQ,    0,      'l' },
     { "dry-run",               OPTF_NEGATE,    0,      'n' },


@@ -231,36 +270,49 @@ static void parse_options(int argc, char *argv[])
     { 0,                       0,              0,      0 }
   };
 
     { 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 (;;) {
   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,
+    i = mdwopt(argc, argv, "+hVD+E+L:c:d:e:l:n+o:p:qv", opts, 0, 0,

               OPTF_NEGATION | OPTF_NOPROGNAME);
     if (i < 0) break;
     switch (i) {
               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 '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 'd': CMDL; push_eval_op('?', optarg); 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;
     }
   }
       default: flags |= AF_BOGUS; break;
     }
   }

+
+#undef FLAGOPT
+#undef CMDL

 }
 
 }
 

+/* Extract and process the embedded options from a SCRIPT. */

 static void handle_embedded_args(const char *script)
 {
   struct dstr d = DSTR_INIT;
 static void handle_embedded_args(const char *script)
 {
   struct dstr d = DSTR_INIT;


@@ -270,17 +322,40 @@ static void handle_embedded_args(const char *script)
   int qstate = 0;
   FILE *fp = 0;
 
   int qstate = 0;
   FILE *fp = 0;
 

+  /* Open the script.  If this doesn't work, then we have no hope. */

   fp = fopen(script, "r");
   if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
 
   fp = fopen(script, "r");
   if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
 

+  /* Read the second line. */

   if (dstr_readline(&d, fp)) goto end;
   dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
 
   if (dstr_readline(&d, fp)) goto end;
   dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
 

+  /* Check to find the magic marker. */

   p = strstr(d.p, "@RUNLISP:"); if (!p) goto end;
   p += 9; q = p; l = d.p + d.len;
   p = strstr(d.p, "@RUNLISP:"); if (!p) goto end;
   p += 9; q = p; l = d.p + d.len;

+
+  /* Split the line into words.
+   *
+   * Do this by hand because we have strange things to support, such as Emacs
+   * turds and the early `--' exit.
+   *
+   * We work in place: `p' is the input cursor and advances through the
+   * string as we parse, until it meets the limit pointer `l'; `q' is the
+   * output cursor which will always be no further forward than `p'.
+   */

   for (;;) {
   for (;;) {

+    /* Iterate over the words. */
+
+    /* Skip spaces. */

     while (p < l && ISSPACE(*p)) p++;
     while (p < l && ISSPACE(*p)) p++;

+
+    /* If we've reached the end then we're done. */

     if (p >= l) break;
     if (p >= l) break;

+
+    /* Check for an Emacs local-variables `-*-' turd.
+     *
+     * If we find one, find the matching end marker and move past it.
+     */

     if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') {
       p = strstr(p + 3, "-*-");
       if (!p || p + 3 > l)
     if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') {
       p = strstr(p + 3, "-*-");
       if (!p || p + 3 > l)


@@ -288,31 +363,60 @@ static void handle_embedded_args(const char *script)
       p += 3;
       continue;
     }
       p += 3;
       continue;
     }

+
+    /* If we find a `--' marker then stop immediately. */

     if (l - p >= 2 && p[0] == '-' && p[1] == '-' &&
        (l == p + 2 || ISSPACE(p[2])))
       break;
 
     if (l - p >= 2 && p[0] == '-' && p[1] == '-' &&
        (l == p + 2 || ISSPACE(p[2])))
       break;
 

+    /* Push the output cursor position onto the output, because this is where
+     * the next word will start.
+     */

     argv_append(&av, q);
     argv_append(&av, q);

+
+    /* Collect characters until we find an unquoted space. */

     while (p < l && (qstate || !ISSPACE(*p))) {
     while (p < l && (qstate || !ISSPACE(*p))) {

-      if (*p == '"') { p++; qstate = !qstate; }
+
+      if (*p == '"')
+       /* A quote.  Skip past, and toggle quotedness. */
+
+       { p++; qstate = !qstate; }
+

       else if (*p == '\\') {
       else if (*p == '\\') {

+       /* A backslash.  Just emit the following character. */
+

        p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script);
        *q++ = *p++;
        p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script);
        *q++ = *p++;

+

       } else if (*p == '\'') {
       } else if (*p == '\'') {

+       /* A single quote.  Find its matching end quote, and emit everything
+        * in between.
+        */
+

        p++; r = strchr(p, '\'');
        if (!r || r > l) lose("%s:2: missing `''", script);
        n = r - p; memmove(q, p, n); q += n; p = r + 1;
        p++; r = strchr(p, '\'');
        if (!r || r > l) lose("%s:2: missing `''", script);
        n = r - p; memmove(q, p, n); q += n; p = r + 1;

+

       } else {
       } else {

+       /* An ordinary constituent.  Gather a bunch of these up and emit them
+        * all.
+        */

        n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v");
        if (n > l - p) n = l - p;
        memmove(q, p, n); q += n; p += n;
       }
     }
        n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v");
        if (n > l - p) n = l - p;
        memmove(q, p, n); q += n; p += n;
       }
     }

+
+    /* Check that we're not still inside quotes. */

     if (qstate) lose("%s:2: missing `\"'", script);
     if (qstate) lose("%s:2: missing `\"'", script);

-    if (p < l) p++;
-    *q++ = 0;
+
+    /* Finish off this word and prepare to start the next. */
+    *q++ = 0; if (p < l) p++;

   }
 
   }
 

+  /* Parse the arguments we've collected as options.  Object if we find
+   * positional arguments.
+   */

   flags = (flags&~AF_STATEMASK) | AF_EMBED;
   parse_options(av.n, (char * /*unconst*/*)av.v);
   if (optind < av.n)
   flags = (flags&~AF_STATEMASK) | AF_EMBED;
   parse_options(av.n, (char * /*unconst*/*)av.v);
   if (optind < av.n)


@@ -320,6 +424,7 @@ static void handle_embedded_args(const char *script)
         script, av.v[optind]);
 
 end:
         script, av.v[optind]);
 
 end:

+  /* Tidy up. */

   if (fp) {
     if (ferror(fp))
       lose("error reading script `%s': %s", script, strerror(errno));
   if (fp) {
     if (ferror(fp))
       lose("error reading script `%s': %s", script, strerror(errno));


@@ -328,6 +433,7 @@ end:
   dstr_release(&d); argv_release(&av);
 }
 
   dstr_release(&d); argv_release(&av);
 }
 

+/* Main program. */

 int main(int argc, char *argv[])
 {
   struct config_section_iter si;
 int main(int argc, char *argv[])
 {
   struct config_section_iter si;


@@ -335,51 +441,96 @@ int main(int argc, char *argv[])
   struct config_var *var;
   struct lispsys_list order;
   struct lispsys *lisp, **tail;
   struct config_var *var;
   struct lispsys_list order;
   struct lispsys *lisp, **tail;

+  const char *p;
+  const char *script;

   struct dstr d = DSTR_INIT;
   struct argv av = ARGV_INIT;
 
   struct dstr d = DSTR_INIT;
   struct argv av = ARGV_INIT;
 

+  /* initial setup. */

   set_progname(argv[0]);
   set_progname(argv[0]);

-

   init_config();
   init_config();

-  config_set_var(&config, toplevel, 0, "prefer", "${@ENV:RUNLISP_PREFER?}");

 
 

+  /* Parse the command-line options. */

   flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
   parse_options(argc - 1, argv + 1); optind++;
 
   flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
   parse_options(argc - 1, argv + 1); optind++;
 

-  if (argv_tail.n)
-    flags |= AF_NOEMBED;
-  else if (!script && !argv_tail.n) {
-    if (optind < argc) script = argv[optind]++;
-    else flags |= AF_BOGUS;
-  }
-
+  /* We now know enough to decide whether we're in eval or script mode.  In
+   * the former case, don't check for embedded options (it won't work because
+   * we don't know where the `eval.lisp' script is yet, and besides, there
+   * aren't any).  In the latter case, pick out the script name, leaving the
+   * remaining positional arguments for later.
+   */
+  if (argv_tail.n) { flags |= AF_NOEMBED; script = 0; }
+  else if (optind < argc) script = argv[optind++];
+  else flags |= AF_BOGUS;
+
+  /* Check that everything worked. */
+  if (flags&AF_BOGUS) { usage(stderr); exit(127); }
+
+  /* Reestablish ARGC/ARGV to refer to the tail of positional arguments to be
+   * passed onto the eventual script.  For eval mode, that includes the
+   * operations already queued up, so we'll have to accumulate everything in
+   * `argv_tail'.
+   */

   argc -= optind; argv += optind;
   if (argv_tail.n) {
     argv_append(&argv_tail, "--");
   argc -= optind; argv += optind;
   if (argv_tail.n) {
     argv_append(&argv_tail, "--");

-    argv_appendn(&argv_tail, (const char *const *)argv, argc);
-    argc = argv_tail.n; argv = (/*unconst*/ char */*unconst*/ *)argv_tail.v;
+    argv_appendn(&argv_tail, argv, argc);
+    argc = argv_tail.n; argv = argv_tail.v;

   }
 
   }
 

-  if (flags&AF_BOGUS) { usage(stderr); exit(2); }
+  /* Fetch embedded options. */

   if (!(flags&AF_NOEMBED)) handle_embedded_args(script);
   if (!(flags&AF_NOEMBED)) handle_embedded_args(script);

+
+  /* Load default configuration if no explicit files were requested. */

   if (!(flags&AF_SETCONF)) load_default_config();
   if (!(flags&AF_SETCONF)) load_default_config();

-  if (verbose >= 5) dump_config();

 
 

-  dstr_reset(&d);
-  var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
-  config_subst_var(&config, toplevel, var, &d);
-  add_lispsys(d.p, "preferred", &prefer, LF_PREFER,
-             offsetof(struct lispsys, next_prefer));
+  /* Determine the preferred Lisp systems.  Check the environment first;
+   * otherwise use the configuration file.
+   */
+  p = my_getenv("RUNLISP_PREFER", 0);
+  if (!p) {
+    var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
+    if (var) {
+      dstr_reset(&d);
+      config_subst_var(&config, toplevel, var, &d); p = d.p;
+    }
+  }
+  if (p)
+    add_lispsys(p, "preferred", &prefer, LF_PREFER,
+               offsetof(struct lispsys, next_prefer));

 
 

+  /* If we're in eval mode, then find the `eval.lisp' script. */

   if (!script)
   if (!script)

-    script = config_subst_string_alloc
-      (&config, common, "<internal>",
-       "${@ENV:RUNLISP_EVAL?${@CONFIG:data-dir}/eval.lisp}");
-
+    script = config_subst_string_alloc(&config, common, "<internal>",
+                                      "${@ENV:RUNLISP_EVAL?"
+                                        "${@CONFIG:eval-script?"
+                                          "${@data-dir}/eval.lisp}}");
+
+  /* We now have the script name, so publish it for `uiop'.
+   *
+   * As an aside, this is a terrible interface.  It's too easy to forget to
+   * set it.  (To illustrate this, `cl-launch -x' indeed forgets to set it.)
+   * If you're lucky, the script just thinks that its argument is `nil', in
+   * which case maybe it can use `*load-pathname*' as a fallback.  If you're
+   * unlucky, your script was invoked (possibly indirectly) by another
+   * script, and now you've accidentally inherited the calling script's name.
+   *
+   * It would have been far better simply to repeat the script name as the
+   * first user argument, if nothing else had come readily to mind.
+   */

   if (setenv("__CL_ARGV0", script, 1))
     lose("failed to set script-name environment variable");
   if (setenv("__CL_ARGV0", script, 1))
     lose("failed to set script-name environment variable");

-  config_set_var(&config, builtin, CF_LITERAL, "@SCRIPT", script);

 
 

+  /* And publish it in the configuration for the `run-script' commands. */
+  config_set_var(&config, builtin, CF_LITERAL, "@script", script);
+
+  /* Dump the final configuration if we're being very verbose. */
+  if (verbose >= 5) dump_config();
+
+  /* Identify the configuration sections which correspond to actual Lisp
+   * system definitions, and gather them into the `known' list.
+   */

   tail = lisps.tail;
   for (config_start_section_iter(&config, &si);
        (sect = config_next_section(&si)); ) {
   tail = lisps.tail;
   for (config_start_section_iter(&config, &si);
        (sect = config_next_section(&si)); ) {


@@ -392,9 +543,10 @@ int main(int argc, char *argv[])
   }
   *tail = 0; lisps.tail = tail;
 
   }
   *tail = 0; lisps.tail = tail;
 

-  check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept));
+  /* Make sure that the preferred Lisps actually exist. */

   check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer));
 
   check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer));
 

+  /* If there are no acceptable Lisps, then we'll take all of them. */

   if (!accept.head) {
     if (verbose >= 2)
       moan("no explicitly acceptable implementations: allowing all");
   if (!accept.head) {
     if (verbose >= 2)
       moan("no explicitly acceptable implementations: allowing all");


@@ -404,13 +556,19 @@ int main(int argc, char *argv[])
     *tail = 0; accept.tail = tail;
   }
 
     *tail = 0; accept.tail = tail;
   }
 

+  /* Build the final list of Lisp systems in the order in which we'll try
+   * them: first, preferred Lisps which are acceptable, and then acceptable
+   * Lisps which are known but not preferred.
+   */

   tail = &order.head;
   for (lisp = prefer.head; lisp; lisp = lisp->next_prefer)
     if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; }
   for (lisp = accept.head; lisp; lisp = lisp->next_accept)
   tail = &order.head;
   for (lisp = prefer.head; lisp; lisp = lisp->next_prefer)
     if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; }
   for (lisp = accept.head; lisp; lisp = lisp->next_accept)

-    if (!(lisp->f&LF_PREFER)) { *tail = lisp; tail = &lisp->next_order; }
+    if ((lisp->f&LF_KNOWN) && !(lisp->f&LF_PREFER))
+      { *tail = lisp; tail = &lisp->next_order; }

   *tail = 0;
 
   *tail = 0;
 

+  /* Maybe dump out the various lists of Lisp systems we've collected. */

   if (verbose >= 4)
     dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp));
   if (verbose >= 3) {
   if (verbose >= 4)
     dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp));
   if (verbose >= 3) {


@@ -422,26 +580,43 @@ int main(int argc, char *argv[])
               offsetof(struct lispsys, next_order));
   }
 
               offsetof(struct lispsys, next_order));
   }
 

+  /* Try to actually run the script. */

   for (lisp = order.head; lisp; lisp = lisp->next_order) {
   for (lisp = order.head; lisp; lisp = lisp->next_order) {

-    if (config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
+    /* Try each of the selected systems in turn. */
+
+    /* See whether there's a custom image file.  If so, set `@image' in the
+     * system's configuration section.
+     */
+    if (!(flags&AF_VANILLA) &&
+       config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {

       var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path");
       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))
       dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d);
       if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0))

-       config_set_var(&config, lisp->sect, CF_LITERAL, "@IMAGE", "t");
+       config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t");

     }
     }

+
+    /* Build the command line from `run-script'. */

     argv_reset(&av);
     config_subst_split_var(&config, lisp->sect, lisp->var, &av);
     if (!av.n) {
       moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp));
       continue;
     }
     argv_reset(&av);
     config_subst_split_var(&config, lisp->sect, lisp->var, &av);
     if (!av.n) {
       moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp));
       continue;
     }

-    argv_appendn(&av, (const char *const *)argv, argc);
+
+    /* Append our additional positional arguments. */
+    argv_appendn(&av, argv, argc);
+
+    /* Try to run the Lisp system. */

     if (!try_exec(&av,
                  (flags&AF_DRYRUN ? TEF_DRYRUN : 0) |
                    (verbose >= 2 ? TEF_VERBOSE : 0)))
       return (0);
   }
 
     if (!try_exec(&av,
                  (flags&AF_DRYRUN ? TEF_DRYRUN : 0) |
                    (verbose >= 2 ? TEF_VERBOSE : 0)))
       return (0);
   }
 

+  /* No.  Much errors.  So failure.  Very sadness. */

   lose("no acceptable Lisp systems found");
 }
 
   lose("no acceptable Lisp systems found");
 }