Rewrite thread context switch code (bug#48990)

Make the context switch code handle buffer-local variables more
correctly by reusing the code originally written for `backtrace-eval`.
This has the side benefit of making the `saved_value` field unused.

* src/lisp.h (enum specbind_tag): Remove `saved_value` field.
(rebind_for_thread_switch, unbind_for_thread_switch): Delete decls.
(specpdl_unrewind): Declare function.

* src/eval.c (specpdl_saved_value): Delete function.
(specbind): Delete the code related to `saved_value`, and consolidate
common code between the different branches.
(rebind_for_thread_switch, -unbind_for_thread_switch): Move to `thread.c`.
(specpdl_unrewind): New function, extracted from `backtrace_eval_unrewind`.
Use `SET_INTERNAL_THREAD_SWITCH`.  Skip the buffer & excursion unwinds
depending on new arg `vars_only`.
(backtrace_eval_unrewind): Use it.
(mark_specpdl): Don't mark `saved_value`.

* src/thread.c (rebind_for_thread_switch, unbind_for_thread_switch):
Move from `eval.c` and rewrite using `specpdl_unrewind`.

* test/src/thread-tests.el (threads-test-bug48990): New test.

* test/Makefile.in (test_template): Add a + as suggested by make:
"warning: jobserver unavailable: using -j1.  Add '+' to parent make rule".

src/eval.c

@@ -103,13 +103,6 @@ specpdl_where (union specbinding *pdl)
   return pdl->let.where;
 }
 
-static Lisp_Object
-specpdl_saved_value (union specbinding *pdl)
-{
-  eassert (pdl->kind >= SPECPDL_LET);
-  return pdl->let.saved_value;
-}
-
 static Lisp_Object
 specpdl_arg (union specbinding *pdl)
 {
@@ -3589,9 +3582,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->let.kind = SPECPDL_LET;
       specpdl_ptr->let.symbol = symbol;
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
-      specpdl_ptr->let.saved_value = Qnil;
-      grow_specpdl ();
-      do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
       break;
     case SYMBOL_LOCALIZED:
     case SYMBOL_FORWARDED:
@@ -3601,7 +3591,6 @@ specbind (Lisp_Object symbol, Lisp_Object value)
 	specpdl_ptr->let.symbol = symbol;
 	specpdl_ptr->let.old_value = ovalue;
 	specpdl_ptr->let.where = Fcurrent_buffer ();
-	specpdl_ptr->let.saved_value = Qnil;
 
 	eassert (sym->u.s.redirect != SYMBOL_LOCALIZED
 		 || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
@@ -3619,22 +3608,17 @@ specbind (Lisp_Object symbol, Lisp_Object value)
 	       having their own value.  This is consistent with what
 	       happens with other buffer-local variables.  */
 	    if (NILP (Flocal_variable_p (symbol, Qnil)))
-	      {
-		specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
-		grow_specpdl ();
-                do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
-		return;
-	      }
+	      specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
 	  }
 	else
 	  specpdl_ptr->let.kind = SPECPDL_LET;
 
-	grow_specpdl ();
-        do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
 	break;
       }
     default: emacs_abort ();
     }
+  grow_specpdl ();
+  do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
 }
 
 /* Push unwind-protect entries of various types.  */
@@ -3710,24 +3694,6 @@ record_unwind_protect_module (enum specbind_tag kind, void *ptr)
   grow_specpdl ();
 }
 
-void
-rebind_for_thread_switch (void)
-{
-  union specbinding *bind;
-
-  for (bind = specpdl; bind != specpdl_ptr; ++bind)
-    {
-      if (bind->kind >= SPECPDL_LET)
-	{
-	  Lisp_Object value = specpdl_saved_value (bind);
-	  Lisp_Object sym = specpdl_symbol (bind);
-	  bind->let.saved_value = Qnil;
-          do_specbind (XSYMBOL (sym), bind, value,
-                       SET_INTERNAL_THREAD_SWITCH);
-	}
-    }
-}
-
 static void
 do_one_unbind (union specbinding *this_binding, bool unwinding,
                enum Set_Internal_Bind bindflag)
@@ -3884,22 +3850,6 @@ unbind_to (specpdl_ref count, Lisp_Object value)
   return value;
 }
 
-void
-unbind_for_thread_switch (struct thread_state *thr)
-{
-  union specbinding *bind;
-
-  for (bind = thr->m_specpdl_ptr; bind > thr->m_specpdl;)
-    {
-      if ((--bind)->kind >= SPECPDL_LET)
-	{
-	  Lisp_Object sym = specpdl_symbol (bind);
-	  bind->let.saved_value = find_symbol_value (sym);
-          do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH);
-	}
-    }
-}
-
 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
@@ -4055,11 +4005,13 @@ or a lambda expression for macro calls.  */)
    value and the old value stored in the specpdl), kind of like the inplace
    pointer-reversal trick.  As it turns out, the rewind does the same as the
    unwind, except it starts from the other end of the specpdl stack, so we use
