summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--eval.c8
-rw-r--r--match.c6
-rw-r--r--parser.c48
-rw-r--r--parser.h1
-rw-r--r--txr.c12
5 files changed, 64 insertions, 11 deletions
diff --git a/eval.c b/eval.c
index e16e8075..152006f3 100644
--- a/eval.c
+++ b/eval.c
@@ -4157,11 +4157,17 @@ val load(val target)
env_vbind(dyn_env, load_recursive_s, t);
env_vbind(dyn_env, package_s, cur_package);
- if (txr_lisp_p) {
+ if (txr_lisp_p == t) {
if (!read_eval_stream(stream, std_error)) {
close_stream(stream, nil);
uw_throwf(error_s, lit("load: ~a contains errors"), path, nao);
}
+ } else if (txr_lisp_p == chr('o')) {
+ if (!read_compiled_file(stream, std_error)) {
+ close_stream(stream, nil);
+ uw_throwf(error_s, lit("load: unable to load compiled file ~a"),
+ path, nao);
+ }
} else {
int gc = gc_state(0);
parser_t parser;
diff --git a/match.c b/match.c
index 10fd1770..15bb7e79 100644
--- a/match.c
+++ b/match.c
@@ -4310,7 +4310,11 @@ static val v_load(match_files_ctx *c)
} else {
uw_set_match_context(cons(c->spec, c->bindings));
- if (!read_eval_stream(stream, std_error)){
+ if (txr_lisp_p == chr('o') && !read_compiled_file(stream, std_error)) {
+ close_stream(stream, nil);
+ uw_throwf(error_s, lit("load: unable to load compiled file ~a"),
+ path, nao);
+ } else if (!read_eval_stream(stream, std_error)) {
close_stream(stream, nil);
sem_error(specline, lit("load: ~a contains errors"), path, nao);
}
diff --git a/parser.c b/parser.c
index 0d0151d5..a5109a18 100644
--- a/parser.c
+++ b/parser.c
@@ -55,6 +55,7 @@
#include "cadr.h"
#include "struct.h"
#include "parser.h"
+#include "vm.h"
#include "txr.h"
#if HAVE_TERMIOS
#include "linenoise/linenoise.h"
@@ -411,12 +412,14 @@ val parser_circ_ref(parser_t *p, val num)
void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
{
- enum { none, tl, txr } suffix;
+ enum { none, tl, tlo, txr } suffix;
if (match_str(spec_file, lit(".txr"), negone))
suffix = txr;
else if (match_str(spec_file, lit(".tl"), negone))
suffix = tl;
+ else if (match_str(spec_file, lit(".tlo"), negone))
+ suffix = tlo;
else
suffix = none;
@@ -431,6 +434,9 @@ void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
case tl:
*txr_lisp_p = t;
break;
+ case tlo:
+ *txr_lisp_p = chr('o');
+ break;
case txr:
*txr_lisp_p = nil;
break;
@@ -456,10 +462,17 @@ void open_txr_file(val spec_file, val *txr_lisp_p, val *name, val *stream)
}
- if (suffix == none && in == 0) {
- spec_file_try = scat(lit("."), spec_file, lit("tl"), nao);
- in = w_fopen(c_str(spec_file_try), L"r");
- *txr_lisp_p = t;
+ if (suffix == none) {
+ if (in == 0) {
+ spec_file_try = scat(lit("."), spec_file, lit("tlo"), nao);
+ in = w_fopen(c_str(spec_file_try), L"r");
+ *txr_lisp_p = chr('o');
+ }
+ if (in == 0) {
+ spec_file_try = scat(lit("."), spec_file, lit("tl"), nao);
+ in = w_fopen(c_str(spec_file_try), L"r");
+ *txr_lisp_p = t;
+ }
}
if (in == 0) {
@@ -592,7 +605,7 @@ val iread(val source_in, val error_stream, val error_return_val,
name_in, lineno);
}
-val read_eval_stream(val stream, val error_stream)
+static val read_file_common(val stream, val error_stream, val compiled)
{
val error_val = gensym(nil);
val name = stream_get_prop(stream, name_k);
@@ -609,7 +622,18 @@ val read_eval_stream(val stream, val error_stream)
continue;
}
- (void) eval_intrinsic(form, nil);
+ if (compiled) {
+ val nlevels = pop(&form);
+ val nregs = pop(&form);
+ val bytecode = pop(&form);
+ val dv_raw = pop(&form);
+ val datavec = if3(consp(dv_raw), vec_list(cadr(dv_raw)), dv_raw);
+ val funvec = car(form);
+ val desc = vm_make_desc(nlevels, nregs, bytecode, datavec, funvec);
+ (void) vm_execute_toplevel(desc);
+ } else {
+ (void) eval_intrinsic(form, nil);
+ }
if (parser_eof(parser))
break;
@@ -618,6 +642,16 @@ val read_eval_stream(val stream, val error_stream)
return t;
}
+val read_eval_stream(val stream, val error_stream)
+{
+ return read_file_common(stream, error_stream, nil);
+}
+
+val read_compiled_file(val stream, val error_stream)
+{
+ return read_file_common(stream, error_stream, t);
+}
+
#if HAVE_TERMIOS
static void load_rcfile(val name)
diff --git a/parser.h b/parser.h
index 33b22d00..12378631 100644
--- a/parser.h
+++ b/parser.h
@@ -121,6 +121,7 @@ val nread(val source_in, val error_stream, val error_return_val,
val iread(val source_in, val error_stream, val error_return_val,
val name_in, val lineno);
val read_eval_stream(val stream, val error_stream);
+val read_compiled_file(val stream, val error_stream);
#if HAVE_TERMIOS
val repl(val bindings, val in_stream, val out_stream);
#endif
diff --git a/txr.c b/txr.c
index 30f5c8ae..14cc6642 100644
--- a/txr.c
+++ b/txr.c
@@ -139,6 +139,7 @@ static void help(void)
" 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"
"--noninteractive Synonym for -n\n"
@@ -677,6 +678,9 @@ int txr_main(int argc, char **argv)
} else if (equal(opt, lit("lisp"))) {
txr_lisp_p = t;
continue;
+ } else if (equal(opt, lit("compiled"))) {
+ txr_lisp_p = chr('o');
+ continue;
#if HAVE_FORK_STUFF
} else if (equal(opt, lit("reexec"))) {
exec_wrap(prog_path, arg_list);
@@ -787,7 +791,7 @@ int txr_main(int argc, char **argv)
case 'c':
if (txr_lisp_p) {
format(std_error,
- lit("~a: -c not compatible with --lisp; use -e\n"),
+ lit("~a: -c not compatible with --lisp or --compiled; use -e\n"),
prog_string, nao);
return EXIT_FAILURE;
}
@@ -1036,7 +1040,11 @@ int txr_main(int argc, char **argv)
reg_varl(car(binding), cdr(binding));
}
- {
+ if (txr_lisp_p == chr('o')) {
+ val result = read_compiled_file(parse_stream, std_error);
+ if (!enter_repl)
+ return result ? 0 : EXIT_FAILURE;
+ } else {
val result = read_eval_stream_noerr(parse_stream, spec_file_str,
std_error);
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-16 03:31:56 +0000