From b7432bb20f48902994bee522bea15acdb0c0e209 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 8 Nov 2012 14:12:23 -0500 Subject: [PATCH] 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. --- src/ChangeLog | 27 ++++++++++ src/alloc.c | 3 ++ src/category.c | 4 +- src/composite.c | 4 +- src/emacs.c | 4 +- src/fns.c | 138 ++++++++++++++++++++++-------------------------- src/lisp.h | 44 ++++++++------- src/print.c | 6 +-- src/profiler.c | 91 +++++++++++++++++++++++++------ src/regex.c | 2 +- src/xterm.c | 4 +- 11 files changed, 204 insertions(+), 123 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 8f2aa41bef0..24f3305b870 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,30 @@ +2012-11-08 Stefan Monnier + + 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 * w32fns.c (modifier_set): Fix handling of Scroll Lock when the diff --git a/src/alloc.c b/src/alloc.c index 557c68ca5af..808557dd70f 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5809,6 +5809,9 @@ mark_object (Lisp_Object arg) struct Lisp_Hash_Table *h = (struct Lisp_Hash_Table *) 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. For weak tables, mark only the vector. */ if (NILP (h->weak)) diff --git a/src/category.c b/src/category.c index fe02303f679..31cc90bca68 100644 --- a/src/category.c +++ b/src/category.c @@ -78,10 +78,10 @@ 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 (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_THRESHOLD), - Qnil, Qnil, Qnil)); + Qnil)); h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); i = hash_lookup (h, category_set, &hash); if (i >= 0) diff --git a/src/composite.c b/src/composite.c index 6c603fab3fc..bcde0a4c9e6 100644 --- a/src/composite.c +++ b/src/composite.c @@ -676,7 +676,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) ptrdiff_t i; header = LGSTRING_HEADER (gstring); - hash = h->hashfn (h, header); + hash = h->test.hashfn (&h->test, header); if (len < 0) { 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 } else { - /* automatic composition */ + /* Automatic composition. */ Lisp_Object gstring = composition_gstring_from_id (cmp_it->id); Lisp_Object glyph; ptrdiff_t from; diff --git a/src/emacs.c b/src/emacs.c index f12713b9628..fee9c332c55 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -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. */ syms_of_data (); + syms_of_fns (); /* Before syms_of_charset which uses hashtables. */ syms_of_fileio (); /* Before syms_of_coding to initialize Vgc_cons_threshold. */ syms_of_alloc (); @@ -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. */ #ifdef HAVE_WINDOW_SYSTEM - init_fringe_once (); /* Swap bitmaps if necessary. */ + init_fringe_once (); /* Swap bitmaps if necessary. */ #endif /* HAVE_WINDOW_SYSTEM */ } @@ -1348,7 +1349,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem syms_of_lread (); syms_of_print (); syms_of_eval (); - syms_of_fns (); syms_of_floatfns (); syms_of_buffer (); diff --git a/src/fns.c b/src/fns.c index 1d2e510b7e5..6faaa67152e 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2014,7 +2014,7 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, int depth, bool props) d1 = extract_float (o1); d2 = extract_float (o2); /* 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); } @@ -3424,14 +3424,16 @@ larger_vector (Lisp_Object vec, ptrdiff_t incr_min, ptrdiff_t nitems_max) 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 HASH2 in hash table H using `eql'. Value is true if KEY1 and KEY2 are the same. */ static bool -cmpfn_eql (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_eql (struct hash_table_test *ht, + Lisp_Object key1, + Lisp_Object key2) { return (FLOATP (key1) && FLOATP (key2) @@ -3444,11 +3446,11 @@ cmpfn_eql (struct Lisp_Hash_Table *h, KEY2 are the same. */ static bool -cmpfn_equal (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_equal (struct hash_table_test *ht, + Lisp_Object key1, + 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, if KEY1 and KEY2 are the same. */ static bool -cmpfn_user_defined (struct Lisp_Hash_Table *h, - Lisp_Object key1, EMACS_UINT hash1, - Lisp_Object key2, EMACS_UINT hash2) +cmpfn_user_defined (struct hash_table_test *ht, + Lisp_Object key1, + Lisp_Object key2) { - if (hash1 == hash2) - { - Lisp_Object args[3]; + Lisp_Object args[3]; - args[0] = h->user_cmp_function; - args[1] = key1; - args[2] = key2; - return !NILP (Ffuncall (3, args)); - } - else - return 0; + args[0] = ht->user_cmp_function; + args[1] = key1; + args[2] = key2; + return !NILP (Ffuncall (3, args)); } @@ -3480,54 +3477,48 @@ cmpfn_user_defined (struct Lisp_Hash_Table *h, in a Lisp integer. */ 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); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* 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 in a Lisp integer. */ 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; if (FLOATP (key)) hash = sxhash (key, 0); else hash = XUINT (key) ^ XTYPE (key); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* 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 in a Lisp integer. */ 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); - eassert ((hash & ~INTMASK) == 0); return hash; } - /* 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 guaranteed to fit in a Lisp integer. */ 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; - args[0] = h->user_hash_function; + args[0] = ht->user_hash_function; args[1] = key; hash = Ffuncall (2, args); if (!INTEGERP (hash)) @@ -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'. */ Lisp_Object -make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, - Lisp_Object rehash_threshold, Lisp_Object weak, - Lisp_Object user_test, Lisp_Object user_hash) +make_hash_table (struct hash_table_test test, + Lisp_Object size, Lisp_Object rehash_size, + Lisp_Object rehash_threshold, Lisp_Object weak) { struct Lisp_Hash_Table *h; Lisp_Object table; @@ -3574,7 +3565,7 @@ make_hash_table (Lisp_Object test, Lisp_Object size, Lisp_Object rehash_size, double index_float; /* Preconditions. */ - eassert (SYMBOLP (test)); + eassert (SYMBOLP (test.name)); eassert (INTEGERP (size) && XINT (size) >= 0); eassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) || (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, /* Initialize hash table slots. */ 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->rehash_threshold = rehash_threshold; h->rehash_size = rehash_size; @@ -3776,7 +3744,8 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) ptrdiff_t start_of_bucket; Lisp_Object idx; - hash_code = h->hashfn (h, key); + hash_code = h->test.hashfn (&h->test, key); + eassert ((hash_code & ~INTMASK) == 0); if (hash) *hash = hash_code; @@ -3788,9 +3757,9 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, EMACS_UINT *hash) { ptrdiff_t i = XFASTINT (idx); if (EQ (key, HASH_KEY (h, i)) - || (h->cmpfn - && h->cmpfn (h, key, hash_code, - HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) + || (h->test.cmpfn + && hash_code == XUINT (HASH_HASH (h, i)) + && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) break; idx = HASH_NEXT (h, i); } @@ -3841,7 +3810,8 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) ptrdiff_t start_of_bucket; 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); idx = HASH_INDEX (h, start_of_bucket); prev = Qnil; @@ -3852,9 +3822,9 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) ptrdiff_t i = XFASTINT (idx); if (EQ (key, HASH_KEY (h, i)) - || (h->cmpfn - && h->cmpfn (h, key, hash_code, - HASH_KEY (h, i), XUINT (HASH_HASH (h, i))))) + || (h->test.cmpfn + && hash_code == XUINT (HASH_HASH (h, i)) + && h->test.cmpfn (&h->test, key, HASH_KEY (h, i)))) { /* Take entry out of collision chain. */ if (NILP (prev)) @@ -4303,7 +4273,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object test, size, rehash_size, rehash_threshold, weak; - Lisp_Object user_test, user_hash; + struct hash_table_test testdesc; char *used; ptrdiff_t i; @@ -4315,7 +4285,13 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) /* See if there's a `:test TEST' among the arguments. */ i = get_key_arg (QCtest, nargs, args, used); 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. */ Lisp_Object prop; @@ -4323,11 +4299,12 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) prop = Fget (test, Qhash_table_test); if (!CONSP (prop) || !CONSP (XCDR (prop))) signal_error ("Invalid hash table test", test); - user_test = XCAR (prop); - user_hash = XCAR (XCDR (prop)); + 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; } - else - user_test = user_hash = Qnil; /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); @@ -4369,8 +4346,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) if (!used[i]) signal_error ("Invalid argument list", args[i]); - return make_hash_table (test, size, rehash_size, rehash_threshold, weak, - user_test, user_hash); + return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); } @@ -4424,7 +4400,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; + return check_hash_table (table)->test.name; } @@ -4988,4 +4964,14 @@ this variable. */); defsubr (&Smd5); defsubr (&Ssecure_hash); 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; + } } diff --git a/src/lisp.h b/src/lisp.h index 66612e2987e..cac7d4b7012 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1159,14 +1159,29 @@ struct Lisp_Symbol /* 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 { /* This is for Lisp; the hash table code does not refer to it. */ struct vectorlike_header header; - /* Function used to compare keys. */ - Lisp_Object test; - /* Nil if table is non-weak. Otherwise a symbol describing the weakness of the table. */ Lisp_Object weak; @@ -1197,12 +1212,6 @@ struct Lisp_Hash_Table hash table size to reduce collisions. */ 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 `count' are special and are either ignored by the GC or traced in a special way (e.g. because of weakness). */ @@ -1215,17 +1224,12 @@ struct Lisp_Hash_Table This is gc_marked specially if the table is weak. */ 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 of the list is in weak_hash_tables. */ 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; extern Lisp_Object QCsize, QCtest, QCweakness, Qequal, Qeq, Qeql; EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); -Lisp_Object make_hash_table (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object); +Lisp_Object make_hash_table (struct hash_table_test, Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, EMACS_UINT *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, EMACS_UINT); +extern struct hash_table_test hashtest_eq, hashtest_eql, hashtest_equal; extern Lisp_Object substring_both (Lisp_Object, ptrdiff_t, ptrdiff_t, ptrdiff_t, ptrdiff_t); diff --git a/src/print.c b/src/print.c index ccf0e8ed7cc..af6eda7298f 100644 --- a/src/print.c +++ b/src/print.c @@ -1815,14 +1815,14 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag #endif /* Implement a readable output, e.g.: #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)); strout (buf, len, len, printcharfun); - if (!NILP (h->test)) + if (!NILP (h->test.name)) { strout (" test ", -1, -1, printcharfun); - print_object (h->test, printcharfun, escapeflag); + print_object (h->test.name, printcharfun, escapeflag); } if (!NILP (h->weak)) diff --git a/src/profiler.c b/src/profiler.c index 51580710f28..6f112440902 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -35,6 +35,9 @@ saturated_add (EMACS_INT a, EMACS_INT b) typedef struct Lisp_Hash_Table log_t; +static Lisp_Object Qprofiler_backtrace_equal; +static struct hash_table_test hashtest_profiler; + static Lisp_Object make_log (int heap_size, int max_stack_depth) { @@ -42,10 +45,11 @@ make_log (int heap_size, int max_stack_depth) a special way. This is OK as long as the object is not exposed to Elisp, i.e. until it is returned by *-profiler-log, after which it can't be used any more. */ - Lisp_Object log = make_hash_table (Qequal, make_number (heap_size), + Lisp_Object log = make_hash_table (hashtest_profiler, + make_number (heap_size), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil); + Qnil); struct Lisp_Hash_Table *h = XHASH_TABLE (log); /* What is special about our hash-tables is that the keys are pre-filled @@ -238,8 +242,6 @@ handle_profiler_signal (int signal) cpu_gc_count = saturated_add (cpu_gc_count, 1); else { - Lisp_Object oquit; - bool saved_pending_signals; EMACS_INT count = 1; #ifdef HAVE_ITIMERSPEC if (profiler_timer_ok) @@ -249,19 +251,8 @@ handle_profiler_signal (int signal) count += overruns; } #endif - /* record_backtrace uses hash functions that call Fequal, which - uses QUIT, which can call malloc, which can cause disaster in - a signal handler. So inhibit QUIT. */ - oquit = Vinhibit_quit; - saved_pending_signals = pending_signals; - Vinhibit_quit = Qt; - pending_signals = 0; - eassert (HASH_TABLE_P (cpu_log)); record_backtrace (XHASH_TABLE (cpu_log), count); - - Vinhibit_quit = oquit; - pending_signals = saved_pending_signals; } } @@ -515,6 +506,66 @@ malloc_probe (size_t size) record_backtrace (XHASH_TABLE (memory_log), min (size, MOST_POSITIVE_FIXNUM)); } +DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, + doc: /* Return non-nil if F1 and F2 come from the same source. +Used to determine if different closures are just different instances of +the same lambda expression, or are really unrelated function. */) + (Lisp_Object f1, Lisp_Object f2) +{ + bool res; + if (EQ (f1, f2)) + res = true; + else if (COMPILEDP (f1) && COMPILEDP (f2)) + res = EQ (AREF (f1, COMPILED_BYTECODE), AREF (f2, COMPILED_BYTECODE)); + else if (CONSP (f1) && CONSP (f2) && CONSP (XCDR (f1)) && CONSP (XCDR (f2)) + && EQ (Qclosure, XCAR (f1)) + && EQ (Qclosure, XCAR (f2))) + res = EQ (XCDR (XCDR (f1)), XCDR (XCDR (f2))); + else + res = false; + return res ? Qt : Qnil; +} + +static bool +cmpfn_profiler (struct hash_table_test *t, + Lisp_Object bt1, Lisp_Object bt2) +{ + if (VECTORP (bt1) && VECTORP (bt2)) + { + ptrdiff_t i, l = ASIZE (bt1); + if (l != ASIZE (bt2)) + return false; + for (i = 0; i < l; i++) + if (NILP (Ffunction_equal (AREF (bt1, i), AREF (bt2, i)))) + return false; + return true; + } + else + return EQ (bt1, bt2); +} + +static EMACS_UINT +hashfn_profiler (struct hash_table_test *ht, Lisp_Object bt) +{ + if (VECTORP (bt)) + { + EMACS_UINT hash = 0; + ptrdiff_t i, l = ASIZE (bt); + for (i = 0; i < l; i++) + { + Lisp_Object f = AREF (bt, i); + EMACS_UINT hash1 + = (COMPILEDP (f) ? XUINT (AREF (f, COMPILED_BYTECODE)) + : (CONSP (f) && CONSP (XCDR (f)) && EQ (Qclosure, XCAR (f))) + ? XUINT (XCDR (XCDR (f))) : XUINT (f)); + hash = hash1 + (hash << 1) + (hash == (EMACS_INT) hash); + } + return (hash & INTMASK); + } + else + return XUINT (bt); +} + void syms_of_profiler (void) { @@ -527,6 +578,16 @@ If the log gets full, some of the least-seen call-stacks will be evicted to make room for new entries. */); profiler_log_size = 10000; + DEFSYM (Qprofiler_backtrace_equal, "profiler-backtrace-equal"); + { + struct hash_table_test test + = { Qprofiler_backtrace_equal, Qnil, Qnil, + cmpfn_profiler, hashfn_profiler }; + hashtest_profiler = test; + } + + defsubr (&Sfunction_equal); + #ifdef PROFILER_CPU_SUPPORT profiler_cpu_running = NOT_RUNNING; cpu_log = Qnil; diff --git a/src/regex.c b/src/regex.c index 7443eff3977..1473551e6cc 100644 --- a/src/regex.c +++ b/src/regex.c @@ -28,7 +28,7 @@ rather than at run-time, so that re_match can be reentrant. */ -/* AIX requires this to be the first thing in the file. */ +/* AIX requires this to be the first thing in the file. */ #if defined _AIX && !defined REGEX_MALLOC #pragma alloca #endif diff --git a/src/xterm.c b/src/xterm.c index 4dd1dee0f75..f89fbabaecc 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -10868,10 +10868,10 @@ default is nil, which is the same as `super'. */); 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 (Qeql, make_number (900), + Vx_keysym_table = make_hash_table (hashtest_eql, make_number (900), make_float (DEFAULT_REHASH_SIZE), make_float (DEFAULT_REHASH_THRESHOLD), - Qnil, Qnil, Qnil); + Qnil); } #endif /* HAVE_X_WINDOWS */ -- 2.39.2