#include "hashtable.h" #include "function.h" #include "lisp_math.h" #include "lisp_string.h" #define INITIAL_SIZE 32 #define GROWTH_THRESHOLD 0.5 #define GROWTH_FACTOR 2 static ALWAYS_INLINE float TABLE_LOAD(LispHashTable *ht) { return ((float) ht->count) / ht->size; } LispVal *make_hash_table_no_gc(LispVal *hash_fn, LispVal *eq_fn) { LispHashTable *obj = lisp_alloc_object_no_gc(sizeof(LispHashTable), TYPE_HASH_TABLE); obj->eq_fn = eq_fn; MARK_OBJECT_ADDED(eq_fn, obj); obj->hash_fn = hash_fn; MARK_OBJECT_ADDED(hash_fn, obj); obj->count = 0; obj->size = INITIAL_SIZE; obj->data = lisp_malloc0(sizeof(struct HashTableBucket) * obj->size); return obj; } void release_hash_table_no_gc(LispVal *val) { assert(HASH_TABLE_P(val)); LispHashTable *ht = val; lisp_free(ht->data); lisp_free(ht); } DEFUN(hash_table_p, "hash-table-p", (LispVal * val), "(val)", "") { return HASH_TABLE_P(val) ? Qt : Qnil; } DEFUN(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn), "(&optional hash-fn eq-fn)", "") { LispHashTable *obj = lisp_alloc_object(sizeof(LispHashTable), TYPE_HASH_TABLE); obj->eq_fn = eq_fn; MARK_OBJECT_ADDED(eq_fn, obj); obj->hash_fn = hash_fn; MARK_OBJECT_ADDED(hash_fn, obj); obj->count = 0; obj->size = INITIAL_SIZE; obj->data = lisp_malloc0(sizeof(struct HashTableBucket) * obj->size); return obj; } static uintptr_t hash_key_for_table(LispHashTable *ht, LispVal *key) { if (NILP(ht->hash_fn) || ht->hash_fn == Qid) { return (uintptr_t) key; } else if (ht->hash_fn == Qhash_string) { // needed for initialization return XFIXNUM(Fhash_string(key)); } else { LispVal *hash = CALL(ht->hash_fn, key); if (LISP_GMP_P(hash)) { return mpz_get_ui(((LispGmp *) hash)->val); } else if (FIXNUMP(hash)) { return XFIXNUM(hash); } signal_type_error(hash, Qinteger); } } static bool compare_keys(LispHashTable *ht, LispVal *key1, LispVal *key2) { if (NILP(ht->eq_fn) || ht->eq_fn == Qeq) { return EQ(key1, key2); } else if (ht->eq_fn == Qstrings_equal) { // needed for initialization return !NILP(Fstrings_equal(key1, key2)); } else { return !NILP(CALL(ht->eq_fn, key1, key2)); } } static struct HashTableBucket * find_bucket_for_key(LispHashTable *ht, LispVal *key, uintptr_t hash) { assert(TABLE_LOAD(ht) < 0.95f); for (uintptr_t i = hash % ht->size; true; i = (i + 1) % ht->size) { struct HashTableBucket *cb = &ht->data[i]; if (HT_BUCKET_EMPTY_P(cb) || (cb->hash == hash && compare_keys(ht, key, cb->key))) { return cb; } } } static void rehash(LispHashTable *ht, size_t new_size) { ht->cache_bucket = NULL; struct HashTableBucket *old_data = ht->data; size_t old_size = ht->size; ht->size = new_size; ht->data = lisp_malloc0(sizeof(struct HashTableBucket) * new_size); for (size_t i = 0; i < old_size; ++i) { struct HashTableBucket *cob = &old_data[i]; if (!HT_BUCKET_EMPTY_P(cob)) { struct HashTableBucket *nb = find_bucket_for_key(ht, cob->key, cob->hash); nb->hash = cob->hash; nb->key = cob->key; nb->value = cob->value; } } lisp_free(old_data); } static void maybe_rehash(LispHashTable *ht) { if (TABLE_LOAD(ht) >= GROWTH_THRESHOLD) { rehash(ht, ht->size * GROWTH_FACTOR); } } DEFUN(gethash, "gethash", (LispVal * ht, LispVal *key, LispVal *def), "(ht key &optional def)", "") { CHECK_TYPE(ht, TYPE_HASH_TABLE); LispHashTable *obj = ht; if (obj->cache_bucket && key == obj->cache_bucket->key) { return obj->cache_bucket->value; } uintptr_t hash = hash_key_for_table(obj, key); struct HashTableBucket *b = find_bucket_for_key(obj, key, hash); obj->cache_bucket = b; return HT_BUCKET_EMPTY_P(b) ? def : b->value; } DEFUN(puthash, "puthash", (LispVal * ht, LispVal *key, LispVal *val), "(ht key val)", "") { CHECK_TYPE(ht, TYPE_HASH_TABLE); LispHashTable *obj = ht; if (obj->cache_bucket && key == obj->cache_bucket->key) { obj->cache_bucket->value = val; MARK_OBJECT_ADDED(val, ht); return Qnil; } maybe_rehash(ht); uintptr_t hash = hash_key_for_table(ht, key); struct HashTableBucket *b = find_bucket_for_key(ht, key, hash); if (HT_BUCKET_EMPTY_P(b)) { b->hash = hash; b->key = key; MARK_OBJECT_ADDED(key, ht); } b->value = val; MARK_OBJECT_ADDED(val, ht); ++((LispHashTable *) ht)->count; obj->cache_bucket = b; return Qnil; } DEFUN(remhash, "remhash", (LispVal * ht, LispVal *key), "(ht key)", "") { CHECK_TYPE(ht, TYPE_HASH_TABLE); LispHashTable *obj = ht; uintptr_t hash = hash_key_for_table(ht, key); struct HashTableBucket *b; if (obj->cache_bucket && obj->cache_bucket->key == key) { b = obj->cache_bucket; } else { b = find_bucket_for_key(ht, key, hash); } if (HT_BUCKET_EMPTY_P(b)) { return Qnil; } b->key = NULL; LispHashTable *tobj = ht; --tobj->count; size_t k = hash % tobj->size; for (size_t i = (k + 1) % tobj->size; !HT_BUCKET_EMPTY_P(&tobj->data[i]); i = (i + 1) % tobj->size) { size_t target = tobj->data[i].hash % tobj->size; if ((i > k && target >= k && target < i) || (i < k && (target >= k || target < i))) { tobj->data[k].hash = tobj->data[i].hash; tobj->data[k].key = tobj->data[i].key; tobj->data[k].value = tobj->data[i].value; tobj->data[i].key = NULL; k = i; } } obj->cache_bucket = NULL; return Qt; } DEFUN(hash_table_count, "hash-table-count", (LispVal * ht), "(ht)", "") { CHECK_TYPE(ht, TYPE_HASH_TABLE); return MAKE_FIXNUM(((LispHashTable *) ht)->count); }