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.

1 files changed, 32 insertions, 2 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);