Subject: bug#78917: feature/igc [PATCH] Avoid chaining finalizers together

From: Helmut Eller <[email-masked]>
Date: Sat, 28 Jun 2025 06:42:45 +0200

Lisp_Finalizers are currently chained together in a doubly linked list.
This prevents them from being collected.  I propose that we simply don't
use this list with MPS.

The first patch is minimalistic: it only skips finalizer_insert when
creating finalizers.

The second patch is more thorough: it #ifdefs away the prev/next fields
entirely.

>From 7d34a97c704357fa9e34bd87290a60ef1e8e1ff9 Mon Sep 17 00:00:00 2001
From: Helmut Eller <[email-masked]>
Date: Fri, 27 Jun 2025 20:34:27 +0200
Subject: [PATCH 1/2] Avoid chaining finalizers together

Lisp_Finalizers used be chained together via the prev/next fields.
These links kept all finalizers alive forever.

* src/alloc.c (Fmake_finalizer): Don't insert the new finalizer in the
finalizers list.  It's counterproductive with MPS.
* src/igc.c (Figc__process_messages): New subr.  Used to test
finalizers.
(syms_of_igc): Register it.
* test/src/igc-tests.el (test-two-finalizers): New test.
---
 src/alloc.c           |  2 ++
 src/igc.c             |  9 +++++++++
 test/src/igc-tests.el | 33 +++++++++++++++++++++++++++++++++
 3 files changed, 44 insertions(+)

diff --git a/src/alloc.c b/src/alloc.c
index ceda62f5ed6..cf8b8ad4149 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -4173,7 +4173,9 @@ DEFUN ("make-finalizer", Fmake_finalizer, Smake_finalizer, 1, 1, 0,
     = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER);
   finalizer->function = function;
   finalizer->prev = finalizer->next = NULL;
+#ifndef HAVE_MPS
   finalizer_insert (&finalizers, finalizer);
+#endif
   return make_lisp_ptr (finalizer, Lisp_Vectorlike);
 }
 
diff --git a/src/igc.c b/src/igc.c
index 61886f5cf90..bfb4caab483 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -4171,6 +4171,14 @@ DEFUN ("igc--collect", Figc__collect, Sigc__collect, 0, 0, 0,
   return Qnil;
 }
 
