Subject: [PATCH] Make obarray's buckets a Lisp_Vector

From: Helmut Eller <[email-masked]>
Date: Wed, 28 May 2025 14:03:29 +0200

Making the Lisp_Obarray.buckets field a proper Lisp_Vector instead of a
plain Lisp_Object[] would make some things simpler: some #ifdef HAVE_MPS
can be removed and the dumper is a bit simpler too.

The patch introduces functions vector_ref/vector_set which are analogues
to AREF/ASET; maybe that is contentious.

>From 9859e9d2b4861f3fbda2c1b444049a72c6f82291 Mon Sep 17 00:00:00 2001
From: Helmut Eller <[email-masked]>
Date: Wed, 28 May 2025 11:11:52 +0200
Subject: [PATCH] Make obarray's buckets a Lisp_Vector

This unifies the GC code and simplifies the dumper.

* src/lisp.h (struct Lisp_Obarray): Turn the buckets field into a
struct Lisp_Vector *.
(vector_ref, vector_set, vector_size): New utilties.
(AREF, ASET, ASIZE): Use them.
(obarray_iter_at_end): Use vector_ref.
* src/lread.c (intern_sym, Funintern, oblookup, make_obarray)
(grow_obarray, Fobarray_clear, Finternal__obarray_buckets): Adapt
to vectors.
* src/igc.c (vectorlike_size): Renamed from vector_size.
(fix_obarray): Adapt to vectors.
* src/alloc.c (process_mark_stack): Adapt to vectors.
(cleanup_vector): Nothing special to do for obarrays.
* src/pdumper.c (dump_obarray): Adapt to vectors.
(dump_obarray_buckets): Deleted.
---
 src/alloc.c   | 11 ++------
 src/igc.c     | 12 ++++-----
 src/lisp.h    | 34 +++++++++++++++++++------
 src/lread.c   | 69 +++++++++++++++++----------------------------------
 src/pdumper.c | 15 +++--------
 5 files changed, 60 insertions(+), 81 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index ceda62f5ed6..0eb9cd91f89 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3359,14 +3359,6 @@ cleanup_vector (struct Lisp_Vector *vector)
 	  }
       }
       break;
-    case PVEC_OBARRAY:
-      {
-	struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray);
-	xfree (o->buckets);
-	ptrdiff_t bytes = obarray_size (o) * sizeof *o->buckets;
-	hash_table_allocated_bytes -= bytes;
-      }
-      break;
     /* Keep the switch exhaustive.  */
     case PVEC_NORMAL_VECTOR:
     case PVEC_FREE:
@@ -3377,6 +3369,7 @@ cleanup_vector (struct Lisp_Vector *vector)
     case PVEC_BOOL_VECTOR:
     case PVEC_BUFFER:
     case PVEC_PROCESS:
+    case PVEC_OBARRAY:
     case PVEC_TERMINAL:
     case PVEC_WINDOW_CONFIGURATION:
     case PVEC_OTHER:
@@ -6864,7 +6857,7 @@ #define CHECK_ALLOCATED_AND_LIVE_SYMBOL()		((void) 0)
 		{
 		  struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr;
 		  set_vector_marked (ptr);
-		  mark_stack_push_values (o->buckets, obarray_size (o));
+		  mark_vectorlike (&o->buckets->header);
 		  break;
 		}
 
diff --git a/src/igc.c b/src/igc.c
index 9c3c8e82758..1418de102e5 100644
--- a/src/igc.c
+++ b/src/igc.c
@@ -202,7 +202,7 @@
 # ifndef HASH_face_cache_C289FB8D72
 #  error "struct face_cache changed"
 # endif
-# ifndef HASH_Lisp_Obarray_29CFFD1B74
+# ifndef HASH_Lisp_Obarray_3BA8AFA3DB
 #  error "struct Lisp_Obarray changed"
 # endif
 # ifndef HASH_module_global_reference_85FFC23A88
@@ -1101,7 +1101,7 @@ deregister_thread (struct igc_thread_list *t)
 #pragma GCC diagnostic ignored "-Wunused-variable"
 
 static size_t
