New feature: self-load-path symbol macro.

* eval.c (self_load_path_s): New symbol variable.
(sys_load): Save, set-up and restore self-load-path
around load.
(set_get_symacro): New function.
(eval_init): Register load function using sys_load_s instead
of redundant intern.

* eval.h (set_get_symacro): Declared.

* match.c (v_load): Save, set-up and restore self-load-path
macro.

* parser.c (load_rcfile): Likewise.

* txr.c (txr_main: Set up self-load-path when opening
file.

* txr.1: Documented self-load-path.

6 files changed, 94 insertions, 8 deletions

diff --git a/eval.c b/eval.c
index ebfc9ffe..7316ed30 100644
--- a/eval.c
+++ b/eval.c
@@ -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);
diff --git a/eval.h b/eval.h
index c0cce698..7af95058 100644
--- a/eval.h
+++ b/eval.h
@@ -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);
diff --git a/match.c b/match.c
index bffde874..f3b05abe 100644
--- a/match.c
+++ b/match.c
@@ -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;
   }
 }
 
diff --git a/parser.c b/parser.c
index f5edfbed..d876a4fa 100644
--- a/parser.c
+++ b/parser.c
@@ -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);
   }
diff --git a/txr.1 b/txr.1
index cd071bee..217a2b51 100644
--- a/txr.1
+++ b/txr.1
@@ -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
diff --git a/txr.c b/txr.c
index da7869c7..4f09bf3e 100644
--- a/txr.c
+++ b/txr.c
@@ -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");