mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 23:32:17 -08:00
Code Issues Projects Releases Packages Wiki Activity

Hash tables now carry a slot with the 'gethash' function in it.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-01-20 15:22:12 +01:00
parent 44efbeb285
commit 2bf650d523
2 changed files with 32 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

37
src/c/hash.d
View file

@ -390,14 +390,7 @@ _ecl_sethash_pack(cl_object key, cl_object hashtable, cl_object value)
struct ecl_hashtable_entry *
_ecl_gethash(cl_object key, cl_object hashtable)
{
switch (hashtable->hash.test) {
case htt_eq: return _ecl_gethash_eq(key, hashtable);
case htt_eql: return _ecl_gethash_eql(key, hashtable);
case htt_equal: return _ecl_gethash_equal(key, hashtable);
case htt_equalp:return _ecl_gethash_equalp(key, hashtable);
case htt_pack: return _ecl_gethash_pack(key, hashtable);
default: corrupted_hash(hashtable);
}
return hashtable->hash.get(key, hashtable);
}
cl_object
@ -407,7 +400,7 @@ ecl_gethash(cl_object key, cl_object hashtable)
assert_type_hash_table(hashtable);
HASH_TABLE_LOCK(hashtable);
output = _ecl_gethash(key, hashtable)->value;
output = hashtable->hash.get(key, hashtable)->value;
HASH_TABLE_UNLOCK(hashtable);
return output;
}
@ -419,7 +412,7 @@ ecl_gethash_safe(cl_object key, cl_object hashtable, cl_object def)
assert_type_hash_table(hashtable);
HASH_TABLE_LOCK(hashtable);
e = _ecl_gethash(key, hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key != OBJNULL)
def = e->value;
HASH_TABLE_UNLOCK(hashtable);
@ -467,7 +460,7 @@ ecl_sethash(cl_object key, cl_object hashtable, cl_object value)
assert_type_hash_table(hashtable);
HASH_TABLE_LOCK(hashtable);
e = _ecl_gethash(key, hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key != OBJNULL) {
e->value = value;
goto OUTPUT;
@ -576,18 +569,23 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
if (test == @'eq' || test == SYM_FUN(@'eq')) {
htt = htt_eq;
get = _ecl_gethash_eq;
set = _ecl_sethash_eq;
} else if (test == @'eql' || test == SYM_FUN(@'eql')) {
htt = htt_eql;
get = _ecl_gethash_eql;
set = _ecl_sethash_eql;
} else if (test == @'equal' || test == SYM_FUN(@'equal')) {
htt = htt_equal;
get = _ecl_gethash_equal;
set = _ecl_sethash_equal;
} else if (test == @'equalp' || test == SYM_FUN(@'equalp')) {
htt = htt_equalp;
get = _ecl_gethash_equalp;
set = _ecl_sethash_equalp;
} else if (test == @'package') {
htt = htt_pack;
get = _ecl_gethash_pack;
set = _ecl_sethash_pack;
} else {
FEerror("~S is an illegal hash-table test function.",
1, test);
@ -628,19 +626,22 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
*/
h = ecl_alloc_object(t_hashtable);
h->hash.test = htt;
h->hash.get = get;
h->hash.set = set;
h->hash.size = hsize;
h->hash.entries = 0;
h->hash.data = NULL; /* for GC sake */
h->hash.data = (struct ecl_hashtable_entry *)
ecl_alloc(hsize * sizeof(struct ecl_hashtable_entry));
do_clrhash(h);
h->hash.rehash_size = rehash_size;
h->hash.threshold = rehash_threshold;
h->hash.factor = ecl_to_double(rehash_threshold);
if (h->hash.factor < 0.1) {
h->hash.factor = 0.1;
}
/*h->hash.limit = h->hash.size * h->hash.factor;*/
h->hash.data = NULL; /* for GC sake */
h->hash.data = (struct ecl_hashtable_entry *)
ecl_alloc(hsize * sizeof(struct ecl_hashtable_entry));
do_clrhash(h);
#ifdef ECL_THREADS
if (!Null(lockable)) {
h->hash.lock = mp_make_lock(2, @':recursive', Ct);
@ -662,7 +663,7 @@ cl_hash_table_p(cl_object ht)
@
assert_type_hash_table(ht);
HASH_TABLE_LOCK(ht);
e = *_ecl_gethash(key, ht);
e = *(ht->hash.get(key, ht));
HASH_TABLE_UNLOCK(ht);
if (e.key != OBJNULL)
@(return e.value Ct)
@ -686,7 +687,7 @@ ecl_remhash(cl_object key, cl_object hashtable)
assert_type_hash_table(hashtable);
HASH_TABLE_LOCK(hashtable);
e = _ecl_gethash(key, hashtable);
e = hashtable->hash.get(key, hashtable);
if (e->key == OBJNULL) {
output = FALSE;
} else {

21
src/c/stacks.d
View file

@ -79,7 +79,8 @@ ecl_cs_overflow(void)
void
ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object value)
{
struct ecl_hashtable_entry *h = _ecl_gethash(s, env->bindings_hash);
cl_object bindings = env->bindings_hash;
struct ecl_hashtable_entry *h = bindings->hash.get(s, bindings);
struct bds_bd *slot = ++env->bds_top;
if (slot >= env->bds_limit) {
ecl_bds_overflow();
@ -89,7 +90,7 @@ ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object value)
/* The previous binding was at most global */
slot->symbol = s;
slot->value = s->symbol.value;
ecl_sethash(s, env->bindings_hash, value);
ecl_sethash(s, bindings, value);
} else {
/* We have to save a dynamic binding */
slot->symbol = h->key;
@ -102,7 +103,8 @@ ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object value)
void
ecl_bds_push(cl_env_ptr env, cl_object s)
{
struct ecl_hashtable_entry *h = _ecl_gethash(s, env->bindings_hash);
cl_object bindings = env->bindings_hash;
struct ecl_hashtable_entry *h = bindings->hash.get(s, bindings);
struct bds_bd *slot = ++env->bds_top;
if (slot >= env->bds_limit) {
ecl_bds_overflow();
@ -112,7 +114,7 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
/* The previous binding was at most global */
slot->symbol = s;
slot->value = s->symbol.value;
ecl_sethash(s, env->bindings_hash, s->symbol.value);
ecl_sethash(s, bindings, s->symbol.value);
} else {
/* We have to save a dynamic binding */
slot->symbol = h->key;
@ -126,12 +128,13 @@ ecl_bds_unwind1(cl_env_ptr env)
{
struct bds_bd *slot = env->bds_top--;
cl_object s = slot->symbol;
struct ecl_hashtable_entry *h = _ecl_gethash(s, env->bindings_hash);
cl_object bindings = env->bindings_hash;
struct ecl_hashtable_entry *h = bindings->hash.get(s, bindings);
if (slot->value == OBJNULL) {
/* We have deleted all dynamic bindings */
h->key = OBJNULL;
h->value = Cnil;
env->bindings_hash->hash.entries--;
bindings->hash.entries--;
} else {
/* We restore the previous dynamic binding */
h->value = slot->value;
@ -144,7 +147,8 @@ ecl_symbol_slot(cl_env_ptr env, cl_object s)
if (Null(s))
s = Cnil_symbol;
if (s->symbol.dynamic) {
struct ecl_hashtable_entry *h = _ecl_gethash(s, env->bindings_hash);
cl_object bindings = env->bindings_hash;
struct ecl_hashtable_entry *h = bindings->hash.get(s, bindings);
if (h->key != OBJNULL)
return &h->value;
}
@ -155,7 +159,8 @@ cl_object
ecl_set_symbol(cl_env_ptr env, cl_object s, cl_object value)
{
if (s->symbol.dynamic) {
struct ecl_hashtable_entry *h = _ecl_gethash(s, env->bindings_hash);
cl_object bindings = env->bindings_hash;
struct ecl_hashtable_entry *h = bindings->hash.get(s, bindings);
if (h->key != OBJNULL) {
return (h->value = value);
}