[PATCH 04/10] introduce new functions to deal with specpdl

[Tom Tromey]

This introduces some new functions to handle the specpdl.  The basic
idea is that when a thread loses the interpreter lock, it will unbind
the bindings it has put in place.  Then when a thread acquires the
lock, it will restore its bindings.

This code reuses an existing empty slot in struct specbinding to store
the current value when the thread is "swapped out".

This approach performs worse than my previously planned approach.
However, it was one I could implement with minimal time and
brainpower.  I hope that perhaps someone else could improve the code
once it is in.
---
 src/eval.c   |  165 +++++++++++++++++++++++++++++++++++++++++++--------------
 src/lisp.h   |    4 +-
 src/thread.c |    1 +
 src/thread.h |    6 ++
 4 files changed, 134 insertions(+), 42 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 49ead49..f5f6fe7 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3102,6 +3102,52 @@ grow_specpdl (void)
   specpdl_ptr = specpdl + count;
 }
 
+static Lisp_Object
+binding_symbol (const struct specbinding *bind)
+{
+  if (!CONSP (bind->symbol))
+    return bind->symbol;
+  return XCAR (bind->symbol);
+}
+
+void
+do_specbind (struct Lisp_Symbol *sym, struct specbinding *bind,
+            Lisp_Object value)
+{
+  switch (sym->redirect)
+    {
+    case SYMBOL_PLAINVAL:
+      if (!sym->constant)
+       SET_SYMBOL_VAL (sym, value);
+      else
+       set_internal (bind->symbol, value, Qnil, 1);
+      break;
+
+    case SYMBOL_LOCALIZED:
+    case SYMBOL_FORWARDED:
+      if ((sym->redirect == SYMBOL_LOCALIZED
+          || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
+         && CONSP (bind->symbol))
+       {
+         Lisp_Object where;
+
+         where = XCAR (XCDR (bind->symbol));
+         if (NILP (where)
+             && sym->redirect == SYMBOL_FORWARDED)
+           {
+             Fset_default (XCAR (bind->symbol), value);
+             return;
+           }
+       }
+
+      set_internal (binding_symbol (bind), value, Qnil, 1);
+      break;
+
+    default:
+      abort ();
+    }
+}
+
 /* `specpdl_ptr->symbol' is a field which describes which variable is
    let-bound, so it can be properly undone when we unbind_to.
    It can have the following two shapes:
@@ -3140,11 +3186,9 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->symbol = symbol;
       specpdl_ptr->old_value = SYMBOL_VAL (sym);
       specpdl_ptr->func = NULL;
+      specpdl_ptr->saved_value = Qnil;
       ++specpdl_ptr;
-      if (!sym->constant)
-       SET_SYMBOL_VAL (sym, value);
-      else
-       set_internal (symbol, value, Qnil, 1);
+      do_specbind (sym, specpdl_ptr - 1, value);
       break;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
@@ -3199,7 +3243,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
              {
                eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
                ++specpdl_ptr;
-               Fset_default (symbol, value);
+               do_specbind (sym, specpdl_ptr - 1, value);
                return;
              }
          }
@@ -3207,7 +3251,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
          specpdl_ptr->symbol = symbol;
 
        specpdl_ptr++;
-       set_internal (symbol, value, Qnil, 1);
+       do_specbind (sym, specpdl_ptr - 1, value);
        break;
       }
     default: abort ();
@@ -3224,9 +3268,67 @@ record_unwind_protect (Lisp_Object (*function) 
(Lisp_Object), Lisp_Object arg)
   specpdl_ptr->func = function;
   specpdl_ptr->symbol = Qnil;
   specpdl_ptr->old_value = arg;
+  specpdl_ptr->saved_value = Qnil;
   specpdl_ptr++;
 }
 
+void
+rebind_for_thread_switch (void)
+{
+  struct specbinding *bind;
+
+  for (bind = specpdl; bind != specpdl_ptr; ++bind)
+    {
+      if (bind->func == NULL)
+       {
+         Lisp_Object value = bind->saved_value;
+
+         bind->saved_value = Qnil;
+         do_specbind (XSYMBOL (binding_symbol (bind)), bind, value);
+       }
+    }
+}
+
+static void
+do_one_unbind (const struct specbinding *this_binding, int unwinding)
+{
+  if (this_binding->func != 0)
+    (*this_binding->func) (this_binding->old_value);
+  /* If the symbol is a list, it is really (SYMBOL WHERE
+     . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
+     frame.  If WHERE is a buffer or frame, this indicates we
+     bound a variable that had a buffer-local or frame-local
+     binding.  WHERE nil means that the variable had the default
+     value when it was bound.  CURRENT-BUFFER is the buffer that
+     was current when the variable was bound.  */
+  else if (CONSP (this_binding->symbol))
+    {
+      Lisp_Object symbol, where;
+
+      symbol = XCAR (this_binding->symbol);
+      where = XCAR (XCDR (this_binding->symbol));
+
+      if (NILP (where))
+       Fset_default (symbol, this_binding->old_value);
+      /* If `where' is non-nil, reset the value in the appropriate
+        local binding, but only if that binding still exists.  */
+      else if (BUFFERP (where)
+              ? !NILP (Flocal_variable_p (symbol, where))
+              : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
+       set_internal (symbol, this_binding->old_value, where, 1);
+    }
+  /* If variable has a trivial value (no forwarding), we can
+     just set it.  No need to check for constant symbols here,
+     since that was already done by specbind.  */
+  else if (XSYMBOL (this_binding->symbol)->redirect == SYMBOL_PLAINVAL)
+    SET_SYMBOL_VAL (XSYMBOL (this_binding->symbol),
+                   this_binding->old_value);
+  else
+    /* NOTE: we only ever come here if make_local_foo was used for
+       the first time on this var within this let.  */
+    Fset_default (this_binding->symbol, this_binding->old_value);
+}
+
 Lisp_Object
 unbind_to (ptrdiff_t count, Lisp_Object value)
 {
@@ -3247,41 +3349,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
       struct specbinding this_binding;
       this_binding = *--specpdl_ptr;
 
-      if (this_binding.func != 0)
-       (*this_binding.func) (this_binding.old_value);
-      /* If the symbol is a list, it is really (SYMBOL WHERE
-        . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
-        frame.  If WHERE is a buffer or frame, this indicates we
-        bound a variable that had a buffer-local or frame-local
-        binding.  WHERE nil means that the variable had the default
-        value when it was bound.  CURRENT-BUFFER is the buffer that
-        was current when the variable was bound.  */
-      else if (CONSP (this_binding.symbol))
-       {
-         Lisp_Object symbol, where;
-
-         symbol = XCAR (this_binding.symbol);
-         where = XCAR (XCDR (this_binding.symbol));
-
-         if (NILP (where))
-           Fset_default (symbol, this_binding.old_value);
-         /* If `where' is non-nil, reset the value in the appropriate
-            local binding, but only if that binding still exists.  */
-         else if (BUFFERP (where)
-                  ? !NILP (Flocal_variable_p (symbol, where))
-                  : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
-           set_internal (symbol, this_binding.old_value, where, 1);
-       }
-      /* If variable has a trivial value (no forwarding), we can
-        just set it.  No need to check for constant symbols here,
-        since that was already done by specbind.  */
-      else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
-       SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
-                       this_binding.old_value);
-      else
-       /* NOTE: we only ever come here if make_local_foo was used for
-          the first time on this var within this let.  */
-       Fset_default (this_binding.symbol, this_binding.old_value);
+      do_one_unbind (&this_binding, 1);
     }
 
   if (NILP (Vquit_flag) && !NILP (quitf))
@@ -3291,6 +3359,21 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
   return value;
 }
 
