Remove igc_header::pvec_type

* src/igc.c (igc_grow_ptr_vec): New function.
* src/image.c (cache_image):
* src/xfaces.c (cache_face): Use it instead of unconditionally
doubling the storage each time.

admin/IGC-TODO

@@ -0,0 +1,29 @@
+Todo list for scratch/igc
+
+- Generate the code to mirror the object graph in a loaded dump in MPS.
+
+- Implement weak hash tables.
+
+- Write the code to handle marker lists, undo list etc.
+
+- Maybe implement weak-ptr for the old GC.
+
+- Make native compilation work on macOS. (Might be fixed with Helmut's
+  exact root approach, but can't check because Homebrew libgccjit 14.1
+  makes problems when configuring (libgcc_s.dylib not found)).
+Todo list for scratch/igc
+
+- Complete the code to mirror the object graph in a loaded dump in MPS.
+
+- Write the code that replaces references to the loaded dump with
+  references to the mirrored graph in all roots.
+
+- Implement weak hash tables.
+
+- Write the code to handle marker lists, undo list etc.
+
+- Maybe implement weak-ptr for the old GC.
+
+- Make native compilation work on macOS. (Might be fixed with Helmut's
+  exact root approach, but can't check because Homebrew libgccjit 14.1
+  makes problems when configuring (libgcc_s.dylib not found)).

src/igc.c

@@ -282,20 +282,15 @@ struct igc_stats
 enum
 {
   IGC_TYPE_BITS = 5,
-  IGC_PVEC_BITS = 6,
-  IGC_HASH_BITS = 21,
+  IGC_HASH_BITS = 27,
   IGC_SIZE_BITS = 32
 };
 
 igc_static_assert (IGC_OBJ_LAST - 1 < (1 << IGC_TYPE_BITS));
-igc_static_assert (PVEC_TAG_MAX < (1 << IGC_PVEC_BITS));
 
 struct igc_header
 {
   enum igc_obj_type obj_type : IGC_TYPE_BITS;
-  /* FIXME: This was originally a debug aid only, but it now
-     used for something. Remove. */
-  enum pvec_type pvec_type : IGC_PVEC_BITS;
   mps_word_t hash : IGC_HASH_BITS;
   mps_word_t nwords : IGC_SIZE_BITS;
 };
@@ -1073,17 +1068,8 @@ fix_image_cache (mps_ss_t ss, struct image_cache *c)
   MPS_SCAN_BEGIN (ss)
   {
 #ifdef HAVE_WINDOW_SYSTEM
-    /* FIXME: the malloc'd buckets and images are not included in
-       the exclusive access granted to the image cache by MPS.  */
-    if (c->images)
-      for (ptrdiff_t i = 0; i < c->used; ++i)
-	if (c->images[i])
-	  IGC_FIX12_RAW (ss, &c->images[i]);
-
-    if (c->buckets)
-      for (ptrdiff_t i = 0; i < IMAGE_CACHE_BUCKETS_SIZE; ++i)
-	if (c->buckets[i])
-	  IGC_FIX12_RAW (ss, &c->buckets[i]);
+    IGC_FIX12_RAW (ss, &c->images);
+    IGC_FIX12_RAW (ss, &c->buckets);
 #endif
   }
   MPS_SCAN_END (ss);
@@ -1108,32 +1094,14 @@ fix_face (mps_ss_t ss, struct face *f)
   return MPS_RES_OK;
 }
 
-/* FIXME: Bot image_cache and face_cache are hash tables containing
-   malloc'd vectors. Tracing these here and in fix_image_cache is
-   strictly speaking not safe 100% safe, because MPS only guarantess
-   exclusive access to the face_cache itself, not its malloc'd vectors.
-
-   Introduce a new IGC_OBJ_PTR_VECTOR. That object is an array of
-   pointers that are guaranteed to point to MPS objects if non-null. Use
-   these objects for the four vectors in face_cache and image_cache.  */
-
 static mps_res_t
 fix_face_cache (mps_ss_t ss, struct face_cache *c)
 {
   MPS_SCAN_BEGIN (ss)
   {
     IGC_FIX12_RAW (ss, &c->f);
-    if (c->faces_by_id)
-      for (int i = 0; i < c->used; ++i)
-	{
-	  igc_assert (c->faces_by_id[i] != NULL);
-	  IGC_FIX12_RAW (ss, &c->faces_by_id[i]);
-	}
-
-    if (c->buckets)
-      for (int i = 0; i < FACE_CACHE_BUCKETS_SIZE; ++i)
-	if (c->buckets[i])
-	  IGC_FIX12_RAW (ss, &c->buckets[i]);
+    IGC_FIX12_RAW (ss, &c->faces_by_id);
+    IGC_FIX12_RAW (ss, &c->buckets);
   }
   MPS_SCAN_END (ss);
   return MPS_RES_OK;
@@ -1232,15 +1200,21 @@ fix_weak_ref (mps_ss_t ss, struct Lisp_Weak_Ref *wref)
   return MPS_RES_OK;
 }
 
