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.
This commit is contained in:
Noam Postavsky 2016-12-11 13:08:15 -05:00
parent 8db7b65d66
commit f66174a1b7
3 changed files with 52 additions and 51 deletions

View file

@ -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);

View file

@ -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);
}
}
}

View file

@ -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 *);