-vector_size (const struct Lisp_Vector *v)
+vectorlike_size (const struct Lisp_Vector *v)
 {
   size_t size = v->header.size;
   if (size & PSEUDOVECTOR_FLAG)
@@ -2129,7 +2129,7 @@ fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v)
 {
   MPS_SCAN_BEGIN (ss)
   {
-    size_t size = vector_size (v);
+    size_t size = vectorlike_size (v);
     IGC_FIX12_NOBJS (ss, v->contents, size);
   }
   MPS_SCAN_END (ss);
@@ -2432,7 +2432,7 @@ fix_char_table (mps_ss_t ss, struct Lisp_Vector *v)
 {
   MPS_SCAN_BEGIN (ss)
   {
-    for (size_t i = vector_start (v), n = vector_size (v); i < n; ++i)
+    for (size_t i = vector_start (v), n = vectorlike_size (v); i < n; ++i)
       IGC_FIX12_OBJ (ss, &v->contents[i]);
   }
   MPS_SCAN_END (ss);
@@ -2665,7 +2665,7 @@ fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o)
 {
   MPS_SCAN_BEGIN (ss)
   {
-    IGC_FIX12_WRAPPED_VEC (ss, &o->buckets);
+    IGC_FIX12_PVEC (ss, &o->buckets);
   }
   MPS_SCAN_END (ss);
   return MPS_RES_OK;
@@ -3471,7 +3471,7 @@ finalize_bignum (struct Lisp_Bignum *n)
 finalize_font (struct font *font)
 {
   struct Lisp_Vector *v = (void *) font;
-  if (vector_size (v) == FONT_OBJECT_MAX)
+  if (vectorlike_size (v) == FONT_OBJECT_MAX)
     {
       /* The font driver might sometimes be NULL, e.g. if Emacs was
 	 interrupted before it had time to set it up.  */
diff --git a/src/lisp.h b/src/lisp.h
index 315ff89f391..fb4201d1a7d 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1821,13 +1821,19 @@ XVECTOR (Lisp_Object a)
 }
 
 INLINE ptrdiff_t
-ASIZE (Lisp_Object array)
+vector_size (const struct Lisp_Vector *v)
 {
-  ptrdiff_t size = XVECTOR (array)->header.size;
+  ptrdiff_t size = v->header.size;
   eassume (0 <= size);
   return size;
 }
 
+INLINE ptrdiff_t
+ASIZE (Lisp_Object array)
+{
+  return vector_size (XVECTOR (array));
+}
+
 INLINE ptrdiff_t
 gc_asize (Lisp_Object array)
 {
@@ -2039,11 +2045,17 @@ bool_vector_set (Lisp_Object a, EMACS_INT i, bool b)
 
 /* Conveniences for dealing with Lisp arrays.  */
 
+INLINE Lisp_Object
+vector_ref (const struct Lisp_Vector *v, ptrdiff_t idx)
+{
+  eassert (0 <= idx && idx < vector_size (v));
+  return v->contents[idx];
+}
+
 INLINE Lisp_Object
 AREF (Lisp_Object array, ptrdiff_t idx)
 {
-  eassert (0 <= idx && idx < gc_asize (array));
-  return XVECTOR (array)->contents[idx];
+  return vector_ref (XVECTOR (array), idx);
 }
 
 INLINE Lisp_Object *
@@ -2053,11 +2065,17 @@ aref_addr (Lisp_Object array, ptrdiff_t idx)
   return & XVECTOR (array)->contents[idx];
 }
 
+INLINE void
+vector_set (struct Lisp_Vector *v, ptrdiff_t idx, Lisp_Object val)
+{
+  eassert (0 <= idx && idx < vector_size (v));
+  v->contents[idx] = val;
+}
+
 INLINE void
 ASET (Lisp_Object array, ptrdiff_t idx, Lisp_Object val)
 {
-  eassert (0 <= idx && idx < ASIZE (array));
-  XVECTOR (array)->contents[idx] = val;
+  vector_set (XVECTOR (array), idx, val);
 }
 
 INLINE void
@@ -2482,7 +2500,7 @@ #define DEFSYM(sym, name) /* empty */
   /* Array of 2**size_bits values, each being either a (bare) symbol or
      the fixnum 0.  The symbols for each bucket are chained via
      their s.next field.  */
-  Lisp_Object *buckets;
+  struct Lisp_Vector *buckets;
 
   unsigned size_bits;  /* log2(size of buckets vector) */
   unsigned count;      /* number of symbols in obarray */
@@ -2558,7 +2576,7 @@ obarray_iter_at_end (obarray_iter_t *it)
   ptrdiff_t size = obarray_size (it->o);
   while (++it->idx < size)
     {
-      Lisp_Object obj = it->o->buckets[it->idx];
+      Lisp_Object obj = vector_ref (it->o->buckets, it->idx);
       if (!BASE_EQ (obj, make_fixnum (0)))
 	{
 	  it->symbol = XBARE_SYMBOL (obj);
diff --git a/src/lread.c b/src/lread.c
index a248c8f5ed9..8dac71f4c7a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4903,9 +4903,10 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
     }
 
   struct Lisp_Obarray *o = XOBARRAY (obarray);
-  Lisp_Object *ptr = o->buckets + XFIXNUM (index);
-  s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL;
-  *ptr = sym;
+  ptrdiff_t idx = XFIXNUM (index);
+  Lisp_Object entry = vector_ref (o->buckets, idx);
+  s->u.s.next = BARE_SYMBOL_P (entry) ? XBARE_SYMBOL (entry) : NULL;
+  vector_set (o->buckets, idx, sym);
   o->count++;
   if (o->count > obarray_size (o))
     grow_obarray (o);
@@ -5113,12 +5114,17 @@ DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0,
   sym->u.s.interned = SYMBOL_UNINTERNED;
 
   ptrdiff_t idx = oblookup_last_bucket_number;
-  Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx];
+  struct Lisp_Vector *buckets = XOBARRAY (obarray)->buckets;
+  Lisp_Object entry = vector_ref (buckets, idx);
 
-  eassert (BARE_SYMBOL_P (*loc));
-  struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc);
+  eassert (BARE_SYMBOL_P (entry));
+  struct Lisp_Symbol *prev = XBARE_SYMBOL (entry);
   if (sym == prev)
-    *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0);
+    {
+      Lisp_Object val
+	= sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0);
+      vector_set (buckets, idx, val);
+    }
   else
     while (1)
       {
@@ -5157,7 +5163,7 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
 {
   struct Lisp_Obarray *o = XOBARRAY (obarray);
   ptrdiff_t idx = obarray_index (o, ptr, size_byte);
-  Lisp_Object bucket = o->buckets[idx];
+  Lisp_Object bucket = vector_ref (o->buckets, idx);
 
   oblookup_last_bucket_number = idx;
   if (!BASE_EQ (bucket, make_fixnum (0)))
@@ -5255,13 +5261,7 @@ make_obarray (unsigned bits)
   o->count = 0;
   o->size_bits = bits;
   ptrdiff_t size = (ptrdiff_t)1 << bits;
-#ifdef HAVE_MPS
-  o->buckets = hash_table_alloc_kv (o, size);
-#else
-  o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets);
-#endif
-  for (ptrdiff_t i = 0; i < size; i++)
-    o->buckets[i] = make_fixnum (0);
+  o->buckets = XVECTOR (make_vector (size, make_fixnum (0)));
   return make_lisp_obarray (o);
 }
 
