From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Tom Tromey Newsgroups: gmane.emacs.devel Subject: [PATCH 04/10] introduce new functions to deal with specpdl Date: Thu, 09 Aug 2012 13:39:08 -0600 Message-ID: <87ipcretyb.fsf@fleche.redhat.com> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: dough.gmane.org 1344541159 11806 80.91.229.3 (9 Aug 2012 19:39:19 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Thu, 9 Aug 2012 19:39:19 +0000 (UTC) To: Emacs discussions Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Thu Aug 09 21:39:19 2012 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1SzYZh-00057H-St for ged-emacs-devel@m.gmane.org; Thu, 09 Aug 2012 21:39:18 +0200 Original-Received: from localhost ([::1]:48094 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYZh-0001l6-4n for ged-emacs-devel@m.gmane.org; Thu, 09 Aug 2012 15:39:17 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:46980) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYZe-0001kv-58 for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:39:15 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1SzYZb-0003nN-Mf for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:39:14 -0400 Original-Received: from mx1.redhat.com ([209.132.183.28]:28453) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1SzYZb-0003n2-DM for emacs-devel@gnu.org; Thu, 09 Aug 2012 15:39:11 -0400 Original-Received: from int-mx10.intmail.prod.int.phx2.redhat.com (int-mx10.intmail.prod.int.phx2.redhat.com [10.5.11.23]) by mx1.redhat.com (8.14.4/8.14.4) with ESMTP id q79JdArc008794 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES256-SHA bits=256 verify=OK) for ; Thu, 9 Aug 2012 15:39:10 -0400 Original-Received: from barimba (ovpn01.gateway.prod.ext.phx2.redhat.com [10.5.9.1]) by int-mx10.intmail.prod.int.phx2.redhat.com (8.14.4/8.14.4) with ESMTP id q79Jd8dh011808 (version=TLSv1/SSLv3 cipher=DHE-RSA-AES128-SHA bits=128 verify=NO); Thu, 9 Aug 2012 15:39:09 -0400 X-Attribution: Tom User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.1 (gnu/linux) X-Scanned-By: MIMEDefang 2.68 on 10.5.11.23 X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 209.132.183.28 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:152378 Archived-At: 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 49ead49..f5f6fe7 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 8f3afa7..fbde5bb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2013,7 +2013,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 19faa1b..605a52c 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 020346b..def05fd 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) -- 1.7.7.6