+DEFUN ("igc--process-messages", Figc__process_messages, Sigc__process_messages,
+       0, 0, 0, doc: /* Allow Emacs to process queued MPS messages. */)
+  (void)
+{
+  igc_process_messages ();
+  return Qnil;
+}
+
 size_t
 igc_hash (Lisp_Object key)
 {
@@ -5456,6 +5464,7 @@ syms_of_igc (void)
   defsubr (&Sigc_info);
   defsubr (&Sigc__roots);
   defsubr (&Sigc__collect);
+  defsubr (&Sigc__process_messages);
   defsubr (&Sigc__set_commit_limit);
   defsubr (&Sigc__add_extra_dependency);
   defsubr (&Sigc__remove_extra_dependency);
diff --git a/test/src/igc-tests.el b/test/src/igc-tests.el
index c9e6d895a38..c4bb863b61b 100644
--- a/test/src/igc-tests.el
+++ b/test/src/igc-tests.el
@@ -37,4 +37,37 @@ set-commit-limit-test
   (should (equal (assoc-string "commit-limit" (igc-info))
                  '("commit-limit" 1 -1 0))))
 
+
+(defvar finalizer-1-called nil)
+(defvar finalizer-2-called nil)
+
+(defun finalize-1 ()
+  (message "finalize-1 called")
+  (setq finalizer-1-called t))
+
+(defun finalize-2 ()
+  (message "finalize-2 called")
+  (setq finalizer-2-called t))
+
+(defvar finalizer-1 (cons 1 (make-finalizer #'finalize-1)))
+(defvar finalizer-2 (cons 2 (make-finalizer #'finalize-2)))
+
+;; Finalizers used to be chained together in a doubly linked list. The
+;; head of the list was the static variable finalizers (in alloc.c).
+;; Those links were strong references and prevented any finalizer from
+;; being collected.
+(ert-deftest test-two-finalizers ()
+  (let ((garbage-collection-messages t))
+    (dotimes (_ 3)
+      (igc--collect)
+      (igc--process-messages))
+    (should (not finalizer-1-called))
+    (should (not finalizer-2-called))
+    (setq finalizer-1 nil)
+    (dotimes (_ 1)
+      (igc--collect)
+      (igc--process-messages))
+    (should finalizer-1-called)
+    (should (not finalizer-2-called))))
+
 ;;; igc-tests.el ends here.
-- 
2.39.5

>From 64ee510fccf61c9f35f1408eddcbf055a7a6f692 Mon Sep 17 00:00:00 2001
From: Helmut Eller <[email-masked]>
Date: Fri, 27 Jun 2025 20:54:18 +0200
Subject: [PATCH 2/2] For MPS, #ifdef away the prev/next fields in
 Lisp_Finalizer

* src/lisp.h (struct Lisp_Finalizer): no more next/prev fields
(finalizers, doomed_finalizers, unchain_finalizer): #ifdef away.
* src/alloc.c (finalizers, doomed_finalizers, init_finalizer_list)
(finalizer_insert, unchain_finalizer Fmake_finalizer)
(init_alloc_once_for_pdumper): #ifdef away code related to
next/prev/finalizers/doomed_finalizers.
* src/pdumper.c (dump_finalizer)
(dump_field_finalizer_ref dump_finalizer_list_head_ptr)
(Fdump_emacs_portable): #ifdef away code related to
next/prev/finalizers/doomed_finalizers.
---
 src/alloc.c   | 13 +++++++------
 src/igc.c     |  5 +----
 src/lisp.h    |  5 ++++-
 src/pdumper.c | 10 +++++++++-
 4 files changed, 21 insertions(+), 12 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index cf8b8ad4149..52a6e7d5fee 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -561,6 +561,7 @@ mmap_lisp_allowed_p (void)
 }
 #endif
 
+#ifndef HAVE_MPS
 /* Head of a circularly-linked list of extant finalizers. */
 struct Lisp_Finalizer finalizers;
 
@@ -569,6 +570,7 @@ mmap_lisp_allowed_p (void)
    not a local inside garbage_collect, in case we GC again while
    running finalizers.  */
 struct Lisp_Finalizer doomed_finalizers;
+#endif
 
 
 /************************************************************************
@@ -4049,6 +4051,7 @@ make_user_ptr (void (*finalizer) (void *), void *p)
 }
 #endif
 
+#ifndef HAVE_MPS
 static void
 init_finalizer_list (struct Lisp_Finalizer *head)
 {
@@ -4080,6 +4083,7 @@ unchain_finalizer (struct Lisp_Finalizer *finalizer)
       finalizer->prev = finalizer->next = NULL;
     }
 }
+#endif
 
 #ifndef HAVE_MPS
 
@@ -4172,8 +4176,8 @@ DEFUN ("make-finalizer", Fmake_finalizer, Smake_finalizer, 1, 1, 0,
   struct Lisp_Finalizer *finalizer
     = ALLOCATE_PSEUDOVECTOR (struct Lisp_Finalizer, function, PVEC_FINALIZER);
   finalizer->function = function;
-  finalizer->prev = finalizer->next = NULL;
 #ifndef HAVE_MPS
+  finalizer->prev = finalizer->next = NULL;
   finalizer_insert (&finalizers, finalizer);
 #endif
   return make_lisp_ptr (finalizer, Lisp_Vectorlike);
@@ -7696,14 +7700,11 @@ init_alloc_once_for_pdumper (void)
   mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);   /* Max. number of mmap'ed areas.  */
 #endif
 
+#ifndef HAVE_MPS
   init_finalizer_list (&finalizers);
   init_finalizer_list (&doomed_finalizers);
-#ifdef HAVE_MPS
-  igc_root_create_exact_ptr (&finalizers.next);
-  igc_root_create_exact_ptr (&finalizers.prev);
-  igc_root_create_exact_ptr (&doomed_finalizers.next);
-  igc_root_create_exact_ptr (&doomed_finalizers.prev);
 #endif
+
   refill_memory_reserve ();
 }
 
diff --git a/src/igc.c b/src/igc.c
index bfb4caab483..b20d75baffa 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -101,7 +101,7 @@
 # ifndef HASH_Lisp_Overlay_AF021DC256
 #  error "struct Lisp_Overlay changed"
 # endif
-# ifndef HASH_Lisp_Finalizer_7DACDD23C5
+# ifndef HASH_Lisp_Finalizer_E3665AD113
 #  error "struct Lisp_Finalizer changed"
 # endif
 # ifndef HASH_Lisp_Bignum_8732048B98
@@ -2651,8 +2651,6 @@ fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f)
   MPS_SCAN_BEGIN (ss)
   {
     IGC_FIX_CALL_FN (ss, struct Lisp_Vector, f, fix_vectorlike);
-    IGC_FIX12_PVEC (ss, &f->next);
-    IGC_FIX12_PVEC (ss, &f->prev);
   }
   MPS_SCAN_END (ss);
   return MPS_RES_OK;
@@ -3664,7 +3662,6 @@ finalize_finalizer (struct Lisp_Finalizer *f)
   if (!NILP (fun))
     {
       f->function = Qnil;
-      unchain_finalizer (f);
       specpdl_ref count = SPECPDL_INDEX ();
       ++number_finalizers_run;
       specbind (Qinhibit_quit, Qt);
diff --git a/src/lisp.h b/src/lisp.h
index 167f2cb3a8f..3a858233465 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3191,15 +3191,18 @@ xmint_pointer (Lisp_Object a)
        FUNCTION contains a reference to the finalizer; i.e., call
        FUNCTION when it is reachable _only_ through finalizers.  */
     Lisp_Object function;
-
+#ifndef HAVE_MPS
     /* Circular list of all active weak references.  */
     struct Lisp_Finalizer *prev;
     struct Lisp_Finalizer *next;
+#endif
   } GCALIGNED_STRUCT;
 
+#ifndef HAVE_MPS
 extern struct Lisp_Finalizer finalizers;
 extern struct Lisp_Finalizer doomed_finalizers;
 void unchain_finalizer (struct Lisp_Finalizer *finalizer);
+#endif
 
 INLINE bool
 FINALIZERP (Lisp_Object x)
diff --git a/src/pdumper.c b/src/pdumper.c
index d73a0704e20..3003aa0b923 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2304,6 +2304,7 @@ dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
   return offset;
 }
 
+#ifndef HAVE_MPS
 static void
 dump_field_finalizer_ref (struct dump_context *ctx,
                           void *out,
@@ -2317,12 +2318,13 @@ dump_field_finalizer_ref (struct dump_context *ctx,
                           Lisp_Vectorlike,
                           WEIGHT_NORMAL);
 }
+#endif
 
 static dump_off
 dump_finalizer (struct dump_context *ctx,
                 const struct Lisp_Finalizer *finalizer)
 {
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_7DACDD23C5)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Finalizer_E3665AD113)
 # error "Lisp_Finalizer changed. See CHECK_STRUCTS comment in config.h."
 #endif
   START_DUMP_PVEC (ctx, &finalizer->header, struct Lisp_Finalizer, out);
@@ -2330,8 +2332,10 @@ dump_finalizer (struct dump_context *ctx,
      only Lisp field, finalizer->function, manually, so we can give it
      a low weight.  */
   dump_field_lv (ctx, out, finalizer, &finalizer->function, WEIGHT_NONE);
+#ifndef HAVE_MPS
   dump_field_finalizer_ref (ctx, out, finalizer, &finalizer->prev);
   dump_field_finalizer_ref (ctx, out, finalizer, &finalizer->next);
+#endif
   return finish_dump_pvec (ctx, &out->header);
 }
 
@@ -3448,6 +3452,7 @@ dump_charset_table (struct dump_context *ctx)
   return offset;
 }
 
+#ifndef HAVE_MPS
 static void
 dump_finalizer_list_head_ptr (struct dump_context *ctx,
                               struct Lisp_Finalizer **ptr)
@@ -3459,6 +3464,7 @@ dump_finalizer_list_head_ptr (struct dump_context *ctx,
        dump_object_for_offset (ctx,
 			       make_lisp_ptr (value, Lisp_Vectorlike)));
 }
+#endif
 
 static void
 dump_metadata_for_pdumper (struct dump_context *ctx)
@@ -4489,10 +4495,12 @@ DEFUN ("dump-emacs-portable",
   dump_roots (ctx);
 
   dump_charset_table (ctx);
+#ifndef HAVE_MPS
   dump_finalizer_list_head_ptr (ctx, &finalizers.prev);
   dump_finalizer_list_head_ptr (ctx, &finalizers.next);
   dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.prev);
   dump_finalizer_list_head_ptr (ctx, &doomed_finalizers.next);
+#endif
   dump_drain_user_remembered_data_hot (ctx);
 
   /* We've already remembered all the objects to which GC roots point,
-- 
2.39.5