Mercurial > hg > xemacs-beta
view src/hash.c @ 1292:f3437b56874d
[xemacs-hg @ 2003-02-13 09:57:04 by ben]
profile updates
profile.c: Major reworking. Keep track of new information -- total
function timing (includes descendants), GC usage, total GC usage
(includes descendants). New functions to be called appropriately
from eval.c, alloc.c to keep track of this information. Keep track
of when we're actually in a function vs. in its profile, for more
accurate timing counts. Track profile overhead separately. Create
new mechanism for specifying "internal sections" that are tracked
just like regular Lisp functions and even appear in the backtrace
if `backtrace-with-internal-sections' is non-nil (t by default
for error-checking builds). Add some KKCC information for the
straight (non-Elisp) hash table used by profile, which contains
Lisp objects in its keys -- but not used yet. Remove old ad-hoc
methods for tracking garbage collection, redisplay (which was
incorrect anyway when Lisp was called within these sections).
Don't record any tick info when blocking under MS Windows, since
the timer there is in real time rather than in process time.
Make `start-profiling', `stop-profiling' interactive. Be consistent
wrt. recursive functions and functions currently on the stack when
starting or stopping -- together these make implementing the
`total' values extremely difficult. When we start profiling, we
act as if we just entered all the functions currently on the stack.
Likewise when exiting. Create vars in_profile for tracking
time spent inside of profiling, and profiling_lock for setting
exclusive access to the main hash table when reading from it or
modifying it. (protects against getting screwed up by the signal
handle going off at the same time.
profile.h: New file.
Create macros for declaring internal profiling sections.
lisp.h: Move profile-related stuff to profile.h.
alloc.c: Keep track of total consing, for profile.
Tell profile when we are consing.
Use new profile-section method for noting garbage-collection.
alloc.c: Abort if we attempt to call the allocator reentrantly.
backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer
PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile.
elhash.c: Author comment.
eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when
error-checking is on.
eval.c: When unwinding,
eval.c: Report to profile when we are about-to-call and just-called wrt. a
function.
alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by
profile and `backtrace-with-internal-sections'.
event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake.
event-stream.c: Record internal profiling sections for getting, dispatching events.
extents.c: Record internal profiling sections for map_extents.
hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code
since the signal handler is the main grower but can't allow
a realloc(). We make sure, at critical points, that the table
is large enough.)
lread.c: Create internal profiling sections for `load' (which may be triggered
internally by autoload, etc.).
redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare
internal profiling section for redisplay.
text.c: Use new macros to declare internal profiling sections for
char-byte conversion and internal-external conversion.
SEMI-UNRELATED CHANGES:
-----------------------
text.c: Update the long comments.
author | ben |
---|---|
date | Thu, 13 Feb 2003 09:57:08 +0000 |
parents | e22b0213b713 |
children | a8d8f419b459 |
line wrap: on
line source
/* Hash tables. Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc. Copyright (C) 2003 Ben Wing. This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* Synched up with: Not in FSF. */ /* Author: Lost in the mists of history. At least back to Lucid 19.3, circa Sep 1992. */ #include <config.h> #include "lisp.h" #include "hash.h" #define NULL_ENTRY ((void *) 0xdeadbeef) /* -559038737 base 10 */ #define COMFORTABLE_SIZE(size) (21 * (size) / 16) #define KEYS_DIFFER_P(old, new, testfun) \ (((old) != (new)) && (!(testfun) || !(testfun) ((old),(new)))) static void rehash (hentry *harray, struct hash_table *ht, Elemcount size); Hashcode memory_hash (const void *xv, Bytecount size) { Hashcode h = 0; unsigned const char *x = (unsigned const char *) xv; if (!x) return 0; while (size--) { Hashcode g; h = (h << 4) + *x++; if ((g = h & 0xf0000000) != 0) h = (h ^ (g >> 24)) ^ g; } return h; } Hashcode string_hash (const char *xv) { Hashcode h = 0; unsigned const char *x = (unsigned const char *) xv; if (!x) return 0; while (*x) { Hashcode g; h = (h << 4) + *x++; if ((g = h & 0xf0000000) != 0) h = (h ^ (g >> 24)) ^ g; } return h; } /* Return a suitable size for a hash table, with at least SIZE slots. */ static Elemcount hash_table_size (Elemcount requested_size) { /* Return some prime near, but greater than or equal to, SIZE. Decades from the time of writing, someone will have a system large enough that the list below will be too short... */ static const Elemcount primes [] = { 19, 29, 41, 59, 79, 107, 149, 197, 263, 347, 457, 599, 787, 1031, 1361, 1777, 2333, 3037, 3967, 5167, 6719, 8737, 11369, 14783, 19219, 24989, 32491, 42257, 54941, 71429, 92861, 120721, 156941, 204047, 265271, 344857, 448321, 582821, 757693, 985003, 1280519, 1664681, 2164111, 2813353, 3657361, 4754591, 6180989, 8035301, 10445899, 13579681, 17653589, 22949669, 29834603, 38784989, 50420551, 65546729, 85210757, 110774011, 144006217, 187208107, 243370577, 316381771, 411296309, 534685237, 695090819, 903618083, 1174703521, 1527114613, 1985248999 /* , 2580823717UL, 3355070839UL */ }; /* We've heard of binary search. */ int low, high; for (low = 0, high = countof (primes) - 1; high - low > 1;) { /* Loop Invariant: size < primes [high] */ int mid = (low + high) / 2; if (primes [mid] < requested_size) low = mid; else high = mid; } return primes [high]; } const void * gethash (const void *key, struct hash_table *hash_table, const void **ret_value) { if (!key) { *ret_value = hash_table->zero_entry; return (void *) hash_table->zero_set; } else { hentry *harray = hash_table->harray; hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; Hashcode hcode_initial = hash_table->hash_function ? hash_table->hash_function (key) : (Hashcode) key; Elemcount hcode = (Elemcount) (hcode_initial % size); hentry *e = &harray [hcode]; const void *e_key = e->key; if (e_key ? KEYS_DIFFER_P (e_key, key, test_function) : e->contents == NULL_ENTRY) { Elemcount h2 = size - 2; Elemcount incr = (Elemcount) (1 + (hcode_initial % h2)); do { hcode += incr; if (hcode >= size) hcode -= size; e = &harray [hcode]; e_key = e->key; } while (e_key ? KEYS_DIFFER_P (e_key, key, test_function) : e->contents == NULL_ENTRY); } *ret_value = e->contents; return e->key; } } void clrhash (struct hash_table *hash_table) { memset (hash_table->harray, 0, sizeof (hentry) * hash_table->size); hash_table->zero_entry = 0; hash_table->zero_set = 0; hash_table->fullness = 0; } void free_hash_table (struct hash_table *hash_table) { xfree (hash_table->harray); xfree (hash_table); } struct hash_table* make_hash_table (Elemcount size) { struct hash_table *hash_table = xnew_and_zero (struct hash_table); hash_table->size = hash_table_size (COMFORTABLE_SIZE (size)); hash_table->harray = xnew_array (hentry, hash_table->size); clrhash (hash_table); return hash_table; } struct hash_table * make_general_hash_table (Elemcount size, hash_table_hash_function hash_function, hash_table_test_function test_function) { struct hash_table* hash_table = make_hash_table (size); hash_table->hash_function = hash_function; hash_table->test_function = test_function; return hash_table; } static void grow_hash_table (struct hash_table *hash_table, Elemcount new_size) { Elemcount old_size = hash_table->size; hentry *old_harray = hash_table->harray; hash_table->size = hash_table_size (new_size); hash_table->harray = xnew_array (hentry, hash_table->size); /* do the rehash on the "grown" table */ { long old_zero_set = hash_table->zero_set; void *old_zero_entry = hash_table->zero_entry; clrhash (hash_table); hash_table->zero_set = old_zero_set; hash_table->zero_entry = old_zero_entry; rehash (old_harray, hash_table, old_size); } xfree (old_harray); } void pregrow_hash_table_if_necessary (struct hash_table *hash_table, Elemcount breathing_room) { Elemcount comfortable_size = COMFORTABLE_SIZE (hash_table->fullness); if (hash_table->size < comfortable_size - breathing_room) grow_hash_table (hash_table, comfortable_size + 1); } void puthash (const void *key, void *contents, struct hash_table *hash_table) { if (!key) { hash_table->zero_entry = contents; hash_table->zero_set = 1; } else { hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; hentry *harray = hash_table->harray; Hashcode hcode_initial = hash_table->hash_function ? hash_table->hash_function (key) : (Hashcode) key; Elemcount hcode = (Elemcount) (hcode_initial % size); Elemcount h2 = size - 2; Elemcount incr = (Elemcount) (1 + (hcode_initial % h2)); const void *e_key = harray [hcode].key; const void *oldcontents; if (e_key && KEYS_DIFFER_P (e_key, key, test_function)) { do { hcode += incr; if (hcode >= size) hcode -= size; e_key = harray [hcode].key; } while (e_key && KEYS_DIFFER_P (e_key, key, test_function)); } oldcontents = harray [hcode].contents; harray [hcode].key = key; harray [hcode].contents = contents; /* If the entry that we used was a deleted entry, check for a non deleted entry of the same key, then delete it. */ if (!e_key && oldcontents == NULL_ENTRY) { hentry *e; do { hcode += incr; if (hcode >= size) hcode -= size; e = &harray [hcode]; e_key = e->key; } while (e_key ? KEYS_DIFFER_P (e_key, key, test_function): e->contents == NULL_ENTRY); if (e_key) { e->key = 0; e->contents = NULL_ENTRY; } } /* only increment the fullness when we used up a new hentry */ if (!e_key || KEYS_DIFFER_P (e_key, key, test_function)) { Elemcount comfortable_size = COMFORTABLE_SIZE (++(hash_table->fullness)); if (hash_table->size < comfortable_size) grow_hash_table (hash_table, comfortable_size + 1); } } } static void rehash (hentry *harray, struct hash_table *hash_table, Elemcount size) { hentry *limit = harray + size; hentry *e; for (e = harray; e < limit; e++) { if (e->key) puthash (e->key, e->contents, hash_table); } } void remhash (const void *key, struct hash_table *hash_table) { if (!key) { hash_table->zero_entry = 0; hash_table->zero_set = 0; } else { hentry *harray = hash_table->harray; hash_table_test_function test_function = hash_table->test_function; Elemcount size = hash_table->size; Hashcode hcode_initial = (hash_table->hash_function) ? (hash_table->hash_function (key)) : ((Hashcode) key); Elemcount hcode = (Elemcount) (hcode_initial % size); hentry *e = &harray [hcode]; const void *e_key = e->key; if (e_key ? KEYS_DIFFER_P (e_key, key, test_function) : e->contents == NULL_ENTRY) { Elemcount h2 = size - 2; Elemcount incr = (Elemcount) (1 + (hcode_initial % h2)); do { hcode += incr; if (hcode >= size) hcode -= size; e = &harray [hcode]; e_key = e->key; } while (e_key? KEYS_DIFFER_P (e_key, key, test_function): e->contents == NULL_ENTRY); } if (e_key) { e->key = 0; e->contents = NULL_ENTRY; /* Note: you can't do fullness-- here, it breaks the world. */ } } } void maphash (maphash_function mf, struct hash_table *hash_table, void *arg) { hentry *e; hentry *limit; if (hash_table->zero_set) { if (mf (0, hash_table->zero_entry, arg)) return; } for (e = hash_table->harray, limit = e + hash_table->size; e < limit; e++) { if (e->key && mf (e->key, e->contents, arg)) return; } } void map_remhash (remhash_predicate predicate, struct hash_table *hash_table, void *arg) { hentry *e; hentry *limit; if (hash_table->zero_set && predicate (0, hash_table->zero_entry, arg)) { hash_table->zero_set = 0; hash_table->zero_entry = 0; } for (e = hash_table->harray, limit = e + hash_table->size; e < limit; e++) if (predicate (e->key, e->contents, arg)) { e->key = 0; e->contents = NULL_ENTRY; } }