@@ -5277,19 +5277,13 @@ grow_obarray (struct Lisp_Obarray *o)
 {
   ptrdiff_t old_size = obarray_size (o);
   eassert (o->count > old_size);
-  Lisp_Object *old_buckets = o->buckets;
+  struct Lisp_Vector *old_buckets = o->buckets;
 
   int new_bits = o->size_bits + 1;
   if (new_bits > obarray_max_bits)
     error ("Obarray too big");
   ptrdiff_t new_size = (ptrdiff_t) 1 << new_bits;
-#ifdef HAVE_MPS
-  o->buckets = hash_table_alloc_kv (o, new_size);
-#else
-  o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets);
-#endif
-  for (ptrdiff_t i = 0; i < new_size; i++)
-    o->buckets[i] = make_fixnum (0);
+  o->buckets = XVECTOR (make_vector (new_size, make_fixnum (0)));
   o->size_bits = new_bits;
 
   /* Rehash symbols.
@@ -5297,7 +5291,7 @@ grow_obarray (struct Lisp_Obarray *o)
      symbol name.  Would it be reasonable to store it in the symbol?  */
   for (ptrdiff_t i = 0; i < old_size; i++)
     {
-      Lisp_Object obj = old_buckets[i];
+      Lisp_Object obj = vector_ref (old_buckets, i);
       if (BARE_SYMBOL_P (obj))
 	{
 	  struct Lisp_Symbol *s = XBARE_SYMBOL (obj);
@@ -5305,18 +5299,16 @@ grow_obarray (struct Lisp_Obarray *o)
 	    {
 	      Lisp_Object name = s->u.s.name;
 	      ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name));
-	      Lisp_Object *loc = o->buckets + idx;
+	      Lisp_Object sym = vector_ref (o->buckets, idx);
 	      struct Lisp_Symbol *next = s->u.s.next;
-	      s->u.s.next = BARE_SYMBOL_P (*loc) ? XBARE_SYMBOL (*loc) : NULL;
-	      *loc = make_lisp_symbol (s);
+	      s->u.s.next = BARE_SYMBOL_P (sym) ? XBARE_SYMBOL (sym) : NULL;
+	      vector_set (o->buckets, idx, make_lisp_symbol (s));
 	      if (next == NULL)
 		break;
 	      s = next;
 	    }
 	}
     }