-static mps_res_t
-fix_weak (mps_ss_t ss, struct igc_header* base)
+static enum pvec_type
+pseudo_vector_type (const struct Lisp_Vector *v)
 {
-  MPS_SCAN_BEGIN (ss) {
-    const mps_addr_t client = base_to_client(base);
-    switch (base->pvec_type)
+  return PSEUDOVECTOR_TYPE (v);
+}
+
+static mps_res_t
+fix_weak (mps_ss_t ss, struct Lisp_Vector* v)
+{
+  MPS_SCAN_BEGIN (ss)
+  {
+    switch (pseudo_vector_type (v))
       {
       case PVEC_WEAK_REF:
-	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Ref, client, fix_weak_ref);
+	IGC_FIX_CALL_FN (ss, struct Lisp_Weak_Ref, v, fix_weak_ref);
 	break;
       default:
 	igc_assert (!"fix_weak");
@@ -1374,7 +1348,7 @@ dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit,
 	    break;
 
 	  case IGC_OBJ_WEAK:
-	    IGC_FIX_CALL_FN (ss, struct igc_header, base, fix_weak);
+	    IGC_FIX_CALL_FN (ss, struct Lisp_Vector, client, fix_weak);
 	    break;
 	  }
       }
@@ -1394,12 +1368,6 @@ dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit)
   return MPS_RES_OK;
 }
 
-static enum pvec_type
-pseudo_vector_type (const struct Lisp_Vector *v)
-{
-  return PSEUDOVECTOR_TYPE (v);
-}
-
 static mps_res_t
 fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
 {
@@ -2897,7 +2865,7 @@ igc_hash (Lisp_Object key)
 }
 
 static mps_addr_t
