From cc7792376076bd763261506bc6d2d85a4ffb7ec3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gerd=20M=C3=B6llmann?= <gerd@gnu.org>
Date: Sun, 19 May 2024 21:18:22 +0200
Subject: [PATCH] Alloc module_global_reference from AMS pool

---
 src/emacs-module.c |  5 +++++
 src/igc.c          | 28 +++++++++++++++++++++++++---
 src/igc.h          |  1 +
 3 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/src/emacs-module.c b/src/emacs-module.c
index 92b324185f3..eb23e7243de 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -76,6 +76,7 @@ To add a new module function, proceed as follows:
 #include <config.h>
 
 #include "lisp.h"
+#include "igc.h"
 #include "emacs-module.h"
 
 #include <stdarg.h>
@@ -423,9 +424,13 @@ module_make_global_ref (emacs_env *env, emacs_value value)
     }
   else
     {
+#ifdef HAVE_MPS
+      struct module_global_reference *ref = igc_alloc_global_ref ();
+#else
       struct module_global_reference *ref
         = ALLOCATE_PLAIN_PSEUDOVECTOR (struct module_global_reference,
                                        PVEC_MODULE_GLOBAL_REFERENCE);
+#endif
       ref->value.v = new_obj;
       ref->refcount = 1;
       Lisp_Object value;
diff --git a/src/igc.c b/src/igc.c
index 46106a2d05b..6da2c8c8a44 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -2786,11 +2786,11 @@ thread_ap (enum igc_obj_type type)
     case IGC_OBJ_WEAK:
       return t->d.weak_weak_ap;
 
+    case IGC_OBJ_VECTOR:
     case IGC_OBJ_CONS:
     case IGC_OBJ_SYMBOL:
     case IGC_OBJ_INTERVAL:
     case IGC_OBJ_STRING:
-    case IGC_OBJ_VECTOR:
     case IGC_OBJ_ITREE_TREE:
     case IGC_OBJ_ITREE_NODE:
     case IGC_OBJ_IMAGE:
@@ -2883,9 +2883,8 @@ igc_hash (Lisp_Object key)
 }
 
 static mps_addr_t
-alloc (size_t size, enum igc_obj_type type)
+alloc_impl (size_t size, enum igc_obj_type type, mps_ap_t ap)
 {
-  mps_ap_t ap = thread_ap (type);
   mps_addr_t p, obj;
   size = obj_size (size);
   do
@@ -2910,6 +2909,29 @@ alloc (size_t size, enum igc_obj_type type)
   return obj;
 }
 
+static mps_addr_t
+alloc (size_t size, enum igc_obj_type type)
+{
+  return alloc_impl (size, type, thread_ap (type));
+}
+
+static mps_addr_t
+alloc_immovable (size_t size, enum igc_obj_type type)
+{
+  struct igc_thread_list *t = current_thread->gc_info;
+  return alloc_impl (size, type, t->d.ams_ap);
+}
+
+void *
+igc_alloc_global_ref (void)
+{
+  size_t nwords_mem = VECSIZE (struct module_global_reference);
+  struct Lisp_Vector *v
+    = alloc_immovable (header_size + nwords_mem * word_size, IGC_OBJ_VECTOR);
+  XSETPVECTYPESIZE (v, PVEC_MODULE_GLOBAL_REFERENCE, 0, nwords_mem);
+  return v;
+}
+
 Lisp_Object
 igc_make_cons (Lisp_Object car, Lisp_Object cdr)
 {
diff --git a/src/igc.h b/src/igc.h
index 2ea80edd3f2..c985fbdf3c3 100644
--- a/src/igc.h
+++ b/src/igc.h
@@ -65,6 +65,7 @@ void igc_on_face_cache_change (void *face_cache);
 void igc_process_messages (void);
 Lisp_Object igc_make_cons (Lisp_Object car, Lisp_Object cdr);
 Lisp_Object igc_alloc_symbol (void);
+void *igc_alloc_global_ref (void);
 
 struct Lisp_Buffer_Local_Value *igc_alloc_blv (void);
 void *igc_xzalloc_ambig (size_t size);