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.

diff --git a/src/data.c b/src/data.c
index 52cfe4ae4a3c36e734cec3d253a2436a55d10fa1..6dd346bf8df1771205a3407d736d7b1b411fbc71 100644 (file)
--- 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 7852ef700baf459c6fe1b573ac0f2284cab29181..0b257e2d9a08ab7c6bddf24d4a35f4a2325047c1 100644 (file)
--- 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 252707c349556c024e7c5aaf8b598843967c9b7c..5b77dc8b7fd95db779a631704331e7cd96f0e451 100644 (file)
--- 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 *);