+void
+unbind_for_thread_switch (void)
+{
+  struct specbinding *bind;
+
+  for (bind = specpdl_ptr; bind != specpdl; --bind)
+    {
+      if (bind->func == NULL)
+       {
+         bind->saved_value = find_symbol_value (binding_symbol (bind));
+         do_one_unbind (bind, 0);
+       }
+    }
+}
+
 DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0,
        doc: /* Return non-nil if SYMBOL's global binding has been declared 
special.
 A special variable is one that will be bound dynamically, even in a
diff --git a/src/lisp.h b/src/lisp.h
index 8f3afa7..fbde5bb 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2013,7 +2013,9 @@ struct specbinding
   {
     Lisp_Object symbol, old_value;
     specbinding_func func;
-    Lisp_Object unused;                /* Dividing by 16 is faster than by 12 
*/
+    /* Normally this is unused; but it is to the symbol's current
+       value when a thread is swapped out.  */
+    Lisp_Object saved_value;
   };
 
 #define SPECPDL_INDEX()        (specpdl_ptr - specpdl)
diff --git a/src/thread.c b/src/thread.c
index 19faa1b..605a52c 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -40,6 +40,7 @@ mark_one_thread (struct thread_state *thread)
     {
       mark_object (bind->symbol);
       mark_object (bind->old_value);
+      mark_object (bind->saved_value);
     }
 
 #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
diff --git a/src/thread.h b/src/thread.h
index 020346b..def05fd 100644
--- a/src/thread.h
+++ b/src/thread.h
@@ -83,6 +83,12 @@ struct thread_state
   struct specbinding *m_specpdl_ptr;
 #define specpdl_ptr (current_thread->m_specpdl_ptr)
 
+  /* Pointer to the first "saved" element in specpdl.  When this
+     thread is swapped out, the current values of all specpdl bindings
+     are pushed onto the specpdl; then these are popped again when
+     switching back to this thread.  */
+  struct specbinding *m_saved_specpdl_ptr;
+
   /* Depth in Lisp evaluations and function calls.  */
   EMACS_INT m_lisp_eval_depth;
 #define lisp_eval_depth (current_thread->m_lisp_eval_depth)
-- 
1.7.7.6