1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-12 00:50:43 -08:00

Add a proper type for obarrays

The new opaque type replaces the previous use of vectors for obarrays.
`obarray-make` now returns objects of this type.  Functions that take
obarrays continue to accept vectors for compatibility, now just using
their first slot to store an actual obarray object.

obarray-size and obarray-default-size now obsolete.

* lisp/obarray.el (obarray-default-size, obarray-size):
Declare obsolete.
(obarray-make, obarrayp, obarray-clear): Remove from here.
* src/fns.c (reduce_emacs_uint_to_hash_hash): Remove from here.
* src/lisp.h (struct Lisp_Obarray, OBARRAYP, XOBARRAY, CHECK_OBARRAY)
(make_lisp_obarray, obarray_size, check_obarray)
(obarray_iter_t, make_obarray_iter, obarray_iter_at_end)
(obarray_iter_step, obarray_iter_symbol, DOOBARRAY, knuth_hash): New.
(reduce_emacs_uint_to_hash_hash): Moved here.
* src/lread.c (check_obarray): Renamed and reworked as...
(checked_obarray_slow): ...this.
(intern_sym, Funintern, oblookup, map_obarray)
(Finternal__obarray_buckets): Adapt to new type.
(obarray_index, allocate_obarray, make_obarray, grow_obarray)
(obarray_default_bits, Fobarray_make, Fobarrayp, Fobarray_clear): New.
* etc/emacs_lldb.py (Lisp_Object):
* lisp/emacs-lisp/cl-macs.el (`(,type . ,pred)):
* lisp/emacs-lisp/cl-preloaded.el (cl--typeof-types):
* lisp/emacs-lisp/comp-common.el (comp-known-type-specifiers):
* lisp/emacs-lisp/comp.el (comp-known-predicates):
* src/alloc.c (cleanup_vector, process_mark_stack):
* src/data.c (Ftype_of, syms_of_data):
* src/minibuf.c (Ftry_completion, Fall_completions, Ftest_completion):
* src/pdumper.c (dump_obarray_buckets, dump_obarray, dump_vectorlike):
* src/print.c (print_vectorlike_unreadable):
* test/lisp/abbrev-tests.el (abbrev-make-abbrev-table-test):
* test/lisp/obarray-tests.el (obarrayp-test)
(obarrayp-unchecked-content-test, obarray-make-default-test)
(obarray-make-with-size-test):
Adapt to new type.
This commit is contained in:
Mattias Engdegård 2024-02-10 21:14:09 +01:00
parent 6a182658a5
commit 462d8ba813
17 changed files with 499 additions and 226 deletions

View file

@ -1032,6 +1032,7 @@ enum pvec_type
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
PVEC_OBARRAY,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
@ -2386,6 +2387,118 @@ INLINE int
definition is done by lread.c's define_symbol. */
#define DEFSYM(sym, name) /* empty */
struct Lisp_Obarray
{
union vectorlike_header header;
/* 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;
unsigned size_bits; /* log2(size of buckets vector) */
unsigned count; /* number of symbols in obarray */
};
INLINE bool
OBARRAYP (Lisp_Object a)
{
return PSEUDOVECTORP (a, PVEC_OBARRAY);
}
INLINE struct Lisp_Obarray *
XOBARRAY (Lisp_Object a)
{
eassert (OBARRAYP (a));
return XUNTAG (a, Lisp_Vectorlike, struct Lisp_Obarray);
}
INLINE void
CHECK_OBARRAY (Lisp_Object x)
{
CHECK_TYPE (OBARRAYP (x), Qobarrayp, x);
}
INLINE Lisp_Object
make_lisp_obarray (struct Lisp_Obarray *o)
{
eassert (PSEUDOVECTOR_TYPEP (&o->header, PVEC_OBARRAY));
return make_lisp_ptr (o, Lisp_Vectorlike);
}
INLINE ptrdiff_t
obarray_size (const struct Lisp_Obarray *o)
{
return (ptrdiff_t)1 << o->size_bits;
}
Lisp_Object check_obarray_slow (Lisp_Object);
/* Return an obarray object from OBARRAY or signal an error. */
INLINE Lisp_Object
check_obarray (Lisp_Object obarray)
{
return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray);
}
/* Obarray iterator state. Don't access these members directly.
The iterator functions must be called in the order followed by DOOBARRAY. */
typedef struct {
struct Lisp_Obarray *o;
ptrdiff_t idx; /* Current bucket index. */
struct Lisp_Symbol *symbol; /* Current symbol, or NULL if at end
of current bucket. */
} obarray_iter_t;
INLINE obarray_iter_t
make_obarray_iter (struct Lisp_Obarray *oa)
{
return (obarray_iter_t){.o = oa, .idx = -1, .symbol = NULL};
}
/* Whether IT has reached the end and there are no more symbols.
If true, IT is dead and cannot be used any more. */
INLINE bool
obarray_iter_at_end (obarray_iter_t *it)
{
if (it->symbol)
return false;
ptrdiff_t size = obarray_size (it->o);
while (++it->idx < size)
{
Lisp_Object obj = it->o->buckets[it->idx];
if (!BASE_EQ (obj, make_fixnum (0)))
{
it->symbol = XBARE_SYMBOL (obj);
return false;
}
}
return true;
}
/* Advance IT to the next symbol if any. */
INLINE void
obarray_iter_step (obarray_iter_t *it)
{
it->symbol = it->symbol->u.s.next;
}
/* The Lisp symbol at IT, if obarray_iter_at_end returned false. */
INLINE Lisp_Object
obarray_iter_symbol (obarray_iter_t *it)
{
return make_lisp_symbol (it->symbol);
}
/* Iterate IT over the symbols of the obarray OA.
The body shouldn't add or remove symbols in OA, but disobeying that rule
only risks symbols to be iterated more than once or not at all,
not crashes or data corruption. */
#define DOOBARRAY(oa, it) \
for (obarray_iter_t it = make_obarray_iter (oa); \
!obarray_iter_at_end (&it); obarray_iter_step (&it))
/***********************************************************************
Hash Tables
@ -2666,6 +2779,28 @@ SXHASH_REDUCE (EMACS_UINT x)
return (x ^ x >> (EMACS_INT_WIDTH - FIXNUM_BITS)) & INTMASK;
}
/* Reduce an EMACS_UINT hash value to hash_hash_t. */
INLINE hash_hash_t
reduce_emacs_uint_to_hash_hash (EMACS_UINT x)
{
verify (sizeof x <= 2 * sizeof (hash_hash_t));
return (sizeof x == sizeof (hash_hash_t)
? x
: x ^ (x >> (8 * (sizeof x - sizeof (hash_hash_t)))));
}
/* Reduce HASH to a value BITS wide. */
INLINE ptrdiff_t
knuth_hash (hash_hash_t hash, unsigned bits)
{
/* Knuth multiplicative hashing, tailored for 32-bit indices
(avoiding a 64-bit multiply). */
uint32_t alpha = 2654435769; /* 2**32/phi */
/* Note the cast to uint64_t, to make it work for bits=0. */
return (uint64_t)((uint32_t)hash * alpha) >> (32 - bits);
}
struct Lisp_Marker
{
union vectorlike_header header;
@ -4585,7 +4720,6 @@ extern ptrdiff_t evxprintf (char **, ptrdiff_t *, char *, ptrdiff_t,
ATTRIBUTE_FORMAT_PRINTF (5, 0);
/* Defined in lread.c. */
extern Lisp_Object check_obarray (Lisp_Object);
extern Lisp_Object intern_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
extern Lisp_Object intern_driver (Lisp_Object, Lisp_Object, Lisp_Object);