diff options
Diffstat (limited to 'txr.c')
| -rw-r--r-- | txr.c | 483 |
1 files changed, 322 insertions, 161 deletions
@@ -1,4 +1,4 @@ -/* Copyright 2009-2020 +/* Copyright 2009-2024 * Kaz Kylheku <kaz@kylheku.com> * Vancouver, Canada * All rights reserved. @@ -6,23 +6,24 @@ * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * - * 1. Redistributions of source code must retain the above copyright notice, this - * list of conditions and the following disclaimer. + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. * * 2. Redistributions in binary form must reproduce the above copyright notice, * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND - * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED - * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, - * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE + * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR + * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF + * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS + * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN + * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) + * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + * POSSIBILITY OF SUCH DAMAGE. */ #include <stdio.h> @@ -56,36 +57,53 @@ #include "regex.h" #include "arith.h" #include "sysif.h" +#include "itypes.h" #if HAVE_GLOB #include "glob.h" #endif #include "txr.h" +#if CONFIG_FULL_REPL +#define if_full_repl(THEN, ELSE) (THEN) +#else +#define if_full_repl(THEN, ELSE) (ELSE) +#endif + const wchli_t *version = wli(TXR_VER); +#ifdef TXR_BUILD_ID +const wchli_t *build_id = wli(TXR_BUILD_ID); +#endif wchar_t *progname; static const char *progname_u8; static val prog_path = nil, sysroot_path = nil; -int opt_noninteractive; +int opt_noninteractive = if_full_repl(0, 1); +int opt_noprofile; int opt_compat; int opt_dbg_expansion; +int opt_free_all; val stdlib_path; +val self_path_s; + +#if HAVE_FORK_STUFF +#define IF_HAVE_FORK_STUFF(THEN, ELSE) THEN +#else +#define IF_HAVE_FORK_STUFF(THEN, ELSE) ELSE +#endif static void help(void) { val text = lit( "\n" "TXR Version ~a\n" -"Copyright 2009-2020 Kaz Kylheku <kaz@kylheku.com>\n" +"Copyright 2009-2024 Kaz Kylheku <kaz@kylheku.com>\n" "\n" "Usage:\n" "\n" -" ~a [ options ] query-file { data-file }*\n" +" ~a [ options ] script-file { argument }*\n" "\n" -#if HAVE_TERMIOS "If no arguments are present, TXR will enter into interactive listener mode.\n" "\n" -#endif -"The query-file or data-file arguments may be specified as -, in which case\n" +"The script-file or data-file arguments may be specified as -, in which case\n" "standard input is used. All data-file arguments which begin with a !\n" "character are treated as command pipes. Those which begin with a $\n" "are interpreted as directories to read. Leading arguments which begin\n" @@ -104,8 +122,6 @@ static void help(void) "-Dvar Predefine variable var, with empty string value.\n" "-q Quiet: don't report errors during query matching.\n" "-v Verbose: extra logging from matcher.\n" -"-b Don't dump list of bindings, or 'false'\n" -" on unsuccessful termination.\n" "-B Force list of bindings to be dumped, or false\n" " if termination is unsuccessful.\n" "-l If dumping bindings, use TXR Lisp format.\n" @@ -121,44 +137,53 @@ static void help(void) " Additional dimensions beyond N are fudged\n" " by generating numeric suffixes. Implies -B.\n" "-c query-text The query is read from the query-text argument\n" -" itself. The query-file argument is omitted in\n" +" itself. The script-file argument is omitted in\n" " this case; the first argument is a data file.\n" -"-f query-file Specify the query-file as an option argument.\n" -" option, instead of the query-file argument.\n" +"-f script-file Specify the script-file as an option argument\n" +" instead of as the script-file argument.\n" " This allows #! scripts to pass options through\n" -" to the utility.\n" -"-e expression Evaluate TXR Lisp expression. Can be specified\n" -" multiple times. The query-file arg becomes optional.\n" -"-p expression Like -e, but prints the result of the expression\n" +" to the txr utility.\n" +"-e expressions Evaluate zero or more TXR Lisp expressions.\n" +" Can be specified multiple times. The script-file\n" +" arg becomes optional.\n" +"-p expression Evaluate a single expression, and print the value\n" " using the prinl function.\n" "-P expression Like -p, but prints using pprinl.\n" "-t expression Like -p, but prints using tprint.\n" +"-b var=value Bind a Lisp global variable as if by defparml.\n" +" var and value are parsed as Lisp syntax.\n" +" value is not evaluated.\n" "-C N Request backward-compatible behavior to the\n" " specified version of TXR.\n" "--help Reproduce this help text.\n" -"--version Display program version\n" -"--license Display software license\n" +"--version Display program version.\n" +"--build-id Print build ID string if compiled in.\n" +"--license Display software license.\n" " Use of txr implies agreement with the disclaimer\n" " section at the bottom of the license.\n" "--lisp Treat unsuffixed query files as TXR Lisp.\n" "--compiled Treat unsuffixed query files as compiled TXR Lisp.\n" -"--lisp-bindings Synonym for -l\n" -"--debugger Synonym for -d\n" +"--lisp-bindings Synonym for -l.\n" +"--debugger Synonym for -d.\n" "--backtrace Enable backtraces.\n" -"--noninteractive Synonym for -n\n" -"--compat=N Synonym for -C N\n" +"--noninteractive Synonym for -n.\n" +"--compat=N Synonym for -C N.\n" +"--in-package=name Switch to specified package\n" +"--compile=src[:target] Compile a file.\n" "--gc-delta=N Invoke garbage collection when malloc activity\n" " increments by N megabytes since last collection.\n" "--args... Allows multiple arguments to be encoded as a single\n" -" argument. This is useful in hash-bang scripting.\n" -" Peculiar syntax. See manual.\n" +" argument. This is useful in hash-bang scripts.\n" +" Peculiar syntax. See the manual.\n" "--eargs... arg Extended version of --args: additionally consumes\n" -" the following argument arg, and allows one or more\n" +" the following argument arg and allows one or more\n" " copies of it to be to be embedded in the\n" -" encoded arguments. See manual.\n" -#if HAVE_FORK_STUFF -"--reexec Re-execute TXR with remaining arguments.\n" -#endif +" encoded arguments. See the manual.\n" +"--noprofile Do not read .txr_profile when entering listener.\n" +IF_HAVE_FORK_STUFF( +"--reexec Re-execute TXR with remaining arguments.\n", +"" +) "--debug-autoload Allow debugger to step through library auto-loading.\n" "--debug-expansion Allow debugger to step through macro-expansion of query.\n" "--yydebug Debug Yacc parser, if compiled with YYDEBUG support.\n" @@ -173,21 +198,21 @@ static void help(void) format(std_output, text, static_str(version), prog_string, nao); } -#if HAVE_TERMIOS -static void banner(void) +static void banner(val self) { + if (!isatty(c_int(stream_fd(std_input), self))) + return; + format(std_output, - lit("This is the TXR Lisp interactive listener of TXR ~a.\n" - "Quit with :quit or Ctrl-D on empty line. Ctrl-X ? for cheatsheet.\n"), + if3(opt_noninteractive, + lit("This is the TXR Lisp plain mode listener of TXR ~a.\n" + "Quit with :quit or Ctrl-D on an empty line.\n"), + if_full_repl(lit("This is the TXR Lisp interactive " + "listener of TXR ~a.\n" + "Quit with :quit or Ctrl-D on an empty line. " + "Ctrl-X ? for cheatsheet.\n"), nil)), static_str(version), nao); } -#else -static void hint(void) -{ - format(std_error, lit("~a: incorrect arguments: try --help\n"), - prog_string, nao); -} -#endif static val check_hash_bang(val stream, val args, int *occurs) { @@ -254,11 +279,16 @@ static val get_self_path(void) val execname = string_utf8(getexecname()); if (car(execname) == chr('/')) return execname; - return format(nil, lit("~a/~a"), getcwd_wrap(), execname, nao); + return scat3(getcwd_wrap(), chr('/'), execname); } #else static val get_self_path(void) { + char self[PATH_MAX]; + + if (progname_u8 && realpath(progname_u8, self)) + return string_utf8(self); + return lit(TXR_INST_PATH); } #endif @@ -278,45 +308,50 @@ static val substitute_basename(val edited_path, val source_path) source_path); return if3(lslash, - format(nil, lit("~a~a"), - sub_str(edited_path, 0, succ(lslash)), - basename, nao), + scat2(sub_str(edited_path, 0, succ(lslash)), basename), basename); } static val sysroot(val target) { - return format(nil, lit("~a~a"), sysroot_path, target, nao); + return scat2(sysroot_path, target); } static void sysroot_init(void) { val prog_dir; - const wchar_t *psc = wref(coerce(const wchar_t *, path_sep_chars)); + const wchar_t *psc = coerce(const wchar_t *, path_sep_chars); + int share_txr_stdlib = 1; -#if HAVE_WINDOWS_H - val slash = regex_compile(lit("\\\\"), nil); -#endif protect(&prog_path, &sysroot_path, &stdlib_path, convert(val *, 0)); prog_path = get_self_path(); #if HAVE_WINDOWS_H - prog_path = regsub(slash, lit("/"), prog_path); + prog_path = regsub(lit("\\"), lit("/"), prog_path); #endif prog_dir = dir_name(prog_path); if (ref(prog_dir, negone) != chr(psc[0])) - prog_dir = format(nil, lit("~a~a"), prog_dir, chr(psc[0]), nao); + prog_dir = scat3(prog_dir, chr(psc[0]), null_string); if (!(maybe_sysroot(lit(TXR_REL_PATH)) || - maybe_sysroot(lit(TXR_REL_PATH EXE_SUFF)) || - maybe_sysroot(lit(PROG_NAME)) || - maybe_sysroot(lit(PROG_NAME EXE_SUFF)) || - maybe_sysroot(substitute_basename(lit(TXR_REL_PATH), prog_path)))) + maybe_sysroot(substitute_basename(lit(TXR_REL_PATH), prog_path)) || + (share_txr_stdlib = 0) || + maybe_sysroot(lit(PROG_NAME EXE_SUFF)))) { sysroot_path = prog_dir; } - stdlib_path = sysroot(lit("share/txr/stdlib/")); + stdlib_path = sysroot(if3(share_txr_stdlib, + lit("share/txr/stdlib/"), + lit("stdlib/"))); + + { + loc lsd = lookup_var_l(nil, load_search_dirs_s); + set(lsd, cons(sysroot(if3(share_txr_stdlib, + lit("share/txr/lib/"), + lit("lib/"))), + nil)); + } reg_varl(intern(lit("stdlib"), user_package), stdlib_path); reg_varl(intern(lit("*txr-version*"), user_package), @@ -359,7 +394,7 @@ static int license(void) for (iter = path_list; iter; iter = cdr(iter)) { val lic = open_file(car(iter), lit("r")); - put_lines(lazy_stream_cons(lic), std_output); + put_lines(lazy_stream_cons(lic, nil), std_output); put_char(chr('\n'), std_output); } } @@ -378,6 +413,16 @@ static int license(void) return retval; } +static void free_all(void) +{ + if (opt_free_all) { + regex_free_all(); + gc_free_all(); + arith_free_all(); + free(progname); + } +} + int txr_main(int argc, char **argv); int main(int argc, char **argv) @@ -386,6 +431,7 @@ int main(int argc, char **argv) repress_privilege(); progname = utf8_dup_from(argv[0] ? argv[0]: "txr"); progname_u8 = argv[0]; + atexit(free_all); init(&stack_bottom); match_init(); debug_init(); @@ -399,6 +445,38 @@ static void requires_arg(val opt) prog_string, opt, nao); } +static void do_compile_opt(val arg) +{ + val compile_update_file = intern(lit("compile-update-file"), user_package); + val col_pos = search_str(arg, lit(":"), nil, nil); + val source = arg; + val target = nil; + + if (col_pos) { + target = sub_str(source, succ(col_pos), t); + source = sub_str(source, zero, col_pos); + } + + reg_varl(self_path_s, source); + + funcall2(compile_update_file, source, target); +} + +static int do_in_package_opt(val opt, val arg) +{ + val pkg_binding = lookup_var(nil, package_s); + val package = find_package(arg); + + if (!package) { + format(std_error, lit("~a: option --~a: ~a package not found\n"), + prog_string, opt, arg, nao); + return 0; + } + + rplacd(pkg_binding, package); + return 1; +} + static int do_fixnum_opt(int (*opt_func)(val), val opt, val arg) { if (arg) { @@ -420,7 +498,7 @@ static int do_fixnum_opt(int (*opt_func)(val), val opt, val arg) static int compat(val optval) { - int compat = c_num(optval); + int compat = c_num(optval, lit("txr")); int min = compat_fixup(compat); if (min) { @@ -431,6 +509,8 @@ static int compat(val optval) } sysroot_compat_fixup(compat); + match_compat_fixup(compat); + opt_compat = compat; reg_varl(intern(lit("compat"), system_package), num(compat)); return 1; @@ -438,33 +518,21 @@ static int compat(val optval) static int array_dim(val optval) { - opt_arraydims = c_num(optval); + opt_arraydims = c_num(optval, lit("txr")); opt_print_bindings = 1; return 1; } static int gc_delta(val optval) { - opt_gc_delta = c_num(mul(optval, num_fast(1048576))); + opt_gc_delta = c_num(mul(optval, num_fast(1048576)), lit("gc")); return 1; } -static void free_all(void) -{ - static int called; - - if (!called) { - called = 1; - regex_free_all(); - gc_free_all(); - arith_free_all(); - free(progname); - } -} - #ifndef CONFIG_DEBUG_SUPPORT static void no_dbg_support(val arg) { + drop_privilege(); format(std_error, lit("~a: option ~a requires debug support compiled in\n"), prog_string, arg, nao); @@ -473,21 +541,21 @@ static void no_dbg_support(val arg) static int parse_once_noerr(val stream, val name) { - val pfx = format(nil, lit("~a:"), name, nao); + val pfx = scat2(name, lit(":")); ignerr_func_body(int, 0, parse_once(prog_string, stream, name), std_error, pfx); } static val read_compiled_file_noerr(val self, val stream, val name, val error_stream) { - val pfx = format(nil, lit("~a:"), name, nao); + val pfx = scat2(name, lit(":")); ignerr_func_body(val, nil, read_compiled_file(self, stream, error_stream), std_error, pfx); } static val read_eval_stream_noerr(val self, val stream, val name, val error_stream) { - val pfx = format(nil, lit("~a:"), name, nao); + val pfx = scat2(name, lit(":")); ignerr_func_body(val, nil, read_eval_stream(self, stream, error_stream), std_error, pfx); } @@ -508,7 +576,6 @@ int txr_main(int argc, char **argv) val txr_lisp_p = nil; val enter_repl = nil; val args_s = intern(lit("*args*"), user_package); - val self_path_s = intern(lit("self-path"), user_package); val compat_var = lit("TXR_COMPAT"); val compat_val = getenv_wrap(compat_var); val orig_args = nil, ref_arg_list = nil; @@ -518,6 +585,13 @@ int txr_main(int argc, char **argv) static char alt_args_buf[128 + 7] = "@(txr):", *alt_args = alt_args_buf + 7; + self_path_s = intern(lit("self-path"), user_package); + + if (ends_with(lit("lisp" EXE_SUFF), prog_path, nil, nil)) + txr_lisp_p = t; + else if (ends_with(lit("vm" EXE_SUFF), prog_path, nil, nil)) + txr_lisp_p = chr('o'); + setvbuf(stderr, 0, _IOLBF, 0); if (compat_val && length(compat_val) != zero) { @@ -553,13 +627,8 @@ int txr_main(int argc, char **argv) arg_list = list(string_utf8(alt_args), nao); } else if (argc <= 1) { drop_privilege(); -#if HAVE_TERMIOS - banner(); + banner(self); goto repl; -#else - hint(); - return EXIT_FAILURE; -#endif } for (ref_arg_list = arg_list, arg = upop(&arg_list, &arg_undo); @@ -574,7 +643,7 @@ int txr_main(int argc, char **argv) if (car(arg) != chr('-')) { if (!parse_stream) { spec_file_str = arg; - open_txr_file(arg, &txr_lisp_p, &spec_file_str, &parse_stream); + open_txr_file(arg, &txr_lisp_p, &spec_file_str, &parse_stream, t, self); simulate_setuid_setgid(parse_stream); dyn_env = make_env(nil, nil, dyn_env); env_vbind(dyn_env, load_path_s, spec_file_str); @@ -634,18 +703,31 @@ int txr_main(int argc, char **argv) /* Odd case 3: -Dfoo=bar syntax. */ if (equal(sub(arg, zero, two), lit("-D"))) { val dopt_arg = sub(arg, two, t); - cons_bind(var, def, split_str(dopt_arg, lit("="))); - val deflist = if2(def, split_str(car(def), lit(","))); - val sym = intern(var, cur_package); + val eq_pos = search_str(dopt_arg, lit("="), nil, nil); - if (rest(deflist)) - bindings = cons(cons(sym, deflist), bindings); - else if (deflist) - bindings = cons(cons(sym, car(deflist)), bindings); - else - bindings = cons(cons(sym, t), bindings); + if (eq_pos) { + val var = sub_str(dopt_arg, zero, eq_pos); + val def = sub_str(dopt_arg, succ(eq_pos), t); + val deflist = split_str(def, lit(",")); + val sym = intern(var, cur_package); - match_reg_var(sym); + if (rest(deflist)) + bindings = cons(cons(sym, deflist), bindings); + else + bindings = cons(cons(sym, car(deflist)), bindings); + + match_reg_var(sym); + } else { + if (search_str(dopt_arg, lit(","), nil, nil)) { + format(std_error, + lit("~a: bad -D syntax: ~a\n"), prog_string, arg, nao); + return EXIT_FAILURE; + } else { + val sym = intern(dopt_arg, cur_package); + bindings = cons(cons(sym, null_string), bindings); + match_reg_var(sym); + } + } continue; } @@ -670,8 +752,29 @@ int txr_main(int argc, char **argv) continue; } + if (equal(opt, lit("compile"))) { + if (!org) { + requires_arg(opt); + return EXIT_FAILURE; + } + reg_var(args_s, or2(orig_args, arg_list)); + do_compile_opt(org); + evaled = t; + continue; + } + + if (equal(opt, lit("in-package"))) { + if (!org) { + requires_arg(opt); + return EXIT_FAILURE; + } + if (!do_in_package_opt(opt, org)) + return EXIT_FAILURE; + continue; + } + /* Long opts with no arguments */ - if (org) { + if (0) noarg: { drop_privilege(); format(std_error, lit("~a: option --~a takes no argument, ~a given\n"), @@ -680,12 +783,24 @@ int txr_main(int argc, char **argv) } if (equal(opt, lit("version"))) { + if (org) + goto noarg; drop_privilege(); format(std_output, lit("~a: version ~a\n"), prog_string, static_str(version), nao); return 0; } + if (equal(opt, lit("build-id"))) { + if (org) + goto noarg; + drop_privilege(); +#ifdef TXR_BUILD_ID + format(std_output, lit("~a\n"), static_str(build_id), nao); +#endif + return 0; + } + if (equal(opt, lit("help"))) { drop_privilege(); help(); @@ -693,46 +808,65 @@ int txr_main(int argc, char **argv) } if (equal(opt, lit("license"))) { + if (org) + goto noarg; drop_privilege(); return license(); } if (equal(opt, lit("gc-debug"))) { + if (org) + goto noarg; drop_privilege(); opt_gc_debug = 1; continue; } else if (equal(opt, lit("vg-debug"))) { - drop_privilege(); #if HAVE_VALGRIND + if (org) + goto noarg; + drop_privilege(); opt_vg_debug = 1; continue; #else + drop_privilege(); format(std_error, lit("~a: option ~a requires Valgrind support compiled in\n"), prog_string, arg, nao); return EXIT_FAILURE; #endif } else if (equal(opt, lit("dv-regex"))) { + if (org) + goto noarg; opt_derivative_regex = 1; continue; } else if (equal(opt, lit("lisp-bindings"))) { + if (org) + goto noarg; opt_lisp_bindings = 1; opt_print_bindings = 1; continue; } else if (equal(opt, lit("lisp"))) { + if (org) + goto noarg; txr_lisp_p = t; continue; } else if (equal(opt, lit("compiled"))) { + if (org) + goto noarg; txr_lisp_p = chr('o'); continue; #if HAVE_FORK_STUFF } else if (equal(opt, lit("reexec"))) { + if (org) + goto noarg; exec_wrap(prog_path, arg_list); return EXIT_FAILURE; #endif } else if (equal(opt, lit("debugger"))) { - drop_privilege(); #if CONFIG_DEBUG_SUPPORT + if (org) + goto noarg; + drop_privilege(); opt_debugger = 1; debug_set(DBG_ENABLE | DBG_BACKTRACE); continue; @@ -741,8 +875,10 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; #endif } else if (equal(opt, lit("debug-autoload"))) { - drop_privilege(); #if CONFIG_DEBUG_SUPPORT + if (org) + goto noarg; + drop_privilege(); opt_debugger = 1; opt_dbg_autoload = 1; debug_set(DBG_ENABLE | DBG_BACKTRACE); @@ -752,8 +888,10 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; #endif } else if (equal(opt, lit("debug-expansion"))) { - drop_privilege(); #if CONFIG_DEBUG_SUPPORT + if (org) + goto noarg; + drop_privilege(); opt_debugger = 1; opt_dbg_expansion = 1; debug_set(DBG_ENABLE | DBG_BACKTRACE); @@ -763,6 +901,8 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; #endif } else if (equal(opt, lit("yydebug"))) { + if (org) + goto noarg; drop_privilege(); if (have_yydebug) { yydebug_onoff(1); @@ -778,6 +918,8 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; } } else if (equal(opt, lit("backtrace"))) { + if (org) + goto noarg; #if CONFIG_DEBUG_SUPPORT debug_set(DBG_BACKTRACE); continue; @@ -786,11 +928,20 @@ int txr_main(int argc, char **argv) return EXIT_FAILURE; #endif } else if (equal(opt, lit("noninteractive"))) { + if (org) + goto noarg; opt_noninteractive = 1; stream_set_prop(std_input, real_time_k, nil); continue; } else if (equal(opt, lit("free-all"))) { - atexit(free_all); + if (org) + goto noarg; + opt_free_all = 1; + continue; + } else if (equal(opt, lit("noprofile"))) { + if (org) + goto noarg; + opt_noprofile = 1; continue; } else { drop_privilege(); @@ -827,20 +978,27 @@ int txr_main(int argc, char **argv) case 'b': drop_privilege(); { - val pair = partition_star(arg, pos(chr('='), arg, nil, nil)); - val sym = lisp_parse(pop(&pair), std_error, - colon_k, lit("cmdline-expr"), colon_k); - val obj = lisp_parse(pop(&pair), std_error, - colon_k, lit("cmdline-expr"), colon_k); - - if (!bindable(sym)) { + val pair = split_str(arg, chr('=')); + if (cdr(pair)) { + val sym = lisp_parse(pop(&pair), std_error, + colon_k, lit("cmdline-expr"), colon_k); + val obj = lisp_parse(pop(&pair), std_error, + colon_k, lit("cmdline-expr"), colon_k); + + if (!bindable(sym)) { + format(std_error, + lit("~a: ~s isn't a bindable symbol\n"), + prog_string, sym, nao); + return EXIT_FAILURE; + } + + reg_var(sym, obj); + } else { format(std_error, - lit("~a: ~s isn't a bindable symbol\n"), - prog_string, sym, nao); + lit("~a: -b argument must be var=val syntax\n"), + prog_string, nao); return EXIT_FAILURE; } - - reg_var(sym, obj); } break; case 'c': @@ -874,8 +1032,10 @@ int txr_main(int argc, char **argv) prog_string, arg, spec_file_str, nao); return EXIT_FAILURE; } - if (wcscmp(c_str(spec_file), L"-") != 0) { - open_txr_file(spec_file, &txr_lisp_p, &spec_file_str, &parse_stream); + if (wcscmp(c_str(spec_file, self), L"-") != 0) { + spec_file_str = spec_file; + open_txr_file(spec_file, &txr_lisp_p, &spec_file_str, + &parse_stream, t, self); simulate_setuid_setgid(parse_stream); dyn_env = make_env(nil, nil, dyn_env); env_vbind(dyn_env, load_path_s, spec_file_str); @@ -895,10 +1055,17 @@ int txr_main(int argc, char **argv) reg_varl(self_path_s, lit("cmdline-expr")); reg_var(args_s, or2(orig_args, arg_list)); - eval_intrinsic(lisp_parse(arg, std_error, colon_k, - lit("cmdline-expr"), colon_k), - make_env(bindings, nil, nil)); + { + val forms = read_objects_from_string(arg, std_error, colon_k, + lit("cmdline-expr")); + + if (forms != colon_k) + eval_intrinsic(cons(progn_s, forms), + make_env(bindings, nil, nil), nil); + } + evaled = t; + args_new = cdr(lookup_global_var(args_s)); if (args_new != args_saved) { @@ -926,7 +1093,7 @@ int txr_main(int argc, char **argv) obj = eval_intrinsic(lisp_parse(arg, std_error, colon_k, lit("cmdline-expr"), colon_k), - make_env(bindings, nil, nil)); + make_env(bindings, nil, nil), nil); gc_hint(obj); pf(z(obj), std_output); @@ -967,15 +1134,8 @@ int txr_main(int argc, char **argv) break; case 'i': drop_privilege(); -#if HAVE_TERMIOS enter_repl = t; break; -#else - format(std_error, - lit("~a: option ~a requires a platform with termios\n"), - prog_string, arg, nao); - return EXIT_FAILURE; -#endif case 'd': drop_privilege(); #if CONFIG_DEBUG_SUPPORT @@ -1031,13 +1191,8 @@ int txr_main(int argc, char **argv) goto repl; if (evaled) return EXIT_SUCCESS; -#if HAVE_TERMIOS - banner(); + banner(self); goto repl; -#else - hint(); - return EXIT_FAILURE; -#endif } drop_privilege(); @@ -1061,10 +1216,11 @@ int txr_main(int argc, char **argv) val parser_obj = ensure_parser(parse_stream, spec_file_str); parser_t *parser = parser_get_impl(prog_string, parser_obj); parse_once_noerr(parse_stream, spec_file_str); + mut(parser_obj); gc_state(gc); close_stream(parse_stream, nil); - + run_load_hooks(dyn_env); uw_release_deferred_warnings(); spec = parser->syntax_tree; @@ -1103,36 +1259,41 @@ int txr_main(int argc, char **argv) reg_varl(car(binding), cdr(binding)); } - if (txr_lisp_p == chr('o')) { - val result = read_compiled_file_noerr(self, parse_stream, spec_file_str, - std_error); - if (!enter_repl) - return result ? 0 : EXIT_FAILURE; - } else { - val result = read_eval_stream_noerr(self, parse_stream, spec_file_str, - std_error); - - close_stream(parse_stream, nil); - - uw_release_deferred_warnings(); - - if (!enter_repl) - return result ? 0 : EXIT_FAILURE; + { + if (txr_lisp_p == chr('o')) { + uw_block_begin (load_s, ret); + ret = read_compiled_file_noerr(self, parse_stream, + spec_file_str, std_error); + uw_block_end; + if (!enter_repl) + exit_wrap(ret); + } else if (enter_repl) { + uw_block_begin (load_s, ret); + ret = read_eval_stream_noerr(self, parse_stream, + spec_file_str, std_error); + uw_block_end; + close_stream(parse_stream, nil); + run_load_hooks(dyn_env); + uw_release_deferred_warnings(); + } else { + uw_block_begin (load_s, ret); + ret = read_eval_stream(self, parse_stream, std_error); + uw_block_end; + exit_wrap(ret); + } } repl: -#if HAVE_TERMIOS if (compat_val) format(std_output, lit("Note: operating in TXR ~a compatibility mode " "due to environment variable.\n"), num(opt_compat), nao); reg_var(args_s, or2(orig_args, arg_list)); - reg_varl(intern(lit("self-path"), user_package), lit("listener")); + reg_varl(self_path_s, lit("listener")); env_vbind(dyn_env, package_s, opt_compat && opt_compat <= 190 ? user_package : public_package); env_vbind(dyn_env, load_recursive_s, nil); repl(bindings, std_input, std_output, nil); -#endif return 0; } |