Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Change to a different hash table implementation

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-09-23 14:24:13 -07:00
parent 733c4103a3
commit f961673670
2 changed files with 219 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

324
src/lisp.c
View File

@ -3,7 +3,6 @@
// used by static function registering macros // used by static function registering macros
#include "read.h" // IWYU pragma: keep #include "read.h" // IWYU pragma: keep
#include <assert.h>
#include <ctype.h> #include <ctype.h>
#include <stdarg.h> #include <stdarg.h>
#include <stdio.h> #include <stdio.h>
@ -106,6 +105,14 @@ void *lisp_realloc(void *old_ptr, size_t size) {
return new_ptr; return new_ptr;
} }
void *lisp_malloc0(size_t size) {
void *ptr = lisp_malloc(size);
if (ptr && size) {
memset(ptr, 0, size);
}
return ptr;
}
void garbage_collect(void) { void garbage_collect(void) {
last_gc = bytes_allocated; last_gc = bytes_allocated;
refcount_garbage_collect(); refcount_garbage_collect();
@ -136,12 +143,20 @@ static bool held_refs_callback(void *obj, RefcountList **held, void *ignored) {
} }
return true; return true;
} }
case TYPE_HASHTABLE: case TYPE_HASHTABLE: {
HASHTABLE_FOREACH(key, val, obj) { LispHashtable *ht = obj;
*held = refcount_list_push(*held, key); HT_FOREACH_VALID_INDEX(obj, i) {
*held = refcount_list_push(*held, val); *held = refcount_list_push(*held, HASH_KEY(obj, i));
*held = refcount_list_push(*held, HASH_VALUE(obj, i));
}
if (ht->eq_fn != Qstrings_equal) {
*held = refcount_list_push(*held, ht->eq_fn);
}
if (ht->hash_fn != Qhash_string) {
*held = refcount_list_push(*held, ht->hash_fn);
} }
return true; return true;
}
case TYPE_FUNCTION: { case TYPE_FUNCTION: {
LispFunction *fn = obj; LispFunction *fn = obj;
*held = refcount_list_push(*held, fn->name); *held = refcount_list_push(*held, fn->name);
@ -192,16 +207,8 @@ static void free_obj_callback(void *obj, void *ignored) {
} }
} break; } break;
case TYPE_HASHTABLE: { case TYPE_HASHTABLE: {
LispHashtable *tbl = obj; LispHashtable *ht = obj;
for (size_t i = 0; i < tbl->table_size; ++i) { lisp_free(ht->key_vals);
struct HashtableBucket *cur = tbl->data[i];
while (cur) {
struct HashtableBucket *next = cur->next;
lisp_free(cur);
cur = next;
}
}
lisp_free(tbl->data);
} break; } break;
case TYPE_FUNCTION: case TYPE_FUNCTION:
case TYPE_SYMBOL: case TYPE_SYMBOL:
@ -353,12 +360,20 @@ LispVal *make_lisp_function(LispVal *name, LispVal *return_tag, LispVal *args,
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn) { LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn) {
CONSTRUCT_OBJECT(self, LispHashtable, TYPE_HASHTABLE); CONSTRUCT_OBJECT(self, LispHashtable, TYPE_HASHTABLE);
self->table_size = LISP_HASHTABLE_INITIAL_SIZE; self->table_size = LISP_HASHTABLE_INITIAL_SIZE;
self->data = self->key_vals =
lisp_malloc(sizeof(struct HashtableBucket *) * self->table_size); lisp_malloc0(sizeof(struct HashtableEntry) * self->table_size);
memset(self->data, 0, sizeof(struct HashtableBucket *) * self->table_size);
self->count = 0; self->count = 0;
self->eq_fn = eq_fn; // needed during early initialization
self->hash_fn = hash_fn; if (eq_fn == Qstrings_equal) {
self->eq_fn = eq_fn;
} else {
self->eq_fn = refcount_ref(eq_fn);
}
if (hash_fn == Qhash_string) {
self->hash_fn = hash_fn;
} else {
self->hash_fn = refcount_ref(hash_fn);
}
return LISPVAL(self); return LISPVAL(self);
} }
@ -541,10 +556,7 @@ static LispVal **process_builtin_args(LispVal *fname, LispFunction *func,
(func->n_req + func->n_opt + ((LispHashtable *) func->kwargs)->count (func->n_req + func->n_opt + ((LispHashtable *) func->kwargs)->count
+ !NILP(func->rest_arg)); + !NILP(func->rest_arg));
*nargs = raw_count; *nargs = raw_count;
LispVal **vec = lisp_malloc(sizeof(LispVal *) * raw_count); LispVal **vec = lisp_malloc0(sizeof(LispVal *) * raw_count);
if (raw_count) {
memset(vec, 0, sizeof(LispVal *) * raw_count);
}
LispVal *rest = Qnil; LispVal *rest = Qnil;
LispVal *rest_end = Qnil; LispVal *rest_end = Qnil;
size_t have_count = 0; size_t have_count = 0;
@ -741,10 +753,9 @@ static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
if (!NILP(rargs)) { if (!NILP(rargs)) {
goto missing_required; goto missing_required;
} }
#pragma GCC diagnostic push HT_FOREACH_VALID_INDEX(func->kwargs, i) {
#pragma GCC diagnostic ignored "-Wunused-but-set-variable" struct OptArgDesc *oad =
HASHTABLE_FOREACH(arg, desc_lv, func->kwargs) { USERPTR(struct OptArgDesc, HASH_VALUE(func->kwargs, i));
struct OptArgDesc *oad = USERPTR(struct OptArgDesc, desc_lv);
// only check the current function's lexenv and not its parents' // only check the current function's lexenv and not its parents'
if (NILP(gethash(added_kwds, oad->name, Qnil))) { if (NILP(gethash(added_kwds, oad->name, Qnil))) {
LispVal *eval_res = Feval(oad->default_form); LispVal *eval_res = Feval(oad->default_form);
@ -755,7 +766,6 @@ static void process_lisp_args(LispVal *fname, LispFunction *func, LispVal *args,
} }
} }
} }
#pragma GCC diagnostic pop
FOREACH(arg, oargs) { FOREACH(arg, oargs) {
struct OptArgDesc *oad = USERPTR(struct OptArgDesc, arg); struct OptArgDesc *oad = USERPTR(struct OptArgDesc, arg);
LispVal *default_val = Feval(oad->default_form); LispVal *default_val = Feval(oad->default_form);
@ -917,10 +927,7 @@ DEFUN(eval_in_env, "eval-in-env", (LispVal * form, LispVal *lexenv)) {
} }
case TYPE_VECTOR: { case TYPE_VECTOR: {
LispVector *vec = (LispVector *) form; LispVector *vec = (LispVector *) form;
LispVal **elts = lisp_malloc(sizeof(LispVal *) * vec->length); LispVal **elts = lisp_malloc0(sizeof(LispVal *) * vec->length);
if (elts) { // in case length is 0
memset(elts, 0, sizeof(LispVal *) * vec->length);
}
WITH_PUSH_FRAME(Qnil, Qnil, true, { WITH_PUSH_FRAME(Qnil, Qnil, true, {
struct UnrefListData uld; struct UnrefListData uld;
uld.vals = elts; uld.vals = elts;
@ -2171,17 +2178,13 @@ DEFUN(mapsymbols, "mapsymbols", (LispVal * func, LispVal *package)) {
} else { } else {
pkg = (LispPackage *) normalize_package(package); pkg = (LispPackage *) normalize_package(package);
} }
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Wunused-but-set-variable"
// TODO make hash tables not crash if modified during a loop
WITH_CLEANUP(pkg, { WITH_CLEANUP(pkg, {
IGNORE(); IGNORE();
HASHTABLE_FOREACH(name, sym, pkg->obarray) { HT_FOREACH_VALID_INDEX(pkg->obarray, i) {
LispVal *args = const_list(true, 1, sym); LispVal *args = const_list(true, 1, HASH_VALUE(pkg->obarray, i));
refcount_unref(Ffuncall(func, args)); refcount_unref(Ffuncall(func, args));
} }
}); });
#pragma GCC diagnostic pop
return Qnil; return Qnil;
} }
@ -2461,7 +2464,7 @@ LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
} }
// ####################### // #######################
// # Hashtable Functions # // # Hash Table Functions #
// ####################### // #######################
DEFUN(hashtablep, "hashtablep", (LispVal * val)) { DEFUN(hashtablep, "hashtablep", (LispVal * val)) {
return LISP_BOOL(HASHTABLEP(val)); return LISP_BOOL(HASHTABLEP(val));
@ -2473,28 +2476,8 @@ DEFUN(make_hashtable, "make-hashtable", (LispVal * hash_fn, LispVal *eq_fn)) {
DEFUN(copy_hash_table, "copy-hash-table", (LispVal * table)) { DEFUN(copy_hash_table, "copy-hash-table", (LispVal * table)) {
CHECK_TYPE(TYPE_HASHTABLE, table); CHECK_TYPE(TYPE_HASHTABLE, table);
LispHashtable *orig = (LispHashtable *) table; // TODO implement
CONSTRUCT_OBJECT(copy, LispHashtable, TYPE_HASHTABLE); return Qnil;
copy->table_size = orig->table_size;
copy->data =
lisp_malloc(sizeof(struct HashtableBucket *) * copy->table_size);
memset(copy->data, 0, sizeof(struct HashtableBucket *) * copy->table_size);
copy->count = orig->count;
copy->eq_fn = orig->eq_fn;
copy->hash_fn = orig->hash_fn;
for (size_t i = 0; i < orig->table_size; ++i) {
for (struct HashtableBucket *bucket = orig->data[i]; bucket;
bucket = bucket->next) {
struct HashtableBucket *new_bucket =
lisp_malloc(sizeof(struct HashtableBucket));
new_bucket->hash = bucket->hash;
new_bucket->key = refcount_ref(bucket->key);
new_bucket->value = refcount_ref(bucket->value);
new_bucket->next = copy->data[i];
copy->data[i] = new_bucket;
}
}
return LISPVAL(copy);
} }
DEFUN(hash_table_count, "hash-table-count", (LispVal * table)) { DEFUN(hash_table_count, "hash-table-count", (LispVal * table)) {
@ -2510,20 +2493,16 @@ DEFUN(gethash, "gethash", (LispVal * table, LispVal *key, LispVal *def)) {
return refcount_ref(gethash(table, key, def)); return refcount_ref(gethash(table, key, def));
} }
DEFUN(remhash, "remhash", (LispVal * table, LispVal *key)) { static bool hash_table_eq(LispVal *eq_fn, LispVal *v1, LispVal *v2) {
return refcount_ref(remhash(table, key)); if (NILP(eq_fn)) {
}
static bool hash_table_eq(LispHashtable *self, LispVal *v1, LispVal *v2) {
if (NILP(self->eq_fn)) {
return v1 == v2; return v1 == v2;
} else if (self->eq_fn == Qstrings_equal) { } else if (eq_fn == Qstrings_equal) {
return !NILP(Fstrings_equal(v1, v2)); return !NILP(Fstrings_equal(v1, v2));
} else { } else {
LispVal *eq_obj; LispVal *eq_obj;
LispVal *args = const_list(true, 2, v1, v2); LispVal *args = const_list(true, 2, v1, v2);
WITH_CLEANUP(args, { WITH_CLEANUP(args, {
eq_obj = Ffuncall(self->eq_fn, args); // eq_obj = Ffuncall(eq_fn, args); //
}); });
bool result = !NILP(eq_obj); bool result = !NILP(eq_obj);
refcount_unref(eq_obj); refcount_unref(eq_obj);
@ -2555,107 +2534,143 @@ static uint64_t hash_table_hash(LispHashtable *self, LispVal *key) {
} }
} }
static struct HashtableBucket * static ptrdiff_t hash_table_find_entry(struct HashtableEntry *entries,
find_hash_table_bucket(LispHashtable *self, LispVal *key, uint64_t hash) { size_t size, LispVal *eq_fn,
struct HashtableBucket *cur = self->data[hash % self->table_size]; LispVal *key, uint64_t hash) {
while (cur) { size_t i = hash % size;
if (hash_table_eq(self, key, cur->key)) { while (entries[i].key && !hash_table_eq(eq_fn, key, entries[i].key)) {
return cur; i = (i + 1) % size;
}
cur = cur->next;
} }
return NULL; return i;
} }
static void hash_table_rehash(LispHashtable *self, size_t new_size) { DEFUN(remhash, "remhash", (LispVal * table, LispVal *key)) {
struct HashtableBucket **new_data = CHECK_TYPE(TYPE_HASHTABLE, table);
lisp_malloc(sizeof(struct HashtableBucket *) * new_size); LispHashtable *self = (LispHashtable *) table;
memset(new_data, 0, sizeof(struct HashtableBucket *) * new_size); uint64_t hash = hash_table_hash(self, key);
for (size_t i = 0; i < self->table_size; ++i) { ptrdiff_t i = hash_table_find_entry(self->key_vals, self->table_size,
struct HashtableBucket *cur = self->data[i]; self->eq_fn, key, hash);
while (cur) { if (HASH_SLOT_UNSET_P(self, i)) {
struct HashtableBucket *next = cur->next; return Qnil;
cur->next = new_data[cur->hash % new_size]; }
new_data[cur->hash % new_size] = cur; refcount_unref(self->key_vals[i].key);
cur = next; self->key_vals[i].key = NULL;
LispVal *retval = self->key_vals[i].value;
--self->count;
// fixup the table
for (size_t j = (i + 1) % self->table_size; !HASH_SLOT_UNSET_P(self, j);
j = (j + 1) % self->table_size) {
size_t k = HASH_HASH(self, j) % self->table_size;
if ((i <= j && i < k && k <= j) || (i > j && (k <= j || i < k))) {
// https://en.wikipedia.org/wiki/Open_addressing
// test if the value actually should come before i or after j
continue;
}
self->key_vals[i].hash = HASH_HASH(self, j);
self->key_vals[i].key = HASH_KEY(self, j);
self->key_vals[i].value = HASH_VALUE(self, j);
self->key_vals[j].key = NULL;
i = j;
}
return retval;
}
void free_hash_table_data_array(void *data) {
struct HashtableDataArray *arr = data;
for (size_t i = 0; i < arr->size; ++i) {
refcount_unref(arr->entries[i].key);
refcount_unref(arr->entries[i].value);
}
lisp_free(arr->entries);
}
// we assume the table is not full
// return true if we added a new entry, false otherwise
static bool puthash_to_array(LispVal *eq_fn, struct HashtableEntry *key_vals,
size_t table_size, LispVal *key, uint64_t hash,
LispVal *value) {
ptrdiff_t i = hash_table_find_entry(key_vals, table_size, eq_fn, key, hash);
if (!key_vals[i].key) {
key_vals[i].key = refcount_ref(key);
key_vals[i].hash = hash;
key_vals[i].value = refcount_ref(value);
return true;
} else {
refcount_unref(key_vals[i].key);
key_vals[i].key = refcount_ref(key);
refcount_unref(key_vals[i].value);
key_vals[i].value = refcount_ref(value);
return false;
}
}
static void rehash_to(LispHashtable *self, size_t new_size) {
struct HashtableEntry *new_data =
lisp_malloc0(sizeof(struct HashtableEntry) * new_size);
struct HashtableDataArray data_arr = {.size = new_size,
.entries = new_data};
void *cl_handler;
if (the_stack) {
cl_handler = register_cleanup(&free_hash_table_data_array, &data_arr);
}
size_t new_count = 0; // this should be the same, but just in case the user
// violates the rules of immutability
HT_FOREACH_VALID_INDEX(self, i) {
LispVal *key = HASH_KEY(self, i);
uint64_t hash = HASH_HASH(self, i);
LispVal *value = HASH_VALUE(self, i);
if (puthash_to_array(self->eq_fn, new_data, new_size, key, hash,
value)) {
++new_count;
} }
} }
free(self->data); if (the_stack) {
self->data = new_data; cancel_cleanup(cl_handler);
}
free_hash_table_data_array(&(struct HashtableDataArray) {
.size = self->table_size, .entries = self->key_vals});
self->key_vals = new_data;
self->table_size = new_size; self->table_size = new_size;
self->count = new_count;
}
static inline void maybe_rehash(LispHashtable *self) {
if (HASH_TABLE_LOAD_FACTOR(self) >= 0.5) {
rehash_to(self, self->table_size * LISP_HASHTABLE_GROWTH_FACTOR);
} /* else if (HASH_TABLE_LOAD_FACTOR(self) <= 0.1
&& self->table_size > LISP_HASHTABLE_INITIAL_SIZE) {
rehash_to(self, self->table_size / LISP_HASHTABLE_GROWTH_FACTOR);
} */
} }
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value) { LispVal *puthash(LispVal *table, LispVal *key, LispVal *value) {
CHECK_TYPE(TYPE_HASHTABLE, table); CHECK_TYPE(TYPE_HASHTABLE, table);
LispHashtable *self = (LispHashtable *) table; LispHashtable *self = (LispHashtable *) table;
maybe_rehash(self);
uint64_t hash = hash_table_hash(self, key); uint64_t hash = hash_table_hash(self, key);
struct HashtableBucket *cur_bucket = if (puthash_to_array(self->eq_fn, self->key_vals, self->table_size, key,
find_hash_table_bucket(self, key, hash); hash, value)) {
if (cur_bucket) {
refcount_ref(value);
refcount_unref(cur_bucket->value);
cur_bucket->value = value;
} else {
cur_bucket = lisp_malloc(sizeof(struct HashtableBucket));
cur_bucket->next = self->data[hash % self->table_size];
cur_bucket->hash = hash;
cur_bucket->key = refcount_ref(key);
cur_bucket->value = refcount_ref(value);
self->data[hash % self->table_size] = cur_bucket;
++self->count; ++self->count;
if ((double) self->count / self->table_size
>= LISP_HASHTABLE_GROWTH_THRESHOLD) {
hash_table_rehash(self,
LISP_HASHTABLE_GROWTH_FACTOR * self->table_size);
}
} }
return table; return value;
} }
LispVal *gethash(LispVal *table, LispVal *key, LispVal *def) { LispVal *gethash(LispVal *table, LispVal *key, LispVal *def) {
CHECK_TYPE(TYPE_HASHTABLE, table); CHECK_TYPE(TYPE_HASHTABLE, table);
assert(HASH_TABLE_LOAD_FACTOR(table) < 0.95); // infinite loop otherwise
LispHashtable *self = (LispHashtable *) table; LispHashtable *self = (LispHashtable *) table;
uint64_t hash = hash_table_hash(self, key); uint64_t hash = hash_table_hash(self, key);
struct HashtableBucket *cur_bucket = ptrdiff_t i = hash_table_find_entry(self->key_vals, self->table_size,
find_hash_table_bucket(self, key, hash); self->eq_fn, key, hash);
if (cur_bucket) { if (HASH_SLOT_UNSET_P(self, i)) {
return cur_bucket->value; return def;
} else {
return HASH_VALUE(self, i);
} }
return def;
} }
LispVal *remhash(LispVal *table, LispVal *key) { LispVal *remhash(LispVal *table, LispVal *key) {
CHECK_TYPE(TYPE_HASHTABLE, table); return refcount_unref(Fremhash(table, key));
LispHashtable *self = (LispHashtable *) table;
uint64_t hash = hash_table_hash(self, key);
struct HashtableBucket *cur_bucket = self->data[hash % self->table_size];
if (cur_bucket && hash_table_eq(self, cur_bucket->key, key)) {
self->data[hash % self->table_size] = cur_bucket->next;
refcount_unref(cur_bucket->key);
refcount_unref(cur_bucket->value);
lisp_free(cur_bucket);
--self->count;
} else {
struct HashtableBucket *prev_bucket = cur_bucket;
cur_bucket = cur_bucket->next;
while (cur_bucket) {
if (hash_table_eq(self, cur_bucket->key, key)) {
prev_bucket->next = cur_bucket->next;
refcount_unref(cur_bucket->key);
refcount_unref(cur_bucket->value);
lisp_free(cur_bucket);
--self->count;
break;
}
}
}
if ((double) self->count / self->table_size
<= LISP_HASHTABLE_SHRINK_THRESHOLD
&& self->table_size > LISP_HASHTABLE_INITIAL_SIZE) {
hash_table_rehash(self,
self->table_size / LISP_HASHTABLE_GROWTH_FACTOR);
}
return table;
} }
// ##################### // #####################
@ -3097,11 +3112,11 @@ void debug_dump(FILE *stream, void *obj, bool newline) {
void debug_print_hashtable(FILE *stream, LispVal *table) { void debug_print_hashtable(FILE *stream, LispVal *table) {
debug_dump(stream, table, true); debug_dump(stream, table, true);
HASHTABLE_FOREACH(key, val, table) { HT_FOREACH_VALID_INDEX(table, i) {
fprintf(stream, "- "); fprintf(stream, "- ");
debug_dump(stream, key, false); debug_dump(stream, HASH_KEY(table, i), false);
fprintf(stream, " = "); fprintf(stream, " = ");
debug_dump(stream, val, true); debug_dump(stream, HASH_VALUE(table, i), true);
} }
} }
@ -3126,12 +3141,9 @@ void debug_print_tree(FILE *stream, void *obj) {
// ################ // ################
static void register_symbols_and_functions(void) { static void register_symbols_and_functions(void) {
// don't intern Qunbound! // don't intern Qunbound!
puthash(((LispPackage *) system_package)->obarray, REGISTER_DO_INTERN(nil, system_package);
LISPVAL(((LispSymbol *) Qnil)->name), Qnil); REGISTER_DO_INTERN(t, system_package);
((LispSymbol *) Qnil)->package = refcount_ref(system_package);
puthash(((LispPackage *) system_package)->obarray,
LISPVAL(((LispSymbol *) Qt)->name), Qt);
((LispSymbol *) Qt)->package = refcount_ref(system_package);
REGISTER_SYMBOL(opt); REGISTER_SYMBOL(opt);
REGISTER_SYMBOL(allow_other_keys); REGISTER_SYMBOL(allow_other_keys);
REGISTER_SYMBOL(key); REGISTER_SYMBOL(key);

80
src/lisp.h
View File

@ -1,6 +1,7 @@
#ifndef INCLUDED_LISP_H #ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H #define INCLUDED_LISP_H
#include <assert.h>
#include <refcount/refcount.h> #include <refcount/refcount.h>
#include <setjmp.h> #include <setjmp.h>
#include <stdarg.h> #include <stdarg.h>
@ -125,23 +126,20 @@ typedef struct {
LispVal *lexenv; LispVal *lexenv;
} LispFunction; } LispFunction;
struct HashtableBucket { #define LISP_HASHTABLE_INITIAL_SIZE 32
struct HashtableBucket *next; #define LISP_HASHTABLE_GROWTH_FACTOR 2
struct HashtableEntry {
uint64_t hash; uint64_t hash;
LispVal *key; LispVal *key;
LispVal *value; LispVal *value;
}; };
#define LISP_HASHTABLE_INITIAL_SIZE 32
#define LISP_HASHTABLE_GROWTH_FACTOR 2
#define LISP_HASHTABLE_GROWTH_THRESHOLD 0.75f
#define LISP_HASHTABLE_SHRINK_THRESHOLD 0.25f
typedef struct { typedef struct {
LISP_OBJECT_HEADER; LISP_OBJECT_HEADER;
struct HashtableBucket **data; size_t table_size; // number of buckets
size_t table_size; struct HashtableEntry *key_vals; // array of key, hash, value
size_t count; size_t count;
LispVal *eq_fn; LispVal *eq_fn;
LispVal *hash_fn; LispVal *hash_fn;
@ -306,11 +304,13 @@ inline static bool NUMBERP(LispVal *v) {
refcount_init_static(Q##sym); \ refcount_init_static(Q##sym); \
refcount_init_static(((LispSymbol *) Q##sym)->name); \ refcount_init_static(((LispSymbol *) Q##sym)->name); \
} }
#define REGISTER_SYMBOL_INTO(sym, pkg) \ #define REGISTER_DO_INTERN(sym, pkg) \
REGISTER_SYMBOL_NOINTERN(sym) \
((LispSymbol *) Q##sym)->package = refcount_ref(pkg); \ ((LispSymbol *) Q##sym)->package = refcount_ref(pkg); \
puthash(((LispPackage *) pkg)->obarray, \ puthash(((LispPackage *) pkg)->obarray, \
LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym); LISPVAL(((LispSymbol *) Q##sym)->name), Q##sym);
#define REGISTER_SYMBOL_INTO(sym, pkg) \
REGISTER_SYMBOL_NOINTERN(sym) \
REGISTER_DO_INTERN(sym, pkg)
#define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package) #define REGISTER_SYMBOL(sym) REGISTER_SYMBOL_INTO(sym, system_package)
#define REGISTER_STATIC_FUNCTION(name, args, docstr) \ #define REGISTER_STATIC_FUNCTION(name, args, docstr) \
REGISTER_SYMBOL_NOINTERN(name); \ REGISTER_SYMBOL_NOINTERN(name); \
@ -333,22 +333,11 @@ inline static bool NUMBERP(LispVal *v) {
// ############### // ###############
// # Loop macros # // # Loop macros #
// ############### // ###############
#define HASHTABLE_FOREACH(key_var, val_var, table) \ #define HT_FOREACH_VALID_INDEX(table, i_var) \
for (struct { \ for (size_t i_var = 0; i_var < ((LispHashtable *) (table))->table_size; \
LispHashtable *ht; \ ++i_var) \
size_t i; \ if (!HASH_SLOT_UNSET_P((table), i_var))
} __l = {.ht = (void *) table, .i = 0}; \
__l.i < __l.ht->table_size; ++__l.i) \
for (LispVal *__b = (void *) __l.ht->data[__l.i], \
*key_var = __b ? ((struct HashtableBucket *) __b)->key \
: NULL, \
*val_var = __b ? ((struct HashtableBucket *) __b)->value \
: NULL; \
__b; __b = (void *) ((struct HashtableBucket *) __b)->next, \
key_var = __b ? ((struct HashtableBucket *) __b)->key \
: NULL, \
val_var = __b ? ((struct HashtableBucket *) __b)->value \
: NULL)
#define FOREACH(var, list) \ #define FOREACH(var, list) \
for (LispVal *__foreach_cur = list, *var = HEAD(list); \ for (LispVal *__foreach_cur = list, *var = HEAD(list); \
!NILP(__foreach_cur); \ !NILP(__foreach_cur); \
@ -362,6 +351,7 @@ inline static bool NUMBERP(LispVal *v) {
#define GC_EVERY_N_BYTES 1024 * 80 #define GC_EVERY_N_BYTES 1024 * 80
void *lisp_malloc(size_t size); void *lisp_malloc(size_t size);
void *lisp_realloc(void *old_ptr, size_t size); void *lisp_realloc(void *old_ptr, size_t size);
void *lisp_malloc0(size_t size);
#define lisp_free free #define lisp_free free
void garbage_collect(void); void garbage_collect(void);
@ -528,7 +518,7 @@ LispVal *intern(const char *name, size_t length, bool take, LispVal *package,
bool included_too); bool included_too);
// ####################### // #######################
// # Hashtable Functions # // # Hash Table Functions #
// ####################### // #######################
DECLARE_FUNCTION(hashtablep, (LispVal * val)); DECLARE_FUNCTION(hashtablep, (LispVal * val));
DECLARE_FUNCTION(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn)); DECLARE_FUNCTION(make_hashtable, (LispVal * hash_fn, LispVal *eq_fn));
@ -537,6 +527,11 @@ DECLARE_FUNCTION(hash_table_count, (LispVal * table));
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value)); DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def)); DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key)); DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
struct HashtableDataArray {
size_t size;
struct HashtableEntry *entries;
};
void free_hash_table_data_array(void *data);
// Don't ref their return value // Don't ref their return value
LispVal *puthash(LispVal *table, LispVal *key, LispVal *value); LispVal *puthash(LispVal *table, LispVal *key, LispVal *value);
@ -760,7 +755,8 @@ static inline void push_to_lexenv(LispVal **lexenv, LispVal *key,
refcount_unref(old); refcount_unref(old);
} }
// These are like the internal functions, but they don't ref their return value // These are like the internal functions, but they don't ref their
// return value
static inline LispVal *HEAD(LispVal *list) { static inline LispVal *HEAD(LispVal *list) {
if (NILP(list)) { if (NILP(list)) {
return Qnil; return Qnil;
@ -788,6 +784,32 @@ static inline LispVal *TAIL_SAFE(LispVal *list) {
return ((LispPair *) list)->tail; return ((LispPair *) list)->tail;
} }
static inline double HASH_TABLE_LOAD_FACTOR(void *obj) {
assert(HASHTABLEP(obj));
LispHashtable *table = obj;
return (double) table->count / table->table_size;
}
static inline bool HASH_SLOT_UNSET_P(void *obj, size_t i) {
assert(HASHTABLEP(obj));
LispHashtable *table = obj;
return !table->key_vals[i].key;
}
static inline LispVal *HASH_KEY(void *obj, size_t i) {
assert(HASHTABLEP(obj));
LispHashtable *table = obj;
return table->key_vals[i].key;
}
static inline LispVal *HASH_VALUE(void *obj, size_t i) {
assert(HASHTABLEP(obj));
LispHashtable *table = obj;
return table->key_vals[i].value;
}
static inline uint64_t HASH_HASH(void *obj, size_t i) {
assert(HASHTABLEP(obj));
LispHashtable *table = obj;
return table->key_vals[i].hash;
}
// ################### // ###################
// # Debug Functions # // # Debug Functions #
// ################### // ###################