Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

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

Browse source 
* 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.
This commit is contained in:
Stefan Monnier 2012-11-08 14:12:23 -05:00
parent 880027430c
commit b7432bb20f
11 changed files with 204 additions and 123 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
src/ChangeLog
View file

@ -1,3 +1,30 @@
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>
* w32fns.c (modifier_set): Fix handling of Scroll Lock when the

3
src/alloc.c
View file

@ -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))

4
src/category.c
View file

@ -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)

4
src/composite.c
View file

@ -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;

4
src/emacs.c
View file

@ -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 ();

138
src/fns.c
View file

@ -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;
}
}

44
src/lisp.h
View file

@ -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);

6
src/print.c
View file

@ -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))

91
src/profiler.c
View file

@ -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;

2
src/regex.c
View file

@ -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

4
src/xterm.c
View file

@ -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 */