chiark - git - mdw - runlisp/blob - runlisp.c

   1 /* -*-c-*-
   2  *
   3  * Invoke Lisp scripts and implementations
   4  *
   5  * (c) 2020 Mark Wooding
   6  */
   7
   8 /*----- Licensing notice --------------------------------------------------*
   9  *
  10  * This file is part of Runlisp, a tool for invoking Common Lisp scripts.
  11  *
  12  * Runlisp is free software: you can redistribute it and/or modify it
  13  * under the terms of the GNU General Public License as published by the
  14  * Free Software Foundation; either version 3 of the License, or (at your
  15  * option) any later version.
  16  *
  17  * Runlisp is distributed in the hope that it will be useful, but WITHOUT
  18  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  19  * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  20  * for more details.
  21  *
  22  * You should have received a copy of the GNU General Public License
  23  * along with Runlisp.  If not, see <https://www.gnu.org/licenses/>.
  24  */
  25
  26 /*----- Header files ------------------------------------------------------*/
  27
  28 #include "config.h"
  29
  30 #include <ctype.h>
  31 #include <errno.h>
  32 #include <stdio.h>
  33 #include <stdlib.h>
  34 #include <string.h>
  35
  36 #include "common.h"
  37 #include "lib.h"
  38 #include "mdwopt.h"
  39
  40 /*----- Static data -------------------------------------------------------*/
  41
  42 /* The state we need for a Lisp system. */
  43 struct lispsys {
  44   struct treap_node _node;              /* treap intrusion */
  45   struct lispsys *next_lisp,            /* link in all-Lisps list */
  46     *next_accept,                       /* link acceptable-Lisps list */
  47     *next_prefer,                       /* link in preferred-Lisps list */
  48     *next_order;                        /* link in overall-order list */
  49   unsigned f;                           /* flags */
  50 #define LF_KNOWN 1u                     /*   this is actually a Lisp */
  51 #define LF_ACCEPT 2u                    /*   this is an acceptable Lisp */
  52 #define LF_PREFER 4u                    /*   this is a preferred Lisp */
  53   struct config_section *sect;          /* configuration section */
  54   struct config_var *var;               /* `run-script variable */
  55 };
  56 #define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp)
  57 #define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp)
  58
  59 /* Pick out a link from a `struct lispsys' object given its offset. */
  60 #define LISP_LINK(lisp, linkoff)                                        \
  61         ((struct lispsys **)((unsigned char *)(lisp) + (linkoff)))
  62
  63 /* A list of Lisp systems. */
  64 struct lispsys_list {
  65   struct lispsys *head, **tail;         /* list head and tail */
  66 };
  67
  68 static struct argv argv_tail = ARGV_INIT; /* accumulates eval-mode args */
  69 struct treap lispsys = TREAP_INIT;      /* track duplicate Lisp systems */
  70 static struct lispsys_list              /* lists of Lisp systems */
  71   lisps = { 0, &lisps.head },           /*   all known */
  72   accept = { 0, &accept.head },         /*   acceptable */
  73   prefer = { 0, &prefer.head };         /*   preferred */
  74
  75 static unsigned flags = 0;              /* flags for the application */
  76 #define AF_CMDLINE 0x0000u              /*   options are from command-line */
  77 #define AF_EMBED 0x0001u                /*   reading embedded options */
  78 #define AF_STATEMASK 0x000fu            /*   mask of option origin codes */
  79 #define AF_BOGUS 0x0010u                /*   invalid command-line syntax */
  80 #define AF_SETCONF 0x0020u              /*   explicit configuration */
  81 #define AF_NOEMBED 0x0040u              /*   don't read embedded options */
  82 #define AF_DRYRUN 0x0080u               /*   don't actually do it */
  83 #define AF_VANILLA 0x0100u              /*   don't use custom images */
  84
  85 /*----- Main code ---------------------------------------------------------*/
  86
  87 /* Return the `struct lispsys' entry for the given N-byte NAME. */
  88 static struct lispsys *ensure_lispsys(const char *name, size_t n)
  89 {
  90   struct lispsys *lisp;
  91   struct treap_path path;
  92
  93   lisp = treap_probe(&lispsys, name, n, &path);
  94   if (!lisp) {
  95     lisp = xmalloc(sizeof(*lisp));
  96     lisp->f = 0; lisp->sect = 0;
  97     treap_insert(&lispsys, &path, &lisp->_node, name, n);
  98   }
  99   return (lisp);
 100 }
 101
 102 /* Add Lisp systems from the comma- or space-sparated list P to LIST.
 103  *
 104  * WHAT is an adjective describing the list flavour; FLAG is a bit to set in
 105  * the node's flags word; LINKOFF is the offset of the list's link member.
 106  */
 107 static void add_lispsys(const char *p, const char *what,
 108                         struct lispsys_list *list,
 109                         unsigned flag, size_t linkoff)
 110 {
 111   struct lispsys *lisp, **link;
 112   const char *q;
 113
 114   if (!*p) return;
 115   for (;;) {
 116     while (ISSPACE(*p)) p++;
 117     if (!*p) break;
 118     q = p; while (*p && !ISSPACE(*p) && *p != ',') p++;
 119     lisp = ensure_lispsys(q, p - q);
 120     if (lisp->f&flag) {
 121       if (verbose >= 1)
 122         moan("ignoring duplicate %s Lisp `%.*s'", what, (int)(p - q), q);
 123     } else {
 124       link = LISP_LINK(lisp, linkoff);
 125       lisp->f |= flag; *link = 0;
 126       *list->tail = lisp; list->tail = link;
 127     }
 128     while (ISSPACE(*p)) p++;
 129     if (!*p) break;
 130     if (*p == ',') p++;
 131   }
 132 }
 133
 134 /* Check that the Lisp systems on LIST (linked through LINKOFF) are real.
 135  *
 136  * That is, `LF_KNOWN' is set in their flags.
 137  */
 138 static void check_lisps(const char *what,
 139                         struct lispsys_list *list, size_t linkoff)
 140 {
 141   struct lispsys *lisp;
 142
 143   for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff))
 144     if (!(lisp->f&LF_KNOWN))
 145       lose("unknown Lisp implementation `%s'", LISPSYS_NAME(lisp));
 146 }
 147
 148 /* Dump the names of the Lisp systems on LIST (linked through LINKOFF).
 149  *
 150  * WHAT is an adjective describing the list.
 151  */
 152 static void dump_lisps(const char *what,
 153                        struct lispsys_list *list, size_t linkoff)
 154 {
 155   struct dstr d = DSTR_INIT;
 156   struct lispsys *lisp;
 157   int first;
 158
 159   first = 1;
 160   for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) {
 161     if (first) first = 0;
 162     else dstr_puts(&d, ", ");
 163     dstr_puts(&d, LISPSYS_NAME(lisp));
 164   }
 165   if (first) dstr_puts(&d, "(none)");
 166   dstr_putz(&d);
 167   moan("%s: %s", what, d.p);
 168   dstr_release(&d);
 169 }
 170
 171 /* Add an eval-mode operation to the `argv_tail' vector.
 172  *
 173  * OP is the operation character (see `eval.lisp' for these) and `val' is the
 174  * argument (filename or expression).
 175  */
 176 static void push_eval_op(char op, const char *val)
 177 {
 178   char *p;
 179   size_t n;
 180
 181   if ((flags&AF_STATEMASK) != AF_CMDLINE) {
 182     moan("must use `-e', `-p', or `-l' on command line");
 183     flags |= AF_BOGUS;
 184     return;
 185   }
 186
 187   n = strlen(val) + 1;
 188   p = xmalloc(n + 1);
 189   p[0] = op; memcpy(p + 1, val, n);
 190   argv_append(&argv_tail, p);
 191 }
 192
 193 /* Help and related functions. */
 194 static void version(FILE *fp)
 195   { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
 196
 197 static void usage(FILE *fp)
 198 {
 199   fprintf(fp, "\
 200 usage:\n\
 201         %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\
 202         %s [OPTIONS] [-e EXPR] [-d EXPR] [-p EXPR] [-l FILE]\n\
 203                 [--] [ARGUMENTS ...]\n\
 204 OPTIONS:\n\
 205         [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n",
 206           progname, progname);
 207 }
 208
 209 static void help(FILE *fp)
 210 {
 211   version(fp); fputc('\n', fp); usage(fp);
 212   fputs("\n\
 213 Help options:\n\
 214   -h, --help                    Show this help text and exit successfully.\n\
 215   -V, --version                 Show version number and exit successfully.\n\
 216 \n\
 217 Diagnostics:\n\
 218   -n, --dry-run                 Don't run run anything (useful with `-v').\n\
 219   -q, --quiet                   Don't print warning messages.\n\
 220   -v, --verbose                 Print informational messages (repeatable).\n\
 221 \n\
 222 Configuration:\n\
 223   -E, --command-line-only       Don't read embedded options from script.\n\
 224   -c, --config-file=CONF        Read configuration from CONF (repeatable).\n\
 225   -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
 226 \n\
 227 Lisp implementation selection:\n\
 228   -D, --vanilla-image           Run vanilla Lisp images, not custom ones.\n\
 229   -L, --accept-lisp=SYS,SYS,... Only use the listed Lisp systems.\n\
 230 \n\
 231 Evaluation mode:\n\
 232   -d, --dump-expression=EXPR    Print (`prin1') EXPR (repeatable).\n\
 233   -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\
 234   -l, --load-file=FILE          Load FILE (repeatable).\n\
 235   -p, --print-expression=EXPR   Print (`princ') EXPR (repeatable).\n",
 236         fp);
 237 }
 238
 239 /* Complain about options which aren't permitted as embedded options. */
 240 static void check_command_line(int ch)
 241 {
 242   if ((flags&AF_STATEMASK) != AF_CMDLINE) {
 243     moan("`%c%c' is not permitted as embedded option",
 244          ch&OPTF_NEGATED ? '+' : '-',
 245          ch&~OPTF_NEGATED);
 246     flags |= AF_BOGUS;
 247   }
 248 }
 249
 250 /* Parse the options in the argument vector. */
 251 static void parse_options(int argc, char *argv[])
 252 {
 253   int i;
 254
 255   static const struct option opts[] = {
 256     { "help",                   0,              0,      'h' },
 257     { "version",                0,              0,      'V' },
 258     { "vanilla-image",          OPTF_NEGATE,    0,      'D' },
 259     { "command-line-only",      OPTF_NEGATE,    0,      'E' },
 260     { "accept-lisp",            OPTF_ARGREQ,    0,      'L' },
 261     { "config-file",            OPTF_ARGREQ,    0,      'c' },
 262     { "dump-expression",        OPTF_ARGREQ,    0,      'd' },
 263     { "evaluate-expression",    OPTF_ARGREQ,    0,      'e' },
 264     { "load-file",              OPTF_ARGREQ,    0,      'l' },
 265     { "dry-run",                OPTF_NEGATE,    0,      'n' },
 266     { "set-option",             OPTF_ARGREQ,    0,      'o' },
 267     { "print-expression",       OPTF_ARGREQ,    0,      'p' },
 268     { "quiet",                  0,              0,      'q' },
 269     { "verbose",                0,              0,      'v' },
 270     { 0,                        0,              0,      0 }
 271   };
 272
 273 #define FLAGOPT(ch, f, extra)                                           \
 274   case ch:                                                              \
 275     extra                                                               \
 276     flags |= f;                                                         \
 277     break;                                                              \
 278   case ch | OPTF_NEGATED:                                               \
 279     extra                                                               \
 280     flags &= ~f;                                                        \
 281     break
 282 #define CMDL do { check_command_line(i); } while (0)
 283
 284   optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname;
 285   for (;;) {
 286     i = mdwopt(argc, argv, "+hVD+E+L:c:d:e:l:n+o:p:qv", opts, 0, 0,
 287                OPTF_NEGATION | OPTF_NOPROGNAME);
 288     if (i < 0) break;
 289     switch (i) {
 290       case 'h': CMDL; help(stdout); exit(0);
 291       case 'V': CMDL; version(stdout); exit(0);
 292       FLAGOPT('D', AF_VANILLA, ; );
 293       FLAGOPT('E', AF_NOEMBED, { CMDL; });
 294       case 'L':
 295         add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT,
 296                     offsetof(struct lispsys, next_accept));
 297         break;
 298       case 'c': CMDL; read_config_path(optarg, 0); flags |= AF_SETCONF; break;
 299       case 'd': CMDL; push_eval_op('?', optarg); break;
 300       case 'e': CMDL; push_eval_op('!', optarg); break;
 301       case 'l': CMDL; push_eval_op('<', optarg); break;
 302       FLAGOPT('n', AF_DRYRUN, { CMDL; });
 303       case 'o': CMDL; if (set_config_var(optarg)) flags |= AF_BOGUS; break;
 304       case 'p': CMDL; push_eval_op('=', optarg); break;
 305       case 'q': CMDL; if (verbose) verbose--; break;
 306       case 'v': CMDL; verbose++; break;
 307       default: flags |= AF_BOGUS; break;
 308     }
 309   }
 310
 311 #undef FLAGOPT
 312 #undef CMDL
 313 }
 314
 315 /* Extract and process the embedded options from a SCRIPT. */
 316 static void handle_embedded_args(const char *script)
 317 {
 318   struct dstr d = DSTR_INIT;
 319   struct argv av = ARGV_INIT;
 320   char *p, *q, *r; const char *l;
 321   size_t n;
 322   int qstate = 0;
 323   FILE *fp = 0;
 324
 325   /* Open the script.  If this doesn't work, then we have no hope. */
 326   fp = fopen(script, "r");
 327   if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
 328
 329   /* Read the second line. */
 330   if (dstr_readline(&d, fp)) goto end;
 331   dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
 332
 333   /* Check to find the magic marker. */
 334   p = strstr(d.p, "@RUNLISP:"); if (!p) goto end;
 335   p += 9; q = p; l = d.p + d.len;
 336
 337   /* Split the line into words.
 338    *
 339    * Do this by hand because we have strange things to support, such as Emacs
 340    * turds and the early `--' exit.
 341    *
 342    * We work in place: `p' is the input cursor and advances through the
 343    * string as we parse, until it meets the limit pointer `l'; `q' is the
 344    * output cursor which will always be no further forward than `p'.
 345    */
 346   for (;;) {
 347     /* Iterate over the words. */
 348
 349     /* Skip spaces. */
 350     while (p < l && ISSPACE(*p)) p++;
 351
 352     /* If we've reached the end then we're done. */
 353     if (p >= l) break;
 354
 355     /* Check for an Emacs local-variables `-*-' turd.
 356      *
 357      * If we find one, find the matching end marker and move past it.
 358      */
 359     if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') {
 360       p = strstr(p + 3, "-*-");
 361       if (!p || p + 3 > l)
 362         lose("%s:2: unfinished local-variables list", script);
 363       p += 3;
 364       continue;
 365     }
 366
 367     /* If we find a `--' marker then stop immediately. */
 368     if (l - p >= 2 && p[0] == '-' && p[1] == '-' &&
 369         (l == p + 2 || ISSPACE(p[2])))
 370       break;
 371
 372     /* Push the output cursor position onto the output, because this is where
 373      * the next word will start.
 374      */
 375     argv_append(&av, q);
 376
 377     /* Collect characters until we find an unquoted space. */
 378     while (p < l && (qstate || !ISSPACE(*p))) {
 379
 380       if (*p == '"')
 381         /* A quote.  Skip past, and toggle quotedness. */
 382
 383         { p++; qstate = !qstate; }
 384
 385       else if (*p == '\\') {
 386         /* A backslash.  Just emit the following character. */
 387
 388         p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script);
 389         *q++ = *p++;
 390
 391       } else if (*p == '\'') {
 392         /* A single quote.  Find its matching end quote, and emit everything
 393          * in between.
 394          */
 395
 396         p++; r = strchr(p, '\'');
 397         if (!r || r > l) lose("%s:2: missing `''", script);
 398         n = r - p; memmove(q, p, n); q += n; p = r + 1;
 399
 400       } else {
 401         /* An ordinary constituent.  Gather a bunch of these up and emit them
 402          * all.
 403          */
 404         n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v");
 405         if (n > l - p) n = l - p;
 406         memmove(q, p, n); q += n; p += n;
 407       }
 408     }
 409
 410     /* Check that we're not still inside quotes. */
 411     if (qstate) lose("%s:2: missing `\"'", script);
 412
 413     /* Finish off this word and prepare to start the next. */
 414     *q++ = 0; if (p < l) p++;
 415   }
 416
 417   /* Parse the arguments we've collected as options.  Object if we find
 418    * positional arguments.
 419    */
 420   flags = (flags&~AF_STATEMASK) | AF_EMBED;
 421   parse_options(av.n, (char * /*unconst*/*)av.v);
 422   if (optind < av.n)
 423     lose("%s:2: positional argument `%s' not permitted here",
 424          script, av.v[optind]);
 425
 426 end:
 427   /* Tidy up. */
 428   if (fp) {
 429     if (ferror(fp))
 430       lose("error reading script `%s': %s", script, strerror(errno));
 431     fclose(fp);
 432   }
 433   dstr_release(&d); argv_release(&av);
 434 }
 435
 436 /* Main program. */
 437 int main(int argc, char *argv[])
 438 {
 439   struct config_section_iter si;
 440   struct config_section *sect;
 441   struct config_var *var;
 442   struct lispsys_list order;
 443   struct lispsys *lisp, **tail;
 444   const char *p;
 445   const char *script;
 446   struct dstr d = DSTR_INIT;
 447   struct argv av = ARGV_INIT;
 448
 449   /* initial setup. */
 450   set_progname(argv[0]);
 451   init_config();
 452
 453   /* Parse the command-line options. */
 454   flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
 455   parse_options(argc - 1, argv + 1); optind++;
 456
 457   /* We now know enough to decide whether we're in eval or script mode.  In
 458    * the former case, don't check for embedded options (it won't work because
 459    * we don't know where the `eval.lisp' script is yet, and besides, there
 460    * aren't any).  In the latter case, pick out the script name, leaving the
 461    * remaining positional arguments for later.
 462    */
 463   if (argv_tail.n) { flags |= AF_NOEMBED; script = 0; }
 464   else if (optind < argc) script = argv[optind++];
 465   else flags |= AF_BOGUS;
 466
 467   /* Check that everything worked. */
 468   if (flags&AF_BOGUS) { usage(stderr); exit(127); }
 469
 470   /* Reestablish ARGC/ARGV to refer to the tail of positional arguments to be
 471    * passed onto the eventual script.  For eval mode, that includes the
 472    * operations already queued up, so we'll have to accumulate everything in
 473    * `argv_tail'.
 474    */
 475   argc -= optind; argv += optind;
 476   if (argv_tail.n) {
 477     argv_append(&argv_tail, "--");
 478     argv_appendn(&argv_tail, argv, argc);
 479     argc = argv_tail.n; argv = argv_tail.v;
 480   }
 481
 482   /* Fetch embedded options. */
 483   if (!(flags&AF_NOEMBED)) handle_embedded_args(script);
 484
 485   /* Load default configuration if no explicit files were requested. */
 486   if (!(flags&AF_SETCONF)) load_default_config();
 487
 488   /* Determine the preferred Lisp systems.  Check the environment first;
 489    * otherwise use the configuration file.
 490    */
 491   p = my_getenv("RUNLISP_PREFER", 0);
 492   if (!p) {
 493     var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
 494     if (var) {
 495       dstr_reset(&d);
 496       config_subst_var(&config, toplevel, var, &d); p = d.p;
 497     }
 498   }
 499   if (p)
 500     add_lispsys(p, "preferred", &prefer, LF_PREFER,
 501                 offsetof(struct lispsys, next_prefer));
 502
 503   /* If we're in eval mode, then find the `eval.lisp' script. */
 504   if (!script)
 505     script = config_subst_string_alloc(&config, common, "<internal>",
 506                                        "${@ENV:RUNLISP_EVAL?"
 507                                          "${@CONFIG:eval-script?"
 508                                            "${@data-dir}/eval.lisp}}");
 509
 510   /* We now have the script name, so publish it for `uiop'.
 511    *
 512    * As an aside, this is a terrible interface.  It's too easy to forget to
 513    * set it.  (To illustrate this, `cl-launch -x' indeed forgets to set it.)
 514    * If you're lucky, the script just thinks that its argument is `nil', in
 515    * which case maybe it can use `*load-pathname*' as a fallback.  If you're
 516    * unlucky, your script was invoked (possibly indirectly) by another
 517    * script, and now you've accidentally inherited the calling script's name.
 518    *
 519    * It would have been far better simply to repeat the script name as the
 520    * first user argument, if nothing else had come readily to mind.
 521    */
 522   if (setenv("__CL_ARGV0", script, 1))
 523     lose("failed to set script-name environment variable");
 524
 525   /* And publish it in the configuration for the `run-script' commands. */
 526   config_set_var(&config, builtin, CF_LITERAL, "@script", script);
 527
 528   /* Dump the final configuration if we're being very verbose. */
 529   if (verbose >= 5) dump_config();
 530
 531   /* Identify the configuration sections which correspond to actual Lisp
 532    * system definitions, and gather them into the `known' list.
 533    */
 534   tail = lisps.tail;
 535   for (config_start_section_iter(&config, &si);
 536        (sect = config_next_section(&si)); ) {
 537     var = config_find_var(&config, sect, CF_INHERIT, "run-script");
 538     if (!var) continue;
 539     lisp = ensure_lispsys(CONFIG_SECTION_NAME(sect),
 540                           CONFIG_SECTION_NAMELEN(sect));
 541     lisp->f |= LF_KNOWN; lisp->sect = sect; lisp->var = var;
 542     *tail = lisp; tail = &lisp->next_lisp;
 543   }
 544   *tail = 0; lisps.tail = tail;
 545
 546   /* Make sure that the acceptable and preferred Lisps actually exist. */
 547   check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept));
 548   check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer));
 549
 550   /* If there are no acceptable Lisps, then we'll take all of them. */
 551   if (!accept.head) {
 552     if (verbose >= 2)
 553       moan("no explicitly acceptable implementations: allowing all");
 554     tail = accept.tail;
 555     for (lisp = lisps.head; lisp; lisp = lisp->next_lisp)
 556       { lisp->f |= LF_ACCEPT; *tail = lisp; tail = &lisp->next_accept; }
 557     *tail = 0; accept.tail = tail;
 558   }
 559
 560   /* Build the final list of Lisp systems in the order in which we'll try
 561    * them: first, preferred Lisps which are acceptable, and then acceptable
 562    * Lisps which aren't preferred.
 563    */
 564   tail = &order.head;
 565   for (lisp = prefer.head; lisp; lisp = lisp->next_prefer)
 566     if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; }
 567   for (lisp = accept.head; lisp; lisp = lisp->next_accept)
 568     if (!(lisp->f&LF_PREFER)) { *tail = lisp; tail = &lisp->next_order; }
 569   *tail = 0;
 570
 571   /* Maybe dump out the various lists of Lisp systems we've collected. */
 572   if (verbose >= 4)
 573     dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp));
 574   if (verbose >= 3) {
 575     dump_lisps("acceptable Lisps", &accept,
 576                offsetof(struct lispsys, next_accept));
 577     dump_lisps("preferred Lisps", &prefer,
 578                offsetof(struct lispsys, next_prefer));
 579     dump_lisps("overall preference order", &order,
 580                offsetof(struct lispsys, next_order));
 581   }
 582
 583   /* Try to actually run the script. */
 584   for (lisp = order.head; lisp; lisp = lisp->next_order) {
 585     /* Try each of the selected systems in turn. */
 586
 587     /* See whether there's a custom image file.  If so, set `@image' in the
 588      * system's configuration section.
 589      */
 590     if (!(flags&AF_VANILLA) &&
 591         config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
 592       var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path");
 593       if (!var)
 594         lose("variable `image-path' not defined for Lisp `%s'",
 595              LISPSYS_NAME(lisp));
 596       dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d);
 597       if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0))
 598         config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t");
 599     }
 600
 601     /* Build the command line from `run-script'. */
 602     argv_reset(&av);
 603     config_subst_split_var(&config, lisp->sect, lisp->var, &av);
 604     if (!av.n) {
 605       moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp));
 606       continue;
 607     }
 608
 609     /* Append our additional positional arguments. */
 610     argv_appendn(&av, argv, argc);
 611
 612     /* Try to run the Lisp system. */
 613     if (!try_exec(&av,
 614                   (flags&AF_DRYRUN ? TEF_DRYRUN : 0) |
 615                     (verbose >= 2 ? TEF_VERBOSE : 0)))
 616       return (0);
 617   }
 618
 619   /* No.  Much errors.  So failure.  Very sadness. */
 620   lose("no acceptable Lisp systems found");
 621 }
 622
 623 /*----- That's all, folks -------------------------------------------------*/