From 5c1680205ca0fc90ecf45afcb045d7d8457a1b3a Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Sun, 11 Dec 2016 13:08:15 -0500 Subject: [PATCH v2] 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 09d94f5..962648b 100644 --- a/src/data.c +++ b/src/data.c @@ -1296,11 +1296,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; @@ -1411,7 +1413,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); } @@ -1631,11 +1633,9 @@ DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0, 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; @@ -1649,11 +1649,13 @@ DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, 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: @@ -1666,7 +1668,7 @@ DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, 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); @@ -1677,7 +1679,7 @@ DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, /* 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: { @@ -1703,15 +1705,25 @@ DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0, 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 f1e0ae7..7e19df8 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 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) 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 *); -- 2.9.3