From e091bee8db9926716a3e7778275901696896cbdf Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Sat, 5 Mar 2022 11:12:54 +0100 Subject: [PATCH] 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 a4449b18f9b..7269582333c 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 9599934c1fa..c5a772b4231 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)); -- 2.39.5