Commit b7432bb2 authored by Stefan Monnier's avatar Stefan Monnier

Use ad-hoc comparison function for the profiler's hash-tables.

* src/profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars.
(make_log): Use them.
(handle_profiler_signal): Don't inhibit quit any longer since we don't
call Fequal any more.
(Ffunction_equal): New function.
(cmpfn_profiler, hashfn_profiler): New functions.
(syms_of_profiler): Initialize them.
* src/lisp.h (struct hash_table_test): New struct.
(struct Lisp_Hash_Table): Use it.
* src/alloc.c (mark_object): Mark hash_table_test fields of hash tables.
* src/fns.c (make_hash_table): Take a struct to describe the test.
(cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql)
(hashfn_equal, hashfn_user_defined): Adjust to new calling convention.
(hash_lookup, hash_remove_from_table): Move assertion checking of
hashfn result here.  Check hash-equality before calling cmpfn.
(Fmake_hash_table): Adjust call to make_hash_table.
(hashtest_eq, hashtest_eql, hashtest_equal): New structs.
(syms_of_fns): Initialize them.
* src/emacs.c (main): Move syms_of_fns earlier.
* src/xterm.c (syms_of_xterm):
* src/category.c (hash_get_category_set): Adjust call to make_hash_table.
* src/print.c (print_object): Adjust to new hash-table struct.
* src/composite.c (composition_gstring_put_cache): Adjust to new hashfn.
parent 88002743
2012-11-08 Stefan Monnier <monnier@iro.umontreal.ca>
Use ad-hoc comparison function for the profiler's hash-tables.
* profiler.c (Qprofiler_backtrace_equal, hashtest_profiler): New vars.
(make_log): Use them.
(handle_profiler_signal): Don't inhibit quit any longer since we don't
call Fequal any more.
(Ffunction_equal): New function.
(cmpfn_profiler, hashfn_profiler): New functions.
(syms_of_profiler): Initialize them.
* lisp.h (struct hash_table_test): New struct.
(struct Lisp_Hash_Table): Use it.
* alloc.c (mark_object): Mark hash_table_test fields of hash tables.
* fns.c (make_hash_table): Take a struct to describe the test.
(cmpfn_eql, cmpfn_equal, cmpfn_user_defined, hashfn_eq, hashfn_eql)
(hashfn_equal, hashfn_user_defined): Adjust to new calling convention.
(hash_lookup, hash_remove_from_table): Move assertion checking of
hashfn result here. Check hash-equality before calling cmpfn.
(Fmake_hash_table): Adjust call to make_hash_table.
(hashtest_eq, hashtest_eql, hashtest_equal): New structs.
(syms_of_fns): Initialize them.
* emacs.c (main): Move syms_of_fns earlier.
* xterm.c (syms_of_xterm):
* category.c (hash_get_category_set): Adjust call to make_hash_table.
* print.c (print_object): Adjust to new hash-table struct.
* composite.c (composition_gstring_put_cache): Adjust to new hashfn.
2012-11-08 Eli Zaretskii <eliz@gnu.org> 2012-11-08 Eli Zaretskii <eliz@gnu.org>
* w32fns.c (modifier_set): Fix handling of Scroll Lock when the * w32fns.c (modifier_set): Fix handling of Scroll Lock when the
......
...@@ -5809,6 +5809,9 @@ mark_object (Lisp_Object arg) ...@@ -5809,6 +5809,9 @@ mark_object (Lisp_Object arg)
struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr; struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) ptr;
mark_vectorlike (ptr); mark_vectorlike (ptr);
mark_object (h->test.name);
mark_object (h->test.user_hash_function);
mark_object (h->test.user_cmp_function);
/* If hash table is not weak, mark all keys and values. /* If hash table is not weak, mark all keys and values.
For weak tables, mark only the vector. */ For weak tables, mark only the vector. */
if (NILP (h->weak)) if (NILP (h->weak))
......
...@@ -78,10 +78,10 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) ...@@ -78,10 +78,10 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
if (NILP (XCHAR_TABLE (table)->extras[1])) if (NILP (XCHAR_TABLE (table)->extras[1]))
set_char_table_extras set_char_table_extras
(table, 1, (table, 1,
make_hash_table (Qequal, make_number (DEFAULT_HASH_SIZE), make_hash_table (hashtest_equal, make_number (DEFAULT_HASH_SIZE),
make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_SIZE),
make_float (DEFAULT_REHASH_THRESHOLD), make_float (DEFAULT_REHASH_THRESHOLD),
Qnil, Qnil, Qnil)); Qnil));
h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
i = hash_lookup (h, category_set, &hash); i = hash_lookup (h, category_set, &hash);
if (i >= 0) if (i >= 0)
......
...@@ -676,7 +676,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) ...@@ -676,7 +676,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
ptrdiff_t i; ptrdiff_t i;
header = LGSTRING_HEADER (gstring); header = LGSTRING_HEADER (gstring);
hash = h->hashfn (h, header); hash = h->test.hashfn (&h->test, header);
if (len < 0) if (len < 0)
{ {
ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring); ptrdiff_t j, glyph_len = LGSTRING_GLYPH_LEN (gstring);
...@@ -1382,7 +1382,7 @@ composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff ...@@ -1382,7 +1382,7 @@ composition_update_it (struct composition_it *cmp_it, ptrdiff_t charpos, ptrdiff
} }
else else
{ {
/* automatic composition */ /* Automatic composition. */
Lisp_Object gstring = composition_gstring_from_id (cmp_it->id); Lisp_Object gstring = composition_gstring_from_id (cmp_it->id);
Lisp_Object glyph; Lisp_Object glyph;
ptrdiff_t from; ptrdiff_t from;
......
...@@ -1154,6 +1154,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem ...@@ -1154,6 +1154,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
/* Called before syms_of_fileio, because it sets up Qerror_condition. */ /* Called before syms_of_fileio, because it sets up Qerror_condition. */
syms_of_data (); syms_of_data ();
syms_of_fns (); /* Before syms_of_charset which uses hashtables. */
syms_of_fileio (); syms_of_fileio ();
/* Before syms_of_coding to initialize Vgc_cons_threshold. */ /* Before syms_of_coding to initialize Vgc_cons_threshold. */
syms_of_alloc (); syms_of_alloc ();
...@@ -1165,7 +1166,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem ...@@ -1165,7 +1166,7 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
init_window_once (); /* Init the window system. */ init_window_once (); /* Init the window system. */
#ifdef HAVE_WINDOW_SYSTEM #ifdef HAVE_WINDOW_SYSTEM
init_fringe_once (); /* Swap bitmaps if necessary. */ init_fringe_once (); /* Swap bitmaps if necessary. */
#endif /* HAVE_WINDOW_SYSTEM */ #endif /* HAVE_WINDOW_SYSTEM */
} }
...@@ -1348,7 +1349,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem ...@@ -1348,7 +1349,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
syms_of_lread (); syms_of_lread ();
syms_of_print (); syms_of_print ();
syms_of_eval (); syms_of_eval ();
syms_of_fns ();
syms_of_floatfns (); syms_of_floatfns ();
syms_of_buffer (); syms_of_buffer ();
......
...@@ -2014,7 +2014,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props) ...@@ -2014,7 +2014,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props)
d1 = extract_float (o1); d1 = extract_float (o1);
d2 = extract_float (o2); d2 = extract_float (o2);
/* If d is a NaN, then d != d. Two NaNs should be `equal' even /* If d is a NaN, then d != d. Two NaNs should be `equal' even
though they are not =. */ though they are not =. */
return d1 == d2 || (d1 != d1 && d2 != d2); return d1 == d2 || (d1 != d1 && d2 != d2);
} }
...@@ -3424,14 +3424,16 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) ...@@ -3424,14 +3424,16 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max)
Low-level Functions Low-level Functions
***********************************************************************/ ***********************************************************************/
struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code /* Compare KEY1 which has hash code HASH1 and KEY2 with hash code
HASH2 in hash table H using `eql'. Value is true if KEY1 and HASH2 in hash table H using `eql'. Value is true if KEY1 and
KEY2 are the same. */ KEY2 are the same. */
static bool static bool
cmpfn_eql (struct Lisp_Hash_Table *h, cmpfn_eql (struct hash_table_test *ht,
Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key1,
Lisp_Object key2, EMACS_UINT hash2) Lisp_Object key2)
{ {
return (FLOATP (key1) return (FLOATP (key1)
&& FLOATP (key2) && FLOATP (key2)
...@@ -3444,11 +3446,11 @@ cmpfn_eql (struct Lisp_Hash_Table *h, ...@@ -3444,11 +3446,11 @@ cmpfn_eql (struct Lisp_Hash_Table *h,
KEY2 are the same. */ KEY2 are the same. */
static bool static bool
cmpfn_equal (struct Lisp_Hash_Table *h, cmpfn_equal (struct hash_table_test *ht,
Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key1,
Lisp_Object key2, EMACS_UINT hash2) Lisp_Object key2)
{ {
return hash1 == hash2 && !NILP (Fequal (key1, key2)); return !NILP (Fequal (key1, key2));
} }
...@@ -3457,21 +3459,16 @@ cmpfn_equal (struct Lisp_Hash_Table *h, ...@@ -3457,21 +3459,16 @@ cmpfn_equal (struct Lisp_Hash_Table *h,
if KEY1 and KEY2 are the same. */ if KEY1 and KEY2 are the same. */
static bool static bool
cmpfn_user_defined (struct Lisp_Hash_Table *h, cmpfn_user_defined (struct hash_table_test *ht,
Lisp_Object key1, EMACS_UINT hash1, Lisp_Object key1,
Lisp_Object key2, EMACS_UINT hash2) Lisp_Object key2)
{ {
if (hash1 == hash2) Lisp_Object args[3];
{
Lisp_Object args[3];
args[0] = h->user_cmp_function; args[0] = ht->user_cmp_function;
args[1] = key1; args[1] = key1;
args[2] = key2; args[2] = key2;
return !NILP (Ffuncall (3, args)); return !NILP (Ffuncall (3, args));
}
else
return 0;
} }
...@@ -3480,54 +3477,48 @@ cmpfn_user_defined (struct Lisp_Hash_Table *h, ...@@ -3480,54 +3477,48 @@ cmpfn_user_defined (struct Lisp_Hash_Table *h,
in a Lisp integer. */ in a Lisp integer. */
static EMACS_UINT static EMACS_UINT
hashfn_eq (struct Lisp_Hash_Table *h, Lisp_Object key) hashfn_eq (struct hash_table_test *ht, Lisp_Object key)
{ {
EMACS_UINT hash = XUINT (key) ^ XTYPE (key); EMACS_UINT hash = XUINT (key) ^ XTYPE (key);
eassert ((hash & ~INTMASK) == 0);
return hash; return hash;
} }
/* Value is a hash code for KEY for use in hash table H which uses /* Value is a hash code for KEY for use in hash table H which uses
`eql' to compare keys. The hash code returned is guaranteed to fit `eql' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */ in a Lisp integer. */
static EMACS_UINT static EMACS_UINT
hashfn_eql (struct Lisp_Hash_Table *h, Lisp_Object key) hashfn_eql (struct hash_table_test *ht, Lisp_Object key)
{ {
EMACS_UINT hash; EMACS_UINT hash;
if (FLOATP (key)) if (FLOATP (key))
hash = sxhash (key, 0); hash = sxhash (key, 0);
else else
hash = XUINT (key) ^ XTYPE (key); hash = XUINT (key) ^ XTYPE (key);
eassert ((hash & ~INTMASK) == 0);
return hash; return hash;
} }
/* Value is a hash code for KEY for use in hash table H which uses /* Value is a hash code for KEY for use in hash table H which uses
`equal' to compare keys. The hash code returned is guaranteed to fit `equal' to compare keys. The hash code returned is guaranteed to fit
in a Lisp integer. */ in a Lisp integer. */
static EMACS_UINT static EMACS_UINT
hashfn_equal (struct Lisp_Hash_Table *h, Lisp_Object key) hashfn_equal (struct hash_table_test *ht, Lisp_Object key)
{ {
EMACS_UINT hash = sxhash (key, 0); EMACS_UINT hash = sxhash (key, 0);
eassert ((hash & ~INTMASK) == 0);
return hash; return hash;
} }
/* Value is a hash code for KEY for use in hash table H which uses as /* Value is a hash code for KEY for use in hash table H which uses as
user-defined function to compare keys. The hash code returned is user-defined function to compare keys. The hash code returned is
guaranteed to fit in a Lisp integer. */ guaranteed to fit in a Lisp integer. */
static EMACS_UINT static EMACS_UINT
hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key) hashfn_user_defined (struct hash_table_test *ht, Lisp_Object key)
{ {
Lisp_Object args[2], hash; Lisp_Object args[2], hash;
args[0] = h->user_hash_function; args[0] = ht->user_hash_function;
args[1] = key; args[1] = key;
hash = Ffuncall (2, args); hash = Ffuncall (2, args);
if (!INTEGERP (hash)) if (!INTEGERP (hash))
...@@ -3563,9 +3554,9 @@ hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key) ...@@ -3563,9 +3554,9 @@ hashfn_user_defined (struct Lisp_Hash_Table *h, Lisp_Object key)
one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
Lisp_Object Lisp_Object
make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, make_hash_table (struct hash_table_test test,
Lisp_Object rehash_threshold, Lisp_Object weak, Lisp_Object size, Lisp_Object rehash_size,
Lisp_Object user_test, Lisp_Object user_hash) Lisp_Object rehash_threshold, Lisp_Object weak)
{ {
struct Lisp_Hash_Table *h; struct Lisp_Hash_Table *h;
Lisp_Object table; Lisp_Object table;
...@@ -3574,7 +3565,7 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, ...@@ -3574,7 +3565,7 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
double index_float; double index_float;
/* Preconditions. */ /* Preconditions. */
eassert (SYMBOLP (test)); eassert (SYMBOLP (test.name));
eassert (INTEGERP (size) && XINT (size) >= 0); eassert (INTEGERP (size) && XINT (size) >= 0);
eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0)
|| (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size))); || (FLOATP (rehash_size) && 1 < XFLOAT_DATA (rehash_size)));
...@@ -3598,29 +3589,6 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, ...@@ -3598,29 +3589,6 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size,
/* Initialize hash table slots. */ /* Initialize hash table slots. */
h->test = test; h->test = test;
if (EQ (test, Qeql))
{
h->cmpfn = cmpfn_eql;
h->hashfn = hashfn_eql;
}
else if (EQ (test, Qeq))
{
h->cmpfn = NULL;
h->hashfn = hashfn_eq;
}
else if (EQ (test, Qequal))
{
h->cmpfn = cmpfn_equal;
h->hashfn = hashfn_equal;
}
else
{
h->user_cmp_function = user_test;
h->user_hash_function = user_hash;
h->cmpfn = cmpfn_user_defined;
h->hashfn = hashfn_user_defined;
}
h->weak = weak; h->weak = weak;
h->rehash_threshold = rehash_threshold; h->rehash_threshold = rehash_threshold;
h->rehash_size = rehash_size; h->rehash_size = rehash_size;
...@@ -3776,7 +3744,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) ...@@ -3776,7 +3744,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
ptrdiff_t start_of_bucket; ptrdiff_t start_of_bucket;
Lisp_Object idx; Lisp_Object idx;
hash_code = h->hashfn (h, key); hash_code = h->test.hashfn (&h->test, key);
eassert ((hash_code & ~INTMASK) == 0);
if (hash) if (hash)
*hash = hash_code; *hash = hash_code;
...@@ -3788,9 +3757,9 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) ...@@ -3788,9 +3757,9 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash)
{ {
ptrdiff_t i = XFASTINT (idx); ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i)) if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn || (h->test.cmpfn
&& h->cmpfn (h, key, hash_code, && hash_code == XUINT (HASH_HASH (h, i))
HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
break; break;
idx = HASH_NEXT (h, i); idx = HASH_NEXT (h, i);
} }
...@@ -3841,7 +3810,8 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) ...@@ -3841,7 +3810,8 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
ptrdiff_t start_of_bucket; ptrdiff_t start_of_bucket;
Lisp_Object idx, prev; Lisp_Object idx, prev;
hash_code = h->hashfn (h, key); hash_code = h->test.hashfn (&h->test, key);
eassert ((hash_code & ~INTMASK) == 0);
start_of_bucket = hash_code % ASIZE (h->index); start_of_bucket = hash_code % ASIZE (h->index);
idx = HASH_INDEX (h, start_of_bucket); idx = HASH_INDEX (h, start_of_bucket);
prev = Qnil; prev = Qnil;
...@@ -3852,9 +3822,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) ...@@ -3852,9 +3822,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key)
ptrdiff_t i = XFASTINT (idx); ptrdiff_t i = XFASTINT (idx);
if (EQ (key, HASH_KEY (h, i)) if (EQ (key, HASH_KEY (h, i))
|| (h->cmpfn || (h->test.cmpfn
&& h->cmpfn (h, key, hash_code, && hash_code == XUINT (HASH_HASH (h, i))
HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) && h->test.cmpfn (&h->test, key, HASH_KEY (h, i))))
{ {
/* Take entry out of collision chain. */ /* Take entry out of collision chain. */
if (NILP (prev)) if (NILP (prev))
...@@ -4303,7 +4273,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) ...@@ -4303,7 +4273,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
(ptrdiff_t nargs, Lisp_Object *args) (ptrdiff_t nargs, Lisp_Object *args)
{ {
Lisp_Object test, size, rehash_size, rehash_threshold, weak; Lisp_Object test, size, rehash_size, rehash_threshold, weak;
Lisp_Object user_test, user_hash; struct hash_table_test testdesc;
char *used; char *used;
ptrdiff_t i; ptrdiff_t i;
...@@ -4315,7 +4285,13 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) ...@@ -4315,7 +4285,13 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
/* See if there's a `:test TEST' among the arguments. */ /* See if there's a `:test TEST' among the arguments. */
i = get_key_arg (QCtest, nargs, args, used); i = get_key_arg (QCtest, nargs, args, used);
test = i ? args[i] : Qeql; test = i ? args[i] : Qeql;
if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) if (EQ (test, Qeq))
testdesc = hashtest_eq;
else if (EQ (test, Qeql))
testdesc = hashtest_eql;
else if (EQ (test, Qequal))
testdesc = hashtest_equal;
else
{ {
/* See if it is a user-defined test. */ /* See if it is a user-defined test. */
Lisp_Object prop; Lisp_Object prop;
...@@ -4323,11 +4299,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) ...@@ -4323,11 +4299,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
prop = Fget (test, Qhash_table_test); prop = Fget (test, Qhash_table_test);
if (!CONSP (prop) || !CONSP (XCDR (prop))) if (!CONSP (prop) || !CONSP (XCDR (prop)))
signal_error ("Invalid hash table test", test); signal_error ("Invalid hash table test", test);
user_test = XCAR (prop); testdesc.name = test;
user_hash = XCAR (XCDR (prop)); testdesc.user_cmp_function = XCAR (prop);
testdesc.user_hash_function = XCAR (XCDR (prop));
testdesc.hashfn = hashfn_user_defined;
testdesc.cmpfn = cmpfn_user_defined;
} }
else
user_test = user_hash = Qnil;
/* See if there's a `:size SIZE' argument. */ /* See if there's a `:size SIZE' argument. */
i = get_key_arg (QCsize, nargs, args, used); i = get_key_arg (QCsize, nargs, args, used);
...@@ -4369,8 +4346,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) ...@@ -4369,8 +4346,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
if (!used[i]) if (!used[i])
signal_error ("Invalid argument list", args[i]); signal_error ("Invalid argument list", args[i]);
return make_hash_table (test, size, rehash_size, rehash_threshold, weak, return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
user_test, user_hash);
} }
...@@ -4424,7 +4400,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, ...@@ -4424,7 +4400,7 @@ DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0,
doc: /* Return the test TABLE uses. */) doc: /* Return the test TABLE uses. */)
(Lisp_Object table) (Lisp_Object table)
{ {
return check_hash_table (table)->test; return check_hash_table (table)->test.name;
} }
...@@ -4988,4 +4964,14 @@ this variable. */); ...@@ -4988,4 +4964,14 @@ this variable. */);
defsubr (&Smd5); defsubr (&Smd5);
defsubr (&Ssecure_hash); defsubr (&Ssecure_hash);
defsubr (&Slocale_info); defsubr (&Slocale_info);
{
struct hash_table_test
eq = { Qeq, Qnil, Qnil, NULL, hashfn_eq },
eql = { Qeql, Qnil, Qnil, cmpfn_eql, hashfn_eql },
equal = { Qequal, Qnil, Qnil, cmpfn_equal, hashfn_equal };
hashtest_eq = eq;
hashtest_eql = eql;
hashtest_equal = equal;
}
} }
...@@ -1159,14 +1159,29 @@ struct Lisp_Symbol ...@@ -1159,14 +1159,29 @@ struct Lisp_Symbol
/* The structure of a Lisp hash table. */ /* The structure of a Lisp hash table. */
struct hash_table_test
{
/* Name of the function used to compare keys. */
Lisp_Object name;
/* User-supplied hash function, or nil. */
Lisp_Object user_hash_function;
/* User-supplied key comparison function, or nil. */
Lisp_Object user_cmp_function;
/* C function to compare two keys. */
bool (*cmpfn) (struct hash_table_test *t, Lisp_Object, Lisp_Object);
/* C function to compute hash code. */
EMACS_UINT (*hashfn) (struct hash_table_test *t, Lisp_Object);
};
struct Lisp_Hash_Table struct Lisp_Hash_Table
{ {
/* This is for Lisp; the hash table code does not refer to it. */ /* This is for Lisp; the hash table code does not refer to it. */
struct vectorlike_header header; struct vectorlike_header header;
/* Function used to compare keys. */
Lisp_Object test;
/* Nil if table is non-weak. Otherwise a symbol describing the /* Nil if table is non-weak. Otherwise a symbol describing the
weakness of the table. */ weakness of the table. */
Lisp_Object weak; Lisp_Object weak;
...@@ -1197,12 +1212,6 @@ struct Lisp_Hash_Table ...@@ -1197,12 +1212,6 @@ struct Lisp_Hash_Table
hash table size to reduce collisions. */ hash table size to reduce collisions. */
Lisp_Object index; Lisp_Object index;
/* User-supplied hash function, or nil. */
Lisp_Object user_hash_function;
/* User-supplied key comparison function, or nil. */
Lisp_Object user_cmp_function;
/* Only the fields above are traced normally by the GC. The ones below /* Only the fields above are traced normally by the GC. The ones below
`count' are special and are either ignored by the GC or traced in `count' are special and are either ignored by the GC or traced in
a special way (e.g. because of weakness). */ a special way (e.g. because of weakness). */
...@@ -1215,17 +1224,12 @@ struct Lisp_Hash_Table ...@@ -1215,17 +1224,12 @@ struct Lisp_Hash_Table
This is gc_marked specially if the table is weak. */ This is gc_marked specially if the table is weak. */
Lisp_Object key_and_value; Lisp_Object key_and_value;
/* The comparison and hash functions. */
struct hash_table_test test;
/* Next weak hash table if this is a weak hash table. The head /* Next weak hash table if this is a weak hash table. The head
of the list is in weak_hash_tables. */ of the list is in weak_hash_tables. */
struct Lisp_Hash_Table *next_weak; struct Lisp_Hash_Table *next_weak;
/* C function to compare two keys. */
bool (*cmpfn) (struct Lisp_Hash_Table *,
Lisp_Object, EMACS_UINT,
Lisp_Object, EMACS_UINT);
/* C function to compute hash code. */
EMACS_UINT (*hashfn) (struct Lisp_Hash_Table *, Lisp_Object);
}; };
...@@ -2707,12 +2711,12 @@ extern Lisp_Object Qstring_lessp; ...@@ -2707,12 +2711,12 @@ extern Lisp_Object Qstring_lessp;
extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql; extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql;
EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT hash_string (char const *, ptrdiff_t);
EMACS_UINT sxhash (Lisp_Object, int); EMACS_UINT sxhash (Lisp_Object, int);
Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
Lisp_Object);
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *);
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
EMACS_UINT); EMACS_UINT);
extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal;
extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t,
ptrdiff_t, ptrdiff_t); ptrdiff_t, ptrdiff_t);
......
...@@ -1815,14 +1815,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag ...@@ -1815,14 +1815,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag
#endif #endif
/* Implement a readable output, e.g.: /* Implement a readable output, e.g.:
#s(hash-table size 2 test equal data (k1 v1 k2 v2)) */ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
/* Always print the size. */ /* Always print the size. */
len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next)); len = sprintf (buf, "#s(hash-table size %"pD"d", ASIZE (h->next));
strout (buf, len, len, printcharfun); strout (buf, len, len, printcharfun);
if (!NILP (h->test)) if (!NILP (h->test.name))
{ {
strout (" test ", -1, -1, printcharfun); strout (" test ", -1, -1, printcharfun);
print_object (h->test, printcharfun, escapeflag); print_object (h->test.name, printcharfun, escapeflag);
} }
if (!NILP (h->weak)) if (!NILP (h->weak))
......
...@@ -35,6 +35,9 @@ saturated_add (EMACS_INT a, EMACS_INT b) ...@@ -35,6 +35,9 @@ saturated_add (EMACS_INT a, EMACS_INT b)
typedef struct Lisp_Hash_Table log_t; typedef struct Lisp_Hash_Table log_t;
static Lisp_Object Qprofiler_backtrace_equal;
static struct hash_table_test hashtest_profiler;