-   the same function for both unwind and rewind.  */
-static void
-backtrace_eval_unrewind (int distance)
+   the same function for both unwind and rewind.
+   This same code is used when switching threads, except in that case
+   we unwind/rewind the whole specpdl of the threads.  */
+void
+specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only)
 {
-  union specbinding *tmp = specpdl_ptr;
+  union specbinding *tmp = pdl;
   int step = -1;
   if (distance < 0)
     { /* It's a rewind rather than unwind.  */
@@ -4077,6 +4029,8 @@ backtrace_eval_unrewind (int distance)
 	     unwind_protect, but the problem is that we don't know how to
 	     rewind them afterwards.  */
 	case SPECPDL_UNWIND:
+	  if (vars_only)
+	    break;
 	  if (tmp->unwind.func == set_buffer_if_live)
 	    {
 	      Lisp_Object oldarg = tmp->unwind.arg;
@@ -4085,6 +4039,8 @@ backtrace_eval_unrewind (int distance)
 	    }
 	  break;
 	case SPECPDL_UNWIND_EXCURSION:
+	  if (vars_only)
+	    break;
 	  {
 	    Lisp_Object marker = tmp->unwind_excursion.marker;
 	    Lisp_Object window = tmp->unwind_excursion.window;
@@ -4125,7 +4081,7 @@ backtrace_eval_unrewind (int distance)
 	    Lisp_Object sym = specpdl_symbol (tmp);
 	    Lisp_Object old_value = specpdl_old_value (tmp);
 	    set_specpdl_old_value (tmp, default_value (sym));
-	    Fset_default (sym, old_value);
+	    set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH);
 	  }
 	  break;
 	case SPECPDL_LET_LOCAL:
@@ -4141,14 +4097,28 @@ backtrace_eval_unrewind (int distance)
 	      {
 		set_specpdl_old_value
 		  (tmp, buffer_local_value (symbol, where));
-                set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
+                set_internal (symbol, old_value, where,
+                              SET_INTERNAL_THREAD_SWITCH);
 	      }
+	    else
+	      /* FIXME: If the var is not local any more, we failed
+                 to swap the old and new values.  As long as the var remains
+                 non-local, this is fine, but if it ever reverts to being
+                 local we may end up using this entry "in the wrong
+                 direction".  */
+	      ;
 	  }
 	  break;
 	}
     }
 }
 
+static void
+backtrace_eval_unrewind (int distance)
+{
+  specpdl_unrewind (specpdl_ptr, distance, false);
+}
+
 DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
        doc: /* Evaluate EXP in the context of some activation frame.
 NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.  */)
@@ -4302,7 +4272,6 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
 	case SPECPDL_LET:
 	  mark_object (specpdl_symbol (pdl));
 	  mark_object (specpdl_old_value (pdl));
-	  mark_object (specpdl_saved_value (pdl));
 	  break;
 
 	case SPECPDL_UNWIND_PTR:

src/lisp.h

@@ -3337,9 +3337,6 @@ union specbinding
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
       /* `where' is not used in the case of SPECPDL_LET.  */
       Lisp_Object symbol, old_value, where;
-      /* Normally this is unused; but it is set to the symbol's
-	 current value when a thread is swapped out.  */
-      Lisp_Object saved_value;
     } let;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
@@ -4453,8 +4450,7 @@ extern void set_unwind_protect (specpdl_ref, void (*) (Lisp_Object),
 				Lisp_Object);
 extern void set_unwind_protect_ptr (specpdl_ref, void (*) (void *), void *);
 extern Lisp_Object unbind_to (specpdl_ref, Lisp_Object);
-extern void rebind_for_thread_switch (void);
-extern void unbind_for_thread_switch (struct thread_state *);
+void specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only);
 extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
 extern AVOID verror (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);

src/thread.c

@@ -83,6 +83,22 @@ release_global_lock (void)
   sys_mutex_unlock (&global_lock);
 }
 
+static void
+rebind_for_thread_switch (void)
+{
+  ptrdiff_t distance
+    = current_thread->m_specpdl_ptr - current_thread->m_specpdl;
+  specpdl_unrewind (specpdl_ptr, -distance, true);
+}
+
+static void
+unbind_for_thread_switch (struct thread_state *thr)
+{
+  ptrdiff_t distance = thr->m_specpdl_ptr - thr->m_specpdl;
+  specpdl_unrewind (thr->m_specpdl_ptr, distance, true);
+}
+
+
 /* You must call this after acquiring the global lock.
    acquire_global_lock does it for you.  */
 static void

test/Makefile.in

@@ -243,7 +243,7 @@ define test_template
   .PHONY: $(1) $(notdir $(1))
   $(1):
 	@test ! -f $(1).log || mv $(1).log $(1).log~
-	@$(MAKE) $(1).log WRITE_LOG=
+	+@$(MAKE) $(1).log WRITE_LOG=
   $(notdir $(1)): $(1)
 endef
 

test/src/thread-tests.el

@@ -393,4 +393,29 @@
   (let ((th (make-thread 'ignore)))
     (should-not (equal th main-thread))))
 
+(defvar threads-test--var 'global)
+
+(ert-deftest threads-test-bug48990 ()
+  (skip-unless (fboundp 'make-thread))
+  (let ((buf1 (generate-new-buffer " thread-test"))
+        (buf2 (generate-new-buffer " thread-test")))
+    (with-current-buffer buf1
+      (setq-local threads-test--var 'local1))
+    (with-current-buffer buf2
+      (setq-local threads-test--var 'local2))
+    (let ((seen nil))
+      (with-current-buffer buf1
+        (should (eq threads-test--var 'local1))
+        (make-thread (lambda () (setq seen threads-test--var))))
+      (with-current-buffer buf2
+        (should (eq threads-test--var 'local2))
+        (let ((threads-test--var 'let2))
+          (should (eq threads-test--var 'let2))
+          (while (not seen)
+            (thread-yield))
+          (should (eq threads-test--var 'let2))
+          (should (eq seen 'local1)))
+        (should (eq threads-test--var 'local2)))
+      (should (eq threads-test--var 'global)))))
+
 ;;; thread-tests.el ends here