Clean up var watcher disabling on thread switching

* src/data.c (Fset_default): Move code into new C level function,
`set_default_internal'.
(set_default_internal): New function, like `Fset_default' but also takes
additional bindflag parameter.
(set_internal): Only call `notify_variable_watchers' if bindflag is not
SET_INTERNAL_THREAD_SWITCH.
* src/eval.c (do_specbind, do_one_unbind): Add bindflag parameter,
passed on to set_internal and set_default_internal.  Adjust callers.
(rebind_for_thread_switch, unbind_for_thread_switch): Pass
SET_INTERNAL_THREAD_SWITCH to do_specbind, do_one_unbind instead of
temporarily adjusting symbol's trapped_write field.

3 files changed, 52 insertions, 51 deletions

diff --git a/src/data.c b/src/data.c
index 52cfe4ae4a3..6dd346bf8df 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1299,11 +1299,13 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
         return;
 
     case SYMBOL_TRAPPED_WRITE:
-      notify_variable_watchers (symbol, voide? Qnil : newval,
-                                (bindflag == SET_INTERNAL_BIND? Qlet :
-                                 bindflag == SET_INTERNAL_UNBIND? Qunlet :
-                                 voide? Qmakunbound : Qset),
-                                where);
+      /* Setting due to thread-switching doesn't count.  */
+      if (bindflag != SET_INTERNAL_THREAD_SWITCH)
+        notify_variable_watchers (symbol, voide? Qnil : newval,
+                                  (bindflag == SET_INTERNAL_BIND? Qlet :
+                                   bindflag == SET_INTERNAL_UNBIND? Qunlet :
+                                   voide? Qmakunbound : Qset),
+                                  where);
       /* FALLTHROUGH!  */
     case SYMBOL_UNTRAPPED_WRITE:
         break;
@@ -1414,7 +1416,7 @@ set_internal (Lisp_Object symbol, Lisp_Object newval, Lisp_Object where,
             int offset = XBUFFER_OBJFWD (innercontents)->offset;
             int idx = PER_BUFFER_IDX (offset);
             if (idx > 0
-                && !bindflag
+                && bindflag == SET_INTERNAL_SET
                 && !let_shadows_buffer_binding_p (sym))
               SET_PER_BUFFER_VALUE_P (buf, idx, 1);
           }
@@ -1634,11 +1636,9 @@ local bindings in certain buffers.  */)
   xsignal1 (Qvoid_variable, symbol);
 }
 
-DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
-       doc: /* Set SYMBOL's default value to VALUE.  SYMBOL and VALUE are evaluated.
-The default value is seen in buffers that do not have their own values
-for this variable.  */)
-  (Lisp_Object symbol, Lisp_Object value)
+void
+set_default_internal (Lisp_Object symbol, Lisp_Object value,
+                      enum Set_Internal_Bind bindflag)
 {
   struct Lisp_Symbol *sym;
 
@@ -1652,11 +1652,13 @@ for this variable.  */)
         xsignal1 (Qsetting_constant, symbol);
       else
         /* Allow setting keywords to their own value.  */
-        return value;
+        return;
 
     case SYMBOL_TRAPPED_WRITE:
       /* Don't notify here if we're going to call Fset anyway.  */
-      if (sym->redirect != SYMBOL_PLAINVAL)
+      if (sym->redirect != SYMBOL_PLAINVAL
+          /* Setting due to thread switching doesn't count.  */
+          && bindflag != SET_INTERNAL_THREAD_SWITCH)
         notify_variable_watchers (symbol, value, Qset_default, Qnil);
       /* FALLTHROUGH!  */
     case SYMBOL_UNTRAPPED_WRITE:
@@ -1669,7 +1671,7 @@ for this variable.  */)
   switch (sym->redirect)
     {
     case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
-    case SYMBOL_PLAINVAL: return Fset (symbol, value);
+    case SYMBOL_PLAINVAL: set_internal (symbol, value, Qnil, bindflag); return;
     case SYMBOL_LOCALIZED:
       {
         struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
@@ -1680,7 +1682,7 @@ for this variable.  */)
         /* If the default binding is now loaded, set the REALVALUE slot too.  */
         if (blv->fwd && EQ (blv->defcell, blv->valcell))
           store_symval_forwarding (blv->fwd, value, NULL);
-        return value;
+        return;
       }
     case SYMBOL_FORWARDED:
       {
@@ -1706,15 +1708,25 @@ for this variable.  */)
                   if (!PER_BUFFER_VALUE_P (b, idx))
                     set_per_buffer_value (b, offset, value);
               }
-            return value;
           }
         else
-          return Fset (symbol, value);
+          set_internal (symbol, value, Qnil, bindflag);
+        return;
       }
     default: emacs_abort ();
     }
 }
 
+DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
+       doc: /* Set SYMBOL's default value to VALUE.  SYMBOL and VALUE are evaluated.
+The default value is seen in buffers that do not have their own values
+for this variable.  */)
+  (Lisp_Object symbol, Lisp_Object value)
+{
+  set_default_internal (symbol, value, SET_INTERNAL_SET);
+  return value;
+}
+
 DEFUN ("setq-default", Fsetq_default, Ssetq_default, 0, UNEVALLED, 0,
        doc: /* Set the default value of variable VAR to VALUE.
 VAR, the variable name, is literal (not evaluated);
diff --git a/src/eval.c b/src/eval.c
index 7852ef700ba..0b257e2d9a0 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3197,7 +3197,7 @@ let_shadows_global_binding_p (Lisp_Object symbol)
 
 static void
 do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
-             Lisp_Object value)
+             Lisp_Object value, enum Set_Internal_Bind bindflag)
 {
   switch (sym->redirect)
     {
@@ -3205,19 +3205,19 @@ do_specbind (struct Lisp_Symbol *sym, union specbinding *bind,
       if (!sym->trapped_write)
         SET_SYMBOL_VAL (sym, value);
       else
-        set_internal (specpdl_symbol (bind), value, Qnil, SET_INTERNAL_BIND);
+        set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
       break;
 
     case SYMBOL_FORWARDED:
       if (BUFFER_OBJFWDP (SYMBOL_FWD (sym))
           && specpdl_kind (bind) == SPECPDL_LET_DEFAULT)
         {
-          Fset_default (specpdl_symbol (bind), value);
+          set_default_internal (specpdl_symbol (bind), value, bindflag);
           return;
         }
       /* FALLTHROUGH */
     case SYMBOL_LOCALIZED:
-      set_internal (specpdl_symbol (bind), value, Qnil, SET_INTERNAL_BIND);
+      set_internal (specpdl_symbol (bind), value, Qnil, bindflag);
       break;
 
     default:
@@ -3258,7 +3258,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       specpdl_ptr->let.old_value = SYMBOL_VAL (sym);
       specpdl_ptr->let.saved_value = Qnil;
       grow_specpdl ();
-      do_specbind (sym, specpdl_ptr - 1, value);
+      do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
       break;
     case SYMBOL_LOCALIZED:
       if (SYMBOL_BLV (sym)->frame_local)
@@ -3291,7 +3291,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
               {
                 specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT;
                 grow_specpdl ();
-                do_specbind (sym, specpdl_ptr - 1, value);
+                do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
                 return;
               }
           }
@@ -3299,7 +3299,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
           specpdl_ptr->let.kind = SPECPDL_LET;
 
         grow_specpdl ();
-        do_specbind (sym, specpdl_ptr - 1, value);
+        do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND);
         break;
       }
     default: emacs_abort ();
@@ -3354,23 +3354,16 @@ rebind_for_thread_switch (void)
         {
           Lisp_Object value = specpdl_saved_value (bind);
           Lisp_Object sym = specpdl_symbol (bind);
-          bool was_trapped =
-            SYMBOLP (sym)
-            && XSYMBOL (sym)->trapped_write == SYMBOL_TRAPPED_WRITE;
-          /* FIXME: This is not clean, and if do_specbind signals an
-             error, the symbol will be left untrapped.  */
-          if (was_trapped)
-            XSYMBOL (sym)->trapped_write = SYMBOL_UNTRAPPED_WRITE;
           bind->let.saved_value = Qnil;
-          do_specbind (XSYMBOL (sym), bind, value);
-          if (was_trapped)
-            XSYMBOL (sym)->trapped_write = SYMBOL_TRAPPED_WRITE;
+          do_specbind (XSYMBOL (sym), bind, value,
+                       SET_INTERNAL_THREAD_SWITCH);
         }
     }
 }
 
 static void
-do_one_unbind (union specbinding *this_binding, bool unwinding)
+do_one_unbind (union specbinding *this_binding, bool unwinding,
+               enum Set_Internal_Bind bindflag)
 {
   eassert (unwinding || this_binding->kind >= SPECPDL_LET);
   switch (this_binding->kind)
@@ -3399,7 +3392,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding)
               SET_SYMBOL_VAL (XSYMBOL (sym), specpdl_old_value (this_binding));
             else
               set_internal (sym, specpdl_old_value (this_binding),
-                            Qnil, SET_INTERNAL_UNBIND);
+                            Qnil, bindflag);
             break;
           }
         else
@@ -3409,8 +3402,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding)
           }
       }
     case SPECPDL_LET_DEFAULT:
-      Fset_default (specpdl_symbol (this_binding),
-                    specpdl_old_value (this_binding));
+      set_default_internal (specpdl_symbol (this_binding),
+                            specpdl_old_value (this_binding),
+                            bindflag);
       break;
     case SPECPDL_LET_LOCAL:
       {
@@ -3422,7 +3416,7 @@ do_one_unbind (union specbinding *this_binding, bool unwinding)
         /* If this was a local binding, reset the value in the appropriate
            buffer, but only if that buffer's binding still exists.  */
         if (!NILP (Flocal_variable_p (symbol, where)))
-          set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND);
+          set_internal (symbol, old_value, where, bindflag);
       }
       break;
     }
@@ -3496,7 +3490,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
       union specbinding this_binding;
       this_binding = *--specpdl_ptr;
 
-      do_one_unbind (&this_binding, true);
+      do_one_unbind (&this_binding, true, SET_INTERNAL_UNBIND);
     }
 
   if (NILP (Vquit_flag) && !NILP (quitf))
@@ -3515,17 +3509,8 @@ unbind_for_thread_switch (struct thread_state *thr)
       if ((--bind)->kind >= SPECPDL_LET)
         {
           Lisp_Object sym = specpdl_symbol (bind);
-          bool was_trapped =
-            SYMBOLP (sym)
-            && XSYMBOL (sym)->trapped_write == SYMBOL_TRAPPED_WRITE;
           bind->let.saved_value = find_symbol_value (sym);
-          /* FIXME: This is not clean, and if do_one_unbind signals an
-             error, the symbol will be left untrapped.  */
-          if (was_trapped)
-            XSYMBOL (sym)->trapped_write = SYMBOL_UNTRAPPED_WRITE;
-          do_one_unbind (bind, false);
-          if (was_trapped)
-            XSYMBOL (sym)->trapped_write = SYMBOL_TRAPPED_WRITE;
+          do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH);
         }
     }
 }
diff --git a/src/lisp.h b/src/lisp.h
index 252707c3495..5b77dc8b7fd 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3493,10 +3493,14 @@ extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
 enum Set_Internal_Bind {
   SET_INTERNAL_SET,
   SET_INTERNAL_BIND,
-  SET_INTERNAL_UNBIND
+  SET_INTERNAL_UNBIND,
+  SET_INTERNAL_THREAD_SWITCH
 };
 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object,
                           enum Set_Internal_Bind);
+extern void set_default_internal (Lisp_Object, Lisp_Object,
+                                  enum Set_Internal_Bind bindflag);
+
 extern void syms_of_data (void);
 extern void swap_in_global_binding (struct Lisp_Symbol *);