scratch/igc 24aff715519 2/4: SPECPDL_FREE

[Gerd Moellmann]

branch: scratch/igc
commit 24aff7155190389e6ea1003f1795f0033cecb3bf
Author: Gerd Möllmann <gerd@gnu.org>
Commit: Gerd Möllmann <gerd@gnu.org>

    SPECPDL_FREE
---
 src/.lldbinit |  1 -
 src/eval.c    | 11 +++++++++++
 src/igc.c     | 13 +++++++++----
 src/lisp.h    |  3 +++
 4 files changed, 23 insertions(+), 5 deletions(-)

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