From b8460fcb8c320ea6d7449f37f07502d10eb74cd5 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Feb 2022 15:25:53 -0500 Subject: [PATCH] Rewrite thread context switch code (bug#48990) Make the context switch code handle buffer-local variables more correctly by reusing the code originally written for `backtrace-eval`. This has the side benefit of making the `saved_value` field unused. * src/lisp.h (enum specbind_tag): Remove `saved_value` field. (rebind_for_thread_switch, unbind_for_thread_switch): Delete decls. (specpdl_unrewind): Declare function. * src/eval.c (specpdl_saved_value): Delete function. (specbind): Delete the code related to `saved_value`, and consolidate common code between the different branches. (rebind_for_thread_switch, -unbind_for_thread_switch): Move to `thread.c`. (specpdl_unrewind): New function, extracted from `backtrace_eval_unrewind`. Use `SET_INTERNAL_THREAD_SWITCH`. Skip the buffer & excursion unwinds depending on new arg `vars_only`. (backtrace_eval_unrewind): Use it. (mark_specpdl): Don't mark `saved_value`. * src/thread.c (rebind_for_thread_switch, unbind_for_thread_switch): Move from `eval.c` and rewrite using `specpdl_unrewind`. * test/src/thread-tests.el (threads-test-bug48990): New test. * test/Makefile.in (test_template): Add a + as suggested by make: "warning: jobserver unavailable: using -j1. Add '+' to parent make rule". --- src/eval.c | 89 +++++++++++++--------------------------- src/lisp.h | 6 +-- src/thread.c | 16 ++++++++ test/Makefile.in | 2 +- test/src/thread-tests.el | 25 +++++++++++ 5 files changed, 72 insertions(+), 66 deletions(-) diff --git a/src/eval.c b/src/eval.c index d1c45fca56b..6bed7c4a899 100644 --- a/src/eval.c +++ b/src/eval.c @@ -103,13 +103,6 @@ specpdl_where (union specbinding *pdl) return pdl->let.where; } -static Lisp_Object -specpdl_saved_value (union specbinding *pdl) -{ - eassert (pdl->kind >= SPECPDL_LET); - return pdl->let.saved_value; -} - static Lisp_Object specpdl_arg (union specbinding *pdl) { @@ -3589,9 +3582,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET; specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); - specpdl_ptr->let.saved_value = Qnil; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; case SYMBOL_LOCALIZED: case SYMBOL_FORWARDED: @@ -3601,7 +3591,6 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = ovalue; specpdl_ptr->let.where = Fcurrent_buffer (); - specpdl_ptr->let.saved_value = Qnil; eassert (sym->u.s.redirect != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); @@ -3619,22 +3608,17 @@ specbind (Lisp_Object symbol, Lisp_Object value) having their own value. This is consistent with what happens with other buffer-local variables. */ if (NILP (Flocal_variable_p (symbol, Qnil))) - { - specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); - return; - } + specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; } else specpdl_ptr->let.kind = SPECPDL_LET; - grow_specpdl (); - do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); break; } default: emacs_abort (); } + grow_specpdl (); + do_specbind (sym, specpdl_ptr - 1, value, SET_INTERNAL_BIND); } /* Push unwind-protect entries of various types. */ @@ -3710,24 +3694,6 @@ record_unwind_protect_module (enum specbind_tag kind, void *ptr) grow_specpdl (); } -void -rebind_for_thread_switch (void) -{ - union specbinding *bind; - - for (bind = specpdl; bind != specpdl_ptr; ++bind) - { - if (bind->kind >= SPECPDL_LET) - { - Lisp_Object value = specpdl_saved_value (bind); - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = Qnil; - do_specbind (XSYMBOL (sym), bind, value, - SET_INTERNAL_THREAD_SWITCH); - } - } -} - static void do_one_unbind (union specbinding *this_binding, bool unwinding, enum Set_Internal_Bind bindflag) @@ -3884,22 +3850,6 @@ unbind_to (specpdl_ref count, Lisp_Object value) return value; } -void -unbind_for_thread_switch (struct thread_state *thr) -{ - union specbinding *bind; - - for (bind = thr->m_specpdl_ptr; bind > thr->m_specpdl;) - { - if ((--bind)->kind >= SPECPDL_LET) - { - Lisp_Object sym = specpdl_symbol (bind); - bind->let.saved_value = find_symbol_value (sym); - do_one_unbind (bind, false, SET_INTERNAL_THREAD_SWITCH); - } - } -} - 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 @@ -4055,11 +4005,13 @@ or a lambda expression for macro calls. */) value and the old value stored in the specpdl), kind of like the inplace pointer-reversal trick. As it turns out, the rewind does the same as the unwind, except it starts from the other end of the specpdl stack, so we use - the same function for both unwind and rewind. */ -static void -backtrace_eval_unrewind (int distance) + the same function for both unwind and rewind. + This same code is used when switching threads, except in that case + we unwind/rewind the whole specpdl of the threads. */ +void +specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only) { - union specbinding *tmp = specpdl_ptr; + union specbinding *tmp = pdl; int step = -1; if (distance < 0) { /* It's a rewind rather than unwind. */ @@ -4077,6 +4029,8 @@ backtrace_eval_unrewind (int distance) unwind_protect, but the problem is that we don't know how to rewind them afterwards. */ case SPECPDL_UNWIND: + if (vars_only) + break; if (tmp->unwind.func == set_buffer_if_live) { Lisp_Object oldarg = tmp->unwind.arg; @@ -4085,6 +4039,8 @@ backtrace_eval_unrewind (int distance) } break; case SPECPDL_UNWIND_EXCURSION: + if (vars_only) + break; { Lisp_Object marker = tmp->unwind_excursion.marker; Lisp_Object window = tmp->unwind_excursion.window; @@ -4125,7 +4081,7 @@ backtrace_eval_unrewind (int distance) Lisp_Object sym = specpdl_symbol (tmp); Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, default_value (sym)); - Fset_default (sym, old_value); + set_default_internal (sym, old_value, SET_INTERNAL_THREAD_SWITCH); } break; case SPECPDL_LET_LOCAL: @@ -4141,14 +4097,28 @@ backtrace_eval_unrewind (int distance) { set_specpdl_old_value (tmp, buffer_local_value (symbol, where)); - set_internal (symbol, old_value, where, SET_INTERNAL_UNBIND); + set_internal (symbol, old_value, where, + SET_INTERNAL_THREAD_SWITCH); } + else + /* FIXME: If the var is not local any more, we failed + to swap the old and new values. As long as the var remains + non-local, this is fine, but if it ever reverts to being + local we may end up using this entry "in the wrong + direction". */ + ; } break; } } } +static void +backtrace_eval_unrewind (int distance) +{ + specpdl_unrewind (specpdl_ptr, distance, false); +} + DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL, doc: /* Evaluate EXP in the context of some activation frame. NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) @@ -4302,7 +4272,6 @@ mark_specpdl (union specbinding *first, union specbinding *ptr) case SPECPDL_LET: mark_object (specpdl_symbol (pdl)); mark_object (specpdl_old_value (pdl)); - mark_object (specpdl_saved_value (pdl)); break; case SPECPDL_UNWIND_PTR: diff --git a/src/lisp.h b/src/lisp.h index f27c2ad2dd5..19788ef07cc 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3337,9 +3337,6 @@ union specbinding ENUM_BF (specbind_tag) kind : CHAR_BIT; /* `where' is not used in the case of SPECPDL_LET. */ Lisp_Object symbol, old_value, where; - /* Normally this is unused; but it is set to the symbol's - current value when a thread is swapped out. */ - Lisp_Object saved_value; } let; struct { ENUM_BF (specbind_tag) kind : CHAR_BIT; @@ -4453,8 +4450,7 @@ extern void set_unwind_protect (specpdl_ref, void (*) (Lisp_Object), Lisp_Object); extern void set_unwind_protect_ptr (specpdl_ref, void (*) (void *), void *); extern Lisp_Object unbind_to (specpdl_ref, Lisp_Object); -extern void rebind_for_thread_switch (void); -extern void unbind_for_thread_switch (struct thread_state *); +void specpdl_unrewind (union specbinding *pdl, int distance, bool vars_only); extern AVOID error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2); extern AVOID verror (const char *, va_list) ATTRIBUTE_FORMAT_PRINTF (1, 0); diff --git a/src/thread.c b/src/thread.c index 8a6a2de18be..4c98d590b7a 100644 --- a/src/thread.c +++ b/src/thread.c @@ -83,6 +83,22 @@ release_global_lock (void) sys_mutex_unlock (&global_lock); } +static void +rebind_for_thread_switch (void) +{ + ptrdiff_t distance + = current_thread->m_specpdl_ptr - current_thread->m_specpdl; + specpdl_unrewind (specpdl_ptr, -distance, true); +} + +static void +unbind_for_thread_switch (struct thread_state *thr) +{ + ptrdiff_t distance = thr->m_specpdl_ptr - thr->m_specpdl; + specpdl_unrewind (thr->m_specpdl_ptr, distance, true); +} + + /* You must call this after acquiring the global lock. acquire_global_lock does it for you. */ static void diff --git a/test/Makefile.in b/test/Makefile.in index 9ad994e1101..bc315ac4b3a 100644 --- a/test/Makefile.in +++ b/test/Makefile.in @@ -243,7 +243,7 @@ define test_template .PHONY: $(1) $(notdir $(1)) $(1): @test ! -f $(1).log || mv $(1).log $(1).log~ - @$(MAKE) $(1).log WRITE_LOG= + +@$(MAKE) $(1).log WRITE_LOG= $(notdir $(1)): $(1) endef diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index b7ab31120aa..75d67140a90 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -393,4 +393,29 @@ (let ((th (make-thread 'ignore))) (should-not (equal th main-thread)))) +(defvar threads-test--var 'global) + +(ert-deftest threads-test-bug48990 () + (skip-unless (fboundp 'make-thread)) + (let ((buf1 (generate-new-buffer " thread-test")) + (buf2 (generate-new-buffer " thread-test"))) + (with-current-buffer buf1 + (setq-local threads-test--var 'local1)) + (with-current-buffer buf2 + (setq-local threads-test--var 'local2)) + (let ((seen nil)) + (with-current-buffer buf1 + (should (eq threads-test--var 'local1)) + (make-thread (lambda () (setq seen threads-test--var)))) + (with-current-buffer buf2 + (should (eq threads-test--var 'local2)) + (let ((threads-test--var 'let2)) + (should (eq threads-test--var 'let2)) + (while (not seen) + (thread-yield)) + (should (eq threads-test--var 'let2)) + (should (eq seen 'local1))) + (should (eq threads-test--var 'local2))) + (should (eq threads-test--var 'global))))) + ;;; thread-tests.el ends here -- 2.39.5