-alloc (size_t size, enum igc_obj_type type, enum pvec_type pvec_type)
+alloc (size_t size, enum igc_obj_type type)
 {
   mps_ap_t ap = thread_ap (type);
   mps_addr_t p, obj;
@@ -2911,7 +2879,6 @@ alloc (size_t size, enum igc_obj_type type, enum pvec_type pvec_type)
       memclear (p, size);
       struct igc_header *h = p;
       h->obj_type = type;
-      h->pvec_type = pvec_type;
       h->hash = obj_hash ();
 #if IGC_SIZE_BITS >= 32 && INTPTR_MAX > INT_MAX
       /* On 32-bit architecture the assertion below is redudnant and
@@ -2928,7 +2895,7 @@ alloc (size_t size, enum igc_obj_type type, enum pvec_type pvec_type)
 Lisp_Object
 igc_make_cons (Lisp_Object car, Lisp_Object cdr)
 {
-  struct Lisp_Cons *cons = alloc (sizeof *cons, IGC_OBJ_CONS, PVEC_FREE);
+  struct Lisp_Cons *cons = alloc (sizeof *cons, IGC_OBJ_CONS);
   cons->u.s.car = car;
   cons->u.s.u.cdr = cdr;
   return make_lisp_ptr (cons, Lisp_Cons);
@@ -2937,14 +2904,14 @@ igc_make_cons (Lisp_Object car, Lisp_Object cdr)
 Lisp_Object
 igc_alloc_symbol (void)
 {
-  struct Lisp_Symbol *sym = alloc (sizeof *sym, IGC_OBJ_SYMBOL, PVEC_FREE);
+  struct Lisp_Symbol *sym = alloc (sizeof *sym, IGC_OBJ_SYMBOL);
   return make_lisp_symbol (sym);
 }
 
 Lisp_Object
 igc_make_float (double val)
 {
-  struct Lisp_Float *f = alloc (sizeof *f, IGC_OBJ_FLOAT, PVEC_FREE);
+  struct Lisp_Float *f = alloc (sizeof *f, IGC_OBJ_FLOAT);
   f->u.data = val;
   return make_lisp_ptr (f, Lisp_Float);
 }
@@ -2952,7 +2919,7 @@ igc_make_float (double val)
 static unsigned char *
 alloc_string_data (size_t nbytes, bool clear)
 {
-  unsigned char *data = alloc (nbytes + 1, IGC_OBJ_STRING_DATA, PVEC_FREE);
+  unsigned char *data = alloc (nbytes + 1, IGC_OBJ_STRING_DATA);
   data[nbytes] = 0;
   return data;
 }
@@ -2994,7 +2961,7 @@ igc_replace_char (Lisp_Object string, ptrdiff_t at_byte_pos,
 Lisp_Object
 igc_make_string (size_t nchars, size_t nbytes, bool unibyte, bool clear)
 {
-  struct Lisp_String *s = alloc (sizeof *s, IGC_OBJ_STRING, PVEC_FREE);
+  struct Lisp_String *s = alloc (sizeof *s, IGC_OBJ_STRING);
   s->u.s.size = nchars;
   s->u.s.size_byte = unibyte ? -1 : nbytes;
   s->u.s.data = alloc_string_data (nbytes, clear);
@@ -3016,7 +2983,7 @@ igc_make_unibyte_string (size_t nchars, size_t nbytes, bool clear)
 struct interval *
 igc_make_interval (void)
 {
-  return alloc (sizeof (struct interval), IGC_OBJ_INTERVAL, PVEC_FREE);
+  return alloc (sizeof (struct interval), IGC_OBJ_INTERVAL);
 }
 
 struct Lisp_Vector *
@@ -3024,7 +2991,7 @@ igc_alloc_pseudovector (size_t nwords_mem, size_t nwords_lisp,
 			size_t nwords_zero, enum pvec_type tag)
 {
   struct Lisp_Vector *v
-    = alloc (header_size + nwords_mem * word_size, IGC_OBJ_VECTOR, tag);
+    = alloc (header_size + nwords_mem * word_size, IGC_OBJ_VECTOR);
   XSETPVECTYPESIZE (v, tag, nwords_lisp, nwords_mem - nwords_lisp);
   maybe_finalize (v, tag);
   return v;
@@ -3034,7 +3001,7 @@ struct Lisp_Vector *
 igc_alloc_vector (ptrdiff_t len)
 {
   struct Lisp_Vector *v
-    = alloc (header_size + len * word_size, IGC_OBJ_VECTOR, PVEC_NORMAL_VECTOR);
+    = alloc (header_size + len * word_size, IGC_OBJ_VECTOR);
   v->header.size = len;
   return v;
 }
@@ -3043,7 +3010,7 @@ struct Lisp_Vector *
 igc_alloc_record (ptrdiff_t len)
 {
   struct Lisp_Vector *v
-    = alloc (header_size + len * word_size, IGC_OBJ_VECTOR, PVEC_RECORD);
+    = alloc (header_size + len * word_size, IGC_OBJ_VECTOR);
   v->header.size = len;
   XSETPVECTYPE (v, PVEC_RECORD);
   return v;
@@ -3052,14 +3019,14 @@ igc_alloc_record (ptrdiff_t len)
 struct itree_tree *
 igc_make_itree_tree (void)
 {
-  struct itree_tree *t = alloc (sizeof *t, IGC_OBJ_ITREE_TREE, PVEC_FREE);
+  struct itree_tree *t = alloc (sizeof *t, IGC_OBJ_ITREE_TREE);
   return t;
 }
 
 struct itree_node *
 igc_make_itree_node (void)
 {
-  struct itree_node *n = alloc (sizeof *n, IGC_OBJ_ITREE_NODE, PVEC_FREE);
+  struct itree_node *n = alloc (sizeof *n, IGC_OBJ_ITREE_NODE);
   return n;
 }
 
@@ -3067,7 +3034,7 @@ igc_make_itree_node (void)
 struct image *
 igc_make_image (void)
 {
-  struct image *img = alloc (sizeof *img, IGC_OBJ_IMAGE, PVEC_FREE);
+  struct image *img = alloc (sizeof *img, IGC_OBJ_IMAGE);
   return img;
 }
 #endif
@@ -3075,27 +3042,57 @@ igc_make_image (void)
 struct face *
 igc_make_face (void)
 {
-  struct face *face = alloc (sizeof *face, IGC_OBJ_FACE, PVEC_FREE);
+  struct face *face = alloc (sizeof *face, IGC_OBJ_FACE);
   return face;
 }
 
 struct face_cache *
 igc_make_face_cache (void)
 {
-  struct face_cache *c = alloc (sizeof *c, IGC_OBJ_FACE_CACHE, PVEC_FREE);
+  struct face_cache *c = alloc (sizeof *c, IGC_OBJ_FACE_CACHE);
   return c;
 }
 
 void *
 igc_make_ptr_vec (size_t n)
 {
-  return alloc (n * sizeof (void *), IGC_OBJ_PTR_VEC, PVEC_FREE);
+  return alloc (n * sizeof (void *), IGC_OBJ_PTR_VEC);
+}
+
+/* Like xpalloc, but uses 'alloc' instead of xrealloc, and should only
+   be used for growing a vector of pointers whose current size is N
+   pointers.  */
+void *
+igc_grow_ptr_vec (ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max)
+{
+  const ptrdiff_t min_items = 16;
+  ptrdiff_t nitems0 = *n;
+  ptrdiff_t half_nitems0 = nitems0 / 2;
+  ptrdiff_t max_items = n_max < 0 ? PTRDIFF_MAX : n_max;
+  ptrdiff_t new_nitems;
+
+  if (half_nitems0 < n_incr_min)
+    half_nitems0 = n_incr_min;
+
+  if (nitems0 < min_items)
+    new_nitems = min_items;
+  else if (nitems0 < max_items - half_nitems0)
+    new_nitems = nitems0 + half_nitems0;
+  else
+    new_nitems = max_items;
+
+  if (new_nitems <= nitems0)
+    memory_full (0);
+
+  void *new_vec = igc_make_ptr_vec (new_nitems);
+  *n = new_nitems;
+  return new_vec;
 }
 
 struct image_cache *
 igc_make_image_cache (void)
 {
-  struct image_cache *c = alloc (sizeof *c, IGC_OBJ_IMAGE_CACHE, PVEC_FREE);
+  struct image_cache *c = alloc (sizeof *c, IGC_OBJ_IMAGE_CACHE);
   return c;
 }
 
@@ -3105,7 +3102,7 @@ DEFUN ("igc-make-weak-ref", Figc_make_weak_ref, Sigc_make_weak_ref, 1, 1, 0,
 (Lisp_Object target)
 {
   const enum pvec_type type = PVEC_WEAK_REF;
-  struct Lisp_Weak_Ref *wref = alloc (sizeof *wref, IGC_OBJ_WEAK, type);
+  struct Lisp_Weak_Ref *wref = alloc (sizeof *wref, IGC_OBJ_WEAK);
   int nwords_lisp = VECSIZE (struct Lisp_Weak_Ref);
   XSETPVECTYPESIZE (wref, type, nwords_lisp, 0);
   wref->ref = target;
@@ -3138,7 +3135,7 @@ struct Lisp_Buffer_Local_Value *
 igc_alloc_blv (void)
 {
   struct Lisp_Buffer_Local_Value *blv
-    = alloc (sizeof *blv, IGC_OBJ_BLV, PVEC_FREE);
+    = alloc (sizeof *blv, IGC_OBJ_BLV);
   return blv;
 }
 
@@ -3362,8 +3359,7 @@ igc_finish_obj (void *client, enum igc_obj_type type, char *base, char *end)
   size_t client_size = end - base - sizeof *out;
   size_t nbytes = obj_size (client_size);
   size_t nwords = to_words (nbytes);
-  *out = (struct igc_header)
-    { .obj_type = type, .pvec_type = PVEC_FREE, .nwords = nwords };
+  *out = (struct igc_header) { .obj_type = type, .nwords = nwords };
   return base + nbytes;
 }
 
@@ -3390,621 +3386,6 @@ syms_of_igc (void)
   Fprovide (intern_c_string ("mps"), Qnil);
 }
 
-/***********************************************************************
-			    Copying the dump
- ***********************************************************************/
-
-#pragma GCC diagnostic ignored "-Wunused-function"
-
-static mps_addr_t
-copy (mps_addr_t base)
-{
-  struct igc_header *h = base;
-  mps_ap_t ap = thread_ap (h->obj_type);
-  size_t nbytes = to_bytes (h->nwords);
-  mps_addr_t p;
-  do
-    {
-      mps_res_t res = mps_reserve (&p, ap, nbytes);
-      if (res != MPS_RES_OK)
-	memory_full (0);
-      memcpy (p, base, nbytes);
-      struct igc_header *nh = p;
-      nh->hash = obj_hash ();
-    }
-  while (!mps_commit (ap, p, nbytes));
-  return p;
-}
-
-struct igc_mirror
-{
-  Lisp_Object start_time;
-  Lisp_Object end_copy_time;
-  Lisp_Object end_time;
-  Lisp_Object dumped_to_obj;
-  struct {
-    size_t n;
-    size_t nbytes;
-  } objs[IGC_OBJ_LAST];
-};
-
-static struct igc_mirror
-make_igc_mirror (void)
-{
-  Lisp_Object nobj = make_fixnum (500000);
-  Lisp_Object ht = CALLN (Fmake_hash_table, QCtest, Qeq, QCsize, nobj);
-  return (struct igc_mirror){ .dumped_to_obj = ht,
-			      .start_time = Ffloat_time (Qnil) };
-}
-
-static void
-print_copy_stats (struct igc_mirror *m)
-{
-  size_t ntotal = 0, nbytes_total = 0;
-  fprintf (stderr, "--------------------------------------------------\n");
-  fprintf (stderr, "%30s %8s %10s\n", "Type", "N", "Bytes");
-  fprintf (stderr, "--------------------------------------------------\n");
-  for (int i = 0; i < ARRAYELTS (m->objs); ++i)
-    {
-      fprintf (stderr, "%30s %8zu %10zu\n", obj_type_names[i], m->objs[i].n,
-	       m->objs[i].nbytes);
-      ntotal += m->objs[i].n;
-      nbytes_total += m->objs[i].nbytes;
-    }
-  fprintf (stderr, "--------------------------------------------------\n");
-  fprintf (stderr, "%30s %8zu %10zu\n", "Total", ntotal, nbytes_total);
-  fprintf (stderr, "%30s %8.4fs\n", "Copy time",
-	   XFLOAT_DATA (m->end_copy_time) - XFLOAT_DATA (m->start_time));
-  if (!NILP (m->end_time))
-  fprintf (stderr, "%30s %8.4fs\n", "Total time",
-	   XFLOAT_DATA (m->end_time) - XFLOAT_DATA (m->start_time));
-  fprintf (stderr, "--------------------------------------------------\n");
-}
-
-static Lisp_Object
-ptr_to_lisp (void *p)
-{
-  return make_fixnum ((EMACS_INT) p);
-}
-
-static void *
-lisp_to_ptr (Lisp_Object obj)
-{
-  igc_assert (FIXNUMP (obj));
-  return (void *) XFIXNUM (obj);
-}
-
-static void
-record_copy (struct igc_mirror *m, void *dumped, void *copy)
-{
-  Lisp_Object key = ptr_to_lisp (dumped);
-  Lisp_Object val = ptr_to_lisp (copy);
-  Fputhash (key, val, m->dumped_to_obj);
-  struct igc_header *h = copy;
-  m->objs[h->obj_type].nbytes += to_bytes (h->nwords);
-  m->objs[h->obj_type].n += 1;
-}
-
-static void *
-lookup_ptr (struct igc_mirror *m, void *dumped)
-{
-  Lisp_Object key = ptr_to_lisp (dumped);
-  Lisp_Object found = Fgethash (key, m->dumped_to_obj, Qnil);
-  return lisp_to_ptr (found);
-}
-
-static void
-mirror_lisp_obj (struct igc_mirror *m, Lisp_Object *pobj)
-{
-    mps_word_t *p = (mps_word_t *) pobj;
-    mps_word_t word = *p;
-    mps_word_t tag = word & IGC_TAG_MASK;
-
-    if (tag == Lisp_Int0 || tag == Lisp_Int1)
-      return;
-    else if (tag == Lisp_Type_Unused0)
-      emacs_abort ();
-
-    if (tag == Lisp_Symbol)
-      {
-	ptrdiff_t off = word ^ tag;
-	mps_addr_t client = (mps_addr_t) ((char *) lispsym + off);
-	if (pdumper_object_p (client))
-	  {
-	    mps_addr_t base = client_to_base (client);
-	    mps_addr_t mirror = lookup_ptr (m, base);
-	    igc_assert (mirror != NULL);
-	    client = base_to_client (mirror);
-	    ptrdiff_t new_off = (char *) client - (char *) lispsym;
-	    *p = new_off | tag;
-	  }
-      }
-    else
-      {
-	mps_addr_t client = (mps_addr_t) (word ^ tag);
-	if (pdumper_object_p (client))
-	  {
-	    mps_addr_t base = client_to_base (client);
-	    mps_addr_t mirror = lookup_ptr (m, base);
-	    igc_assert (mirror != NULL);
-	    client = base_to_client (mirror);
-	    *p = (mps_word_t) client | tag;
-	  }
-      }
-}
-
-static void
-copy_to_mps (void *dumped, void *closure)
-{
-  struct igc_mirror *m = closure;
-  void *obj = copy (dumped);
-  record_copy (m, dumped, obj);
-}
-
-static void
-mirror_symbol (struct igc_mirror *m, struct Lisp_Symbol *sym)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_string (struct igc_mirror *m, struct Lisp_String *s)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_interval (struct igc_mirror *m, struct interval *iv)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_itree_tree (struct igc_mirror *m, struct itree_tree *t)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_itree_node (struct igc_mirror *m, struct itree_node *n)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_image (struct igc_mirror *m, struct image *i)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_image_cache (struct igc_mirror *m, struct image_cache *ca)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_face (struct igc_mirror *m, struct face *f)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_face_cache (struct igc_mirror *m, struct face_cache *ca)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_ptr_vec (struct igc_mirror *m, void *client)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_weak_ref (struct igc_mirror *m, struct Lisp_Weak_Ref *wref)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_weak (struct igc_mirror *m, struct igc_header *base)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_cons (struct igc_mirror *m, struct Lisp_Cons *cons)
-{
-  mirror_lisp_obj (m, &cons->u.s.car);
-  mirror_lisp_obj (m, &cons->u.s.u.cdr);
-}
-
-static void
-mirror_blv (struct igc_mirror *m, struct Lisp_Buffer_Local_Value *blv)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_vectorlike (struct igc_mirror *m, struct Lisp_Vector *v)
-{
-  emacs_abort ();
-}
-
-#ifndef IN_MY_FORK
-static void
-mirror_obarray (struct igc_mirror *m, struct Lisp_Obarray *o)
-{
-  emacs_abort ();
-}
-#endif
-
-static void
-mirror_font (struct igc_mirror *m, struct Lisp_Vector *v)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_mutex (struct igc_mirror *m, struct Lisp_Mutex *mx)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_coding (struct igc_mirror *m, struct coding_system *cs)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_buffer (struct igc_mirror *m, struct buffer *b)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_glyph_matrix (struct igc_mirror *m, struct glyph_matrix *g)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_frame (struct igc_mirror *m, struct frame *b)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_window (struct igc_mirror *m, struct window *w)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_hash_table (struct igc_mirror *m, struct Lisp_Hash_Table *h)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_char_table (struct igc_mirror *m, struct Lisp_Vector *v)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_overlay (struct igc_mirror *m, struct Lisp_Overlay *o)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_subr (struct igc_mirror *m, struct Lisp_Subr *s)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_misc_ptr (struct igc_mirror *m, struct Lisp_Misc_Ptr *p)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_user_ptr (struct igc_mirror *m, struct Lisp_User_Ptr *p)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_handler (struct igc_mirror *m, struct handler *h)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_thread (struct igc_mirror *m, struct thread_state *s)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_terminal (struct igc_mirror *m, struct terminal *t)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_marker (struct igc_mirror *m, struct Lisp_Marker *ma)
-{
-}
-
-static void
-mirror_finalizer (struct igc_mirror *m, struct Lisp_Finalizer *f)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_comp_unit (struct igc_mirror *m, struct Lisp_Native_Comp_Unit *u)
-{
-  emacs_abort ();
-}
-
-#ifdef HAVE_XWIDGETS
-static void
-mirror_xwidget (struct igc_mirror *m, struct xwidget *w)
-{
-  emacs_abort ();
-}
-
-static void
-mirror_xwidget_view (struct igc_mirror *m, struct xwidget_view *w)
-{
-  emacs_abort ();
-}
-#endif
-
-#ifdef HAVE_MODULES
-static void
-mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r)
-{
-  emacs_abort ();
-}
-#endif
-
-static void
-mirror_vector (struct igc_mirror *m, struct Lisp_Vector *v)
-{
-  void *client = v;
-  switch (pseudo_vector_type (v))
-    {
-#ifndef IN_MY_FORK
-    case PVEC_OBARRAY:
-      mirror_obarray (m, client);
-      break;
-#endif
-
-    case PVEC_BUFFER:
-      mirror_buffer (m, client);
-      break;
-
-    case PVEC_FRAME:
-      mirror_frame (m, client);
-      break;
-
-    case PVEC_WINDOW:
-      mirror_window (m, client);
-      break;
-
-    case PVEC_HASH_TABLE:
-      mirror_hash_table (m, client);
-      break;
-
-    case PVEC_CHAR_TABLE:
-    case PVEC_SUB_CHAR_TABLE:
-      mirror_char_table (m, client);
-      break;
-
-    case PVEC_BOOL_VECTOR:
-      break;
-
-    case PVEC_OVERLAY:
-      mirror_overlay (m, client);
-      break;
-
-    case PVEC_SUBR:
-      mirror_subr (m, client);
-      break;
-
-    case PVEC_FREE:
-      emacs_abort ();
-
-    case PVEC_FINALIZER:
-      mirror_finalizer (m, client);
-      break;
-
-    case PVEC_MISC_PTR:
-      mirror_misc_ptr (m, client);
-      break;
-
-    case PVEC_USER_PTR:
-      mirror_user_ptr (m, client);
-      break;
-
-#ifdef HAVE_XWIDGETS
-    case PVEC_XWIDGET:
-      mirror_xwidget (c, client);
-      break;
-
-    case PVEC_XWIDGET_VIEW:
-      mirror_widget_view (c, client);
-      break;
-#endif
-
-    case PVEC_THREAD:
-      mirror_thread (m, client);
-      break;
-
-    case PVEC_MUTEX:
-      mirror_mutex (m, client);
-      break;
-
-    case PVEC_TERMINAL:
-      mirror_terminal (m, client);
-      break;
-
-    case PVEC_MARKER:
-      mirror_marker (m, client);
-      break;
-
-    case PVEC_BIGNUM:
-      break;
-
-    case PVEC_NATIVE_COMP_UNIT:
-      mirror_comp_unit (m, client);
-      break;
-
-    case PVEC_MODULE_GLOBAL_REFERENCE:
-#ifdef HAVE_MODULES
-      mirror_global_ref (m, client);
-#endif
-      break;
-
-    case PVEC_FONT:
-      mirror_font (m, client);
-      break;
-
-    case PVEC_NORMAL_VECTOR:
-    case PVEC_SYMBOL_WITH_POS:
-    case PVEC_PROCESS:
-    case PVEC_WINDOW_CONFIGURATION:
-    case PVEC_XWIDGET:
-    case PVEC_XWIDGET_VIEW:
-    case PVEC_MODULE_FUNCTION:
-    case PVEC_CONDVAR:
-    case PVEC_TS_COMPILED_QUERY:
-    case PVEC_TS_NODE:
-    case PVEC_TS_PARSER:
-    case PVEC_SQLITE:
-    case PVEC_COMPILED:
-    case PVEC_RECORD:
-    case PVEC_OTHER:
-#ifdef IN_MY_FORK
-    case PVEC_PACKAGE:
-#endif
-      mirror_vectorlike (m, client);
-      break;
-
-    case PVEC_WEAK_REF:
-      // FIXME: why is this abort here?
-      emacs_abort ();
-    }
-}
-
-static void
-mirror_obj (struct igc_mirror *m, void *base)
-{
-  struct igc_header *header = base;
-  void *client = base_to_client (header);
-  switch (header->obj_type)
-    {
-    case IGC_OBJ_PAD:
-    case IGC_OBJ_FWD:
-    case IGC_OBJ_INVALID:
-    case IGC_OBJ_LAST:
-      emacs_abort ();
-
-    case IGC_OBJ_PTR_VEC:
-      mirror_ptr_vec (m, client);
-      break;
-
-    case IGC_OBJ_CONS:
-      mirror_cons (m, client);
-      break;
-
-    case IGC_OBJ_STRING_DATA:
-    case IGC_OBJ_FLOAT:
-      break;
-
-    case IGC_OBJ_SYMBOL:
-      mirror_symbol (m, client);
-      break;
-
-    case IGC_OBJ_INTERVAL:
-      mirror_interval (m, client);
-      break;
-
-    case IGC_OBJ_STRING:
-      mirror_string (m, client);
-      break;
-
-    case IGC_OBJ_VECTOR:
-      mirror_vector (m, client);
-      break;
-
-    case IGC_OBJ_ITREE_TREE:
-      mirror_itree_tree (m, client);
-      break;
-
-    case IGC_OBJ_ITREE_NODE:
-      mirror_itree_node (m, client);
-      break;
-
-    case IGC_OBJ_IMAGE:
-      mirror_image (m, client);
-      break;
-
-    case IGC_OBJ_IMAGE_CACHE:
-      mirror_image_cache (m, client);
-      break;
-
-    case IGC_OBJ_FACE:
-      mirror_face (m, client);
-      break;
-
-    case IGC_OBJ_FACE_CACHE:
-      mirror_face_cache (m, client);
-      break;
-
-    case IGC_OBJ_BLV:
-      mirror_blv (m, client);
-      break;
-
-    case IGC_OBJ_WEAK:
-      mirror_weak (m, client);
-      break;
-    }
-}
-
-static void
-mirror_objects (struct igc_mirror *m)
-{
-#if 0
-  DOHASH (XHASH_TABLE (m->dumped_to_obj), dumped, obj)
-    mirror_obj (m, lisp_to_ptr (obj));
-#endif
-}
-
-static void
-copy_dump_to_mps (struct igc_mirror *m)
-{
-  pdumper_visit_object_starts (copy_to_mps, m);
-  m->end_copy_time = Ffloat_time (Qnil);
-  if (getenv ("IGC_COPY_STATS"))
-    print_copy_stats (m);
-}
-
-static void
-mirror_dump (void)
-{
-  struct igc_mirror m = make_igc_mirror ();
-  copy_dump_to_mps (&m);
-  mirror_objects (&m);
-}
-
 struct register_pdump_roots_ctx
 {
   void *hot_start;  /* start of hot section in pdump */
@@ -4062,7 +3443,4 @@ igc_on_pdump_loaded (void *start, void *end)
 {
   // root_create_ambig (global_igc, start, end);
   register_pdump_roots (start, end);
-  specpdl_ref count = igc_park_arena ();
-  mirror_dump ();
-  unbind_to (count, Qnil);
 }

src/igc.h

@@ -86,6 +86,7 @@ struct image *igc_make_image (void);
 struct face *igc_make_face (void);
 struct face_cache *igc_make_face_cache (void);
 void *igc_make_ptr_vec (size_t n);
+void *igc_grow_ptr_vec (ptrdiff_t *n, ptrdiff_t n_incr_min, ptrdiff_t n_max);
 struct image_cache *igc_make_image_cache (void);
 struct interval *igc_make_interval (void);
 

src/image.c

@@ -2121,8 +2121,13 @@ make_image_cache (void)
 
   c->size = 50;
   c->used = c->refcount = 0;
+#ifdef HAVE_MPS
+  c->images = igc_make_ptr_vec (c->size);
+  c->buckets = igc_make_ptr_vec (IMAGE_CACHE_BUCKETS_SIZE);
+#else
   c->images = xmalloc (c->size * sizeof *c->images);
   c->buckets = xzalloc (IMAGE_CACHE_BUCKETS_SIZE * sizeof *c->buckets);
+#endif
   return c;
 }
 
