[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/obarray 37fdb9d87f3 8/9: add PVEC_OBARRAY and use it for obarray
|
From: |
Mattias Engdegård |
|
Subject: |
scratch/obarray 37fdb9d87f3 8/9: add PVEC_OBARRAY and use it for obarray functions |
|
Date: |
Mon, 12 Feb 2024 09:10:55 -0500 (EST) |
branch: scratch/obarray
commit 37fdb9d87f37945f8ac59b133925f7c443dad478
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
add PVEC_OBARRAY and use it for obarray functions
New C definitions for obarray-make and obarray-size, replacing elisp
New functions obarray-object-p and obarray-clear
Adapt all functions to accept both obarray objects and vectors
as obarray values
---
etc/emacs_lldb.py | 1 +
lisp/obarray.el | 28 +---
src/alloc.c | 19 +++
src/data.c | 2 +
src/lisp.h | 64 ++++++++-
src/lread.c | 336 ++++++++++++++++++++++++++++++++++++---------
src/minibuf.c | 67 ++++++---
src/pdumper.c | 47 +++++++
src/print.c | 8 ++
test/lisp/obarray-tests.el | 11 +-
10 files changed, 473 insertions(+), 110 deletions(-)
diff --git a/etc/emacs_lldb.py b/etc/emacs_lldb.py
index fdf4314e2d0..9865fe391a2 100644
--- a/etc/emacs_lldb.py
+++ b/etc/emacs_lldb.py
@@ -56,6 +56,7 @@ class Lisp_Object:
"PVEC_BOOL_VECTOR": "struct Lisp_Bool_Vector",
"PVEC_BUFFER": "struct buffer",
"PVEC_HASH_TABLE": "struct Lisp_Hash_Table",
+ "PVEC_OBARRAY": "struct Lisp_Obarray",
"PVEC_TERMINAL": "struct terminal",
"PVEC_WINDOW_CONFIGURATION": "struct save_window_data",
"PVEC_SUBR": "struct Lisp_Subr",
diff --git a/lisp/obarray.el b/lisp/obarray.el
index e1ebb2ade51..bc9086c90ad 100644
--- a/lisp/obarray.el
+++ b/lisp/obarray.el
@@ -27,24 +27,15 @@
;;; Code:
-(defconst obarray-default-size 59
- "The value 59 is an arbitrary prime number that gives a good hash.")
-
-(defun obarray-make (&optional size)
- "Return a new obarray of size SIZE or `obarray-default-size'."
- (let ((size (or size obarray-default-size)))
- (if (< 0 size)
- (make-vector size 0)
- (signal 'wrong-type-argument '(size 0)))))
-
-(defun obarray-size (ob)
- "Return the number of slots of obarray OB."
- (length ob))
+(defconst obarray-default-size 4)
+(make-obsolete-variable 'obarray-default-size
+ "obarrays now grow automatically" "30.1")
(defun obarrayp (object)
- "Return t if OBJECT is an obarray."
- (and (vectorp object)
- (< 0 (length object))))
+ "Return t if OBJECT is an obarray object or a nonempty vector.
+See also `obarray-object-p'."
+ (or (obarray-object-p object)
+ (and (vectorp object) (< 0 (length object)))))
;; Don’t use obarray as a variable name to avoid shadowing.
(defun obarray-get (ob name)
@@ -66,10 +57,5 @@ Return t on success, nil otherwise."
"Call function FN on every symbol in obarray OB and return nil."
(mapatoms fn ob))
-(defun obarray-clear (ob)
- "Remove all symbols from obarray OB."
- ;; FIXME: This doesn't change the symbols to uninterned status.
- (fillarray ob 0))
-
(provide 'obarray)
;;; obarray.el ends here
diff --git a/src/alloc.c b/src/alloc.c
index 6abe9e28650..990f75fc8fa 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3455,6 +3455,17 @@ cleanup_vector (struct Lisp_Vector *vector)
hash_table_allocated_bytes -= bytes;
}
}
+ break;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = PSEUDOVEC_STRUCT (vector, Lisp_Obarray);
+ eassert (o->size_bits > 0);
+ xfree (o->buckets);
+ ptrdiff_t bytes = (sizeof *o->buckets) << o->size_bits;
+ /* FIXME: should have our own counter */
+ hash_table_allocated_bytes -= bytes;
+ }
+ break;
/* Keep the switch exhaustive. */
case PVEC_NORMAL_VECTOR:
case PVEC_FREE:
@@ -7311,6 +7322,14 @@ process_mark_stack (ptrdiff_t base_sp)
break;
}
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = (struct Lisp_Obarray *)ptr;
+ set_vector_marked (ptr);
+ mark_stack_push_values (o->buckets, 1 << o->size_bits);
+ break;
+ }
+
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
mark_char_table (ptr, (enum pvec_type) pvectype);
diff --git a/src/data.c b/src/data.c
index 0c47750cb75..8b6005f8699 100644
--- a/src/data.c
+++ b/src/data.c
@@ -231,6 +231,7 @@ for example, (type-of 1) returns `integer'. */)
case PVEC_BOOL_VECTOR: return Qbool_vector;
case PVEC_FRAME: return Qframe;
case PVEC_HASH_TABLE: return Qhash_table;
+ case PVEC_OBARRAY: return Qobarray;
case PVEC_FONT:
if (FONT_SPEC_P (object))
return Qfont_spec;
@@ -4238,6 +4239,7 @@ syms_of_data (void)
DEFSYM (Qtreesit_parser, "treesit-parser");
DEFSYM (Qtreesit_node, "treesit-node");
DEFSYM (Qtreesit_compiled_query, "treesit-compiled-query");
+ DEFSYM (Qobarray, "obarray");
DEFSYM (Qdefun, "defun");
diff --git a/src/lisp.h b/src/lisp.h
index 5326824bf38..54b8e42c61c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1062,6 +1062,7 @@ enum pvec_type
PVEC_BOOL_VECTOR,
PVEC_BUFFER,
PVEC_HASH_TABLE,
+ PVEC_OBARRAY,
PVEC_TERMINAL,
PVEC_WINDOW_CONFIGURATION,
PVEC_SUBR,
@@ -2393,6 +2394,68 @@ 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**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), always positive */
+ 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 (Lisp_Object a)
+{
+ eassert (OBARRAYP (a));
+ return 1 << XOBARRAY (a)->size_bits;
+}
+
+INLINE Lisp_Object
+obarray_bucket (Lisp_Object a, ptrdiff_t index)
+{
+ eassert (OBARRAYP (a));
+ return XOBARRAY (a)->buckets[index];
+}
+
+Lisp_Object check_obarray_slow (Lisp_Object);
+
+INLINE Lisp_Object
+check_obarray (Lisp_Object obarray)
+{
+ return OBARRAYP (obarray) ? obarray : check_obarray_slow (obarray);
+}
+
/***********************************************************************
Hash Tables
@@ -4604,7 +4667,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);
diff --git a/src/lread.c b/src/lread.c
index 71564f8a0f1..d8c9dd10ef0 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -4888,7 +4888,7 @@ static size_t oblookup_last_bucket_number;
If it is one, return it. */
Lisp_Object
-check_obarray (Lisp_Object obarray)
+check_obarray_slow (Lisp_Object obarray)
{
/* We don't want to signal a wrong-type-argument error when we are
shutting down due to a fatal error, and we don't want to hit
@@ -4898,13 +4898,16 @@ check_obarray (Lisp_Object obarray)
{
/* If Vobarray is now invalid, force it to be valid. */
if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
- wrong_type_argument (Qvectorp, obarray);
+ wrong_type_argument (Qobarrayp, obarray);
}
return obarray;
}
+static void grow_obarray (struct Lisp_Obarray *o);
+
/* Intern symbol SYM in OBARRAY using bucket INDEX. */
+/* FIXME: retype index as a C integer, maybe sym as a symbol struct */
static Lisp_Object
intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
{
@@ -4923,9 +4926,22 @@ intern_sym (Lisp_Object sym, Lisp_Object obarray,
Lisp_Object index)
SET_SYMBOL_VAL (s, sym);
}
- Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index));
- s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL;
- *ptr = sym;
+ if (OBARRAYP (obarray))
+ {
+ 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;
+ o->count++;
+ if (o->count > (1 << o->size_bits))
+ grow_obarray (o);
+ }
+ else
+ {
+ Lisp_Object *ptr = aref_addr (obarray, XFIXNUM (index));
+ s->u.s.next = BARE_SYMBOL_P (*ptr) ? XBARE_SYMBOL (*ptr) : NULL;
+ *ptr = sym;
+ }
return sym;
}
@@ -5079,7 +5095,6 @@ usage: (unintern NAME OBARRAY) */)
{
register Lisp_Object tem;
Lisp_Object string;
- size_t hash;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
@@ -5119,41 +5134,63 @@ usage: (unintern NAME OBARRAY) */)
/* if (NILP (tem) || EQ (tem, Qt))
error ("Attempt to unintern t or nil"); */
- XBARE_SYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
+ struct Lisp_Symbol *sym = XBARE_SYMBOL (tem);
+ sym->u.s.interned = SYMBOL_UNINTERNED;
- hash = oblookup_last_bucket_number;
+ ptrdiff_t idx = oblookup_last_bucket_number;
+ Lisp_Object *loc = (OBARRAYP (obarray)
+ ? &XOBARRAY (obarray)->buckets[idx]
+ : aref_addr (obarray, idx));
- if (BASE_EQ (AREF (obarray, hash), tem))
- {
- if (XBARE_SYMBOL (tem)->u.s.next)
- {
- Lisp_Object sym;
- XSETSYMBOL (sym, XBARE_SYMBOL (tem)->u.s.next);
- ASET (obarray, hash, sym);
- }
- else
- ASET (obarray, hash, make_fixnum (0));
- }
+ eassert (BARE_SYMBOL_P (*loc));
+ struct Lisp_Symbol *prev = XBARE_SYMBOL (*loc);
+ if (sym == prev)
+ *loc = sym->u.s.next ? make_lisp_symbol (sym->u.s.next) : make_fixnum (0);
else
- {
- Lisp_Object tail, following;
+ while (1)
+ {
+ struct Lisp_Symbol *next = prev->u.s.next;
+ if (next == sym)
+ {
+ prev->u.s.next = next->u.s.next;
+ break;
+ }
+ prev = next;
+ }
- for (tail = AREF (obarray, hash);
- XBARE_SYMBOL (tail)->u.s.next;
- tail = following)
- {
- XSETSYMBOL (following, XBARE_SYMBOL (tail)->u.s.next);
- if (BASE_EQ (following, tem))
- {
- set_symbol_next (tail, XBARE_SYMBOL (following)->u.s.next);
- break;
- }
- }
- }
+ if (OBARRAYP (obarray))
+ XOBARRAY (obarray)->count--;
return Qt;
}
+
+/* FIXME: copied from fns.c, should move to lisp.h */
+static 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)))));
+}
+
+/* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA. */
+static ptrdiff_t
+obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte)
+{
+ unsigned bits = oa->size_bits;
+ EMACS_UINT hash = hash_string (str, size_byte);
+#if 1
+ uint32_t hash32 = reduce_emacs_uint_to_hash_hash (hash);
+ uint32_t alpha = 2654435769; /* 2**32/phi */
+ return (uint64_t)((uint32_t)hash32 * alpha) >> (32 - bits);
+#else
+ uint64_t alpha = 11400714819323198485uLL; /* 2**64/phi */
+ return ((uint64_t)hash * alpha) >> (64 - bits);
+#endif
+}
+
/* Return the symbol in OBARRAY whose names matches the string
of SIZE characters (SIZE_BYTE bytes) at PTR.
If there is no such symbol, return the integer bucket number of
@@ -5164,17 +5201,24 @@ usage: (unintern NAME OBARRAY) */)
Lisp_Object
oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size,
ptrdiff_t size_byte)
{
- size_t hash;
- size_t obsize;
- register Lisp_Object tail;
- Lisp_Object bucket, tem;
+ Lisp_Object bucket;
+ ptrdiff_t idx;
+ if (OBARRAYP (obarray))
+ {
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ idx = obarray_index (o, ptr, size_byte);
+ bucket = o->buckets[idx];
+ }
+ else
+ {
+ obarray = check_obarray (obarray);
+ /* This is sometimes needed in the middle of GC. */
+ size_t obsize = gc_asize (obarray);
+ idx = hash_string (ptr, size_byte) % obsize;
+ bucket = AREF (obarray, idx);
+ }
- obarray = check_obarray (obarray);
- /* This is sometimes needed in the middle of GC. */
- obsize = gc_asize (obarray);
- hash = hash_string (ptr, size_byte) % obsize;
- bucket = AREF (obarray, hash);
- oblookup_last_bucket_number = hash;
+ oblookup_last_bucket_number = idx;
if (BASE_EQ (bucket, make_fixnum (0)))
;
else if (!BARE_SYMBOL_P (bucket))
@@ -5182,18 +5226,21 @@ oblookup (Lisp_Object obarray, register const char
*ptr, ptrdiff_t size, ptrdiff
xsignal2 (Qwrong_type_argument, Qobarrayp,
build_string ("Bad data in guts of obarray"));
else
- for (tail = bucket; ; XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next))
- {
- Lisp_Object name = XBARE_SYMBOL (tail)->u.s.name;
- if (SBYTES (name) == size_byte
- && SCHARS (name) == size
- && !memcmp (SDATA (name), ptr, size_byte))
- return tail;
- else if (XBARE_SYMBOL (tail)->u.s.next == 0)
- break;
- }
- XSETINT (tem, hash);
- return tem;
+ {
+ Lisp_Object sym = bucket;
+ while (1)
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (sym);
+ Lisp_Object name = s->u.s.name;
+ if (SBYTES (name) == size_byte && SCHARS (name) == size
+ && memcmp (SDATA (name), ptr, size_byte) == 0)
+ return sym;
+ if (s->u.s.next == NULL)
+ break;
+ sym = make_lisp_symbol(s->u.s.next);
+ }
+ }
+ return make_fixnum (idx);
}
/* Like 'oblookup', but considers 'Vread_symbol_shorthands',
@@ -5260,22 +5307,164 @@ oblookup_considering_shorthand (Lisp_Object obarray,
const char *in,
}
+static struct Lisp_Obarray *
+allocate_obarray (void)
+{
+ return ALLOCATE_PLAIN_PSEUDOVECTOR (struct Lisp_Obarray, PVEC_OBARRAY);
+}
+
+static Lisp_Object
+make_obarray (int bits)
+{
+ eassert (bits > 0);
+ struct Lisp_Obarray *o = allocate_obarray ();
+ o->count = 0;
+ o->size_bits = bits;
+ ptrdiff_t size = 1 << bits;
+ o->buckets = hash_table_alloc_bytes (size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < size; i++)
+ o->buckets[i] = make_fixnum (0);
+ return make_lisp_obarray (o);
+}
+
+static void
+grow_obarray (struct Lisp_Obarray *o)
+{
+ ptrdiff_t old_size = 1 << o->size_bits;
+ eassert (o->count > old_size);
+ Lisp_Object *old_buckets = o->buckets;
+
+ int new_bits = o->size_bits + 1;
+ ptrdiff_t new_size = 1 << new_bits;
+ o->buckets = hash_table_alloc_bytes (new_size * sizeof *o->buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ o->buckets[i] = make_fixnum (0);
+ o->size_bits = new_bits;
+
+ /* Rehash symbols.
+ FIXME: this is expensive since we need to recompute hashes for every
+ 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];
+ if (BARE_SYMBOL_P (obj))
+ {
+ struct Lisp_Symbol *s = XBARE_SYMBOL (obj);
+ while (1)
+ {
+ Lisp_Object name = s->u.s.name;
+ ptrdiff_t idx = obarray_index (o, SSDATA (name), SBYTES (name));
+ Lisp_Object *loc = 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);
+ if (next == NULL)
+ break;
+ s = next;
+ }
+ }
+ }
+
+ hash_table_free_bytes (old_buckets, old_size * sizeof *old_buckets);
+}
+
+enum { obarray_default_bits = 3 };
+
+DEFUN ("obarray-make", Fobarray_make, Sobarray_make, 0, 1, 0,
+ doc: /* Return a new obarray of size SIZE.
+The obarray will grow to accommodate any number of symbols; the size, if
+given, is only a hint for the expected number. */)
+ (Lisp_Object size)
+{
+ EMACS_INT n;
+ if (NILP (size))
+ n = obarray_default_bits - 1;
+ else
+ {
+ CHECK_FIXNUM (size);
+ n = XFIXNUM (size);
+ if (n < 1)
+ n = 1;
+ }
+ int bits = elogb (n) + 1;
+ eassert (bits > 0);
+ return make_obarray (bits);
+}
+
+DEFUN ("obarray-object-p", Fobarray_object_p, Sobarray_object_p, 1, 1, 0,
+ doc: /* Return t iff OBJECT is an obarray object.
+See also `obarrayp' which also accepts old vector-based obarrays. */)
+ (Lisp_Object object)
+{
+ return OBARRAYP (object) ? Qt : Qnil;
+}
+
+DEFUN ("obarray-size", Fobarray_size, Sobarray_size, 1, 1, 0,
+ doc: /* Allocated size of OBARRAY.
+This is not the number of symbols in OBARRAY, but an internal size
+that is rarely of interest. */)
+ (Lisp_Object obarray)
+{
+ if (VECTORP (obarray))
+ return Flength (obarray);
+ CHECK_OBARRAY (obarray);
+ return make_fixnum (1 << XOBARRAY (obarray)->size_bits);
+}
+
+DEFUN ("obarray-clear", Fobarray_clear, Sobarray_clear, 1, 1, 0,
+ doc: /* Remove all symbols from OBARRAY. */)
+ (Lisp_Object obarray)
+{
+ /* FIXME: This code doesn't set the symbol status to uninterned. */
+ /* FIXME: Should it work on vectors as well? (probably not) */
+ CHECK_OBARRAY (obarray);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+
+ int new_bits = obarray_default_bits;
+ int new_size = 1 << new_bits;
+ Lisp_Object *new_buckets
+ = hash_table_alloc_bytes (new_size * sizeof *new_buckets);
+ for (ptrdiff_t i = 0; i < new_size; i++)
+ new_buckets[i] = make_fixnum (0);
+
+ int old_size = 1 << o->size_bits;
+ hash_table_free_bytes (o->buckets, old_size * sizeof *o->buckets);
+ o->buckets = new_buckets;
+ o->size_bits = new_bits;
+ o->count = 0;
+
+ return Qnil;
+}
+
void
-map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object),
Lisp_Object arg)
+map_obarray (Lisp_Object obarray,
+ void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
{
- ptrdiff_t i;
- register Lisp_Object tail;
- CHECK_VECTOR (obarray);
- for (i = ASIZE (obarray) - 1; i >= 0; i--)
+ Lisp_Object *buckets;
+ ptrdiff_t size;
+ if (OBARRAYP (obarray))
{
- tail = AREF (obarray, i);
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ buckets = o->buckets;
+ size = 1 << o->size_bits;
+ }
+ else
+ {
+ CHECK_VECTOR (obarray);
+ buckets = XVECTOR (obarray)->contents;
+ size = ASIZE (obarray);
+ }
+
+ for (ptrdiff_t i = 0; i < size; i++)
+ {
+ Lisp_Object tail = buckets[i];
if (BARE_SYMBOL_P (tail))
while (1)
{
(*fn) (tail, arg);
if (XBARE_SYMBOL (tail)->u.s.next == 0)
break;
- XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next);
+ tail = make_lisp_symbol (XBARE_SYMBOL (tail)->u.s.next);
}
}
}
@@ -5304,12 +5493,24 @@ DEFUN ("internal--obarray-buckets",
(Lisp_Object obarray)
{
obarray = check_obarray (obarray);
- ptrdiff_t size = ASIZE (obarray);
+ ptrdiff_t size;
+ Lisp_Object *buckets;
+ if (OBARRAYP (obarray))
+ {
+ struct Lisp_Obarray *o = XOBARRAY (obarray);
+ size = 1 << o->size_bits;
+ buckets = o->buckets;
+ }
+ else
+ {
+ size = ASIZE (obarray);
+ buckets = XVECTOR (obarray)->contents;
+ }
Lisp_Object ret = Qnil;
for (ptrdiff_t i = 0; i < size; i++)
{
Lisp_Object bucket = Qnil;
- Lisp_Object sym = AREF (obarray, i);
+ Lisp_Object sym = buckets[i];
if (BARE_SYMBOL_P (sym))
while (1)
{
@@ -5324,11 +5525,12 @@ DEFUN ("internal--obarray-buckets",
return Fnreverse (ret);
}
-#define OBARRAY_SIZE 15121
+#define OBARRAY_SIZE 16384
void
init_obarray_once (void)
{
+ /* FIXME: use PVEC_OBARRAY */
Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
initial_obarray = Vobarray;
staticpro (&initial_obarray);
@@ -5712,6 +5914,10 @@ syms_of_lread (void)
defsubr (&Smapatoms);
defsubr (&Slocate_file_internal);
defsubr (&Sinternal__obarray_buckets);
+ defsubr (&Sobarray_make);
+ defsubr (&Sobarray_object_p);
+ defsubr (&Sobarray_size);
+ defsubr (&Sobarray_clear);
DEFVAR_LISP ("obarray", Vobarray,
doc: /* Symbol table for use by `intern' and `read'.
diff --git a/src/minibuf.c b/src/minibuf.c
index 7c0c9799a60..bdfc28fb719 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -1617,7 +1617,7 @@ or from one of the possible completions. */)
ptrdiff_t compare, matchsize;
enum { function_table, list_table, obarray_table, hash_table}
type = (HASH_TABLE_P (collection) ? hash_table
- : VECTORP (collection) ? obarray_table
+ : (OBARRAYP (collection) || VECTORP (collection)) ? obarray_table
: ((NILP (collection)
|| (CONSP (collection) && !FUNCTIONP (collection)))
? list_table : function_table));
@@ -1637,8 +1637,16 @@ or from one of the possible completions. */)
if (type == obarray_table)
{
collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
+ if (OBARRAYP (collection))
+ {
+ obsize = obarray_size (collection);
+ bucket = obarray_bucket (collection, idx);
+ }
+ else
+ {
+ obsize = ASIZE (collection);
+ bucket = AREF (collection, idx);
+ }
}
while (1)
@@ -1673,7 +1681,10 @@ or from one of the possible completions. */)
break;
else
{
- bucket = AREF (collection, idx);
+ if (OBARRAYP (collection))
+ bucket = obarray_bucket (collection, idx);
+ else
+ bucket = AREF (collection, idx);
continue;
}
}
@@ -1859,7 +1870,7 @@ with a space are ignored unless STRING itself starts with
a space. */)
Lisp_Object tail, elt, eltstring;
Lisp_Object allmatches;
int type = HASH_TABLE_P (collection) ? 3
- : VECTORP (collection) ? 2
+ : (OBARRAYP (collection) || VECTORP (collection)) ? 2
: NILP (collection) || (CONSP (collection) && !FUNCTIONP (collection));
ptrdiff_t idx = 0, obsize = 0;
Lisp_Object bucket, tem, zero;
@@ -1875,8 +1886,16 @@ with a space are ignored unless STRING itself starts
with a space. */)
if (type == 2)
{
collection = check_obarray (collection);
- obsize = ASIZE (collection);
- bucket = AREF (collection, idx);
+ if (OBARRAYP (collection))
+ {
+ obsize = obarray_size (collection);
+ bucket = obarray_bucket (collection, idx);
+ }
+ else
+ {
+ obsize = ASIZE (collection);
+ bucket = AREF (collection, idx);
+ }
}
while (1)
@@ -1911,7 +1930,10 @@ with a space are ignored unless STRING itself starts
with a space. */)
break;
else
{
- bucket = AREF (collection, idx);
+ if (OBARRAYP (collection))
+ bucket = obarray_bucket (collection, idx);
+ else
+ bucket = AREF (collection, idx);
continue;
}
}
@@ -2069,19 +2091,32 @@ the values STRING, PREDICATE and `lambda'. */)
if (NILP (tem))
return Qnil;
}
- else if (VECTORP (collection))
+ else if (OBARRAYP (collection) || VECTORP (collection))
{
/* Bypass intern-soft as that loses for nil. */
tem = oblookup (collection,
SSDATA (string),
SCHARS (string),
SBYTES (string));
- if (completion_ignore_case && !SYMBOLP (tem))
+ if (completion_ignore_case && !BARE_SYMBOL_P (tem))
{
- for (ptrdiff_t i = ASIZE (collection) - 1; i >= 0; i--)
+ Lisp_Object *buckets;
+ ptrdiff_t size;
+ if (OBARRAYP (collection))
+ {
+ buckets = XOBARRAY (collection)->buckets;
+ size = obarray_size (collection);
+ }
+ else
+ {
+ buckets = XVECTOR (collection)->contents;
+ size = ASIZE (collection);
+ }
+
+ for (ptrdiff_t i = size - 1; i >= 0; i--)
{
- tail = AREF (collection, i);
- if (SYMBOLP (tail))
+ tail = buckets[i];
+ if (BARE_SYMBOL_P (tail))
while (1)
{
if (BASE_EQ (Fcompare_strings (string, make_fixnum (0),
@@ -2093,14 +2128,14 @@ the values STRING, PREDICATE and `lambda'. */)
tem = tail;
break;
}
- if (XSYMBOL (tail)->u.s.next == 0)
+ if (XBARE_SYMBOL (tail)->u.s.next == 0)
break;
- XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
+ XSETSYMBOL (tail, XBARE_SYMBOL (tail)->u.s.next);
}
}
}
- if (!SYMBOLP (tem))
+ if (!BARE_SYMBOL_P (tem))
return Qnil;
}
else if (HASH_TABLE_P (collection))
diff --git a/src/pdumper.c b/src/pdumper.c
index b8006b035ea..af839dbb98b 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2748,6 +2748,51 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object
object)
return offset;
}
+static dump_off
+dump_obarray_buckets (struct dump_context *ctx, const struct Lisp_Obarray *o)
+{
+ dump_align_output (ctx, DUMP_ALIGNMENT);
+ dump_off start_offset = ctx->offset;
+ ptrdiff_t n = 1 << o->size_bits;
+
+ struct dump_flags old_flags = ctx->flags;
+ ctx->flags.pack_objects = true;
+
+ for (ptrdiff_t i = 0; i < n; i++)
+ {
+ Lisp_Object out;
+ const Lisp_Object *slot = &o->buckets[i];
+ dump_object_start (ctx, &out, sizeof out);
+ dump_field_lv (ctx, &out, slot, slot, WEIGHT_STRONG);
+ dump_object_finish (ctx, &out, sizeof out);
+ }
+
+ ctx->flags = old_flags;
+ return start_offset;
+}
+
+static dump_off
+dump_obarray (struct dump_context *ctx, Lisp_Object object)
+{
+#if CHECK_STRUCTS && !defined HASH_Lisp_Obarray_XXXXXXXXXX
+# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ const struct Lisp_Obarray *in_oa = XOBARRAY (object);
+ struct Lisp_Obarray munged_oa = *in_oa;
+ struct Lisp_Obarray *oa = &munged_oa;
+ START_DUMP_PVEC (ctx, &oa->header, struct Lisp_Obarray, out);
+ 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_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;
+}
+
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
@@ -3031,6 +3076,8 @@ dump_vectorlike (struct dump_context *ctx,
return dump_bool_vector(ctx, v);
case PVEC_HASH_TABLE:
return dump_hash_table (ctx, lv);
+ case PVEC_OBARRAY:
+ return dump_obarray (ctx, lv);
case PVEC_BUFFER:
return dump_buffer (ctx, XBUFFER (lv));
case PVEC_SUBR:
diff --git a/src/print.c b/src/print.c
index e2252562915..c16573a93be 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2078,6 +2078,14 @@ print_vectorlike_unreadable (Lisp_Object obj,
Lisp_Object printcharfun,
}
return;
+ case PVEC_OBARRAY:
+ {
+ struct Lisp_Obarray *o = XOBARRAY (obj);
+ int i = sprintf (buf, "#<obarray %d/%d>", o->count, 1 << o->size_bits);
+ strout (buf, i, i, printcharfun);
+ return;
+ }
+
/* Types handled earlier. */
case PVEC_NORMAL_VECTOR:
case PVEC_RECORD:
diff --git a/test/lisp/obarray-tests.el b/test/lisp/obarray-tests.el
index dd8f1c8abd4..36c59ea4235 100644
--- a/test/lisp/obarray-tests.el
+++ b/test/lisp/obarray-tests.el
@@ -43,17 +43,14 @@
(ert-deftest obarray-make-default-test ()
(let ((table (obarray-make)))
- (should (obarrayp table))
- (should (eq (obarray-size table) obarray-default-size))))
+ (should (obarrayp table))))
(ert-deftest obarray-make-with-size-test ()
- ;; FIXME: Actually, `wrong-type-argument' is not the right error to signal,
- ;; so we shouldn't enforce this misbehavior in tests!
- (should-error (obarray-make -1) :type 'wrong-type-argument)
- (should-error (obarray-make 0) :type 'wrong-type-argument)
+ (should-error (obarray-make 'a) :type 'wrong-type-argument)
(let ((table (obarray-make 1)))
(should (obarrayp table))
- (should (eq (obarray-size table) 1))))
+ (should (obarray-object-p table))
+ (should (>= (obarray-size table) 1))))
(ert-deftest obarray-get-test ()
(let ((table (obarray-make 3)))
- branch scratch/obarray created (now d6af4455d72), Mattias Engdegård, 2024/02/12
- scratch/obarray 82cf3ab0edf 2/9: Make minibuf-tests independent of obarray hash order, Mattias Engdegård, 2024/02/12
- scratch/obarray aa6f6434342 3/9: lread.c: Use bare symbol operations, Mattias Engdegård, 2024/02/12
- scratch/obarray 05e8b01d8c4 6/9: add obarray-clear and use it, Mattias Engdegård, 2024/02/12
- scratch/obarray 0a1c9810065 1/9: Internal function for obarray performance analysis (bug#68244), Mattias Engdegård, 2024/02/12
- scratch/obarray 0e821664f89 4/9: use obarray-make instead of make-vector, Mattias Engdegård, 2024/02/12
- scratch/obarray 3997133bf13 5/9: use obarrayp, not vectorp, to detect obarrays, Mattias Engdegård, 2024/02/12
- scratch/obarray d6af4455d72 9/9: Use obarray object for initial obarray, Mattias Engdegård, 2024/02/12
- scratch/obarray 2fd9f17a063 7/9: remove check of obarray-default-size in tests, Mattias Engdegård, 2024/02/12
- scratch/obarray 37fdb9d87f3 8/9: add PVEC_OBARRAY and use it for obarray functions,
Mattias Engdegård <=