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] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n\
 203 OPTIONS:\n\
 204         [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n",
 205           progname, progname);
 206 }
 207
 208 static void help(FILE *fp)
 209 {
 210   version(fp); fputc('\n', fp); usage(fp);
 211   fputs("\n\
 212 Help options:\n\
 213   -h, --help                    Show this help text and exit successfully.\n\
 214   -V, --version                 Show version number and exit successfully.\n\
 215 \n\
 216 Diagnostics:\n\
 217   -n, --dry-run                 Don't run run anything (useful with `-v').\n\
 218   -q, --quiet                   Don't print warning messages.\n\
 219   -v, --verbose                 Print informational messages (repeatable).\n\
 220 \n\
 221 Configuration:\n\
 222   -E, --command-line-only       Don't read embedded options from script.\n\
 223   -c, --config-file=CONF        Read configuration from CONF (repeatable).\n\
 224   -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\
 225 \n\
 226 Lisp implementation selection:\n\
 227   -D, --vanilla-image           Run vanilla Lisp images, not custom ones.\n\
 228   -L, --accept-lisp=SYS,SYS,... Only use the listed Lisp systems.\n\
 229 \n\
 230 Evaluation mode:\n\
 231   -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\
 232   -l, --load-file=FILE          Load FILE (repeatable).\n\
 233   -p, --print-expression=EXPR   Print (`prin1') EXPR (repeatable).\n",
 234         fp);
 235 }
 236
 237 /* Complain about options which aren't permitted as embedded options. */
 238 static void check_command_line(int ch)
 239 {
 240   if ((flags&AF_STATEMASK) != AF_CMDLINE) {
 241     moan("`%c%c' is not permitted as embedded option",
 242          ch&OPTF_NEGATED ? '+' : '-',
 243          ch&~OPTF_NEGATED);
 244     flags |= AF_BOGUS;
 245   }
 246 }
 247
 248 /* Parse the options in the argument vector. */
 249 static void parse_options(int argc, char *argv[])
 250 {
 251   int i;
 252
 253   static const struct option opts[] = {
 254     { "help",                   0,              0,      'h' },
 255     { "version",                0,              0,      'V' },
 256     { "vanilla-image",          OPTF_NEGATE,    0,      'D' },
 257     { "command-line-only",      OPTF_NEGATE,    0,      'E' },
 258     { "accept-lisp",            OPTF_ARGREQ,    0,      'L' },
 259     { "config-file",            OPTF_ARGREQ,    0,      'c' },
 260     { "evaluate-expression",    OPTF_ARGREQ,    0,      'e' },
 261     { "load-file",              OPTF_ARGREQ,    0,      'l' },
 262     { "dry-run",                OPTF_NEGATE,    0,      'n' },
 263     { "set-option",             OPTF_ARGREQ,    0,      'o' },
 264     { "print-expression",       OPTF_ARGREQ,    0,      'p' },
 265     { "quiet",                  0,              0,      'q' },
 266     { "verbose",                0,              0,      'v' },
 267     { 0,                        0,              0,      0 }
 268   };
 269
 270 #define FLAGOPT(ch, f, extra)                                           \
 271   case ch:                                                              \
 272     extra                                                               \
 273     flags |= f;                                                         \
 274     break;                                                              \
 275   case ch | OPTF_NEGATED:                                               \
 276     extra                                                               \
 277     flags &= ~f;                                                        \
 278     break
 279 #define CMDL do { check_command_line(i); } while (0)
 280
 281   optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname;
 282   for (;;) {
 283     i = mdwopt(argc, argv, "+hVD+E+L:c:e:l:n+o:p:qv", opts, 0, 0,
 284                OPTF_NEGATION | OPTF_NOPROGNAME);
 285     if (i < 0) break;
 286     switch (i) {
 287       case 'h': CMDL; help(stdout); exit(0);
 288       case 'V': CMDL; version(stdout); exit(0);
 289       FLAGOPT('D', AF_VANILLA, ; );
 290       FLAGOPT('E', AF_NOEMBED, { CMDL; });
 291       case 'L':
 292         add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT,
 293                     offsetof(struct lispsys, next_accept));
 294         break;
 295       case 'c': CMDL; read_config_path(optarg, 0); flags |= AF_SETCONF; break;
 296       case 'e': CMDL; push_eval_op('!', optarg); break;
 297       case 'l': CMDL; push_eval_op('<', optarg); break;
 298       FLAGOPT('n', AF_DRYRUN, { CMDL; });
 299       case 'o': CMDL; if (set_config_var(optarg)) flags |= AF_BOGUS; break;
 300       case 'p': CMDL; push_eval_op('?', optarg); break;
 301       case 'q': CMDL; if (verbose) verbose--; break;
 302       case 'v': CMDL; verbose++; break;
 303       default: flags |= AF_BOGUS; break;
 304     }
 305   }
 306
 307 #undef FLAGOPT
 308 #undef CMDL
 309 }
 310
 311 /* Extract and process the embedded options from a SCRIPT. */
 312 static void handle_embedded_args(const char *script)
 313 {
 314   struct dstr d = DSTR_INIT;
 315   struct argv av = ARGV_INIT;
 316   char *p, *q, *r; const char *l;
 317   size_t n;
 318   int qstate = 0;
 319   FILE *fp = 0;
 320
 321   /* Open the script.  If this doesn't work, then we have no hope. */
 322   fp = fopen(script, "r");
 323   if (!fp) lose("can't read script `%s': %s", script, strerror(errno));
 324
 325   /* Read the second line. */
 326   if (dstr_readline(&d, fp)) goto end;
 327   dstr_reset(&d); if (dstr_readline(&d, fp)) goto end;
 328
 329   /* Check to find the magic marker. */
 330   p = strstr(d.p, "@RUNLISP:"); if (!p) goto end;
 331   p += 9; q = p; l = d.p + d.len;
 332
 333   /* Split the line into words.
 334    *
 335    * Do this by hand because we have strange things to support, such as Emacs
 336    * turds and the early `--' exit.
 337    *
 338    * We work in place: `p' is the input cursor and advances through the
 339    * string as we parse, until it meets the limit pointer `l'; `q' is the
 340    * output cursor which will always be no further forward than `p'.
 341    */
 342   for (;;) {
 343     /* Iterate over the words. */
 344
 345     /* Skip spaces. */
 346     while (p < l && ISSPACE(*p)) p++;
 347
 348     /* If we've reached the end then we're done. */
 349     if (p >= l) break;
 350
 351     /* Check for an Emacs local-variables `-*-' turd.
 352      *
 353      * If we find one, find the matching end marker and move past it.
 354      */
 355     if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') {
 356       p = strstr(p + 3, "-*-");
 357       if (!p || p + 3 > l)
 358         lose("%s:2: unfinished local-variables list", script);
 359       p += 3;
 360       continue;
 361     }
 362
 363     /* If we find a `--' marker then stop immediately. */
 364     if (l - p >= 2 && p[0] == '-' && p[1] == '-' &&
 365         (l == p + 2 || ISSPACE(p[2])))
 366       break;
 367
 368     /* Push the output cursor position onto the output, because this is where
 369      * the next word will start.
 370      */
 371     argv_append(&av, q);
 372
 373     /* Collect characters until we find an unquoted space. */
 374     while (p < l && (qstate || !ISSPACE(*p))) {
 375
 376       if (*p == '"')
 377         /* A quote.  Skip past, and toggle quotedness. */
 378
 379         { p++; qstate = !qstate; }
 380
 381       else if (*p == '\\') {
 382         /* A backslash.  Just emit the following character. */
 383
 384         p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script);
 385         *q++ = *p++;
 386
 387       } else if (*p == '\'') {
 388         /* A single quote.  Find its matching end quote, and emit everything
 389          * in between.
 390          */
 391
 392         p++; r = strchr(p, '\'');
 393         if (!r || r > l) lose("%s:2: missing `''", script);
 394         n = r - p; memmove(q, p, n); q += n; p = r + 1;
 395
 396       } else {
 397         /* An ordinary constituent.  Gather a bunch of these up and emit them
 398          * all.
 399          */
 400         n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v");
 401         if (n > l - p) n = l - p;
 402         memmove(q, p, n); q += n; p += n;
 403       }
 404     }
 405
 406     /* Check that we're not still inside quotes. */
 407     if (qstate) lose("%s:2: missing `\"'", script);
 408
 409     /* Finish off this word and prepare to start the next. */
 410     *q++ = 0; if (p < l) p++;
 411   }
 412
 413   /* Parse the arguments we've collected as options.  Object if we find
 414    * positional arguments.
 415    */
 416   flags = (flags&~AF_STATEMASK) | AF_EMBED;
 417   parse_options(av.n, (char * /*unconst*/*)av.v);
 418   if (optind < av.n)
 419     lose("%s:2: positional argument `%s' not permitted here",
 420          script, av.v[optind]);
 421
 422 end:
 423   /* Tidy up. */
 424   if (fp) {
 425     if (ferror(fp))
 426       lose("error reading script `%s': %s", script, strerror(errno));
 427     fclose(fp);
 428   }
 429   dstr_release(&d); argv_release(&av);
 430 }
 431
 432 /* Main program. */
 433 int main(int argc, char *argv[])
 434 {
 435   struct config_section_iter si;
 436   struct config_section *sect;
 437   struct config_var *var;
 438   struct lispsys_list order;
 439   struct lispsys *lisp, **tail;
 440   const char *p;
 441   const char *script;
 442   struct dstr d = DSTR_INIT;
 443   struct argv av = ARGV_INIT;
 444
 445   /* initial setup. */
 446   set_progname(argv[0]);
 447   init_config();
 448
 449   /* Parse the command-line options. */
 450   flags = (flags&~AF_STATEMASK) | AF_CMDLINE;
 451   parse_options(argc - 1, argv + 1); optind++;
 452
 453   /* We now know enough to decide whether we're in eval or script mode.  In
 454    * the former case, don't check for embedded options (it won't work because
 455    * we don't know where the `eval.lisp' script is yet, and besides, there
 456    * aren't any).  In the latter case, pick out the script name, leaving the
 457    * remaining positional arguments for later.
 458    */
 459   if (argv_tail.n) { flags |= AF_NOEMBED; script = 0; }
 460   else if (optind < argc) script = argv[optind++];
 461   else flags |= AF_BOGUS;
 462
 463   /* Check that everything worked. */
 464   if (flags&AF_BOGUS) { usage(stderr); exit(127); }
 465
 466   /* Reestablish ARGC/ARGV to refer to the tail of positional arguments to be
 467    * passed onto the eventual script.  For eval mode, that includes the
 468    * operations already queued up, so we'll have to accumulate everything in
 469    * `argv_tail'.
 470    */
 471   argc -= optind; argv += optind;
 472   if (argv_tail.n) {
 473     argv_append(&argv_tail, "--");
 474     argv_appendn(&argv_tail, argv, argc);
 475     argc = argv_tail.n; argv = argv_tail.v;
 476   }
 477
 478   /* Fetch embedded options. */
 479   if (!(flags&AF_NOEMBED)) handle_embedded_args(script);
 480
 481   /* Load default configuration if no explicit files were requested. */
 482   if (!(flags&AF_SETCONF)) load_default_config();
 483
 484   /* Determine the preferred Lisp systems.  Check the environment first;
 485    * otherwise use the configuration file.
 486    */
 487   p = my_getenv("RUNLISP_PREFER", 0);
 488   if (!p) {
 489     var = config_find_var(&config, toplevel, CF_INHERIT, "prefer");
 490     if (var) {
 491       dstr_reset(&d);
 492       config_subst_var(&config, toplevel, var, &d); p = d.p;
 493     }
 494   }
 495   if (p)
 496     add_lispsys(p, "preferred", &prefer, LF_PREFER,
 497                 offsetof(struct lispsys, next_prefer));
 498
 499   /* If we're in eval mode, then find the `eval.lisp' script. */
 500   if (!script)
 501     script = config_subst_string_alloc(&config, common, "<internal>",
 502                                        "${@ENV:RUNLISP_EVAL?"
 503                                          "${@CONFIG:eval-script?"
 504                                            "${@data-dir}/eval.lisp}}");
 505
 506   /* We now have the script name, so publish it for `uiop'.
 507    *
 508    * As an aside, this is a terrible interface.  It's too easy to forget to
 509    * set it.  (To illustrate this, `cl-launch -x' indeed forgets to set it.)
 510    * If you're lucky, the script just thinks that its argument is `nil', in
 511    * which case maybe it can use `*load-pathname*' as a fallback.  If you're
 512    * unlucky, your script was invoked (possibly indirectly) by another
 513    * script, and now you've accidentally inherited the calling script's name.
 514    *
 515    * It would have been far better simply to repeat the script name as the
 516    * first user argument, if nothing else had come readily to mind.
 517    */
 518   if (setenv("__CL_ARGV0", script, 1))
 519     lose("failed to set script-name environment variable");
 520
 521   /* And publish it in the configuration for the `run-script' commands. */
 522   config_set_var(&config, builtin, CF_LITERAL, "@script", script);
 523
 524   /* Dump the final configuration if we're being very verbose. */
 525   if (verbose >= 5) dump_config();
 526
 527   /* Identify the configuration sections which correspond to actual Lisp
 528    * system definitions, and gather them into the `known' list.
 529    */
 530   tail = lisps.tail;
 531   for (config_start_section_iter(&config, &si);
 532        (sect = config_next_section(&si)); ) {
 533     var = config_find_var(&config, sect, CF_INHERIT, "run-script");
 534     if (!var) continue;
 535     lisp = ensure_lispsys(CONFIG_SECTION_NAME(sect),
 536                           CONFIG_SECTION_NAMELEN(sect));
 537     lisp->f |= LF_KNOWN; lisp->sect = sect; lisp->var = var;
 538     *tail = lisp; tail = &lisp->next_lisp;
 539   }
 540   *tail = 0; lisps.tail = tail;
 541
 542   /* Make sure that the acceptable and preferred Lisps actually exist. */
 543   check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept));
 544   check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer));
 545
 546   /* If there are no acceptable Lisps, then we'll take all of them. */
 547   if (!accept.head) {
 548     if (verbose >= 2)
 549       moan("no explicitly acceptable implementations: allowing all");
 550     tail = accept.tail;
 551     for (lisp = lisps.head; lisp; lisp = lisp->next_lisp)
 552       { lisp->f |= LF_ACCEPT; *tail = lisp; tail = &lisp->next_accept; }
 553     *tail = 0; accept.tail = tail;
 554   }
 555
 556   /* Build the final list of Lisp systems in the order in which we'll try
 557    * them: first, preferred Lisps which are acceptable, and then acceptable
 558    * Lisps which aren't preferred.
 559    */
 560   tail = &order.head;
 561   for (lisp = prefer.head; lisp; lisp = lisp->next_prefer)
 562     if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; }
 563   for (lisp = accept.head; lisp; lisp = lisp->next_accept)
 564     if (!(lisp->f&LF_PREFER)) { *tail = lisp; tail = &lisp->next_order; }
 565   *tail = 0;
 566
 567   /* Maybe dump out the various lists of Lisp systems we've collected. */
 568   if (verbose >= 4)
 569     dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp));
 570   if (verbose >= 3) {
 571     dump_lisps("acceptable Lisps", &accept,
 572                offsetof(struct lispsys, next_accept));
 573     dump_lisps("preferred Lisps", &prefer,
 574                offsetof(struct lispsys, next_prefer));
 575     dump_lisps("overall preference order", &order,
 576                offsetof(struct lispsys, next_order));
 577   }
 578
 579   /* Try to actually run the script. */
 580   for (lisp = order.head; lisp; lisp = lisp->next_order) {
 581     /* Try each of the selected systems in turn. */
 582
 583     /* See whether there's a custom image file.  If so, set `@image' in the
 584      * system's configuration section.
 585      */
 586     if (!(flags&AF_VANILLA) &&
 587         config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) {
 588       var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path");
 589       if (!var)
 590         lose("variable `image-path' not defined for Lisp `%s'",
 591              LISPSYS_NAME(lisp));
 592       dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d);
 593       if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0))
 594         config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t");
 595     }
 596
 597     /* Build the command line from `run-script'. */
 598     argv_reset(&av);
 599     config_subst_split_var(&config, lisp->sect, lisp->var, &av);
 600     if (!av.n) {
 601       moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp));
 602       continue;
 603     }
 604
 605     /* Append our additional positional arguments. */
 606     argv_appendn(&av, argv, argc);
 607
 608     /* Try to run the Lisp system. */
 609     if (!try_exec(&av,
 610                   (flags&AF_DRYRUN ? TEF_DRYRUN : 0) |
 611                     (verbose >= 2 ? TEF_VERBOSE : 0)))
 612       return (0);
 613   }
 614
 615   /* No.  Much errors.  So failure.  Very sadness. */
 616   lose("no acceptable Lisp systems found");
 617 }
 618
 619 /*----- That's all, folks -------------------------------------------------*/