X-Git-Url: https://git.distorted.org.uk/~mdw/runlisp/blobdiff_plain/7b8ff279e7304e41b243459d78c3b6703bb8c3f5..e41cbc79e39d62f0343a48efc4d832ed99c83aaf:/runlisp.c diff --git a/runlisp.c b/runlisp.c index c555f13..65741ad 100644 --- a/runlisp.c +++ b/runlisp.c @@ -39,89 +39,52 @@ /*----- Static data -------------------------------------------------------*/ +/* The state we need for a Lisp system. */ struct lispsys { - struct treap_node _node; - struct lispsys *next_lisp, *next_accept, *next_prefer, *next_order; - unsigned f; -#define LF_KNOWN 1u -#define LF_ACCEPT 2u -#define LF_PREFER 4u - struct config_section *sect; - struct config_var *var; + struct treap_node _node; /* treap intrusion */ + struct lispsys *next_lisp, /* link in all-Lisps list */ + *next_accept, /* link acceptable-Lisps list */ + *next_prefer, /* link in preferred-Lisps list */ + *next_order; /* link in overall-order list */ + unsigned f; /* flags */ +#define LF_KNOWN 1u /* this is actually a Lisp */ +#define LF_ACCEPT 2u /* this is an acceptable Lisp */ +#define LF_PREFER 4u /* this is a preferred Lisp */ + struct config_section *sect; /* configuration section */ + struct config_var *var; /* `run-script variable */ }; #define LISPSYS_NAME(lisp) TREAP_NODE_KEY(lisp) #define LISPSYS_NAMELEN(lisp) TREAP_NODE_KEYLEN(lisp) +/* Pick out a link from a `struct lispsys' object given its offset. */ +#define LISP_LINK(lisp, linkoff) \ + ((struct lispsys **)((unsigned char *)(lisp) + (linkoff))) + +/* A list of Lisp systems. */ struct lispsys_list { - struct lispsys *head, **tail; + struct lispsys *head, **tail; /* list head and tail */ }; -static struct argv argv_tail = ARGV_INIT; -const char *script = 0; - -static unsigned flags = 0; -#define AF_CMDLINE 0x0000u -#define AF_EMBED 0x0001u -#define AF_ENV 0x0002u -#define AF_CONF 0x0003u -#define AF_STATEMASK 0x000fu -#define AF_BOGUS 0x0010u -#define AF_SETCONF 0x0020u -#define AF_NOEMBED 0x0040u -#define AF_DRYRUN 0x0080u -#define AF_VANILLA 0x0100u - -struct treap lispsys = TREAP_INIT; -static struct lispsys_list - lisps = { 0, &lisps.head }, - accept = { 0, &accept.head }, - prefer = { 0, &prefer.head }; +static struct argv argv_tail = ARGV_INIT; /* accumulates eval-mode args */ +struct treap lispsys = TREAP_INIT; /* track duplicate Lisp systems */ +static struct lispsys_list /* lists of Lisp systems */ + lisps = { 0, &lisps.head }, /* all known */ + accept = { 0, &accept.head }, /* acceptable */ + prefer = { 0, &prefer.head }; /* preferred */ + +static unsigned flags = 0; /* flags for the application */ +#define AF_CMDLINE 0x0000u /* options are from command-line */ +#define AF_EMBED 0x0001u /* reading embedded options */ +#define AF_STATEMASK 0x000fu /* mask of option origin codes */ +#define AF_BOGUS 0x0010u /* invalid command-line syntax */ +#define AF_SETCONF 0x0020u /* explicit configuration */ +#define AF_NOEMBED 0x0040u /* don't read embedded options */ +#define AF_DRYRUN 0x0080u /* don't actually do it */ +#define AF_VANILLA 0x0100u /* don't use custom images */ /*----- Main code ---------------------------------------------------------*/ -static void version(FILE *fp) - { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); } - -static void usage(FILE *fp) -{ - fprintf(fp, "\ -usage:\n\ - %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\ - %s [OPTIONS] [-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n\ -OPTIONS:\n\ - [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n", - progname, progname); -} - -static void help(FILE *fp) -{ - version(fp); fputc('\n', fp); usage(fp); - fputs("\n\ -Help options:\n\ - -h, --help Show this help text and exit successfully.\n\ - -V, --version Show version number and exit successfully.\n\ -\n\ -Diagnostics:\n\ - -n, --dry-run Don't run run anything (useful with `-v').\n\ - -q, --quiet Don't print warning messages.\n\ - -v, --verbose Print informational messages (repeatable).\n\ -\n\ -Configuration:\n\ - -E, --command-line-only Don't read embedded options from script.\n\ - -c, --config-file=CONF Read configuration from CONF (repeatable).\n\ - -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\ -\n\ -Lisp implementation selection:\n\ - -D, --vanilla-image Run vanilla Lisp images, not custom ones.\n\ - -L, --accept-lisp=SYS,SYS,... Only use the listed Lisp systems.\n\ -\n\ -Evaluation mode:\n\ - -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\ - -l, --load-file=FILE Load FILE (repeatable).\n\ - -p, --print-expression=EXPR Print (`prin1') EXPR (repeatable).\n", - fp); -} - +/* Return the `struct lispsys' entry for the given N-byte NAME. */ static struct lispsys *ensure_lispsys(const char *name, size_t n) { struct lispsys *lisp; @@ -136,9 +99,11 @@ static struct lispsys *ensure_lispsys(const char *name, size_t n) return (lisp); } -#define LISP_LINK(lisp, linkoff) \ - ((struct lispsys **)((unsigned char *)(lisp) + (linkoff))) - +/* Add Lisp systems from the comma- or space-sparated list P to LIST. + * + * WHAT is an adjective describing the list flavour; FLAG is a bit to set in + * the node's flags word; LINKOFF is the offset of the list's link member. + */ static void add_lispsys(const char *p, const char *what, struct lispsys_list *list, unsigned flag, size_t linkoff) @@ -148,8 +113,9 @@ static void add_lispsys(const char *p, const char *what, if (!*p) return; for (;;) { + while (ISSPACE(*p)) p++; if (!*p) break; - q = p; while (*p && *p != ',') p++; + q = p; while (*p && !ISSPACE(*p) && *p != ',') p++; lisp = ensure_lispsys(q, p - q); if (lisp->f&flag) { if (verbose >= 1) @@ -159,11 +125,16 @@ static void add_lispsys(const char *p, const char *what, lisp->f |= flag; *link = 0; *list->tail = lisp; list->tail = link; } + while (ISSPACE(*p)) p++; if (!*p) break; - p++; + if (*p == ',') p++; } } +/* Check that the Lisp systems on LIST (linked through LINKOFF) are real. + * + * That is, `LF_KNOWN' is set in their flags. + */ static void check_lisps(const char *what, struct lispsys_list *list, size_t linkoff) { @@ -174,6 +145,10 @@ static void check_lisps(const char *what, lose("unknown Lisp implementation `%s'", LISPSYS_NAME(lisp)); } +/* Dump the names of the Lisp systems on LIST (linked through LINKOFF). + * + * WHAT is an adjective describing the list. + */ static void dump_lisps(const char *what, struct lispsys_list *list, size_t linkoff) { @@ -185,7 +160,7 @@ static void dump_lisps(const char *what, for (lisp = list->head; lisp; lisp = *LISP_LINK(lisp, linkoff)) { if (first) first = 0; else dstr_puts(&d, ", "); - dstr_putf(&d, "`%s'", LISPSYS_NAME(lisp)); + dstr_puts(&d, LISPSYS_NAME(lisp)); } if (first) dstr_puts(&d, "(none)"); dstr_putz(&d); @@ -193,6 +168,11 @@ static void dump_lisps(const char *what, dstr_release(&d); } +/* Add an eval-mode operation to the `argv_tail' vector. + * + * OP is the operation character (see `eval.lisp' for these) and `val' is the + * argument (filename or expression). + */ static void push_eval_op(char op, const char *val) { char *p; @@ -210,6 +190,62 @@ static void push_eval_op(char op, const char *val) argv_append(&argv_tail, p); } +/* Help and related functions. */ +static void version(FILE *fp) + { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); } + +static void usage(FILE *fp) +{ + fprintf(fp, "\ +usage:\n\ + %s [OPTIONS] [--] SCRIPT [ARGUMENTS ...]\n\ + %s [OPTIONS] [-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n\ +OPTIONS:\n\ + [-CDEnqv] [+DEn] [-L SYS,SYS,...] [-c CONF] [-o [SECT:]VAR=VAL]\n", + progname, progname); +} + +static void help(FILE *fp) +{ + version(fp); fputc('\n', fp); usage(fp); + fputs("\n\ +Help options:\n\ + -h, --help Show this help text and exit successfully.\n\ + -V, --version Show version number and exit successfully.\n\ +\n\ +Diagnostics:\n\ + -n, --dry-run Don't run run anything (useful with `-v').\n\ + -q, --quiet Don't print warning messages.\n\ + -v, --verbose Print informational messages (repeatable).\n\ +\n\ +Configuration:\n\ + -E, --command-line-only Don't read embedded options from script.\n\ + -c, --config-file=CONF Read configuration from CONF (repeatable).\n\ + -o, --set-option=[SECT:]VAR=VAL Set configuration variable (repeatable).\n\ +\n\ +Lisp implementation selection:\n\ + -D, --vanilla-image Run vanilla Lisp images, not custom ones.\n\ + -L, --accept-lisp=SYS,SYS,... Only use the listed Lisp systems.\n\ +\n\ +Evaluation mode:\n\ + -e, --evaluate-expression=EXPR Evaluate EXPR for effect (repeatable).\n\ + -l, --load-file=FILE Load FILE (repeatable).\n\ + -p, --print-expression=EXPR Print (`prin1') EXPR (repeatable).\n", + fp); +} + +/* Complain about options which aren't permitted as embedded options. */ +static void check_command_line(int ch) +{ + if ((flags&AF_STATEMASK) != AF_CMDLINE) { + moan("`%c%c' is not permitted as embedded option", + ch&OPTF_NEGATED ? '+' : '-', + ch&~OPTF_NEGATED); + flags |= AF_BOGUS; + } +} + +/* Parse the options in the argument vector. */ static void parse_options(int argc, char *argv[]) { int i; @@ -231,36 +267,45 @@ static void parse_options(int argc, char *argv[]) { 0, 0, 0, 0 } }; +#define FLAGOPT(ch, f, extra) \ + case ch: \ + extra \ + flags |= f; \ + break; \ + case ch | OPTF_NEGATED: \ + extra \ + flags &= ~f; \ + break +#define CMDL do { check_command_line(i); } while (0) + optarg = 0; optind = 0; optprog = (/*unconst*/ char *)progname; for (;;) { i = mdwopt(argc, argv, "+hVD+E+L:c:e:l:n+o:p:qv", opts, 0, 0, OPTF_NEGATION | OPTF_NOPROGNAME); if (i < 0) break; switch (i) { - case 'h': help(stdout); exit(0); - case 'V': version(stdout); exit(0); - case 'D': flags |= AF_VANILLA; break; - case 'D' | OPTF_NEGATED: flags &= ~AF_VANILLA; break; - case 'E': flags |= AF_NOEMBED; break; - case 'E' | OPTF_NEGATED: flags &= ~AF_NOEMBED; break; + case 'h': CMDL; help(stdout); exit(0); + case 'V': CMDL; version(stdout); exit(0); + FLAGOPT('D', AF_VANILLA, ; ); + FLAGOPT('E', AF_NOEMBED, { CMDL; }); case 'L': add_lispsys(optarg, "acceptable", &accept, LF_ACCEPT, offsetof(struct lispsys, next_accept)); break; - case 'c': read_config_path(optarg, 0); flags |= AF_SETCONF; break; - case 'e': push_eval_op('!', optarg); break; - case 'l': push_eval_op('<', optarg); break; - case 'n': flags |= AF_DRYRUN; break; - case 'n' | OPTF_NEGATED: flags &= ~AF_DRYRUN; break; - case 'o': if (set_config_var(optarg)) flags |= AF_BOGUS; break; - case 'p': push_eval_op('?', optarg); break; - case 'q': if (verbose) verbose--; break; - case 'v': verbose++; break; + case 'c': CMDL; read_config_path(optarg, 0); flags |= AF_SETCONF; break; + case 'e': CMDL; push_eval_op('!', optarg); break; + case 'l': CMDL; push_eval_op('<', optarg); break; + FLAGOPT('n', AF_DRYRUN, { CMDL; }); + case 'o': CMDL; if (set_config_var(optarg)) flags |= AF_BOGUS; break; + case 'p': CMDL; push_eval_op('?', optarg); break; + case 'q': CMDL; if (verbose) verbose--; break; + case 'v': CMDL; verbose++; break; default: flags |= AF_BOGUS; break; } } } +/* Extract and process the embedded options from a SCRIPT. */ static void handle_embedded_args(const char *script) { struct dstr d = DSTR_INIT; @@ -270,17 +315,40 @@ static void handle_embedded_args(const char *script) int qstate = 0; FILE *fp = 0; + /* Open the script. If this doesn't work, then we have no hope. */ fp = fopen(script, "r"); if (!fp) lose("can't read script `%s': %s", script, strerror(errno)); + /* Read the second line. */ if (dstr_readline(&d, fp)) goto end; dstr_reset(&d); if (dstr_readline(&d, fp)) goto end; + /* Check to find the magic marker. */ p = strstr(d.p, "@RUNLISP:"); if (!p) goto end; p += 9; q = p; l = d.p + d.len; + + /* Split the line into words. + * + * Do this by hand because we have strange things to support, such as Emacs + * turds and the early `--' exit. + * + * We work in place: `p' is the input cursor and advances through the + * string as we parse, until it meets the limit pointer `l'; `q' is the + * output cursor which will always be no further forward than `p'. + */ for (;;) { + /* Iterate over the words. */ + + /* Skip spaces. */ while (p < l && ISSPACE(*p)) p++; + + /* If we've reached the end then we're done. */ if (p >= l) break; + + /* Check for an Emacs local-variables `-*-' turd. + * + * If we find one, find the matching end marker and move past it. + */ if (l - p >= 3 && p[0] == '-' && p[1] == '*' && p[2] == '-') { p = strstr(p + 3, "-*-"); if (!p || p + 3 > l) @@ -288,31 +356,60 @@ static void handle_embedded_args(const char *script) p += 3; continue; } + + /* If we find a `--' marker then stop immediately. */ if (l - p >= 2 && p[0] == '-' && p[1] == '-' && (l == p + 2 || ISSPACE(p[2]))) break; + /* Push the output cursor position onto the output, because this is where + * the next word will start. + */ argv_append(&av, q); + + /* Collect characters until we find an unquoted space. */ while (p < l && (qstate || !ISSPACE(*p))) { - if (*p == '"') { p++; qstate = !qstate; } + + if (*p == '"') + /* A quote. Skip past, and toggle quotedness. */ + + { p++; qstate = !qstate; } + else if (*p == '\\') { + /* A backslash. Just emit the following character. */ + p++; if (p >= l) lose("%s:2: unfinished `\\' escape", script); *q++ = *p++; + } else if (*p == '\'') { + /* A single quote. Find its matching end quote, and emit everything + * in between. + */ + p++; r = strchr(p, '\''); if (!r || r > l) lose("%s:2: missing `''", script); n = r - p; memmove(q, p, n); q += n; p = r + 1; + } else { + /* An ordinary constituent. Gather a bunch of these up and emit them + * all. + */ n = strcspn(p, qstate ? "\"\\" : "\"'\\ \f\n\r\t\v"); if (n > l - p) n = l - p; memmove(q, p, n); q += n; p += n; } } + + /* Check that we're not still inside quotes. */ if (qstate) lose("%s:2: missing `\"'", script); - if (p < l) p++; - *q++ = 0; + + /* Finish off this word and prepare to start the next. */ + *q++ = 0; if (p < l) p++; } + /* Parse the arguments we've collected as options. Object if we find + * positional arguments. + */ flags = (flags&~AF_STATEMASK) | AF_EMBED; parse_options(av.n, (char * /*unconst*/*)av.v); if (optind < av.n) @@ -320,6 +417,7 @@ static void handle_embedded_args(const char *script) script, av.v[optind]); end: + /* Tidy up. */ if (fp) { if (ferror(fp)) lose("error reading script `%s': %s", script, strerror(errno)); @@ -328,6 +426,7 @@ end: dstr_release(&d); argv_release(&av); } +/* Main program. */ int main(int argc, char *argv[]) { struct config_section_iter si; @@ -335,51 +434,96 @@ int main(int argc, char *argv[]) struct config_var *var; struct lispsys_list order; struct lispsys *lisp, **tail; + const char *p; + const char *script; struct dstr d = DSTR_INIT; struct argv av = ARGV_INIT; + /* initial setup. */ set_progname(argv[0]); - init_config(); - config_set_var(&config, toplevel, 0, "prefer", "${@ENV:RUNLISP_PREFER?}"); + /* Parse the command-line options. */ flags = (flags&~AF_STATEMASK) | AF_CMDLINE; parse_options(argc - 1, argv + 1); optind++; - if (argv_tail.n) - flags |= AF_NOEMBED; - else if (!script && !argv_tail.n) { - if (optind < argc) script = argv[optind]++; - else flags |= AF_BOGUS; - } - + /* We now know enough to decide whether we're in eval or script mode. In + * the former case, don't check for embedded options (it won't work because + * we don't know where the `eval.lisp' script is yet, and besides, there + * aren't any). In the latter case, pick out the script name, leaving the + * remaining positional arguments for later. + */ + if (argv_tail.n) { flags |= AF_NOEMBED; script = 0; } + else if (optind < argc) script = argv[optind++]; + else flags |= AF_BOGUS; + + /* Check that everything worked. */ + if (flags&AF_BOGUS) { usage(stderr); exit(127); } + + /* Reestablish ARGC/ARGV to refer to the tail of positional arguments to be + * passed onto the eventual script. For eval mode, that includes the + * operations already queued up, so we'll have to accumulate everything in + * `argv_tail'. + */ argc -= optind; argv += optind; if (argv_tail.n) { argv_append(&argv_tail, "--"); - argv_appendn(&argv_tail, (const char *const *)argv, argc); - argc = argv_tail.n; argv = (/*unconst*/ char */*unconst*/ *)argv_tail.v; + argv_appendn(&argv_tail, argv, argc); + argc = argv_tail.n; argv = argv_tail.v; } - if (flags&AF_BOGUS) { usage(stderr); exit(2); } + /* Fetch embedded options. */ if (!(flags&AF_NOEMBED)) handle_embedded_args(script); + + /* Load default configuration if no explicit files were requested. */ if (!(flags&AF_SETCONF)) load_default_config(); - if (verbose >= 5) dump_config(); - dstr_reset(&d); - var = config_find_var(&config, toplevel, CF_INHERIT, "prefer"); - config_subst_var(&config, toplevel, var, &d); - add_lispsys(d.p, "preferred", &prefer, LF_PREFER, - offsetof(struct lispsys, next_prefer)); + /* Determine the preferred Lisp systems. Check the environment first; + * otherwise use the configuration file. + */ + p = my_getenv("RUNLISP_PREFER", 0); + if (!p) { + var = config_find_var(&config, toplevel, CF_INHERIT, "prefer"); + if (var) { + dstr_reset(&d); + config_subst_var(&config, toplevel, var, &d); p = d.p; + } + } + if (p) + add_lispsys(p, "preferred", &prefer, LF_PREFER, + offsetof(struct lispsys, next_prefer)); + /* If we're in eval mode, then find the `eval.lisp' script. */ if (!script) - script = config_subst_string_alloc - (&config, common, "", - "${@ENV:RUNLISP_EVAL?${@CONFIG:data-dir}/eval.lisp}"); - + script = config_subst_string_alloc(&config, common, "", + "${@ENV:RUNLISP_EVAL?" + "${@CONFIG:eval-script?" + "${@data-dir}/eval.lisp}}"); + + /* We now have the script name, so publish it for `uiop'. + * + * As an aside, this is a terrible interface. It's too easy to forget to + * set it. (To illustrate this, `cl-launch -x' indeed forgets to set it.) + * If you're lucky, the script just thinks that its argument is `nil', in + * which case maybe it can use `*load-pathname*' as a fallback. If you're + * unlucky, your script was invoked (possibly indirectly) by another + * script, and now you've accidentally inherited the calling script's name. + * + * It would have been far better simply to repeat the script name as the + * first user argument, if nothing else had come readily to mind. + */ if (setenv("__CL_ARGV0", script, 1)) lose("failed to set script-name environment variable"); - config_set_var(&config, builtin, CF_LITERAL, "@SCRIPT", script); + /* And publish it in the configuration for the `run-script' commands. */ + config_set_var(&config, builtin, CF_LITERAL, "@script", script); + + /* Dump the final configuration if we're being very verbose. */ + if (verbose >= 5) dump_config(); + + /* Identify the configuration sections which correspond to actual Lisp + * system definitions, and gather them into the `known' list. + */ tail = lisps.tail; for (config_start_section_iter(&config, &si); (sect = config_next_section(&si)); ) { @@ -392,9 +536,11 @@ int main(int argc, char *argv[]) } *tail = 0; lisps.tail = tail; + /* Make sure that the acceptable and preferred Lisps actually exist. */ check_lisps("acceptable", &accept, offsetof(struct lispsys, next_accept)); check_lisps("preferred", &prefer, offsetof(struct lispsys, next_prefer)); + /* If there are no acceptable Lisps, then we'll take all of them. */ if (!accept.head) { if (verbose >= 2) moan("no explicitly acceptable implementations: allowing all"); @@ -404,6 +550,10 @@ int main(int argc, char *argv[]) *tail = 0; accept.tail = tail; } + /* Build the final list of Lisp systems in the order in which we'll try + * them: first, preferred Lisps which are acceptable, and then acceptable + * Lisps which aren't preferred. + */ tail = &order.head; for (lisp = prefer.head; lisp; lisp = lisp->next_prefer) if (lisp->f&LF_ACCEPT) { *tail = lisp; tail = &lisp->next_order; } @@ -411,6 +561,7 @@ int main(int argc, char *argv[]) if (!(lisp->f&LF_PREFER)) { *tail = lisp; tail = &lisp->next_order; } *tail = 0; + /* Maybe dump out the various lists of Lisp systems we've collected. */ if (verbose >= 4) dump_lisps("known Lisps", &lisps, offsetof(struct lispsys, next_lisp)); if (verbose >= 3) { @@ -422,26 +573,43 @@ int main(int argc, char *argv[]) offsetof(struct lispsys, next_order)); } + /* Try to actually run the script. */ for (lisp = order.head; lisp; lisp = lisp->next_order) { - if (config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) { + /* Try each of the selected systems in turn. */ + + /* See whether there's a custom image file. If so, set `@image' in the + * system's configuration section. + */ + if (!(flags&AF_VANILLA) && + config_find_var(&config, lisp->sect, CF_INHERIT, "image-file")) { var = config_find_var(&config, lisp->sect, CF_INHERIT, "image-path"); + if (!var) + lose("variable `image-path' not defined for Lisp `%s'", + LISPSYS_NAME(lisp)); dstr_reset(&d); config_subst_var(&config, lisp->sect, var, &d); if (file_exists_p(d.p, verbose >= 2 ? FEF_VERBOSE : 0)) - config_set_var(&config, lisp->sect, CF_LITERAL, "@IMAGE", "t"); + config_set_var(&config, lisp->sect, CF_LITERAL, "@image", "t"); } + + /* Build the command line from `run-script'. */ argv_reset(&av); config_subst_split_var(&config, lisp->sect, lisp->var, &av); if (!av.n) { moan("empty command for Lisp implementation `%s'", LISPSYS_NAME(lisp)); continue; } - argv_appendn(&av, (const char *const *)argv, argc); + + /* Append our additional positional arguments. */ + argv_appendn(&av, argv, argc); + + /* Try to run the Lisp system. */ if (!try_exec(&av, (flags&AF_DRYRUN ? TEF_DRYRUN : 0) | (verbose >= 2 ? TEF_VERBOSE : 0))) return (0); } + /* No. Much errors. So failure. Very sadness. */ lose("no acceptable Lisp systems found"); }