@@ -2239,9 +2244,13 @@ free_image_cache (struct frame *f)
 
       for (i = 0; i < c->used; ++i)
 	free_image (f, c->images[i]);
+#ifndef HAVE_MPS
       xfree (c->images);
+#endif
       c->images = NULL;
+#ifndef HAVE_MPS
       xfree (c->buckets);
+#endif
       c->buckets = NULL;
 #ifndef HAVE_MPS
       xfree (c);
@@ -3528,7 +3537,15 @@ cache_image (struct frame *f, struct image *img)
 
   /* If no free slot found, maybe enlarge c->images.  */
   if (i == c->used && c->used == c->size)
-    c->images = xpalloc (c->images, &c->size, 1, -1, sizeof *c->images);
+    {
+#ifdef HAVE_MPS
+      struct image **old = c->images;
+      c->images = igc_grow_ptr_vec (&c->size, 1, -1);
+      memcpy (c->images, old, c->size * sizeof *old);
+#else
+      c->images = xpalloc (c->images, &c->size, 1, -1, sizeof *c->images);
+#endif
+    }
 
   /* Add IMG to c->images, and assign IMG an id.  */
   c->images[i] = img;

src/pdumper.c

@@ -5388,6 +5388,28 @@ dump_visit_igc_objects (dump_visit_fn fn, void *closure)
       fn (start, closure);
     }
 }
