Commit | Line | Data |
---|---|---|
e29834b8 MW |
1 | /* -*-c-*- |
2 | * | |
7b8ff279 | 3 | * Invoke Lisp scripts and implementations |
e29834b8 MW |
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 | ||
e29834b8 MW |
30 | #include <ctype.h> |
31 | #include <errno.h> | |
e29834b8 MW |
32 | #include <stdio.h> |
33 | #include <stdlib.h> | |
34 | #include <string.h> | |
35 | ||
7b8ff279 MW |
36 | #include "common.h" |
37 | #include "lib.h" | |
38 | #include "mdwopt.h" | |
e29834b8 | 39 | |
7b8ff279 | 40 | /*----- Static data -------------------------------------------------------*/ |
e29834b8 | 41 | |
8996f767 | 42 | /* The state we need for a Lisp system. */ |
7b8ff279 | 43 | struct lispsys { |
8996f767 MW |
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 */ | |
e29834b8 | 55 | }; |
7b8ff279 MW |
56 | #define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp) |
57 | #define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp) | |
e29834b8 | 58 | |
8996f767 MW |
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. */ | |
7b8ff279 | 64 | struct lispsys_list { |
8996f767 | 65 | struct lispsys *head, **tail; /* list head and tail */ |
e29834b8 | 66 | }; |
e29834b8 | 67 | |
8996f767 MW |
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 */ | |
e29834b8 | 84 | |
7b8ff279 | 85 | /*----- Main code ---------------------------------------------------------*/ |
e29834b8 | 86 | |
8996f767 | 87 | /* Return the `struct lispsys' entry for the given N-byte NAME. */ |
7b8ff279 | 88 | static struct lispsys *ensure_lispsys(const char *name, size_t n) |
e29834b8 | 89 | { |
7b8ff279 MW |
90 | struct lispsys *lisp; |
91 | struct treap_path path; | |
e29834b8 | 92 | |
7b8ff279 MW |
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); | |
e29834b8 | 98 | } |
7b8ff279 | 99 | return (lisp); |
e29834b8 MW |
100 | } |
101 | ||
8996f767 MW |
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 | */ | |
7b8ff279 MW |
107 | static void add_lispsys(const char *p, const char *what, |
108 | struct lispsys_list *list, | |
109 | unsigned flag, size_t linkoff) | |
e29834b8 | 110 | { |
7b8ff279 MW |
111 | struct lispsys *lisp, **link; |
112 | const char *q; | |
e29834b8 | 113 | |
7b8ff279 | 114 | if (!*p) return; |
e29834b8 | 115 | for (;;) { |
8996f767 | 116 | while (ISSPACE(*p)) p++; |
e29834b8 | 117 | if (!*p) break; |
8996f767 | 118 | q = p; while (*p && !ISSPACE(*p) && *p != ',') p++; |
7b8ff279 MW |
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; | |
e29834b8 | 127 | } |
8996f767 | 128 | while (ISSPACE(*p)) p++; |
7b8ff279 | 129 | if (!*p) break; |
8996f767 | 130 | if (*p == ',') p++; |
e29834b8 MW |
131 | } |
132 | } | |
133 | ||
8996f767 MW |
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 | */ | |
7b8ff279 MW |
138 | static void check_lisps(const char *what, |
139 | struct lispsys_list *list, size_t linkoff) | |
e29834b8 | 140 | { |
7b8ff279 | 141 | struct lispsys *lisp; |
e29834b8 | 142 | |
7b8ff279 MW |
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)); | |
e29834b8 MW |
146 | } |
147 | ||
8996f767 MW |
148 | /* Dump the names of the Lisp systems on LIST (linked through LINKOFF). |
149 | * | |
150 | * WHAT is an adjective describing the list. | |
151 | */ | |
7b8ff279 MW |
152 | static void dump_lisps(const char *what, |
153 | struct lispsys_list *list, size_t linkoff) | |
e29834b8 MW |
154 | { |
155 | struct dstr d = DSTR_INIT; | |
7b8ff279 MW |
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, ", "); | |
8996f767 | 163 | dstr_puts(&d, LISPSYS_NAME(lisp)); |
e29834b8 | 164 | } |
7b8ff279 MW |
165 | if (first) dstr_puts(&d, "(none)"); |
166 | dstr_putz(&d); | |
167 | moan("%s: %s", what, d.p); | |
e29834b8 MW |
168 | dstr_release(&d); |
169 | } | |
170 | ||
8996f767 MW |
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 | */ | |
7b8ff279 | 176 | static void push_eval_op(char op, const char *val) |
e29834b8 MW |
177 | { |
178 | char *p; | |
179 | size_t n; | |
180 | ||
7b8ff279 | 181 | if ((flags&AF_STATEMASK) != AF_CMDLINE) { |
e29834b8 | 182 | moan("must use `-e', `-p', or `-l' on command line"); |
7b8ff279 | 183 | flags |= AF_BOGUS; |
e29834b8 MW |
184 | return; |
185 | } | |
186 | ||
187 | n = strlen(val) + 1; | |
188 | p = xmalloc(n + 1); | |
189 | p[0] = op; memcpy(p + 1, val, n); | |
7b8ff279 | 190 | argv_append(&argv_tail, p); |
e29834b8 MW |
191 | } |
192 | ||
8996f767 MW |
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 | ||
10427eb2 MW |
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 | ||
8996f767 | 248 | /* Parse the options in the argument vector. */ |
7b8ff279 | 249 | static void parse_options(int argc, char *argv[]) |
e29834b8 | 250 | { |
7b8ff279 | 251 | int i; |
e29834b8 | 252 | |
7b8ff279 MW |
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 | ||
10427eb2 MW |
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 | ||
7b8ff279 | 281 | optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname; |
e29834b8 | 282 | for (;;) { |
7b8ff279 MW |
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) { | |
10427eb2 MW |
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; }); | |
7b8ff279 MW |
291 | case 'L': |
292 | add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT, | |
293 | offsetof(struct lispsys, next_accept)); | |
294 | break; | |
10427eb2 MW |
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; | |
7b8ff279 | 303 | default: flags |= AF_BOGUS; break; |
e29834b8 | 304 | } |
e29834b8 | 305 | } |
2d4554ca MW |
306 | |
307 | #undef FLAGOPT | |
308 | #undef CMDL | |
e29834b8 MW |
309 | } |
310 | ||
8996f767 | 311 | /* Extract and process the embedded options from a SCRIPT. */ |
7b8ff279 | 312 | static void handle_embedded_args(const char *script) |
e29834b8 MW |
313 | { |
314 | struct dstr d = DSTR_INIT; | |
7b8ff279 MW |
315 | struct argv av = ARGV_INIT; |
316 | char *p, *q, *r; const char *l; | |
317 | size_t n; | |
318 | int qstate = 0; | |
e29834b8 MW |
319 | FILE *fp = 0; |
320 | ||
8996f767 | 321 | /* Open the script. If this doesn't work, then we have no hope. */ |
e29834b8 MW |
322 | fp = fopen(script, "r"); |
323 | if (!fp) lose("can't read script `%s': %s", script, strerror(errno)); | |
324 | ||
8996f767 | 325 | /* Read the second line. */ |
e29834b8 MW |
326 | if (dstr_readline(&d, fp)) goto end; |
327 | dstr_reset(&d); if (dstr_readline(&d, fp)) goto end; | |
328 | ||
8996f767 | 329 | /* Check to find the magic marker. */ |
7b8ff279 MW |
330 | p = strstr(d.p, "@RUNLISP:"); if (!p) goto end; |
331 | p += 9; q = p; l = d.p + d.len; | |
8996f767 MW |
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 | */ | |
7b8ff279 | 342 | for (;;) { |
8996f767 MW |
343 | /* Iterate over the words. */ |
344 | ||
345 | /* Skip spaces. */ | |
7b8ff279 | 346 | while (p < l && ISSPACE(*p)) p++; |
8996f767 MW |
347 | |
348 | /* If we've reached the end then we're done. */ | |
7b8ff279 | 349 | if (p >= l) break; |
8996f767 MW |
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 | */ | |
7b8ff279 MW |
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 | } | |
8996f767 MW |
362 | |
363 | /* If we find a `--' marker then stop immediately. */ | |
7b8ff279 MW |
364 | if (l - p >= 2 && p[0] == '-' && p[1] == '-' && |
365 | (l == p + 2 || ISSPACE(p[2]))) | |
366 | break; | |
e29834b8 | 367 | |
8996f767 MW |
368 | /* Push the output cursor position onto the output, because this is where |
369 | * the next word will start. | |
370 | */ | |
7b8ff279 | 371 | argv_append(&av, q); |
8996f767 MW |
372 | |
373 | /* Collect characters until we find an unquoted space. */ | |
7b8ff279 | 374 | while (p < l && (qstate || !ISSPACE(*p))) { |
8996f767 MW |
375 | |
376 | if (*p == '"') | |
377 | /* A quote. Skip past, and toggle quotedness. */ | |
378 | ||
379 | { p++; qstate = !qstate; } | |
380 | ||
7b8ff279 | 381 | else if (*p == '\\') { |
8996f767 MW |
382 | /* A backslash. Just emit the following character. */ |
383 | ||
7b8ff279 MW |
384 | p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script); |
385 | *q++ = *p++; | |
8996f767 | 386 | |
7b8ff279 | 387 | } else if (*p == '\'') { |
8996f767 MW |
388 | /* A single quote. Find its matching end quote, and emit everything |
389 | * in between. | |
390 | */ | |
391 | ||
7b8ff279 MW |
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; | |
8996f767 | 395 | |
7b8ff279 | 396 | } else { |
8996f767 MW |
397 | /* An ordinary constituent. Gather a bunch of these up and emit them |
398 | * all. | |
399 | */ | |
7b8ff279 MW |
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 | } | |
e29834b8 | 404 | } |
8996f767 MW |
405 | |
406 | /* Check that we're not still inside quotes. */ | |
7b8ff279 | 407 | if (qstate) lose("%s:2: missing `\"'", script); |
8996f767 MW |
408 | |
409 | /* Finish off this word and prepare to start the next. */ | |
410 | *q++ = 0; if (p < l) p++; | |
e29834b8 | 411 | } |
7b8ff279 | 412 | |
8996f767 MW |
413 | /* Parse the arguments we've collected as options. Object if we find |
414 | * positional arguments. | |
415 | */ | |
7b8ff279 MW |
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]); | |
e29834b8 MW |
421 | |
422 | end: | |
8996f767 | 423 | /* Tidy up. */ |
e29834b8 MW |
424 | if (fp) { |
425 | if (ferror(fp)) | |
7b8ff279 | 426 | lose("error reading script `%s': %s", script, strerror(errno)); |
e29834b8 MW |
427 | fclose(fp); |
428 | } | |
7b8ff279 | 429 | dstr_release(&d); argv_release(&av); |
e29834b8 MW |
430 | } |
431 | ||
8996f767 | 432 | /* Main program. */ |
e29834b8 MW |
433 | int main(int argc, char *argv[]) |
434 | { | |
7b8ff279 MW |
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; | |
8996f767 MW |
440 | const char *p; |
441 | const char *script; | |
e29834b8 | 442 | struct dstr d = DSTR_INIT; |
7b8ff279 | 443 | struct argv av = ARGV_INIT; |
e29834b8 | 444 | |
8996f767 | 445 | /* initial setup. */ |
7b8ff279 | 446 | set_progname(argv[0]); |
7b8ff279 | 447 | init_config(); |
e29834b8 | 448 | |
8996f767 | 449 | /* Parse the command-line options. */ |
7b8ff279 MW |
450 | flags = (flags&~AF_STATEMASK) | AF_CMDLINE; |
451 | parse_options(argc - 1, argv + 1); optind++; | |
e29834b8 | 452 | |
8996f767 MW |
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 | */ | |
7b8ff279 MW |
471 | argc -= optind; argv += optind; |
472 | if (argv_tail.n) { | |
473 | argv_append(&argv_tail, "--"); | |
8996f767 MW |
474 | argv_appendn(&argv_tail, argv, argc); |
475 | argc = argv_tail.n; argv = argv_tail.v; | |
e29834b8 MW |
476 | } |
477 | ||
8996f767 | 478 | /* Fetch embedded options. */ |
7b8ff279 | 479 | if (!(flags&AF_NOEMBED)) handle_embedded_args(script); |
8996f767 MW |
480 | |
481 | /* Load default configuration if no explicit files were requested. */ | |
7b8ff279 | 482 | if (!(flags&AF_SETCONF)) load_default_config(); |
e29834b8 | 483 | |
8996f767 MW |
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)); | |
e29834b8 | 498 | |
8996f767 | 499 | /* If we're in eval mode, then find the `eval.lisp' script. */ |
7b8ff279 | 500 | if (!script) |
6c39ec6d MW |
501 | script = config_subst_string_alloc(&config, common, "<internal>", |
502 | "${@ENV:RUNLISP_EVAL?" | |
503 | "${@CONFIG:eval-script?" | |
504 | "${@data-dir}/eval.lisp}}"); | |
8996f767 MW |
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 | */ | |
e29834b8 MW |
518 | if (setenv("__CL_ARGV0", script, 1)) |
519 | lose("failed to set script-name environment variable"); | |
7b8ff279 | 520 | |
8996f767 MW |
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 | */ | |
7b8ff279 MW |
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 | ||
8996f767 | 542 | /* Make sure that the acceptable and preferred Lisps actually exist. */ |
7b8ff279 MW |
543 | check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept)); |
544 | check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer)); | |
545 | ||
8996f767 | 546 | /* If there are no acceptable Lisps, then we'll take all of them. */ |
7b8ff279 MW |
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 | } | |
e29834b8 | 555 | |
8996f767 MW |
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 | */ | |
7b8ff279 MW |
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 | ||
8996f767 | 567 | /* Maybe dump out the various lists of Lisp systems we've collected. */ |
7b8ff279 MW |
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 | } | |
e29834b8 | 578 | |
8996f767 | 579 | /* Try to actually run the script. */ |
7b8ff279 | 580 | for (lisp = order.head; lisp; lisp = lisp->next_order) { |
8996f767 MW |
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")) { | |
7b8ff279 | 588 | var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path"); |
10427eb2 MW |
589 | if (!var) |
590 | lose("variable `image-path' not defined for Lisp `%s'", | |
591 | LISPSYS_NAME(lisp)); | |
7b8ff279 MW |
592 | dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d); |
593 | if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0)) | |
8996f767 | 594 | config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t"); |
e29834b8 | 595 | } |
8996f767 MW |
596 | |
597 | /* Build the command line from `run-script'. */ | |
7b8ff279 MW |
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 | } | |
8996f767 MW |
604 | |
605 | /* Append our additional positional arguments. */ | |
606 | argv_appendn(&av, argv, argc); | |
607 | ||
608 | /* Try to run the Lisp system. */ | |
7b8ff279 MW |
609 | if (!try_exec(&av, |
610 | (flags&AF_DRYRUN ? TEF_DRYRUN : 0) | | |
611 | (verbose >= 2 ? TEF_VERBOSE : 0))) | |
612 | return (0); | |
613 | } | |
e29834b8 | 614 | |
8996f767 | 615 | /* No. Much errors. So failure. Very sadness. */ |
7b8ff279 | 616 | lose("no acceptable Lisp systems found"); |
e29834b8 MW |
617 | } |
618 | ||
619 | /*----- That's all, folks -------------------------------------------------*/ |