/* Copyright 2009-2016
* Kaz Kylheku <kaz@kylheku.com>
* Vancouver, Canada
* All rights reserved.
*
* Redistribution of this software in source and binary forms, with or without
* modification, is permitted provided that the following two conditions are met.
*
* Use of this software in any manner constitutes agreement with the disclaimer
* which follows the two conditions.
*
* 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 ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
* WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE
* COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
* AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include <stdio.h>
#include <stdlib.h>
#include <limits.h>
#include <dirent.h>
#include <stdarg.h>
#include <wchar.h>
#include <signal.h>
#include "config.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_WINDOWS_H
#include <windows.h>
#undef TEXT
#endif
#include "lib.h"
#include "stream.h"
#include "gc.h"
#include "signal.h"
#include "unwind.h"
#include "y.tab.h"
#include "parser.h"
#include "match.h"
#include "utf8.h"
#include "debug.h"
#include "eval.h"
#include "regex.h"
#include "arith.h"
#include "sysif.h"
#if HAVE_GLOB
#include "glob.h"
#endif
#include "txr.h"
const wchli_t *version = wli(TXR_VER);
wchar_t *progname;
static const char *progname_u8;
static val prog_path = nil, sysroot_path = nil;
int opt_noninteractive;
int opt_compat;
int opt_dbg_expansion;
val stdlib_path;
/*
* Can implement an emergency allocator here from a fixed storage
* pool, which sets an OOM flag. Program can check flag
* and gracefully terminate instead of aborting like this.
*/
static mem_t *oom_realloc_handler(mem_t *old, size_t size)
{
format(std_error, lit("~a: out of memory\n"), prog_string, nao);
if (opt_print_bindings)
put_line(lit("false"), std_output);
abort();
}
static void help(void)
{
val text = lit(
"\n"
"TXR Version ~a\n"
"Copyright 2009-2016 Kaz Kylheku <kaz@kylheku.com>\n"
"\n"
"Usage:\n"
"\n"
" ~a [ options ] query-file { data-file }*\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"
"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"
"with a - followed by one or more characters, and which are not arguments to\n"
"options are interpreted as options. The -- option indicates the end of the\n"
"options.\n"
"\n"
"If no data-file arguments are supplied, then the query itself must open a\n"
"a data source prior to attempting to make any pattern match, or it will\n"
"simply fail due to a match which has run out of data.\n"
"\n"
"options:\n"
"\n"
"-Dvar=value Pre-define variable var, with the given value.\n"
" A list value can be specified using commas.\n"
"-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"
"-i Interactive TXR Lisp listener mode.\n"
" (Requires compiled-in support.)\n"
"-d Debugger mode.\n"
"-n Noninteractive input mode for standard input stream,\n"
" even if its connected to a terminal device.\n"
"-a N Generate array variables up to N dimensions.\n"
" N is a decimal integer. The default value is 1.\n"
" 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"
" 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"
" 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"
" using the prinl function.\n"
"-P expression Like -p, but prints using pprinl.\n"
"-t expression Like -p, but prints using tprint.\n"
"-C N Request backward-compatible behavior to the\n"
" specified version of TXR.\n"
"--help You already know!\n"
"--version Display program version\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"
"--lisp-bindings Synonym for -l\n"
"--debugger Synonym for -d\n"
"--noninteractive Synonym for -n\n"
"--compat=N Synonym for -C N\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"
"--eargs... arg Extended version of --args: additionally consumes\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
"--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"
"--gc-debug Enable a garbage collector stress test (slow).\n"
"--vg-debug Enable Valgrind integration, if compiled in.\n"
"--dv-regex Handle all regexes using derivative-based back-end.\n"
"\n"
"Options that take no argument can be combined. The -q and -v options\n"
"are mutually exclusive; the right-most one dominates.\n"
"\n"
);
format(std_output, text, static_str(version), prog_string, nao);
}
#if HAVE_TERMIOS
static void banner(void)
{
format(std_output,
lit("This is the TXR Lisp interactive listener of TXR ~a.\n"
"Use the :quit command or type Ctrl-D on empty line to exit.\n"),
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 remove_hash_bang_line(val spec)
{
if (!consp(spec))
return spec;
{
val firstline = first(spec);
val firstelem = first(firstline);
val item;
if (stringp(firstelem))
item = firstelem;
else if (consp(firstelem) && first(firstelem) == text_s)
item = second(firstelem);
else
return spec;
if (stringp(item)) {
val twochars = sub_str(item, zero, two);
if (equal(twochars, lit("#!")))
return rest(spec);
}
return spec;
}
}
#if __linux__
static val get_self_path(void)
{
char self[PATH_MAX] = { 0 };
int nchar = readlink("/proc/self/exe", self, sizeof self);
if (nchar < 0 || nchar >= convert(int, sizeof self))
return nil;
return string_utf8(self);
}
#elif HAVE_WINDOWS_H
static val get_self_path(void)
{
wchar_t self[MAX_PATH] = { 0 };
DWORD nchar;
SetLastError(0);
nchar = GetModuleFileNameW(NULL, self, MAX_PATH);
if (nchar == 0 ||
(nchar == MAX_PATH &&
((GetLastError() == ERROR_INSUFFICIENT_BUFFER) ||
(self[MAX_PATH - 1] != 0))))
return nil;
return string(self);
}
#else
static val get_self_path(void)
{
char self[PATH_MAX];
if (!progname_u8)
return nil;
if (realpath(progname_u8, self))
return string_utf8(self);
return nil;
}
#endif
static val maybe_sysroot(val exepart)
{
return if2(match_str(prog_path, exepart, negone),
sysroot_path = sub_str(prog_path, 0, neg(length(exepart))));
}
static val dirname(val path)
{
val rslash = rpos(chr('/'), path, nil, nil);
return if3(rslash, sub_str(path, zero, succ(rslash)), path);
}
static val substitute_basename(val edited_path, val source_path)
{
val lslash = rpos(chr('/'), edited_path, nil, nil);
val rslash = rpos(chr('/'), source_path, nil, nil);
val basename = if3(rslash,
sub_str(source_path, succ(rslash), t),
source_path);
return if3(lslash,
format(nil, lit("~a~a"),
sub_str(edited_path, 0, succ(lslash)),
basename, nao),
basename);
}
static val sysroot(val target)
{
return format(nil, lit("~a~a"), sysroot_path, target, nao);
}
static void sysroot_init(void)
{
val prog_dir;
#if HAVE_WINDOWS_H
val slash = regex_compile(lit("\\\\"), nil);
#endif
protect(&prog_path, &sysroot_path, &stdlib_path, (val *) 0);
prog_path = get_self_path();
#if HAVE_WINDOWS_H
prog_path = regsub(slash, lit("/"), prog_path);
#endif
prog_dir = dirname(prog_path);
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))))
{
sysroot_path = prog_dir;
}
stdlib_path = sysroot(lit("share/txr/stdlib/"));
reg_varl(intern(lit("stdlib"), user_package), stdlib_path);
reg_varl(intern(lit("*txr-version*"), user_package),
toint(lit(TXR_VER), nil));
reg_varl(intern(lit("txr-version"), user_package),
toint(lit(TXR_VER), nil));
reg_varl(intern(lit("txr-path"), user_package), prog_dir);
}
static void sysroot_compat_fixup(int compat_ver)
{
if (compat_ver <= 143)
reg_varl(intern(lit("stdlib"), user_package),
sysroot(lit("share/txr/stdlib")));
}
static int license(void)
{
int retval = EXIT_SUCCESS;
uw_catch_begin(cons(error_s, nil), esym, eargs);
{
val iter;
#if HAVE_GLOB
val glob_pattern = sysroot(lit("share/txr/LICENSE*"));
val path_list = glob_wrap(glob_pattern, zero, nil);
#else
val glob_pattern = sysroot(lit("share/txr/LICENSE"));
val path_list = cons(glob_pattern, nil);
#endif
if (!path_list)
uw_throwf(error_s, lit("Error: pattern ~a didn't match any files."),
glob_pattern, nao);
put_char(chr('\n'), std_output);
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_char(chr('\n'), std_output);
}
}
uw_catch (esym, eargs) {
format(std_output,
lit("~a\nThis TXR installation might be unlicensed.\n"),
car(eargs), nao);
retval = EXIT_FAILURE;
}
uw_unwind { }
uw_catch_end;
return retval;
}
int txr_main(int argc, char **argv);
int main(int argc, char **argv)
{
val stack_bottom = nil;
repress_privilege();
progname = utf8_dup_from(argv[0] ? argv[0]: "txr");
progname_u8 = argv[0];
init(oom_realloc_handler, &stack_bottom);
match_init();
debug_init();
sysroot_init();
return txr_main(argc, argv);
}
static void requires_arg(val opt)
{
format(std_error, lit("~a: option --~a requires an argument\n"),
prog_string, opt, nao);
}
static int do_fixnum_opt(int (*opt_func)(val), val opt, val arg)
{
if (arg) {
val optval = int_str(arg, nil);
if (!optval || !fixnump(optval)) {
format(std_error, lit("~a: option -~a needs a small integer "
"argument, not ~a\n"), prog_string, opt,
arg, nao);
return 0;
}
return opt_func(optval);
}
requires_arg(opt);
return 0;
}
static int compat(val optval)
{
int compat = c_num(optval);
int min = compat_fixup(compat);
if (min) {
format(std_error, lit("~a: compatibility with versions "
"lower than ~a not supported by version ~a\n"),
prog_string, num(min), static_str(version), nao);
return 0;
}
sysroot_compat_fixup(compat);
opt_compat = compat;
return 1;
}
static int array_dim(val optval)
{
opt_arraydims = c_num(optval);
opt_print_bindings = 1;
return 1;
}
static int gc_delta(val optval)
{
opt_gc_delta = c_num(mul(optval, num_fast(1048576)));
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)
{
format(std_error,
lit("~a: option ~a requires debug support compiled in\n"),
prog_string, arg, nao);
}
#endif
int txr_main(int argc, char **argv)
{
uses_or2;
val specstring = nil;
val spec = nil;
val spec_file = nil;
val bindings = nil;
val evaled = nil;
val spec_file_str;
int match_loglevel = opt_loglevel;
val arg_undo = nil, arg;
val parse_stream = std_input;
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;
list_collect_decl(arg_list, arg_tail);
static char alt_args_buf[128 + 7] = "@(txr):", *alt_args = alt_args_buf + 7;
setvbuf(stderr, 0, _IOLBF, 0);
if (compat_val && length(compat_val) != zero) {
val value = int_str(compat_val, nil);
if (!value) {
format(std_error,
lit("~a: environment variable ~a=~a must be decimal integer\n"),
prog_string, compat_var, compat_val, nao);
return EXIT_FAILURE;
}
if (!compat(value)) {
format(std_error, lit("~a: caused by environment variable ~a=~a\n"),
prog_string, compat_var, compat_val, nao);
return EXIT_FAILURE;
}
}
while (*argv)
arg_tail = list_collect(arg_tail, string_utf8(*argv++));
reg_var(intern(lit("*full-args*"), user_package), arg_list);
reg_var(intern(lit("*args-full*"), user_package), arg_list);
arg_list = cdr(arg_list);
if (*alt_args) {
orig_args = arg_list;
arg_list = list(string_utf8(alt_args), nao);
} else if (argc <= 1) {
drop_privilege();
#if HAVE_TERMIOS
banner();
goto repl;
#else
hint();
return EXIT_FAILURE;
#endif
}
for (arg = upop(&arg_list, &arg_undo);
arg && car(arg) == chr('-');
arg = upop(&arg_list, &arg_undo))
{
if (equal(arg, lit("--")))
break;
if (equal(arg, lit("-")))
break;
/* Odd case 1: --args is followed by an arbitrary delimiting
* character, not necessarily = */
if (match_str(arg, lit("--args"), zero) && ge(length(arg), num(7))) {
val sep = sub_str(arg, num(6), num(7));
arg = sub_str(arg, num(7), nil);
arg_list = append2(split_str(arg, sep), arg_list);
continue;
}
/* Odd case 2: --eargs is followed by an arbitrary delimiting
* character, not necessarily = */
if (match_str(arg, lit("--eargs"), zero) && ge(length(arg), num(8))) {
val sep = sub_str(arg, num(7), num(8));
val arg2;
if (!arg_list) {
format(std_error,
lit("~a: --eargs=[...] must be followed by an argument\n"),
prog_string, nao);
return EXIT_FAILURE;
}
arg = sub_str(arg, num(8), nil);
arg2 = upop(&arg_list, &arg_undo);
arg_list = append2(mapcar(curry_123_3(func_n3(regsub),
regex_compile(lit("{}"), nil),
arg2),
split_str(arg, sep)),
arg_list);
continue;
}
/* 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(",")));
if (rest(deflist))
bindings = cons(cons(intern(var, nil), deflist), bindings);
else if (deflist)
bindings = cons(cons(intern(var, nil), car(deflist)), bindings);
else
bindings = cons(cons(intern(var, nil), t), bindings);
continue;
}
/* Regular long opts */
if (match_str(arg, lit("--"), zero)) {
val no_dashes = sub(arg, two, t);
val pair = partition_star(no_dashes, pos(chr('='), no_dashes, nil, nil));
val opt = pop(&pair);
val org = pop(&pair);
/* Long opts with arguments */
if (equal(opt, lit("gc-delta"))) {
if (!do_fixnum_opt(gc_delta, opt, arg))
return EXIT_FAILURE;
continue;
}
if (equal(opt, lit("compat"))) {
if (!do_fixnum_opt(compat, opt, org))
return EXIT_FAILURE;
continue;
}
/* Long opts with no arguments */
if (org) {
drop_privilege();
format(std_error,
lit("~a: option --~a takes no argument, ~a given\n"),
prog_string, opt, org, nao);
return EXIT_FAILURE;
}
if (equal(opt, lit("version"))) {
drop_privilege();
format(std_output, lit("~a: version ~a\n"),
prog_string, static_str(version), nao);
return 0;
}
if (equal(opt, lit("help"))) {
drop_privilege();
help();
return 0;
}
if (equal(opt, lit("license"))) {
drop_privilege();
return license();
}
if (equal(opt, lit("gc-debug"))) {
drop_privilege();
opt_gc_debug = 1;
continue;
} else if (equal(opt, lit("vg-debug"))) {
drop_privilege();
#if HAVE_VALGRIND
opt_vg_debug = 1;
continue;
#else
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"))) {
opt_derivative_regex = 1;
continue;
} else if (equal(opt, lit("lisp-bindings"))) {
opt_lisp_bindings = 1;
opt_print_bindings = 1;
continue;
} else if (equal(opt, lit("lisp"))) {
txr_lisp_p = t;
continue;
#if HAVE_FORK_STUFF
} else if (equal(opt, lit("reexec"))) {
exec_wrap(prog_path, arg_list);
return EXIT_FAILURE;
#endif
} else if (equal(opt, lit("debugger"))) {
drop_privilege();
#if CONFIG_DEBUG_SUPPORT
opt_debugger = 1;
continue;
#else
no_dbg_support(arg);
return EXIT_FAILURE;
#endif
} else if (equal(opt, lit("debug-autoload"))) {
drop_privilege();
#if CONFIG_DEBUG_SUPPORT
opt_debugger = 1;
opt_dbg_autoload = 1;
continue;
#else
no_dbg_support(opt);
return EXIT_FAILURE;
#endif
} else if (equal(opt, lit("debug-expansion"))) {
drop_privilege();
#if CONFIG_DEBUG_SUPPORT
opt_debugger = 1;
opt_dbg_expansion = 1;
continue;
#else
no_dbg_support(opt);
return EXIT_FAILURE;
#endif
} else if (equal(opt, lit("yydebug"))) {
drop_privilege();
if (have_yydebug) {
yydebug_onoff(1);
format(std_error,
lit("~a: option --~a takes no argument, ~a given\n"),
prog_string, opt, org, nao);
continue;
} else {
drop_privilege();
format(std_error,
lit("~a: option ~a requires YYDEBUG support compiled in\n"),
prog_string, arg, nao);
return EXIT_FAILURE;
}
} else if (equal(opt, lit("noninteractive"))) {
opt_noninteractive = 1;
stream_set_prop(std_input, real_time_k, nil);
continue;
} else if (equal(opt, lit("free-all"))) {
atexit(free_all);
continue;
} else {
drop_privilege();
format(std_error, lit("~a: unrecognized long option: --~a\n"),
prog_string, opt, nao);
return EXIT_FAILURE;
}
}
/* Single letter options with args: non-clumping. */
if (length(arg) == two && find(ref(arg, one), lit("acfepPtC"), nil, nil))
{
val opt = chr_str(arg, one);
if (!arg_list) {
drop_privilege();
requires_arg(opt);
return EXIT_FAILURE;
}
arg = upop(&arg_list, &arg_undo);
switch (c_chr(opt)) {
case 'a':
if (!do_fixnum_opt(array_dim, opt, arg))
return EXIT_FAILURE;
break;
case 'C':
if (!do_fixnum_opt(compat, opt, arg))
return EXIT_FAILURE;
break;
case 'c':
if (txr_lisp_p) {
format(std_error,
lit("~a: -c not compatible with --lisp; use -e\n"),
prog_string, nao);
return EXIT_FAILURE;
}
specstring = arg;
break;
case 'f':
spec_file = arg;
break;
case 'e':
drop_privilege();
{
val args_saved = or2(orig_args, arg_list);
val args_new;
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));
evaled = t;
args_new = cdr(lookup_global_var(args_s));
if (args_new != args_saved) {
arg_list = args_new;
orig_args = nil;
}
}
break;
case 'p':
case 'P':
case 't':
drop_privilege();
{
val (*pf)(val obj, val out) = if3(c_chr(opt) == 'p',
prinl,
if3(c_chr(opt) == 'P',
pprinl,
tprint));
val args_saved = or2(orig_args, arg_list);
val args_new;
reg_varl(self_path_s, lit("cmdline-expr"));
reg_var(args_s, or2(orig_args, arg_list));
pf(eval_intrinsic(lisp_parse(arg, std_error, colon_k,
lit("cmdline-expr"), colon_k),
make_env(bindings, nil, nil)), std_output);
evaled = t;
args_new = cdr(lookup_global_var(args_s));
if (args_new != args_saved) {
arg_list = args_new;
orig_args = nil;
}
}
break;
}
continue;
}
/* Clumping single-letter options. */
{
val optchars = cdr(arg);
for (; optchars != nil; optchars = cdr(optchars)) {
val opch = car(optchars);
switch (c_chr(opch)) {
case 'v':
match_loglevel = 2;
break;
case 'q':
match_loglevel = 0;
break;
case 'b': /* deprecated */
break;
case 'B':
opt_print_bindings = 1;
break;
case 'l':
opt_lisp_bindings = 1;
opt_print_bindings = 1;
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
opt_debugger = 1;
#else
no_dbg_support(opch);
return EXIT_FAILURE;
#endif
break;
case 'n':
opt_noninteractive = 1;
stream_set_prop(std_input, real_time_k, nil);
break;
case 'a':
case 'c':
case 'e':
case 'p':
case 'P':
case 'f':
case 'C':
case 't':
case 'D':
drop_privilege();
format(std_error, lit("~a: option -~a does not clump\n"),
prog_string, opch, nao);
return EXIT_FAILURE;
case '-':
drop_privilege();
format(std_error, lit("~a: dash in the middle of options: ~a\n"),
prog_string, arg, nao);
return EXIT_FAILURE;
default:
drop_privilege();
format(std_error, lit("~a: unrecognized option: -~a\n"),
prog_string, opch, nao);
return EXIT_FAILURE;
}
}
}
}
if (specstring && spec_file) {
drop_privilege();
format(std_error, lit("~a: cannot specify both -f and -c\n"),
prog_string, nao);
return EXIT_FAILURE;
}
if (specstring) {
drop_privilege();
spec_file_str = lit("cmdline");
if (gt(length_str(specstring), zero) &&
chr_str(specstring, minus(length_str(specstring), one)) != chr('\n'))
specstring = cat_str(list(specstring, string(L"\n"), nao), nil);
parse_stream = make_string_byte_input_stream(specstring);
if (arg)
arg_list = arg_undo;
} else if (spec_file) {
if (wcscmp(c_str(spec_file), L"-") != 0) {
open_txr_file(spec_file, &txr_lisp_p, &spec_file_str, &parse_stream);
simulate_setuid_setgid(parse_stream);
set_get_symacro(self_load_path_s, spec_file_str);
} else {
drop_privilege();
spec_file_str = lit("stdin");
}
if (arg)
arg_list = arg_undo;
} else {
if (!arg) {
drop_privilege();
if (enter_repl)
goto repl;
if (evaled)
return EXIT_SUCCESS;
#if HAVE_TERMIOS
banner();
goto repl;
#else
hint();
return EXIT_FAILURE;
#endif
}
if (!equal(arg, lit("-"))) {
open_txr_file(arg, &txr_lisp_p, &spec_file_str, &parse_stream);
simulate_setuid_setgid(parse_stream);
set_get_symacro(self_load_path_s, spec_file_str);
} else {
drop_privilege();
spec_file_str = lit("stdin");
}
}
reg_var(args_s, or2(orig_args, arg_list));
reg_varl(intern(lit("self-path"), user_package), spec_file_str);
if (!txr_lisp_p)
{
int gc = gc_state(0);
parser_t parser;
parse_once(parse_stream, spec_file_str, &parser);
gc_state(gc);
close_stream(parse_stream, nil);
if (parser.errors)
return EXIT_FAILURE;
spec = remove_hash_bang_line(parser.syntax_tree);
opt_loglevel = match_loglevel;
if (opt_loglevel >= 2) {
format(std_error, lit("spec:\n~s\n"), spec, nao);
format(std_error, lit("bindings:\n~s\n"), bindings, nao);
}
reg_var(intern(lit("*self-path*"), user_package), spec_file_str);
{
val result = extract(spec, arg_list, bindings);
cons_bind (new_bindings, success, result);
if (enter_repl) {
bindings = new_bindings;
goto repl;
}
return (parser.errors || !success) ? EXIT_FAILURE : 0;
}
}
for (; bindings; bindings = cdr(bindings)) {
val binding = car(bindings);
reg_varl(car(binding), cdr(binding));
}
{
val result = read_eval_stream(parse_stream, std_error, t);
close_stream(parse_stream, nil);
if (!enter_repl)
return result ? 0 : EXIT_FAILURE;
}
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"));
repl(bindings, std_input, std_output);
#endif
return 0;
}