summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/alloc.c8
-rw-r--r--src/bytecode.c2
-rw-r--r--src/category.c2
-rw-r--r--src/emacs-module.c2
-rw-r--r--src/fns.c92
-rw-r--r--src/frame.c2
-rw-r--r--src/image.c2
-rw-r--r--src/lisp.h8
-rw-r--r--src/lread.c8
-rw-r--r--src/pdumper.c3
-rw-r--r--src/pgtkterm.c2
-rw-r--r--src/print.c4
-rw-r--r--src/profiler.c2
-rw-r--r--src/xfaces.c2
-rw-r--r--src/xterm.c2
15 files changed, 90 insertions, 51 deletions
diff --git a/src/alloc.c b/src/alloc.c
index 7432163db25..16aaa32e15f 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -5942,10 +5942,6 @@ purecopy_hash_table (struct Lisp_Hash_Table *table)
*pure = *table;
pure->mutable = false;
- pure->test.name = purecopy (table->test.name);
- pure->test.user_hash_function = purecopy (table->test.user_hash_function);
- pure->test.user_cmp_function = purecopy (table->test.user_cmp_function);
-
if (table->table_size > 0)
{
ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash;
@@ -6630,6 +6626,7 @@ garbage_collect (void)
#ifdef HAVE_NS
mark_nsterm ();
#endif
+ mark_fns ();
/* Everything is now marked, except for the data in font caches,
undo lists, and finalizers. The first two are compacted by
@@ -7295,9 +7292,6 @@ process_mark_stack (ptrdiff_t base_sp)
{
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *)ptr;
set_vector_marked (ptr);
- mark_stack_push_value (h->test.name);
- mark_stack_push_value (h->test.user_hash_function);
- mark_stack_push_value (h->test.user_cmp_function);
if (h->weakness == Weak_None)
mark_stack_push_values (h->key_and_value,
2 * h->table_size);
diff --git a/src/bytecode.c b/src/bytecode.c
index a0f02d518b7..ed6e2b34e77 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1743,7 +1743,7 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
/* h->count is a faster approximation for HASH_TABLE_SIZE (h)
here. */
- if (h->count <= 5 && !h->test.cmpfn)
+ if (h->count <= 5 && !h->test->cmpfn)
{ /* Do a linear search if there are not many cases
FIXME: 5 is arbitrarily chosen. */
for (i = h->count; 0 <= --i; )
diff --git a/src/category.c b/src/category.c
index 3a406a567a1..498b6a2a1c9 100644
--- a/src/category.c
+++ b/src/category.c
@@ -51,7 +51,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
if (NILP (XCHAR_TABLE (table)->extras[1]))
set_char_table_extras
(table, 1,
- make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false));
+ make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false));
struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
hash_hash_t hash;
ptrdiff_t i = hash_lookup_get_hash (h, category_set, &hash);
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e78391b3a71..00ae33dfa2c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -1698,7 +1698,7 @@ syms_of_module (void)
{
staticpro (&Vmodule_refs_hash);
Vmodule_refs_hash
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
DEFSYM (Qmodule_load_failed, "module-load-failed");
Fput (Qmodule_load_failed, Qerror_conditions,
diff --git a/src/fns.c b/src/fns.c
index c4e7a98a4d3..e491202cf54 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4448,7 +4448,7 @@ static Lisp_Object
cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2,
struct Lisp_Hash_Table *h)
{
- Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 };
+ Lisp_Object args[] = { h->test->user_cmp_function, key1, key2 };
return hash_table_user_defined_call (ARRAYELTS (args), args, h);
}
@@ -4487,7 +4487,7 @@ hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h)
static hash_hash_t
hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
{
- Lisp_Object args[] = { h->test.user_hash_function, key };
+ Lisp_Object args[] = { h->test->user_hash_function, key };
Lisp_Object hash = hash_table_user_defined_call (ARRAYELTS (args), args, h);
return FIXNUMP (hash) ? XUFIXNUM(hash) : sxhash (hash);
}
@@ -4557,10 +4557,10 @@ static const hash_idx_t empty_hash_index_vector[] = {-1};
changed after purecopy. */
Lisp_Object
-make_hash_table (struct hash_table_test test, EMACS_INT size,
+make_hash_table (const struct hash_table_test *test, EMACS_INT size,
hash_table_weakness_t weak, bool purecopy)
{
- eassert (SYMBOLP (test.name));
+ eassert (SYMBOLP (test->name));
eassert (0 <= size && size <= min (MOST_POSITIVE_FIXNUM, PTRDIFF_MAX));
struct Lisp_Hash_Table *h = allocate_hash_table ();
@@ -4763,7 +4763,7 @@ hash_table_thaw (Lisp_Object hash_table)
/* Freezing discarded most non-essential information; recompute it.
The allocation is minimal with no room for growth. */
- h->test = *hash_table_test_from_std (h->frozen_test);
+ h->test = hash_table_test_from_std (h->frozen_test);
ptrdiff_t size = h->count;
h->table_size = size;
ptrdiff_t index_size = hash_index_size (size);
@@ -4805,9 +4805,9 @@ hash_lookup_with_hash (struct Lisp_Hash_Table *h,
for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
0 <= i; i = HASH_NEXT (h, i))
if (EQ (key, HASH_KEY (h, i))
- || (h->test.cmpfn
+ || (h->test->cmpfn
&& hash == HASH_HASH (h, i)
- && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h))))
+ && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h))))
return i;
return -1;
@@ -4884,9 +4884,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
i = HASH_NEXT (h, i))
{
if (EQ (key, HASH_KEY (h, i))
- || (h->test.cmpfn
+ || (h->test->cmpfn
&& hashval == HASH_HASH (h, i)
- && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h))))
+ && !NILP (h->test->cmpfn (key, HASH_KEY (h, i), h))))
{
/* Take entry out of collision chain. */
if (prev < 0)
@@ -5339,6 +5339,58 @@ Hash codes are not guaranteed to be preserved across Emacs sessions. */)
return make_ufixnum (hashfn_equal (obj, NULL));
}
+
+/* This is a cache of hash_table_test structures so that they can be
+ shared between hash tables using the same test.
+ FIXME: This way of storing and looking up hash_table_test structs
+ isn't wonderful. Find a better solution. */
+struct hash_table_user_test
+{
+ struct hash_table_test test;
+ struct hash_table_user_test *next;
+};
+
+static struct hash_table_user_test *hash_table_user_tests = NULL;
+
+void
+mark_fns (void)
+{
+ for (struct hash_table_user_test *ut = hash_table_user_tests;
+ ut; ut = ut->next)
+ {
+ mark_object (ut->test.name);
+ mark_object (ut->test.user_cmp_function);
+ mark_object (ut->test.user_hash_function);
+ }
+}
+
+static struct hash_table_test *
+get_hash_table_user_test (Lisp_Object test)
+{
+ Lisp_Object prop = Fget (test, Qhash_table_test);
+ if (!CONSP (prop) || !CONSP (XCDR (prop)))
+ signal_error ("Invalid hash table test", test);
+
+ Lisp_Object equal_fn = XCAR (prop);
+ Lisp_Object hash_fn = XCAR (XCDR (prop));
+ struct hash_table_user_test *ut = hash_table_user_tests;
+ while (ut && !(EQ (equal_fn, ut->test.user_cmp_function)
+ && EQ (hash_fn, ut->test.user_hash_function)))
+ ut = ut->next;
+ if (!ut)
+ {
+ ut = xmalloc (sizeof *ut);
+ ut->test.name = test;
+ ut->test.user_cmp_function = equal_fn;
+ ut->test.user_hash_function = hash_fn;
+ ut->test.hashfn = hashfn_user_defined;
+ ut->test.cmpfn = cmpfn_user_defined;
+ ut->next = hash_table_user_tests;
+ hash_table_user_tests = ut;
+ }
+ return &ut->test;
+}
+
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0,
doc: /* Create and return a new hash table.
@@ -5384,25 +5436,15 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
Lisp_Object test = i ? args[i] : Qeql;
if (symbols_with_pos_enabled && SYMBOL_WITH_POS_P (test))
test = SYMBOL_WITH_POS_SYM (test);
- struct hash_table_test testdesc;
+ const struct hash_table_test *testdesc;
if (BASE_EQ (test, Qeq))
- testdesc = hashtest_eq;
+ testdesc = &hashtest_eq;
else if (BASE_EQ (test, Qeql))
- testdesc = hashtest_eql;
+ testdesc = &hashtest_eql;
else if (BASE_EQ (test, Qequal))
- testdesc = hashtest_equal;
+ testdesc = &hashtest_equal;
else
- {
- /* See if it is a user-defined test. */
- Lisp_Object prop = Fget (test, Qhash_table_test);
- if (!CONSP (prop) || !CONSP (XCDR (prop)))
- signal_error ("Invalid hash table test", test);
- testdesc.name = test;
- testdesc.user_cmp_function = XCAR (prop);
- testdesc.user_hash_function = XCAR (XCDR (prop));
- testdesc.hashfn = hashfn_user_defined;
- testdesc.cmpfn = cmpfn_user_defined;
- }
+ testdesc = get_hash_table_user_test (test);
/* See if there's a `:purecopy PURECOPY' argument. */
i = get_key_arg (QCpurecopy, nargs, args, used);
@@ -5504,7 +5546,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
doc: /* Return the test TABLE uses. */)
(Lisp_Object table)
{
- return check_hash_table (table)->test.name;
+ return check_hash_table (table)->test->name;
}
Lisp_Object
diff --git a/src/frame.c b/src/frame.c
index 08057736272..abd6ef00901 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1040,7 +1040,7 @@ make_frame (bool mini_p)
rw->pixel_height = rw->total_lines * FRAME_LINE_HEIGHT (f);
fset_face_hash_table
- (f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false));
+ (f, make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false));
if (mini_p)
{
diff --git a/src/image.c b/src/image.c
index 74d4b6c0bfe..66838adbb2a 100644
--- a/src/image.c
+++ b/src/image.c
@@ -6069,7 +6069,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
{
*put_func = xpm_put_color_table_h;
*get_func = xpm_get_color_table_h;
- return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false);
+ return make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE, Weak_None, false);
}
static void
diff --git a/src/lisp.h b/src/lisp.h
index 33c1e345f7a..b11237381d9 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2397,6 +2397,7 @@ typedef enum {
struct hash_table_test
{
+ /* FIXME: reorder for efficiency */
/* Function used to compare keys; always a bare symbol. */
Lisp_Object name;
@@ -2515,7 +2516,7 @@ struct Lisp_Hash_Table
Lisp_Object *key_and_value;
/* The comparison and hash functions. */
- struct hash_table_test test;
+ const struct hash_table_test *test;
/* Next weak hash table if this is a weak hash table. The head of
the list is in weak_hash_tables. Used only during garbage
@@ -2584,7 +2585,7 @@ HASH_TABLE_SIZE (const struct Lisp_Hash_Table *h)
INLINE hash_hash_t
hash_from_key (struct Lisp_Hash_Table *h, Lisp_Object key)
{
- return h->test.hashfn (key, h);
+ return h->test->hashfn (key, h);
}
void hash_table_thaw (Lisp_Object hash_table);
@@ -4064,7 +4065,7 @@ extern void hexbuf_digest (char *, void const *, int);
extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *);
EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object);
-Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT,
+Lisp_Object make_hash_table (const struct hash_table_test *, EMACS_INT,
hash_table_weakness_t, bool);
Lisp_Object hash_table_weakness_symbol (hash_table_weakness_t weak);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object);
@@ -4098,6 +4099,7 @@ extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop,
Lisp_Object val);
extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop);
extern void syms_of_fns (void);
+extern void mark_fns (void);
/* Defined in sort.c */
extern void tim_sort (Lisp_Object, Lisp_Object *, const ptrdiff_t);
diff --git a/src/lread.c b/src/lread.c
index b76fde3f266..2c6a444ec56 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2544,11 +2544,11 @@ readevalloop (Lisp_Object readcharfun,
if (! HASH_TABLE_P (read_objects_map)
|| XHASH_TABLE (read_objects_map)->count)
read_objects_map
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (! HASH_TABLE_P (read_objects_completed)
|| XHASH_TABLE (read_objects_completed)->count)
read_objects_completed
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (!NILP (Vpurify_flag) && c == '(')
val = read0 (readcharfun, false);
else
@@ -2792,11 +2792,11 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
if (! HASH_TABLE_P (read_objects_map)
|| XHASH_TABLE (read_objects_map)->count)
read_objects_map
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (! HASH_TABLE_P (read_objects_completed)
|| XHASH_TABLE (read_objects_completed)->count)
read_objects_completed
- = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
+ = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None, false);
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
diff --git a/src/pdumper.c b/src/pdumper.c
index 6b053c5b601..13077526776 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2704,7 +2704,8 @@ hash_table_freeze (struct Lisp_Hash_Table *h)
h->index = NULL;
h->table_size = 0;
h->index_size = 0;
- h->frozen_test = hash_table_std_test (&h->test);
+ h->frozen_test = hash_table_std_test (h->test);
+ h->test = NULL;
}
static dump_off
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 57ea82daa5e..b731f52983d 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -7178,7 +7178,7 @@ If set to a non-float value, there will be no wait at all. */);
DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false);
+ Vpgtk_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false);
window_being_scrolled = Qnil;
staticpro (&window_being_scrolled);
diff --git a/src/print.c b/src/print.c
index c27c66ae40a..58a23b79d5d 100644
--- a/src/print.c
+++ b/src/print.c
@@ -2577,10 +2577,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
#s(hash-table test equal data (k1 v1 k2 v2)) */
print_c_string ("#s(hash-table", printcharfun);
- if (!BASE_EQ (h->test.name, Qeql))
+ if (!BASE_EQ (h->test->name, Qeql))
{
print_c_string (" test ", printcharfun);
- print_object (h->test.name, printcharfun, escapeflag);
+ print_object (h->test->name, printcharfun, escapeflag);
}
if (h->weakness != Weak_None)
diff --git a/src/profiler.c b/src/profiler.c
index 06ffecf41e3..5a6a8b48f6b 100644
--- a/src/profiler.c
+++ b/src/profiler.c
@@ -563,7 +563,7 @@ export_log (struct profiler_log *plog)
which is more discriminating than the `function-equal' used by
the log but close enough, and will never confuse two distinct
keys in the log. */
- Lisp_Object h = make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
+ Lisp_Object h = make_hash_table (&hashtest_equal, DEFAULT_HASH_SIZE,
Weak_None, false);
for (int i = 0; i < log->size; i++)
{
diff --git a/src/xfaces.c b/src/xfaces.c
index c9dd0f90feb..2ca2c30636c 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -7333,7 +7333,7 @@ only for this purpose. */);
doc: /* Hash table of global face definitions (for internal use only.) */);
Vface_new_frame_defaults =
/* 33 entries is enough to fit all basic faces */
- make_hash_table (hashtest_eq, 33, Weak_None, false);
+ make_hash_table (&hashtest_eq, 33, Weak_None, false);
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
doc: /* Default stipple pattern used on monochrome displays.
diff --git a/src/xterm.c b/src/xterm.c
index e4139a79a6e..77d6550c8b9 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -32554,7 +32554,7 @@ If set to a non-float value, there will be no wait at all. */);
DEFVAR_LISP ("x-keysym-table", Vx_keysym_table,
doc: /* Hash table of character codes indexed by X keysym codes. */);
- Vx_keysym_table = make_hash_table (hashtest_eql, 900, Weak_None, false);
+ Vx_keysym_table = make_hash_table (&hashtest_eql, 900, Weak_None, false);
DEFVAR_BOOL ("x-frame-normalize-before-maximize",
x_frame_normalize_before_maximize,
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2024-10-25 05:16:53 +0000