+
+void *
+pdumper_next_object (struct pdumper_object_it *it)
+{
+  if (it->relocs == NULL)
+    {
+      const struct dump_table_locator *table
+	= &dump_private.header.igc_object_starts;
+      it->nrelocs = table->nr_entries;
+      it->relocs = dump_ptr (dump_public.start, table->offset);
+      it->i = 0;
+    }
+
+  if (it->i < it->nrelocs)
+    {
+      const struct dump_reloc *const relocs = it->relocs;
+      return dump_ptr (dump_public.start, dump_reloc_get_offset (relocs[it->i]));
+    }
+
+  return NULL;
+}
+
 # endif
 
 bool

src/pdumper.h

@@ -289,6 +289,18 @@ pdumper_visit_object_starts (dump_visit_fn fn, void *closure)
 #endif
 }
 
+#ifdef HAVE_MPS
+struct pdumper_object_it
+{
+  size_t i;
+  size_t nrelocs;
+  void *relocs;
+};
+
+/* Usage: struct pdumper_object_it it = {0};
+   while (p = pdumper_next_object (&it)) ... */
+void *pdumper_next_object (struct pdumper_object_it *it);
+#endif
 
 INLINE_HEADER_END
 #endif

src/xfaces.c

@@ -4738,11 +4738,16 @@ make_face_cache (struct frame *f)
   c = xmalloc (sizeof *c);
 #endif
 
