diff options
| -rw-r--r-- | eval.c | 34 | ||||
| -rw-r--r-- | eval.h | 2 | ||||
| -rw-r--r-- | match.c | 25 | ||||
| -rw-r--r-- | parser.c | 4 | ||||
| -rw-r--r-- | txr.1 | 35 | ||||
| -rw-r--r-- | txr.c | 2 |
6 files changed, 94 insertions, 8 deletions
@@ -98,7 +98,7 @@ val macro_time_s, with_saved_vars_s, macrolet_s; val defsymacro_s, symacrolet_s, prof_s; val fbind_s, lbind_s, flet_s, labels_s; val opip_s, oand_s, chain_s, chand_s; -val sys_load_s, sys_lisp1_value_s; +val sys_load_s, self_load_path_s, sys_lisp1_value_s; val special_s, whole_k, form_k, symacro_k; @@ -3257,6 +3257,7 @@ static val sys_load(val target, val sloc) cons(target, nil)), lit("/"))); val name, stream; val txr_lisp_p = t; + val self_load_path_old = nil; open_txr_file(path, &txr_lisp_p, &name, &stream); @@ -3266,13 +3267,23 @@ static val sys_load(val target, val sloc) eval_error(sloc, lit("load doesn't process .txr files"), nao); } + uw_simple_catch_begin; + + self_load_path_old = set_get_symacro(self_load_path_s, path); + if (!read_eval_stream(stream, std_error, nil)) { rlset(sloc, sloc); close_stream(stream, nil); eval_error(sloc, lit("load: ~a contains errors"), path, nao); } - close_stream(stream, nil); + uw_unwind { + set_get_symacro(self_load_path_s, self_load_path_old); + close_stream(stream, nil); + } + + uw_catch_end; + return nil; } @@ -4383,6 +4394,24 @@ void reg_var(val sym, val val) mark_special(sym); } +val set_get_symacro(val sym, val form) +{ + val cell = gethash_c(top_smb, sym, nulloc); + val binding = cdr(cell); + val old = cdr(binding); + + if (form) { + if (binding) + rplacd(binding, form); + else + rplacd(cell, cons(sym, form)); + } else { + remhash(top_smb, sym); + } + + return old; +} + static val if_fun(val cond, val then, val alt) { return if3(cond, then, default_bool_arg(alt)); @@ -4661,6 +4690,7 @@ void eval_init(void) chain_s = intern(lit("chain"), user_package); chand_s = intern(lit("chand"), user_package); sys_load_s = intern(lit("load"), system_package); + self_load_path_s = intern(lit("self-load-path"), user_package); sys_lisp1_value_s = intern(lit("lisp1-value"), system_package); reg_op(macrolet_s, op_error); @@ -29,6 +29,7 @@ extern val hash_lit_s, hash_construct_s, struct_lit_s, qref_s; extern val eval_error_s, if_s, call_s; extern val eq_s, eql_s, equal_s; extern val last_form_evaled, last_form_expanded; +extern val self_load_path_s; noreturn val eval_error(val ctx, val fmt, ...); val ctx_form(val obj); @@ -56,6 +57,7 @@ val func_get_name(val fun, val env); void reg_varl(val sym, val val); void reg_var(val sym, val val); void reg_fun(val sym, val fun); +val set_get_symacro(val sym, val form); val apply(val fun, val arglist); val apply_intrinsic(val fun, val args); val eval_progn(val forms, val env, val ctx_form); @@ -3771,29 +3771,33 @@ static val v_load(match_files_ctx *c) cons(target, nil)), lit("/"))); val stream, name; val txr_lisp_p = nil; + val ret = nil; + val self_load_path_old = nil; open_txr_file(path, &txr_lisp_p, &name, &stream); + uw_simple_catch_begin; + + self_load_path_old = set_get_symacro(self_load_path_s, name); + if (!txr_lisp_p) { int gc = gc_state(0); parser_t parser; + parse_once(stream, name, &parser); gc_state(gc); - close_stream(stream, nil); - if (parser.errors) sem_error(specline, lit("~s: errors encountered in ~a"), sym, path, nao); if (sym == include_s) { - return parser.syntax_tree; + ret = parser.syntax_tree; } else { val spec = parser.syntax_tree; val result = match_files(mf_spec(*c, spec)); if (!result) { debuglf(specline, lit("load: ~a failed"), path, nao); - return nil; } else { cons_bind (new_bindings, success, result); @@ -3812,7 +3816,7 @@ static val v_load(match_files_ctx *c) c->data = nil; } - return next_spec_k; + ret = next_spec_k; } } } else { @@ -3820,9 +3824,18 @@ static val v_load(match_files_ctx *c) close_stream(stream, nil); sem_error(specline, lit("load: ~a contains errors"), path, nao); } + + ret = (sym == include_s) ? nil : next_spec_k; + } + + uw_unwind { + set_get_symacro(self_load_path_s, self_load_path_old); close_stream(stream, nil); - return (sym == include_s) ? nil : next_spec_k; } + + uw_catch_end; + + return ret; } } @@ -404,6 +404,7 @@ static void load_rcfile(val name) val catch_syms = cons(error_s, nil); val path_private_to_me_p = intern(lit("path-private-to-me-p"), user_package); val path_exists_p = intern(lit("path-exists-p"), user_package); + val self_load_path_old = nil; if (!funcall1(path_exists_p, name)) return; @@ -412,6 +413,8 @@ static void load_rcfile(val name) open_txr_file(name, &lisp_p, &resolved_name, &stream); + self_load_path_old = set_get_symacro(self_load_path_s, resolved_name); + if (stream) { if (!funcall1(path_private_to_me_p, statf(stream))) { format(std_output, @@ -431,6 +434,7 @@ static void load_rcfile(val name) } uw_unwind { + set_get_symacro(self_load_path_s, self_load_path_old); if (stream) close_stream(stream, nil); } @@ -41399,6 +41399,41 @@ Parser error messages are directed to the .code *stderr* stream. +.coNP Symbol Macro @ self-load-path +.desc +The +.code self-load-path +symbol macro expands to a string which holds the name of the file being +loaded. This is a symbol macro rather than a variable so that it can +be replaced during the macro-expansion process, thereby permanently embedding +the file name into the expanded code. + +An expansion for +.code self-load-path +is established for a \*(TX or \*(TL file which is loaded from the +command line. + +If the +.code -i +command line option is used to enter the interactive listener, +and a file to be loaded is also specified, then the +.code self-load-path +macro remains bound to the name of that file. + +An expansion for +.code self-load-path +is also established by the +.code load +function and the +.code @(load) +directive, referring to the file being loaded. When loading completes, the +previous expansion of +.code self-load-path +is restored. + +During the processing of the profile file (see Interactive Profile File), +the variable is bound to the name of that file. + .SH* INTERACTIVE LISTENER .SS* Overview @@ -817,6 +817,7 @@ int txr_main(int argc, char **argv) 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"); @@ -842,6 +843,7 @@ int txr_main(int argc, char **argv) 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"); |