-static const char *getenv_or_default(const char *var, const char *dflt)
- { const char *p = getenv(var); return (p ? p : dflt); }
-
-/*----- Invoking Lisp systems ---------------------------------------------*/
-
-/* Steel Bank Common Lisp. */
-
-static void run_sbcl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, "--script", script, END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "sbcl+asdf.core");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av,
- "--core", d.p,
- "--eval", IMAGE_RESTORE_RUNE,
- END);
- else
- argv_prependl(&arg->av, "--eval", COMMON_PRELUDE_RUNE, END);
-
- argv_prependl(&arg->av, getenv_or_default("SBCL", "sbcl"),
- "--noinform",
- END);
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* Clozure Common Lisp. */
-
-#define CCL_QUIT_RUNE \
- "(ccl:quit)"
-
-static void run_ccl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, "-b", "-n", "-Q",
- "-l", script,
- "-e", CCL_QUIT_RUNE,
- "--",
- END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "ccl+asdf.image");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-I", d.p, "-e", IMAGE_RESTORE_RUNE, END);
- else
- argv_prependl(&arg->av, "-e", COMMON_PRELUDE_RUNE, END);
-
- argv_prepend(&arg->av, getenv_or_default("CCL", "ccl"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* GNU CLisp.
- *
- * CLisp causes much sadness. Superficially, it's the most sensible of all
- * of the systems supported here: you just run `clisp SCRIPT -- ARGS ...' and
- * it works.
- *
- * The problems come when you want to do some preparatory work (e.g., load
- * `asdf') and then run the script. There's a `-x' option to evaluate some
- * Lisp code, but it has three major deficiencies.
- *
- * * It insists on printing the values of the forms it evaluates. It
- * prints a blank line even if the form goes out of its way to produce no
- * values at all. So the whole thing has to be a single top-level form
- * which quits the Lisp rather than returning.
- *
- * * For some idiotic reason, you can have /either/ `-x' forms /or/ a
- * script, but not both. So we have to include the `load' here
- * explicitly. I suppose that was inevitable because we have to inhibit
- * printing of the result forms, but it's still a separate source of
- * annoyance.
- *
- * * The icing on the cake: the `-x' forms are collectively concatenated --
- * without spaces! -- and used to build a string stream, which is then
- * assigned over the top of `*standard-input*', making the original stdin
- * somewhat fiddly to track down.
- *
- * There's an `-i' option which will load a file without any of this
- * stupidity, but nothing analogous for immediate expressions.
- */
-
-#define CLISP_COMMON_STARTUP_RUNES \
- "(setf *standard-input* (ext:make-stream :input)) " \
- "(load \"%e\" :verbose nil :print nil) " \
- "(ext:quit)"
-
-#define CLISP_STARTUP_RUNE \
- "(progn " \
- COMMON_PRELUDE_RUNE " " \
- CLISP_COMMON_STARTUP_RUNES ")"
-
-#define CLISP_STARTUP_IMAGE_RUNE \
- "(progn " \
- IMAGE_RESTORE_RUNE " " \
- CLISP_COMMON_STARTUP_RUNES ")"
-
-static void run_clisp(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT, dd = DSTR_INIT;
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "clisp+asdf.mem");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-M", d.p, "-q",
- "-x", expand_rune(&dd, CLISP_STARTUP_IMAGE_RUNE, script),
- "--",
- END);
- else
- argv_prependl(&arg->av, "-norc", "-q",
- "-x", expand_rune(&dd, CLISP_STARTUP_RUNE, script),
- "--",
- END);
-
- argv_prepend(&arg->av, getenv_or_default("CLISP", "clisp"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
- dstr_release(&dd);
-
-#undef f
-}
-
-/* Embeddable Common Lisp. *
- *
- * ECL is changing its command-line option syntax in version 16. I have no
- * idea why they think the result can ever be worth the pain of a transition.
- */
-
-#if ECL_OPTIONS_GNU
-# define ECLOPT "--"
-#else
-# define ECLOPT "-"
-#endif
-
-#define ECL_STARTUP_RUNE \
- "(progn " \
- COMMON_PRELUDE_RUNE " " \
- CLEAR_CL_USER_RUNE ")"
-
-static void run_ecl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "ecl+asdf");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, FEF_EXEC)) {
- argv_prependl(&arg->av, "-s", script, "--", END);
- argv_prependl(&arg->av, d.p, END);
- } else {
- argv_prependl(&arg->av, ECLOPT "shell", script, "--", END);
- argv_prependl(&arg->av, getenv_or_default("ECL", "ecl"), ECLOPT "norc",
- ECLOPT "eval", ECL_STARTUP_RUNE,
- END);
- }
- try_exec(arg, &arg->av);
-}
-
-/* Carnegie--Mellon University Common Lisp. */
-
-#define CMUCL_STARTUP_RUNE \
- "(progn " \
- "(setf ext:*require-verbose* nil) " \
- COMMON_PRELUDE_RUNE ")"
-#define CMUCL_QUIT_RUNE \
- "(ext:quit)"
-
-static void run_cmucl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av,
- "-load", script,
- "-eval", CMUCL_QUIT_RUNE,
- "--",
- END);
-
- dstr_puts(&d, arg->imagedir);
- dstr_putc(&d, '/');
- dstr_puts(&d, "cmucl+asdf.core");
- if (!(arg->f&F_NODUMP) && file_exists_p(arg, d.p, 0))
- argv_prependl(&arg->av, "-core", d.p, "-eval", IMAGE_RESTORE_RUNE, END);
- else
- argv_prependl(&arg->av, "-batch", "-noinit", "-nositeinit", "-quiet",
- "-eval", CMUCL_STARTUP_RUNE,
- END);
-
- argv_prepend(&arg->av, getenv_or_default("CMUCL", "cmucl"));
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/* Armed Bear Common Lisp. *
- *
- * CLisp made a worthy effort, but ABCL still manages to take the price.
- *
- * * ABCL manages to avoid touching the `stderr' stream at all, ever. Its
- * startup machinery finds `stdout' (as `java.lang.System.out'), wraps it
- * up in a Lisp stream, and uses the result as `*standard-output*' and
- * `*error-output*' (and a goodly number of other things too). So we
- * must manufacture a working `stderr' the hard way.
- *
- * * There doesn't appear to be any easy way to prevent toplevel errors
- * from invoking the interactive debugger. For extra fun, the debugger
- * reads from `stdin' by default, so an input file which somehow manages
- * to break the script can then take over its brain by providing Lisp
- * forms for the debugger to evaluate.
- */
-
-#define ABCL_STARTUP_RUNE \
- "(let ((#9=#:script \"%e\")) " \
- COMMON_PRELUDE_RUNE " " \
- CLEAR_CL_USER_RUNE " " \
- \
- /* Replace the broken `*error-output*' stream with a working \
- * copy of `stderr'. \
- */ \
- "(setf *error-output* " \
- "(java:jnew \"org.armedbear.lisp.Stream\" " \
- "'sys::system-stream " \
- "(java:jfield \"java.lang.System\" \"err\") " \
- "'character " \
- "java:+true+)) " \
- \
- /* Trap errors signalled by the script and arrange for them \
- * to actually kill the process rather than ending up in the \
- * interactive debugger. \
- */ \
- "(handler-case (load #9# :verbose nil :print nil) " \
- "(error (error) " \
- "(format *error-output* \"~A (unhandled error): ~A~%%\" " \
- "#9# error) " \
- "(ext:quit :status 255))))"
-
-static void run_abcl(struct argstate *arg, const char *script)
-{
- struct dstr d = DSTR_INIT;
-
- argv_prependl(&arg->av, getenv_or_default("ABCL", "abcl"),
- "--batch", "--noinform", "--noinit", "--nosystem",
- "--eval", expand_rune(&d, ABCL_STARTUP_RUNE, script),
- "--",
- END);
- try_exec(arg, &arg->av);
- dstr_release(&d);
-}
-
-/*----- Main code ---------------------------------------------------------*/
-
-static void version(FILE *fp)
- { fprintf(fp, "%s, version %s\n", progname, PACKAGE_VERSION); }
-
-static void usage(FILE *fp)
-{
- fprintf(fp, "usage: %s [-CDEnqv] [-I IMAGEDIR] "
- "[-L SYS,SYS,...] [-P SYS,SYS,...]\n"
- "\t[--] SCRIPT [ARGUMENTS ...] |\n"
- "\t[-e EXPR] [-p EXPR] [-l FILE] [--] [ARGUMENTS ...]\n",
- progname);
-}
-
-static void help(FILE *fp)
-{
- version(fp); fputc('\n', fp); usage(fp);
- fputs("\n\
-Options:\n\
- --help Show this help text and exit successfully.\n\
- --version Show the version number and exit successfully.\n\
- -C Clear the list of preferred Lisp systems.\n\
- -D Run system Lisp images, rather than custom images.\n\
- -E Don't read embedded options from the script.\n\
- -I IMAGEDIR Look for custom images in IMAGEDIR rather than\n\
- `" IMAGEDIR "'.\n\
- -L SYS,SYS,... Only use the listed Lisp systems.the script.\n\
- -P SYS,SYS,... Prefer the listed Lisp systems.\n\
- -e EXPR Evaluate EXPR (can be repeated).\n\
- -l FILE Load FILE (can be repeated).\n\
- -n Don't actually run the script (useful with `-v')\n\
- -p EXPR Print (`prin1') EXPR (can be repeated).\n\
- -q Don't print warning messages.\n\
- -v Print informational messages (repeat for even more).\n",
- fp);
-}
-
-/* Parse a comma-separated list of system names SPEC, and add the named
- * systems to LIST.
- */
-static void parse_syslist(const char *spec, const struct argstate *arg,
- struct syslist *list, const char *what)
-{
- char *copy = xstrdup(spec), *p = copy, *q;
- const struct systab *sys;
- size_t n;
-
- for (;;) {
- n = strcspn(p, ",");
- if (p[n]) q = p + n + 1;
- else q = 0;
- p[n] = 0; sys = find_system(p);
- if (list->f&sys->f) {
- if (arg->verbose > 0)
- moan("ignoring duplicate system `%s' in %s list", p, what);
- } else {
- list->sys[list->n++] = sys;
- list->f |= sys->f;
- }
- if (!q) break;
- p = q;
- }
- free(copy);
-}
-
-static void push_eval_op(struct argstate *arg, char op, const char *val)