SPECPDL_FREE

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

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);
     }
 

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;

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.  */