Introducing some changes for improved handling of special variables.

Saving and restoring of individual variables is very silly
and it's making it difficult to implement function parameters
that are rebindings of special variables.

Let's have a global pointer to a dynamic environment called dyn_env.
Let's make it part of the extended_jmp_buf structure, so that it's
implicitly saved and restored across exception handling.

Special variable lookups go through the dyn_env chain, and fall back on
the global bindings.

To override some specials, we just push a new dynamic environment and
stick them there. (As a bonus, the bindings can even be repeated in the
lexical environment (i.e. the same objects), so they can be found
faster. We have to make sure we remove that environment when we
leave the scope in the normal way. If we unwind out, it is done
automatically by extended_longjmp mechanism.

* eval.c (dyn_env): New global variable.
(lookup_var, lookup_var_l): If env is nil, look in the dyn_env
first, and only if that fails, look in the global bindings top_vb.

* signal.h (extended_jmp_buf): New member, de, for saving/restoring
dyn_env. This structure is now used whether or not we have signals.
(extended_setjmp, extended_longjmp): Updated to save and restore
dyn_env, and to do it regardless of whether there is POSIX signal
support.
(dyn_env): Declared here.

3 files changed, 84 insertions, 18 deletions

diff --git a/ChangeLog b/ChangeLog
index b6c1a7e8..d0d52e72 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,35 @@
+2014-02-23  Kaz Kylheku  <kaz@kylheku.com>
+
+	Introducing some changes for improved handling of special variables.
+	Saving and restoring of individual variables is very silly
+	and it's making it difficult to implement function parameters
+	that are rebindings of special variables.
+
+	Let's have a global pointer to a dynamic environment called dyn_env.
+	Let's make it part of the extended_jmp_buf structure, so that it's
+	implicitly saved and restored across exception handling.
+
+	Special variable lookups go through the dyn_env chain, and fall back on
+	the global bindings.
+
+	To override some specials, we just push a new dynamic environment and
+	stick them there. (As a bonus, the bindings can even be repeated in the
+	lexical environment (i.e. the same objects), so they can be found
+	faster. We have to make sure we remove that environment when we
+	leave the scope in the normal way. If we unwind out, it is done
+	automatically by extended_longjmp mechanism.
+
+	* eval.c (dyn_env): New global variable.
+	(lookup_var, lookup_var_l): If env is nil, look in the dyn_env
+	first, and only if that fails, look in the global bindings top_vb.
+
+	* signal.h (extended_jmp_buf): New member, de, for saving/restoring
+	dyn_env. This structure is now used whether or not we have signals.
+	(extended_setjmp, extended_longjmp): Updated to save and restore
+	dyn_env, and to do it regardless of whether there is POSIX signal
+	support.
+	(dyn_env): Declared here.
+
 2014-02-22  Kaz Kylheku  <kaz@kylheku.com>
 
 	* eval.c (symbol_function): Retrieve the global macro binding if the
diff --git a/eval.c b/eval.c
index baa0ed73..8c411f2e 100644
--- a/eval.c
+++ b/eval.c
@@ -73,6 +73,7 @@ struct c_var {
 
 val top_vb, top_fb, top_mb, special;
 val op_table;
+val dyn_env;
 
 val eval_error_s;
 val dwim_s, progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s;
@@ -141,14 +142,22 @@ noreturn static val eval_error(val form, val fmt, ...)
 val lookup_var(val env, val sym)
 {
   if (nilp(env)) {
-    val bind = gethash(top_vb, sym);
-    if (cobjp(bind)) {
-      struct c_var *cv = (struct c_var *) cptr_get(bind);
-      set(cv->bind->c.cdr, *cv->loc);
-      return cv->bind;
+    if (dyn_env) {
+      val binding = assoc(sym, dyn_env->e.vbindings);
+      if (binding)
+        return binding;
+    } 
+    
+    {
+      val bind = gethash(top_vb, sym);
+      if (cobjp(bind)) {
+        struct c_var *cv = (struct c_var *) cptr_get(bind);
+        set(cv->bind->c.cdr, *cv->loc);
+        return cv->bind;
+      }
+      return bind;
     }
-    return bind;
-  } else  {
+  } else {
     type_check(env, ENV);
 
     {
@@ -163,15 +172,23 @@ val lookup_var(val env, val sym)
 val *lookup_var_l(val env, val sym)
 {
   if (nilp(env)) {
-    val bind = gethash(top_vb, sym);
-    if (cobjp(bind)) {
-      struct c_var *cv = (struct c_var *) cptr_get(bind);
-      return cv->loc;
+    if (dyn_env) {
+      val binding = assoc(sym, dyn_env->e.vbindings);
+      if (binding)
+        return cdr_l(binding);
     }
-    if (bind)
-      return cdr_l(bind);
-    return 0;
-  } else  {
+
+    {
+      val bind = gethash(top_vb, sym);
+      if (cobjp(bind)) {
+        struct c_var *cv = (struct c_var *) cptr_get(bind);
+        return cv->loc;
+      }
+      if (bind)
+        return cdr_l(bind);
+      return 0;
+    }
+  } else {
     type_check(env, ENV);
 
     {
diff --git a/signal.h b/signal.h
index 32281e9a..5aa49c82 100644
--- a/signal.h
+++ b/signal.h
@@ -61,15 +61,18 @@ typedef struct {
   jmp_buf jb;
   sig_atomic_t se;
   sigset_t blocked;
+  val de;
   int rv;
 } extended_jmp_buf;
 
 #define extended_setjmp(EJB)                    \
   (setjmp((EJB).jb)                             \
    ? (async_sig_enabled = (EJB).se,             \
+      dyn_env = (EJB).de,                       \
       sig_mask(SIG_SETMASK, &(EJB).blocked, 0), \
       (EJB).rv)                                 \
    : ((EJB).se = async_sig_enabled,             \
+      (EJB).de = dyn_env,                       \
       (EJB).blocked = sig_blocked_cache, 0))
 
 #define extended_longjmp(EJB, ARG)              \
@@ -86,13 +89,27 @@ extern volatile sig_atomic_t async_sig_enabled;
 #define sig_restore_enable do { } while (0); } while (0)
 #define sig_restore_disable do { } while (0); } while (0)
 
-typedef jmp_buf extended_jmp_buf;
-#define extended_setjmp(EJB) setjmp(EJB)
-#define extended_longjmp(EJB, ARG) longjmp(EJB, ARG)
+typedef struct {
+  jmp_buf jb;
+  val de;
+  int rv;
+} extended_jmp_buf;
+
+#define extended_setjmp(EJB)                    \
+  (setjmp((EJB).jb)                             \
+   ? (dyn_env = (EJB).de,                       \
+      (EJB).rv)                                 \
+   : ((EJB).de = dyn_env, 0))
+
+#define extended_longjmp(EJB, ARG)              \
+  ((EJB).rv = (ARG), longjmp((EJB).jb, 1))
+
 extern int async_sig_enabled;
 
 #endif
 
+extern val dyn_env; /* eval.c */
+
 extern val sig_hup, sig_int, sig_quit, sig_ill, sig_trap, sig_abrt, sig_bus;
 extern val sig_fpe, sig_kill, sig_usr1, sig_segv, sig_usr2, sig_pipe, sig_alrm;
 extern val sig_term, sig_chld, sig_cont, sig_stop, sig_tstp, sig_ttin;