-
-  hash_table_free_kv (o, old_buckets, old_size);
 }
 
 DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0,
@@ -5357,22 +5349,7 @@ DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0,
      to uninterned.  It doesn't matter very much.  */
   int new_bits = obarray_default_bits;
   int new_size = (ptrdiff_t)1 << new_bits;
-#ifdef HAVE_MPS
-  Lisp_Object *new_buckets = hash_table_alloc_kv (o, new_size);
-#else
-  Lisp_Object *new_buckets
-    = hash_table_alloc_bytes (new_size * sizeof *new_buckets);
-#endif
-  for (ptrdiff_t i = 0; i < new_size; i++)
-    new_buckets[i] = make_fixnum (0);
-
-#ifdef HAVE_MPS
-  hash_table_free_kv (o, o->buckets, -1 /* ignored */);
-#else
-  int old_size = obarray_size (o);
-  hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets);
-#endif
-  o->buckets = new_buckets;
+  o->buckets = XVECTOR (make_vector (new_size, make_fixnum (0)));
   o->size_bits = new_bits;
   o->count = 0;
 
@@ -5418,7 +5395,7 @@ DEFUN ("internal--obarray-buckets",
   for (ptrdiff_t i = 0; i < size; i++)
     {
       Lisp_Object bucket = Qnil;
-      Lisp_Object sym = XOBARRAY (obarray)->buckets[i];
+      Lisp_Object sym = vector_ref (XOBARRAY (obarray)->buckets, i);
       if (BARE_SYMBOL_P (sym))
 	while (1)
 	  {
diff --git a/src/pdumper.c b/src/pdumper.c
index d73a0704e20..e2e491ef46e 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2857,16 +2857,10 @@ dump_weak_hash_table (struct dump_context *ctx, Lisp_Object object)
 }
 #endif
 
-static dump_off
-dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
-{
-  return dump_hash_vec (ctx, o->buckets, obarray_size (o));
-}
-
 static dump_off
 dump_obarray (struct dump_context *ctx, Lisp_Object object)
 {
-#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_29CFFD1B74
+#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_3BA8AFA3DB
 # error "Lisp_Obarray changed. See CHECK_STRUCTS comment in config.h."
 #endif
   const struct Lisp_Obarray *in_oa = XOBARRAY (object);
@@ -2877,12 +2871,9 @@ dump_obarray (struct dump_context *ctx, Lisp_Object object)
   dump_pseudovector_lisp_fields (ctx, &out->header, &oa->header);
   DUMP_FIELD_COPY (out, oa, count);
   DUMP_FIELD_COPY (out, oa, size_bits);
-  dump_field_fixup_later (ctx, out, oa, &oa->buckets);
+  dump_field_lv_rawptr (ctx, out, oa, &oa->buckets, Lisp_Vectorlike,
+			WEIGHT_NORMAL);
   dump_off offset = finish_dump_pvec (ctx, &out->header);
-  dump_remember_fixup_ptr_raw
-    (ctx,
-     offset + dump_offsetof (struct Lisp_Obarray, buckets),
-     dump_obarray_buckets (ctx, oa));
   return offset;
 }
 
-- 
2.39.5