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.

diff --git a/src/eval.c b/src/eval.c
index 49ead499044352fab549b95d9bcbb886133f7a79..f5f6fe7a80809706fac4944907550243d87ee645 100644 (file)
--- 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 b0ed9be9f07ebfaf7f53310062cd5eff2a3aa551..cbb5b51c783ca1f0a8eb40658989fe03e701ed40 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2014,7 +2014,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 19faa1bafae59a3317822535aadf5bdcd1de1470..605a52cb2f99f03bd5290ef9bd4e501f08fc4063 100644 (file)
--- 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 020346b9af2762b719579ecc8762f383d4565af8..def05fdaec992c1df8c4cc5dbbecbddfc0637227 100644 (file)
--- 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)