From cd229f8346300b435a24bdec86ee2aecf1f61ba0 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@protonmail.com>
Date: Thu, 4 Jul 2024 18:43:54 +0000
Subject: [PATCH 3/5] allow IGC to keep track of an extra dependency in the
 exthdr

---
 src/igc.c | 78 +++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)

diff --git a/src/igc.c b/src/igc.c
index 9be30fcb3cf..bc697700bf7 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -542,6 +542,22 @@ igc_header_nwords (const struct igc_header *h)
   return IGC_HEADER_NWORDS (h);
 }
 
+static struct igc_exthdr *
+igc_external_header (struct igc_header *h)
+{
+  if (IGC_HEADER_TAG (h) != IGC_TAG_EXTHDR)
+    {
+      struct igc_exthdr *exthdr = xmalloc (sizeof *exthdr);
+      exthdr->nwords = IGC_HEADER_NWORDS (h);
+      exthdr->hash = IGC_HEADER_HASH (h);
+      exthdr->obj_type = IGC_HEADER_TYPE (h);
+      exthdr->extra_dependency = Qnil;
+      h->v = (intptr_t)exthdr + IGC_TAG_EXTHDR;
+    }
+
+  return IGC_HEADER_EXTHDR (h);
+}
+
 /* Value is the size in bytes of the object described by header H.
    This includes the header itself. */
 
@@ -1667,6 +1683,12 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	  }
       }
 
+    if (IGC_HEADER_TAG (header) == IGC_TAG_EXTHDR)
+      {
+	struct igc_exthdr *exthdr = IGC_HEADER_EXTHDR (header);
+	IGC_FIX12_OBJ (ss, &exthdr->extra_dependency);
+      }
+
     switch (igc_header_type (header))
       {
       case IGC_OBJ_INVALID:
@@ -4251,6 +4273,61 @@ DEFUN ("igc--roots", Figc__roots, Sigc__roots, 0, 0, 0, doc : /* */)
   return roots;
 }
 
+DEFUN ("igc-add-extra-dependency", Figc_add_extra_dependency,
+       Sigc_add_extra_dependency, 2, 2, 0, doc : /* */)
+  (Lisp_Object obj, Lisp_Object dependency)
+{
+  mps_word_t word = XLI (obj);
+  mps_word_t tag = word & IGC_TAG_MASK;
+  mps_addr_t client = NULL;
+  switch (tag)
+    {
+    case Lisp_Type_Unused0:
+      emacs_abort ();
+
+    case Lisp_Int0:
+    case Lisp_Int1:
+      return Qnil;
+
+    case Lisp_Symbol:
+      {
+	ptrdiff_t off = word ^ tag;
+	client = (mps_addr_t) ((char *) lispsym + off);
+      }
+      break;
+
+    case Lisp_String:
+    case Lisp_Vectorlike:
+    case Lisp_Cons:
+    case Lisp_Float:
+      client = (mps_addr_t) (word ^ tag);
+      break;
+    }
+
+  /* Objects in the the dump have igc_headers, too. */
+  if (!has_header (client, tag == Lisp_Vectorlike))
+    {
+      return Qnil;
+    }
+
+  struct igc_header *h = client_to_base (client);
+  struct igc_exthdr *exthdr = igc_external_header (h);
+  if (HASH_TABLE_P (exthdr->extra_dependency))
+    Fputhash (dependency, Qt, exthdr->extra_dependency);
+  else if (HASH_TABLE_P (dependency) || !NILP (exthdr->extra_dependency))
+    {
+      Lisp_Object hash = CALLN (Fmake_hash_table);
+      Fputhash (dependency, Qt, hash);
+      if (!NILP (exthdr->extra_dependency))
+	Fputhash (exthdr->extra_dependency, Qt, hash);
+      exthdr->extra_dependency = hash;
+    }
+  else
+    exthdr->extra_dependency = dependency;
+
+  return Qt;
+}
+
 static void
 make_arena (struct igc *gc)
 {
@@ -4678,6 +4755,7 @@ syms_of_igc (void)
   defsubr (&Sigc_info);
   defsubr (&Sigc__roots);
   defsubr (&Sigc__collect);
+  defsubr (&Sigc_add_extra_dependency);
   DEFSYM (Qambig, "ambig");
   DEFSYM (Qexact, "exact");
   Fprovide (intern_c_string ("mps"), Qnil);
-- 
2.45.2