master e091bee8db 1/2: Add optional GC marking function to specpdl unwind_ptr record

[Andrew G Cohen]

branch: master
commit e091bee8db9926716a3e7778275901696896cbdf
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Andrew G Cohen <cohen@andy.bu.edu>

    Add optional GC marking function to specpdl unwind_ptr record
    
    Add a new `record_unwind_protect_ptr_mark` function for use with C data
    structures that use the specpdl for clean-up but also contain possibly
    unique references to Lisp objects.
    
    * src/eval.c (record_unwind_protect_ptr_mark): New.
    (record_unwind_protect_module, set_unwind_protect_ptr):
    Set the mark function to NULL.
    (mark_specpdl): Call the mark function if present.
    * src/lisp.h (unwind_ptr): Add a mark function pointer to the
    SPECPDL_UNWIND_PTR case.
---
 src/eval.c | 20 ++++++++++++++++++++
 src/lisp.h |  5 ++++-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/src/eval.c b/src/eval.c
index a4449b18f9..7269582333 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3496,6 +3496,20 @@ record_unwind_protect_ptr (void (*function) (void *), 
void *arg)
   specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
   specpdl_ptr->unwind_ptr.func = function;
   specpdl_ptr->unwind_ptr.arg = arg;
+  specpdl_ptr->unwind_ptr.mark = NULL;
+  grow_specpdl ();
+}
+
+/* Like `record_unwind_protect_ptr', but also specifies a function
+   for GC-marking Lisp objects only reachable through ARG.  */
+void
+record_unwind_protect_ptr_mark (void (*function) (void *), void *arg,
+                               void (*mark) (void *))
+{
+  specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
+  specpdl_ptr->unwind_ptr.func = function;
+  specpdl_ptr->unwind_ptr.arg = arg;
+  specpdl_ptr->unwind_ptr.mark = mark;
   grow_specpdl ();
 }
 
@@ -3539,6 +3553,7 @@ record_unwind_protect_module (enum specbind_tag kind, 
void *ptr)
   specpdl_ptr->kind = kind;
   specpdl_ptr->unwind_ptr.func = NULL;
   specpdl_ptr->unwind_ptr.arg = ptr;
+  specpdl_ptr->unwind_ptr.mark = NULL;
   grow_specpdl ();
 }
 
@@ -3667,6 +3682,7 @@ set_unwind_protect_ptr (specpdl_ref count, void (*func) 
(void *), void *arg)
   p->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
   p->unwind_ptr.func = func;
   p->unwind_ptr.arg = arg;
+  p->unwind_ptr.mark = NULL;
 }
 
 /* Pop and execute entries from the unwind-protect stack until the
@@ -4100,6 +4116,10 @@ mark_specpdl (union specbinding *first, union 
specbinding *ptr)
          break;
 
        case SPECPDL_UNWIND_PTR:
+         if (pdl->unwind_ptr.mark)
+           pdl->unwind_ptr.mark (pdl->unwind_ptr.arg);
+         break;
+
        case SPECPDL_UNWIND_INT:
        case SPECPDL_UNWIND_INTMAX:
         case SPECPDL_UNWIND_VOID:
diff --git a/src/lisp.h b/src/lisp.h
index 9599934c1f..c5a772b423 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3316,8 +3316,9 @@ union specbinding
     } unwind_array;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
-      void (*func) (void *);
+      void (*func) (void *);   /* Unwind function.  */
       void *arg;
+      void (*mark) (void *);   /* GC mark function (if non-null).  */
     } unwind_ptr;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
@@ -4474,6 +4475,8 @@ extern void specbind (Lisp_Object, Lisp_Object);
 extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
 extern void record_unwind_protect_array (Lisp_Object *, ptrdiff_t);
 extern void record_unwind_protect_ptr (void (*) (void *), void *);
+extern void record_unwind_protect_ptr_mark (void (*function) (void *),
+                                           void *arg, void (*mark) (void *));
 extern void record_unwind_protect_int (void (*) (int), int);
 extern void record_unwind_protect_intmax (void (*) (intmax_t), intmax_t);
 extern void record_unwind_protect_void (void (*) (void));