From 2bf650d52380448a57483ff1a58f5231a8ecd8a9 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Wed, 20 Jan 2010 15:22:12 +0100 Subject: [PATCH] Hash tables now carry a slot with the 'gethash' function in it. --- src/c/hash.d | 37 +++++++++++++++++++------------------ src/c/stacks.d | 21 +++++++++++++-------- 2 files changed, 32 insertions(+), 26 deletions(-) diff --git a/src/c/hash.d b/src/c/hash.d index 204a29c2c..7858fca93 100644 --- a/src/c/hash.d +++ b/src/c/hash.d @@ -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 { diff --git a/src/c/stacks.d b/src/c/stacks.d index 724fe9d1d..d1543b502 100644 --- a/src/c/stacks.d +++ b/src/c/stacks.d @@ -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); }