Alloc module_global_reference from AMS pool

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;

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)
 {

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);