diff --git a/src/.lldbinit b/src/.lldbinit index a8e023c5030..150421578cc 100644 --- a/src/.lldbinit +++ b/src/.lldbinit @@ -41,7 +41,6 @@ b pkg_break #b pkg_error #b Fpkg_read b igc_break -#b wrong_type_argument b malloc_error_break # When an assertion in MPS fails b mps_lib_assert_fail diff --git a/src/eval.c b/src/eval.c index 690ae6772f1..59946dc744b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -229,6 +229,8 @@ init_eval_once_for_pdumper (void) specpdl = specpdl_ptr = pdlvec + 1; specpdl_end = specpdl + size; #ifdef HAVE_MPS + for (int i = 0; i < size; ++i) + specpdl[i].kind = SPECPDL_FREE; igc_on_alloc_main_thread_specpdl (); #endif } @@ -2489,6 +2491,8 @@ grow_specpdl_allocation (void) specpdl_end = specpdl + pdlvecsize - 1; specpdl_ptr = specpdl_ref_to_ptr (count); #ifdef HAVE_MPS + for (int i = size; i < pdlvecsize - 1; ++i) + specpdl[i].kind = SPECPDL_FREE; igc_on_grow_specpdl (); #endif } @@ -3702,6 +3706,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding, eassert (unwinding || this_binding->kind >= SPECPDL_LET); switch (this_binding->kind) { +#ifdef HAVE_MPS + case SPECPDL_FREE: + emacs_abort (); +#endif case SPECPDL_UNWIND: lisp_eval_depth = this_binding->unwind.eval_depth; this_binding->unwind.func (this_binding->unwind.arg); @@ -3844,6 +3852,9 @@ unbind_to (specpdl_ref count, Lisp_Object value) union specbinding this_binding; this_binding = *--specpdl_ptr; +#ifdef HAVE_MPS + specpdl_ptr->kind = SPECPDL_FREE; +#endif do_one_unbind (&this_binding, true, SET_INTERNAL_UNBIND); } diff --git a/src/igc.c b/src/igc.c index 9c8deb4441e..efbfce03010 100644 --- a/src/igc.c +++ b/src/igc.c @@ -751,18 +751,22 @@ scan_specpdl (mps_ss_t ss, void *start, void *end, void *closure) { MPS_SCAN_BEGIN (ss) { - /* MPS docs say that root scanning functions have exclusive access to - what is being scanned, the same way format scanning functions - do. That means I can use the thread's specpdl_ptr here. */ + /* MPS docs say that root scanning functions have exclusive access + to what is being scanned, the same way format scanning functions + do. That does not mean one can rely on the thread's specpdl_ptr + here. It might be off because it may be updated after this + scanner runs. */ struct igc_thread_list *t = closure; igc_assert (start == (void *) t->d.ts->m_specpdl); igc_assert (end == (void *) t->d.ts->m_specpdl_end); - end = t->d.ts->m_specpdl_ptr; for (union specbinding *pdl = start; (void *) pdl < end; ++pdl) { switch (pdl->kind) { + case SPECPDL_FREE: + goto out; + case SPECPDL_UNWIND: IGC_FIX12_OBJ (ss, &pdl->unwind.arg); break; @@ -821,6 +825,7 @@ scan_specpdl (mps_ss_t ss, void *start, void *end, void *closure) break; } } + out:; } MPS_SCAN_END (ss); return MPS_RES_OK; diff --git a/src/lisp.h b/src/lisp.h index 810bc41a120..57739740421 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3652,6 +3652,9 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd const *, char const *); enum specbind_tag { +# ifdef HAVE_MPS + SPECPDL_FREE, +# endif SPECPDL_UNWIND, /* An unwind_protect function on Lisp_Object. */ SPECPDL_UNWIND_ARRAY, /* Likewise, on an array that needs freeing. Its elements are potential Lisp_Objects. */