From e160922c665ba65e1dba5b87a924927e61be43b9 Mon Sep 17 00:00:00 2001 From: Tom Tromey Date: Wed, 15 Aug 2012 13:04:34 -0600 Subject: [PATCH] This introduces some new functions to handle the specpdl. The basic idea is that when a thread loses the interpreter lock, it will unbind the bindings it has put in place. Then when a thread acquires the lock, it will restore its bindings. This code reuses an existing empty slot in struct specbinding to store the current value when the thread is "swapped out". This approach performs worse than my previously planned approach. However, it was one I could implement with minimal time and brainpower. I hope that perhaps someone else could improve the code once it is in. --- src/eval.c | 165 ++++++++++++++++++++++++++++++++++++++------------- src/lisp.h | 4 +- src/thread.c | 1 + src/thread.h | 6 ++ 4 files changed, 134 insertions(+), 42 deletions(-) diff --git a/src/eval.c b/src/eval.c index 49ead499044..f5f6fe7a808 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3102,6 +3102,52 @@ grow_specpdl (void) specpdl_ptr = specpdl + count; } +static Lisp_Object +binding_symbol (const struct specbinding *bind) +{ + if (!CONSP (bind->symbol)) + return bind->symbol; + return XCAR (bind->symbol); +} + +void +do_specbind (struct Lisp_Symbol *sym, struct specbinding *bind, + Lisp_Object value) +{ + switch (sym->redirect) + { + case SYMBOL_PLAINVAL: + if (!sym->constant) + SET_SYMBOL_VAL (sym, value); + else + set_internal (bind->symbol, value, Qnil, 1); + break; + + case SYMBOL_LOCALIZED: + case SYMBOL_FORWARDED: + if ((sym->redirect == SYMBOL_LOCALIZED + || BUFFER_OBJFWDP (SYMBOL_FWD (sym))) + && CONSP (bind->symbol)) + { + Lisp_Object where; + + where = XCAR (XCDR (bind->symbol)); + if (NILP (where) + && sym->redirect == SYMBOL_FORWARDED) + { + Fset_default (XCAR (bind->symbol), value); + return; + } + } + + set_internal (binding_symbol (bind), value, Qnil, 1); + break; + + default: + abort (); + } +} + /* `specpdl_ptr->symbol' is a field which describes which variable is let-bound, so it can be properly undone when we unbind_to. It can have the following two shapes: @@ -3140,11 +3186,9 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->symbol = symbol; specpdl_ptr->old_value = SYMBOL_VAL (sym); specpdl_ptr->func = NULL; + specpdl_ptr->saved_value = Qnil; ++specpdl_ptr; - if (!sym->constant) - SET_SYMBOL_VAL (sym, value); - else - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; case SYMBOL_LOCALIZED: if (SYMBOL_BLV (sym)->frame_local) @@ -3199,7 +3243,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) { eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym))); ++specpdl_ptr; - Fset_default (symbol, value); + do_specbind (sym, specpdl_ptr - 1, value); return; } } @@ -3207,7 +3251,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->symbol = symbol; specpdl_ptr++; - set_internal (symbol, value, Qnil, 1); + do_specbind (sym, specpdl_ptr - 1, value); break; } default: abort (); @@ -3224,9 +3268,67 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg) specpdl_ptr->func = function; specpdl_ptr->symbol = Qnil; specpdl_ptr->old_value = arg; + specpdl_ptr->saved_value = Qnil; specpdl_ptr++; } +void +rebind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl; bind != specpdl_ptr; ++bind) + { + if (bind->func == NULL) + { + Lisp_Object value = bind->saved_value; + + bind->saved_value = Qnil; + do_specbind (XSYMBOL (binding_symbol (bind)), bind, value); + } + } +} + +static void +do_one_unbind (const struct specbinding *this_binding, int unwinding) +{ + if (this_binding->func != 0) + (*this_binding->func) (this_binding->old_value); + /* If the symbol is a list, it is really (SYMBOL WHERE + . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a + frame. If WHERE is a buffer or frame, this indicates we + bound a variable that had a buffer-local or frame-local + binding. WHERE nil means that the variable had the default + value when it was bound. CURRENT-BUFFER is the buffer that + was current when the variable was bound. */ + else if (CONSP (this_binding->symbol)) + { + Lisp_Object symbol, where; + + symbol = XCAR (this_binding->symbol); + where = XCAR (XCDR (this_binding->symbol)); + + if (NILP (where)) + Fset_default (symbol, this_binding->old_value); + /* If `where' is non-nil, reset the value in the appropriate + local binding, but only if that binding still exists. */ + else if (BUFFERP (where) + ? !NILP (Flocal_variable_p (symbol, where)) + : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) + set_internal (symbol, this_binding->old_value, where, 1); + } + /* If variable has a trivial value (no forwarding), we can + just set it. No need to check for constant symbols here, + since that was already done by specbind. */ + else if (XSYMBOL (this_binding->symbol)->redirect == SYMBOL_PLAINVAL) + SET_SYMBOL_VAL (XSYMBOL (this_binding->symbol), + this_binding->old_value); + else + /* NOTE: we only ever come here if make_local_foo was used for + the first time on this var within this let. */ + Fset_default (this_binding->symbol, this_binding->old_value); +} + Lisp_Object unbind_to (ptrdiff_t count, Lisp_Object value) { @@ -3247,41 +3349,7 @@ unbind_to (ptrdiff_t count, Lisp_Object value) struct specbinding this_binding; this_binding = *--specpdl_ptr; - if (this_binding.func != 0) - (*this_binding.func) (this_binding.old_value); - /* If the symbol is a list, it is really (SYMBOL WHERE - . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a - frame. If WHERE is a buffer or frame, this indicates we - bound a variable that had a buffer-local or frame-local - binding. WHERE nil means that the variable had the default - value when it was bound. CURRENT-BUFFER is the buffer that - was current when the variable was bound. */ - else if (CONSP (this_binding.symbol)) - { - Lisp_Object symbol, where; - - symbol = XCAR (this_binding.symbol); - where = XCAR (XCDR (this_binding.symbol)); - - if (NILP (where)) - Fset_default (symbol, this_binding.old_value); - /* If `where' is non-nil, reset the value in the appropriate - local binding, but only if that binding still exists. */ - else if (BUFFERP (where) - ? !NILP (Flocal_variable_p (symbol, where)) - : !NILP (Fassq (symbol, XFRAME (where)->param_alist))) - set_internal (symbol, this_binding.old_value, where, 1); - } - /* If variable has a trivial value (no forwarding), we can - just set it. No need to check for constant symbols here, - since that was already done by specbind. */ - else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL) - SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol), - this_binding.old_value); - else - /* NOTE: we only ever come here if make_local_foo was used for - the first time on this var within this let. */ - Fset_default (this_binding.symbol, this_binding.old_value); + do_one_unbind (&this_binding, 1); } if (NILP (Vquit_flag) && !NILP (quitf)) @@ -3291,6 +3359,21 @@ unbind_to (ptrdiff_t count, Lisp_Object value) return value; } +void +unbind_for_thread_switch (void) +{ + struct specbinding *bind; + + for (bind = specpdl_ptr; bind != specpdl; --bind) + { + if (bind->func == NULL) + { + bind->saved_value = find_symbol_value (binding_symbol (bind)); + do_one_unbind (bind, 0); + } + } +} + DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, doc: /* Return non-nil if SYMBOL's global binding has been declared special. A special variable is one that will be bound dynamically, even in a diff --git a/src/lisp.h b/src/lisp.h index b0ed9be9f07..cbb5b51c783 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2014,7 +2014,9 @@ struct specbinding { Lisp_Object symbol, old_value; specbinding_func func; - Lisp_Object unused; /* Dividing by 16 is faster than by 12 */ + /* Normally this is unused; but it is to the symbol's current + value when a thread is swapped out. */ + Lisp_Object saved_value; }; #define SPECPDL_INDEX() (specpdl_ptr - specpdl) diff --git a/src/thread.c b/src/thread.c index 19faa1bafae..605a52cb2f9 100644 --- a/src/thread.c +++ b/src/thread.c @@ -40,6 +40,7 @@ mark_one_thread (struct thread_state *thread) { mark_object (bind->symbol); mark_object (bind->old_value); + mark_object (bind->saved_value); } #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ diff --git a/src/thread.h b/src/thread.h index 020346b9af2..def05fdaec9 100644 --- a/src/thread.h +++ b/src/thread.h @@ -83,6 +83,12 @@ struct thread_state struct specbinding *m_specpdl_ptr; #define specpdl_ptr (current_thread->m_specpdl_ptr) + /* Pointer to the first "saved" element in specpdl. When this + thread is swapped out, the current values of all specpdl bindings + are pushed onto the specpdl; then these are popped again when + switching back to this thread. */ + struct specbinding *m_saved_specpdl_ptr; + /* Depth in Lisp evaluations and function calls. */ EMACS_INT m_lisp_eval_depth; #define lisp_eval_depth (current_thread->m_lisp_eval_depth) -- 2.39.5