[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master f66174a 1/2: Clean up var watcher disabling on thre
From: |
Noam Postavsky |
Subject: |
[Emacs-diffs] master f66174a 1/2: Clean up var watcher disabling on thread switching |
Date: |
Tue, 13 Dec 2016 02:45:41 +0000 (UTC) |
branch: master
commit f66174a1b7f8e87e699ecf629563244782291148
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>
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.
---
src/data.c | 46 +++++++++++++++++++++++++++++-----------------
src/eval.c | 51 ++++++++++++++++++---------------------------------
src/lisp.h | 6 +++++-
3 files changed, 52 insertions(+), 51 deletions(-)
diff --git a/src/data.c b/src/data.c
index 52cfe4a..6dd346b 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 7852ef7..0b257e2 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 252707c..5b77dc8 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 *);