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