-  c->buckets = xzalloc (FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets);
+  c->f = f;
   c->size = 50;
   c->used = 0;
+#ifdef HAVE_MPS
+  c->buckets = igc_make_ptr_vec (FACE_CACHE_BUCKETS_SIZE);
+  c->faces_by_id = igc_make_ptr_vec (c->size);
+#else
+  c->buckets = xzalloc (FACE_CACHE_BUCKETS_SIZE * sizeof *c->buckets);
   c->faces_by_id = xzalloc (c->size * sizeof *c->faces_by_id);
-  c->f = f;
+#endif
   c->menu_face_changed_p = menu_face_changed_default;
   return c;
 }
@@ -4849,13 +4854,13 @@ free_face_cache (struct face_cache *c)
   if (c)
     {
       free_realized_faces (c);
+#ifndef HAVE_MPS
       struct face **p = c->buckets;
       c->buckets = NULL;
       xfree (p);
       p = c->faces_by_id;
       c->faces_by_id = NULL;
       xfree (p);
-#ifndef HAVE_MPS
       xfree (c);
 #endif
     }
@@ -4928,9 +4933,17 @@ cache_face (struct face_cache *c, struct face *face, uintptr_t hash)
   if (i == c->used)
     {
       if (c->used == c->size)
+	{
+#ifdef HAVE_MPS
+	  struct face **old = c->faces_by_id;
+	  c->faces_by_id = igc_grow_ptr_vec (&c->size, 1, MAX_FACE_ID);
+	  memcpy (c->faces_by_id, old, c->size * sizeof *old);
+#else
 	c->faces_by_id
 	  = xpalloc (c->faces_by_id, &c->size, 1, MAX_FACE_ID,
 		     sizeof *c->faces_by_id);
+#endif
+	}
       c->used++;
     }