From 656846ddc0af819d52edecd9a47346353a696594 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Wed, 21 Jan 2026 20:52:18 -0800 Subject: [PATCH] Initial (bad) gc --- .clangd | 15 ++ Makefile | 12 +- src/base.c | 25 +++- src/base.h | 25 ++-- src/function.c | 2 + src/function.h | 12 +- src/gc.c | 362 +++++++++++++++++++++++++++++++++++++++++++++++- src/gc.h | 62 +++++++-- src/hashtable.c | 61 ++++++-- src/hashtable.h | 24 ++++ src/lisp.c | 14 +- src/lisp.h | 10 +- src/main.c | 12 +- src/memory.h | 29 +++- src/stack.c | 58 +++++--- src/stack.h | 6 +- 16 files changed, 650 insertions(+), 79 deletions(-) create mode 100644 .clangd diff --git a/.clangd b/.clangd new file mode 100644 index 0000000..2e7b07a --- /dev/null +++ b/.clangd @@ -0,0 +1,15 @@ +CompileFlags: + Add: [-std=c11, -Wall, -Wpedantic, -xc, -D_POSIX_C_SOURCE=199309L] + Compiler: gcc +--- +If: + PathMatch: .*\.h +CompileFlags: + Remove: -xc + Add: [-std=c11, -Wall, -Wpedantic, -xc-header] + Compiler: gcc +--- +If: + PathMatch: bin/.*\.c +CompileFlags: + Add: -Isrc diff --git a/Makefile b/Makefile index 429ab88..aa626ce 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,15 @@ +DEBUG=1 + +ifeq ($(DEBUG),1) +DEBUG_CFLAGS=-g +else +DEBUG_CFLAGS=-D_NDEBUG +endif + CC=gcc -CFLAGS=-g -std=c11 -Wall -Wpedantic +CFLAGS=$(DEBUG_CFLAGS) -std=c11 -Wall -Wpedantic -D_POSIX_C_SOURCE=199309L LD=gcc -LDFLAGS=-g +LDFLAGS= SRCS:=$(wildcard src/*.c) OBJS:=$(SRCS:src/%.c=bin/%.o) diff --git a/src/base.c b/src/base.c index dfb0d60..b1c5a7e 100644 --- a/src/base.c +++ b/src/base.c @@ -1,7 +1,9 @@ #include "base.h" +#include "gc.h" #include "hashtable.h" #include "lisp.h" +#include "stack.h" #include #include @@ -17,17 +19,32 @@ const char *LISP_TYPE_NAMES[N_LISP_TYPES] = { [TYPE_FUNCTION] = "function", }; -void *lisp_alloc_object(size_t size, LispValType type) { +void *lisp_alloc_object_no_gc(size_t size, LispValType type) { assert(size >= sizeof(LispObject)); LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size); + memset(obj, 0, size); obj->type = type; obj->gc.mark = false; - obj->gc.has_local_ref = false; - // TODO set the below - obj->gc.entry = NULL; + tss_create(&obj->gc.has_local_ref, NULL); return obj; } +void *lisp_alloc_object(size_t size, LispValType type) { + LispObject *obj = lisp_alloc_object_no_gc(size, type); + if (the_stack.depth > 0) { + add_local_reference_no_recurse(obj); + } + lisp_gc_register_object(obj); + return obj; +} + +void lisp_release_object(LispVal *val) { + assert(OBJECTP(val)); + LispObject *obj = val; + tss_delete(obj->gc.has_local_ref); + lisp_free(val); +} + void internal_CHECK_TYPE_signal_type_error(LispVal *obj, size_t count, const LispValType types[count]) { // TODO actually throw an error diff --git a/src/base.h b/src/base.h index 735f660..054ce30 100644 --- a/src/base.h +++ b/src/base.h @@ -89,14 +89,16 @@ typedef enum { } LispValType; extern const char *LISP_TYPE_NAMES[N_LISP_TYPES]; -#define LISP_OBJECT_ALIGNMENT (1 << LISP_TAG_BITS) -void *lisp_alloc_object(size_t size, LispValType type); - typedef struct { LispValType type; ObjectGCInfo gc; } LispObject; +#define LISP_OBJECT_ALIGNMENT (1 << LISP_TAG_BITS) +LispVal *lisp_alloc_object_no_gc(size_t size, LispValType type); +LispVal *lisp_alloc_object(size_t size, LispValType type); +void lisp_release_object(LispVal *val); + static ALWAYS_INLINE bool OBJECTP(LispVal *val) { return EXTRACT_TAG(val) == LISP_OBJECT_TAG; } @@ -111,15 +113,19 @@ static ALWAYS_INLINE bool OBJECT_MARKED_P(LispVal *val) { return ((LispObject *) val)->gc.mark; } +// ONLY APPLIES TO THE CALLING THREAD +static ALWAYS_INLINE bool OBJECT_HAS_LOCAL_REFERENCE_P(LispVal *val) { + assert(OBJECTP(val)); + LispObject *obj = val; + return tss_get(obj->gc.has_local_ref); +} + static ALWAYS_INLINE void SET_OBJECT_HAS_LOCAL_REFERENCE(LispVal *val, bool has_local_ref) { assert(OBJECTP(val)); - ((LispObject *) val)->gc.has_local_ref = has_local_ref; -} - -static ALWAYS_INLINE bool OBJECT_HAS_LOCAL_REFERENCE_P(LispVal *val) { - assert(OBJECTP(val)); - return ((LispObject *) val)->gc.has_local_ref; + LispObject *obj = val; + tss_set(obj->gc.has_local_ref, + (void *) (uintptr_t) (has_local_ref ? 1 : 0)); } static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) { @@ -240,6 +246,7 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, { Q##cname = Fintern(make_lisp_string(internal_Q##cname##_name, \ internal_Q##cname##_name_len, \ false, false)); \ + lisp_gc_register_static_object(Q##cname); \ } #define REGISTER_GLOBAL_FUNCTION(cname) \ { \ diff --git a/src/function.c b/src/function.c index f6c461e..28d389f 100644 --- a/src/function.c +++ b/src/function.c @@ -1,8 +1,10 @@ #include "function.h" +#include "hashtable.h" #include "lisp.h" #include "list.h" #include "read.h" +#include "stack.h" #include #include diff --git a/src/function.h b/src/function.h index 29e65af..e9ff7b1 100644 --- a/src/function.h +++ b/src/function.h @@ -77,14 +77,14 @@ void parse_lambda_list(LambdaListParseResult *out, LispVal *list); // This will cause the program to exit if an error occurs while parsing // LISP_ARGS! -LispVal *make_builtin_function(LispVal *name, LispVal *(*func)(), +LispVal *make_builtin_function(LispVal *name, LispVal *(*func)(void), const char *lisp_args, size_t args_len, LispVal *docstr); -#define BUILTIN_FUNCTION_OBJ(cname) \ - make_builtin_function( \ - Q##cname, (LispVal * (*) ()) F##cname, internal_F##cname##_argstr, \ - internal_F##cname##_argstr_len, \ - make_lisp_string(internal_F##cname##_docstr, \ +#define BUILTIN_FUNCTION_OBJ(cname) \ + make_builtin_function( \ + Q##cname, (LispVal * (*) (void) ) F##cname, \ + internal_F##cname##_argstr, internal_F##cname##_argstr_len, \ + make_lisp_string(internal_F##cname##_docstr, \ internal_F##cname##_docstr_len, false, false)) DECLARE_FUNCTION(funcall, (LispVal * func, LispVal *args)); diff --git a/src/gc.c b/src/gc.c index c9396a6..b07fc1d 100644 --- a/src/gc.c +++ b/src/gc.c @@ -1,5 +1,365 @@ #include "gc.h" +#include "function.h" +#include "hashtable.h" #include "lisp.h" +#include "list.h" +#include "stack.h" -void lisp_gc_register_object(void *obj) {} +#include + +bool lisp_doing_gc; +struct timespec total_gc_time; +size_t total_gc_count; + +#define GC_OBJECTS_BLOCK_SIZE 128 +struct GCObjectsBlock { + LispVal *objs[GC_OBJECTS_BLOCK_SIZE]; +}; +struct GCObjects { + size_t num_blocks; + size_t num_objs; + struct GCObjectsBlock **blocks; +}; + +static struct GCObjects gc_objects; +static struct GCObjects static_objects; + +static void init_gc_objects(struct GCObjects *restrict objects) { + objects->num_blocks = 0; + objects->num_objs = 0; + objects->blocks = NULL; +} + +static void gc_objects_register(struct GCObjects *restrict objects, + LispVal *obj) { + assert(OBJECTP(obj)); + if (objects->num_blocks * GC_OBJECTS_BLOCK_SIZE == objects->num_objs) { + objects->blocks = + lisp_realloc(objects->blocks, sizeof(struct GCObjectsBlock *) + * ++objects->num_blocks); + objects->blocks[objects->num_blocks - 1] = + lisp_malloc(sizeof(struct GCObjectsBlock)); + objects->blocks[objects->num_blocks - 1]->objs[0] = obj; + } else { + size_t block_idx = objects->num_objs / GC_OBJECTS_BLOCK_SIZE; + size_t small_idx = objects->num_objs % GC_OBJECTS_BLOCK_SIZE; + objects->blocks[block_idx]->objs[small_idx] = obj; + } + ++objects->num_objs; +} + +void lisp_init_gc(void) { + init_gc_objects(&gc_objects); + init_gc_objects(&static_objects); +} + +void lisp_gc_register_object(void *obj) { + gc_objects_register(&gc_objects, obj); +} + +// we don't have to put static objects into all_objects because they will never +// be GCed +void lisp_gc_register_static_object(void *obj) { + gc_objects_register(&static_objects, obj); +} + +void free_object_process_stack(ObjectProcessStack *restrict stack) { + for (size_t i = 0; i < stack->num_blocks; ++i) { + lisp_free(stack->blocks[i]); + } + lisp_free(stack->blocks); +} + +// Ensure STACK can hold at least NEW_ENTS more entries +static void ensure_object_process_stack_size(ObjectProcessStack *restrict stack, + size_t new_ents) { + size_t total_spaces = stack->num_blocks * OBJECT_PROCESS_STACK_BLOCK_SIZE; + size_t ents_left = total_spaces - stack->num_objs; + if (ents_left < new_ents) { + // grow the stack + size_t need_to_alloc = + (new_ents - ents_left) / OBJECT_PROCESS_STACK_BLOCK_SIZE; + if ((new_ents - ents_left) % OBJECT_PROCESS_STACK_BLOCK_SIZE != 0) { + ++need_to_alloc; + } + stack->blocks = lisp_realloc(stack->blocks, + sizeof(struct ObjectProcessStackBlock *) + * (stack->num_blocks + need_to_alloc)); + for (size_t i = 0; i < need_to_alloc; ++i) { + stack->blocks[i + stack->num_blocks] = + lisp_malloc(sizeof(struct ObjectProcessStackBlock)); + } + stack->num_blocks += need_to_alloc; + } +} + +// this does NOT check if there is actually space to push the object, so make +// sure to expand the stack with the above function before pushing +static ALWAYS_INLINE void +add_to_object_process_stack(ObjectProcessStack *restrict stack, void *obj) { + if (OBJECTP(obj)) { + size_t block_idx = stack->num_objs / OBJECT_PROCESS_STACK_BLOCK_SIZE; + size_t small_idx = stack->num_objs % OBJECT_PROCESS_STACK_BLOCK_SIZE; + stack->blocks[block_idx]->objs[small_idx] = obj; + ++stack->num_objs; + } +} + +void object_process_stack_push_held_objects(ObjectProcessStack *restrict stack, + void *obj) { + if (!OBJECTP(obj)) { + return; + } + switch (((LispObject *) obj)->type) { + case TYPE_CONS: + ensure_object_process_stack_size(stack, 2); + add_to_object_process_stack(stack, XCAR(obj)); + add_to_object_process_stack(stack, XCDR(obj)); + break; + case TYPE_SYMBOL: { + LispSymbol *sym = obj; + ensure_object_process_stack_size(stack, 4); + add_to_object_process_stack(stack, sym->name); + add_to_object_process_stack(stack, sym->value); + add_to_object_process_stack(stack, sym->function); + add_to_object_process_stack(stack, sym->plist); + break; + } + case TYPE_VECTOR: { + LispVector *vec = obj; + for (size_t i = 0; i < vec->length; ++i) { + if (OBJECTP(vec->data[i])) { + ensure_object_process_stack_size(stack, 1); + } + add_to_object_process_stack(stack, vec->data[i]); + } + break; + } + case TYPE_FUNCTION: { + LispFunction *fobj = obj; + ensure_object_process_stack_size(stack, 6); + add_to_object_process_stack(stack, fobj->name); + add_to_object_process_stack(stack, fobj->docstr); + add_to_object_process_stack(stack, fobj->args.req); + add_to_object_process_stack(stack, fobj->args.opt); + add_to_object_process_stack(stack, fobj->args.kw); + add_to_object_process_stack(stack, fobj->args.rest); + // TODO when other function types are added, record their held + // references + break; + } + case TYPE_HASH_TABLE: { + HT_FOREACH_INDEX(obj, i) { + if (OBJECTP(HASH_KEY(obj, i)) || OBJECTP(HASH_VALUE(obj, i))) { + ensure_object_process_stack_size(stack, 2); + } + add_to_object_process_stack(stack, HASH_KEY(obj, i)); + add_to_object_process_stack(stack, HASH_VALUE(obj, i)); + } + break; + } + case TYPE_STRING: + // holds no references break; + break; + case TYPE_FIXNUM: + case TYPE_FLOAT: + default: + abort(); + } +} + +void *object_process_stack_pop(ObjectProcessStack *restrict stack) { + assert(stack->num_objs > 0); + --stack->num_objs; + size_t block_idx = stack->num_objs / OBJECT_PROCESS_STACK_BLOCK_SIZE; + size_t small_idx = stack->num_objs % OBJECT_PROCESS_STACK_BLOCK_SIZE; + return stack->blocks[block_idx]->objs[small_idx]; +} + +void gc_recursively_mark_object(void *obj) { + if (!OBJECTP(obj) || OBJECT_MARKED_P(obj)) { + return; + } + SET_OBJECT_MARKED(obj, true); + ObjectProcessStack stack; + init_object_process_stack(&stack); + object_process_stack_push_held_objects(&stack, obj); + while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) { + LispVal *top = object_process_stack_pop(&stack); + if (!OBJECT_MARKED_P(top)) { + SET_OBJECT_MARKED(top, true); + object_process_stack_push_held_objects(&stack, top); + } + } + free_object_process_stack(&stack); +} + +// as we never delete static objects, all but the last block of the static +// objects array is filled +static void gc_mark_static_roots(void) { + for (size_t i = 0; i < static_objects.num_blocks - 1; ++i) { + for (size_t j = 0; j < GC_OBJECTS_BLOCK_SIZE; ++j) { + gc_recursively_mark_object(static_objects.blocks[i]->objs[j]); + } + } + for (size_t i = 0; i < static_objects.num_objs % GC_OBJECTS_BLOCK_SIZE; + ++i) { + gc_recursively_mark_object( + static_objects.blocks[static_objects.num_blocks - 1]->objs[i]); + } +} + +static void gc_mark_stack_local_refs(struct LocalReferences *restrict refs) { + size_t full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH; + size_t last_block_len = refs->num_refs % LOCAL_REFERENCES_BLOCK_LENGTH; + for (size_t i = 0; i < full_blocks; ++i) { + for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) { + gc_recursively_mark_object(refs->blocks[i]->refs[j]); + } + } + for (size_t i = 0; i < last_block_len; ++i) { + gc_recursively_mark_object(refs->blocks[full_blocks]->refs[i]); + } +} + +static void gc_mark_stack_frame(struct StackFrame *restrict frame) { + gc_recursively_mark_object(frame->name); + gc_recursively_mark_object(frame->args); + gc_recursively_mark_object(frame->lexenv); + gc_recursively_mark_object(frame->fobj); + gc_mark_stack_local_refs(&frame->local_refs); +} + +static void gc_mark_and_compact_the_stack(void) { + size_t i; + for (i = 0; i < the_stack.depth; ++i) { + gc_mark_stack_frame(&the_stack.frames[i]); + } + for (; i < the_stack.first_clear_local_refs; ++i) { + compact_stack_frame(&the_stack.frames[i]); + } + the_stack.first_clear_local_refs = the_stack.depth; +} + +static void free_object(LispVal *val) { + switch (((LispObject *) val)->type) { + case TYPE_HASH_TABLE: { + LispHashTable *ht = val; + lisp_free(ht->data); + break; + } + case TYPE_STRING: { + LispString *str = val; + if (str->owned) { + lisp_free(str->data); + } + break; + } + case TYPE_VECTOR: { + LispVector *vec = val; + lisp_free(vec->data); + break; + } + case TYPE_CONS: + case TYPE_SYMBOL: + case TYPE_FUNCTION: + // nothing to do + break; + case TYPE_FIXNUM: + case TYPE_FLOAT: + default: + abort(); + } + lisp_release_object(val); +} + +static ALWAYS_INLINE void do_sweep_object(LispGCStats *restrict stats, + LispVal *cur_obj, + size_t *restrict free_block, + size_t *restrict free_idx) { +#ifndef _NDEBUG + ++stats->total_objects_searched; +#endif + if (!OBJECT_MARKED_P(cur_obj)) { + ++stats->total_objects_cleaned; + free_object(cur_obj); + --gc_objects.num_objs; + } else { + SET_OBJECT_MARKED(cur_obj, false); + gc_objects.blocks[*free_block]->objs[*free_idx] = cur_obj; + if (++*free_idx == GC_OBJECTS_BLOCK_SIZE) { + ++*free_block; + free_idx = 0; + } + } +} + +static void gc_sweep_objects(LispGCStats *restrict stats) { +#ifdef _NDEBUG + stats->total_objects_searched = gc_objects.num_objs; +#else + stats->total_objects_searched = 0; +#endif + size_t free_block = 0; + size_t free_idx = 0; + size_t n_full_blocks = gc_objects.num_blocks - 1; + size_t small_idx = gc_objects.num_objs % GC_OBJECTS_BLOCK_SIZE; + if (small_idx == 0) { + ++n_full_blocks; + } + for (size_t search_block = 0; search_block < n_full_blocks; + ++search_block) { + for (size_t search_idx = 0; search_idx < GC_OBJECTS_BLOCK_SIZE; + ++search_idx) { + LispVal *cur_obj = + gc_objects.blocks[search_block]->objs[search_idx]; + do_sweep_object(stats, cur_obj, &free_block, &free_idx); + } + } + for (size_t i = 0; i < small_idx; ++i) { + do_sweep_object(stats, + gc_objects.blocks[gc_objects.num_blocks - 1]->objs[i], + &free_block, &free_idx); + } + // clean up the now empty blocks + size_t non_empty_blocks = gc_objects.num_objs / GC_OBJECTS_BLOCK_SIZE; + if (gc_objects.num_objs % GC_OBJECTS_BLOCK_SIZE != 0) { + ++non_empty_blocks; + } + for (size_t i = non_empty_blocks; i < gc_objects.num_blocks; ++i) { + lisp_free(gc_objects.blocks[i]); + } + gc_objects.num_blocks = non_empty_blocks; + gc_objects.blocks = lisp_realloc( + gc_objects.blocks, sizeof(struct GCObjectsBlock *) * non_empty_blocks); +} + +void lisp_gc_now(LispGCStats *restrict stats) { + lisp_doing_gc = true; + LispGCStats backup_stats; + if (!stats) { + stats = &backup_stats; + } + stats->total_objects_cleaned = 0; + struct timespec start_time; + clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time); + gc_mark_static_roots(); + gc_recursively_mark_object(obarray); + gc_mark_and_compact_the_stack(); + gc_sweep_objects(stats); + struct timespec end_time; + clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &end_time); + sub_timespecs(&end_time, &start_time, &stats->ellapsed_time); + add_timespecs(&stats->ellapsed_time, &total_gc_time, &total_gc_time); + ++total_gc_count; + lisp_doing_gc = false; +} + +void debug_print_gc_stats(FILE *stream, const LispGCStats *stats) { + fprintf(stream, "Objects Searched: %zu\n", stats->total_objects_searched); + fprintf(stream, "Objects Cleaned: %zu\n", stats->total_objects_cleaned); + double time = stats->ellapsed_time.tv_sec * 1000 + + (stats->ellapsed_time.tv_nsec / 1000000.0); + fprintf(stream, "Time Ellapsed (ms): %f\n", time); +} diff --git a/src/gc.h b/src/gc.h index 656f132..2db39c5 100644 --- a/src/gc.h +++ b/src/gc.h @@ -1,23 +1,67 @@ #ifndef INCLUDED_GC_H #define INCLUDED_GC_H -#include +#include "memory.h" -typedef struct GCEntry { - void *obj; - struct GCEntry *prev; - struct GCEntry *next; -} GCEntry; +#include +#include +#include + +extern bool lisp_doing_gc; +extern struct timespec total_gc_time; +extern size_t total_gc_count; + +typedef struct { + size_t total_objects_searched; + size_t total_objects_cleaned; + struct timespec ellapsed_time; +} LispGCStats; typedef struct { unsigned int mark : 1; - unsigned int has_local_ref : 1; - GCEntry *entry; + tss_t has_local_ref; } ObjectGCInfo; +void lisp_init_gc(void); + // the argument is a LispVal * void lisp_gc_register_object(void *obj); +void lisp_gc_register_static_object(void *obj); -size_t lisp_gc_now(void); +// note that the argument is restrict! +void lisp_gc_now(LispGCStats *restrict status); + +#define OBJECT_PROCESS_STACK_BLOCK_SIZE 64 +struct ObjectProcessStackBlock { + void *objs[OBJECT_PROCESS_STACK_BLOCK_SIZE]; +}; +typedef struct { + size_t num_blocks; + size_t num_objs; + struct ObjectProcessStackBlock **blocks; +} ObjectProcessStack; + +static ALWAYS_INLINE bool +OBJECT_PROCESS_STACK_EMPTY_P(ObjectProcessStack *restrict stack) { + return !stack->num_objs; +} + +static ALWAYS_INLINE void +init_object_process_stack(ObjectProcessStack *restrict stack) { + stack->num_blocks = 0; + stack->num_objs = 0; + stack->blocks = NULL; +} + +void free_object_process_stack(ObjectProcessStack *restrict stack); + +void object_process_stack_push_held_objects(ObjectProcessStack *restrict stack, + void *obj); +void *object_process_stack_pop(ObjectProcessStack *restrict stack); + +void gc_recursively_mark_object(void *obj); + +// Debug +void debug_print_gc_stats(FILE *stream, const LispGCStats *stats); #endif diff --git a/src/hashtable.c b/src/hashtable.c index 08b0129..7f5ba6d 100644 --- a/src/hashtable.c +++ b/src/hashtable.c @@ -6,14 +6,28 @@ #define GROWTH_THRESHOLD 0.5 #define GROWTH_FACTOR 2 -static ALWAYS_INLINE bool BUCKET_EMPTY_P(struct HashTableBucket *b) { - return !b->key; -} - 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; + obj->hash_fn = hash_fn; + 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(make_hash_table, "make-hash-table", (LispVal * hash_fn, LispVal *eq_fn), "(hash-fn eq-fn)", "") { LispHashTable *obj = @@ -51,7 +65,7 @@ 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 (BUCKET_EMPTY_P(cb) + if (HT_BUCKET_EMPTY_P(cb) || (cb->hash == hash && compare_keys(ht, key, cb->key))) { return cb; } @@ -59,13 +73,14 @@ find_bucket_for_key(LispHashTable *ht, LispVal *key, uintptr_t hash) { } 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 (!BUCKET_EMPTY_P(cob)) { + if (!HT_BUCKET_EMPTY_P(cob)) { struct HashTableBucket *nb = find_bucket_for_key(ht, cob->key, cob->hash); nb->hash = cob->hash; @@ -84,37 +99,53 @@ static void maybe_rehash(LispHashTable *ht) { // TODO type checking DEFUN(gethash, "gethash", (LispVal * ht, LispVal *key, LispVal *def), "(ht key &optional def)", "") { - uintptr_t hash = hash_key_for_table(ht, key); - struct HashTableBucket *b = find_bucket_for_key(ht, key, hash); - return BUCKET_EMPTY_P(b) ? def : b->value; + 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)", "") { + LispHashTable *obj = ht; + if (obj->cache_bucket && key == obj->cache_bucket->key) { + obj->cache_bucket->value = val; + 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 (BUCKET_EMPTY_P(b)) { + if (HT_BUCKET_EMPTY_P(b)) { b->hash = hash; b->key = key; } b->value = val; ++((LispHashTable *) ht)->count; + obj->cache_bucket = b; return Qnil; } DEFUN(remhash, "remhash", (LispVal * ht, LispVal *key), "(ht key)", "") { + LispHashTable *obj = ht; uintptr_t hash = hash_key_for_table(ht, key); - struct HashTableBucket *b = find_bucket_for_key(ht, key, hash); - if (BUCKET_EMPTY_P(b)) { + 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; - b->value = NULL; // just because LispHashTable *tobj = ht; --tobj->count; size_t k = hash % tobj->size; - for (size_t i = (k + 1) % tobj->size; !BUCKET_EMPTY_P(&tobj->data[i]); + 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) @@ -123,10 +154,10 @@ DEFUN(remhash, "remhash", (LispVal * ht, LispVal *key), "(ht key)", "") { tobj->data[k].key = tobj->data[i].key; tobj->data[k].value = tobj->data[i].value; tobj->data[i].key = NULL; - tobj->data[i].value = NULL; k = i; } } + obj->cache_bucket = NULL; return Qt; } diff --git a/src/hashtable.h b/src/hashtable.h index f6d8e0b..d4ef6cf 100644 --- a/src/hashtable.h +++ b/src/hashtable.h @@ -15,8 +15,14 @@ DEFOBJTYPE(HashTable, HASH_TABLE, HASH_TABLE_P, { struct HashTableBucket *data; size_t size; size_t count; + + struct HashTableBucket *cache_bucket; }); +// makes no effort to ensure its values are not GCed!!! +LispVal *make_hash_table_no_gc(LispVal *hash_fn, LispVal *eq_fn); +void release_hash_table_no_gc(LispVal *val); + DECLARE_FUNCTION(make_hash_table, (LispVal * hash_fn, LispVal *eq_fn)); DECLARE_FUNCTION(gethash, (LispVal * ht, LispVal *key, LispVal *def)); DECLARE_FUNCTION(puthash, (LispVal * ht, LispVal *key, LispVal *val)); @@ -28,4 +34,22 @@ static ALWAYS_INLINE size_t HASH_TABLE_COUNT(LispVal *ht) { return ((LispHashTable *) ht)->count; } +static ALWAYS_INLINE bool HT_BUCKET_EMPTY_P(struct HashTableBucket *b) { + return !b->key; +} + +static ALWAYS_INLINE LispVal *HASH_KEY(LispVal *ht, size_t i) { + assert(HASH_TABLE_P(ht)); + return ((LispHashTable *) ht)->data[i].key; +} + +static ALWAYS_INLINE LispVal *HASH_VALUE(LispVal *ht, size_t i) { + assert(HASH_TABLE_P(ht)); + return ((LispHashTable *) ht)->data[i].value; +} + +#define HT_FOREACH_INDEX(ht, i) \ + for (size_t i = 0; i < ((LispHashTable *) ht)->size; ++i) \ + if (!HT_BUCKET_EMPTY_P(&((LispHashTable *) ht)->data[i])) + #endif diff --git a/src/lisp.c b/src/lisp.c index 46d2e99..f3c8e9f 100644 --- a/src/lisp.c +++ b/src/lisp.c @@ -6,23 +6,28 @@ LispVal *obarray; -static void construct_manual_symbols() { +static void construct_manual_symbols(void) { // IMPORTANT: the symbols listed here need to also be set as special in // gen-init-globals.awk Qnil = Fmake_symbol(LISP_LITSTR("nil")); ((LispSymbol *) Qnil)->function = Qnil; ((LispSymbol *) Qnil)->plist = Qnil; + lisp_gc_register_static_object(Qnil); Qt = Fmake_symbol(LISP_LITSTR("t")); ((LispSymbol *) Qt)->value = Qt; + lisp_gc_register_static_object(Qt); Qunbound = Fmake_symbol(LISP_LITSTR("unbound")); ((LispSymbol *) Qunbound)->value = Qunbound; ((LispSymbol *) Qnil)->value = Qunbound; + lisp_gc_register_static_object(Qunbound); Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string")); + lisp_gc_register_static_object(Qhash_string); Qstrings_equal = Fmake_symbol(LISP_LITSTR("strings-equal")); + lisp_gc_register_static_object(Qstrings_equal); } -static void register_manual_symbols() { +static void register_manual_symbols(void) { #define INTERN(cname) \ Fputhash(obarray, ((LispSymbol *) Q##cname)->name, Q##cname); INTERN(nil); @@ -33,7 +38,8 @@ static void register_manual_symbols() { #undef INTERN } -void lisp_init() { +void lisp_init(void) { + lisp_init_gc(); construct_manual_symbols(); obarray = Fmake_hash_table(Qhash_string, Qstrings_equal); // these call Fintern, so they need to have obarray constructed @@ -47,7 +53,7 @@ void lisp_init() { lisp_init_stack(); } -void lisp_shutdown() {} +void lisp_shutdown(void) {} DEFUN(eval, "eval", (LispVal * form), "(form)", "") { if (!OBJECTP(form)) { diff --git a/src/lisp.h b/src/lisp.h index d50a4c0..f8d90b7 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2,11 +2,11 @@ #define INCLUDED_LISP_H #include "base.h" -#include "function.h" -#include "hashtable.h" -#include "lisp_string.h" -#include "list.h" -#include "stack.h" +#include "function.h" // IWYU pragma: export +#include "hashtable.h" // IWYU pragma: export +#include "lisp_string.h" // IWYU pragma: export +#include "list.h" // IWYU pragma: export +#include "stack.h" // IWYU pragma: export #include diff --git a/src/main.c b/src/main.c index f53773c..c8afee6 100644 --- a/src/main.c +++ b/src/main.c @@ -13,14 +13,22 @@ DEFUN(cool_func, "cool-func", (LispVal * a, LispVal *b), "(a &optional b)", } int main(int argc, const char **argv) { + LispGCStats gc_stats; lisp_init(); REGISTER_GLOBAL_FUNCTION(cool_func); push_stack_frame(Qnil, Qnil, Qnil); ReadStream s; - const char BUF[] = "(1 'a)"; + const char BUF[] = "(cool-func 1 (cons 1 2))"; read_stream_init(&s, BUF, sizeof(BUF) - 1); LispVal *l = read(&s); - Ffuncall(Qcool_func, l); + Feval(l); + push_stack_frame(Qnil, Qnil, Qnil); + for (size_t i = 0; i < 100; ++i) { + Fcons(MAKE_FIXNUM(0x1234), LISP_LITSTR("a")); + } + pop_stack_frame(); + lisp_gc_now(&gc_stats); + debug_print_gc_stats(stdout, &gc_stats); pop_stack_frame(); lisp_shutdown(); return 0; diff --git a/src/memory.h b/src/memory.h index 4eb1938..43f504c 100644 --- a/src/memory.h +++ b/src/memory.h @@ -5,13 +5,14 @@ #include #include #include +#include // Geneal macros #ifndef __has_attribute # define __has_attribute(attr) 0 #endif -#if __has_attribute(always_inline) +#if __has_attribute(always_inline) && defined(_NDEBUG) # define ALWAYS_INLINE inline __attribute__((always_inline)) #else # define ALWAYS_INLINE inline @@ -95,5 +96,31 @@ void *lisp_realloc(void *oldptr, size_t size); void *lisp_malloc(size_t size); void *lisp_malloc0(size_t size); void *lisp_aligned_alloc(size_t alignment, size_t size); +#define lisp_free free + +// other useful things +static ALWAYS_INLINE void sub_timespecs(const struct timespec *t1, + const struct timespec *t2, + struct timespec *out) { + out->tv_sec = t1->tv_sec - t2->tv_sec; + int32_t nsec = t1->tv_nsec - t2->tv_nsec; + if (nsec < 0) { + --out->tv_sec; + nsec += 1000000000; + } + out->tv_nsec = nsec; +} + +static ALWAYS_INLINE void add_timespecs(const struct timespec *t1, + const struct timespec *t2, + struct timespec *out) { + out->tv_sec = t1->tv_sec + t2->tv_sec; + int32_t nsec = t1->tv_nsec + t2->tv_nsec; + if (nsec > 1000000000) { + ++out->tv_sec; + nsec -= 1000000000; + } + out->tv_nsec = nsec; +} #endif diff --git a/src/stack.c b/src/stack.c index 8d5da3c..f1a4282 100644 --- a/src/stack.c +++ b/src/stack.c @@ -1,12 +1,13 @@ #include "stack.h" +#include "hashtable.h" #include "memory.h" #include struct LispStack the_stack; -void lisp_init_stack() { +void lisp_init_stack(void) { the_stack.max_depth = DEFAULT_MAX_LISP_EVAL_DEPTH; the_stack.depth = 0; the_stack.first_clear_local_refs = 0; @@ -23,13 +24,6 @@ void lisp_init_stack() { the_stack.nogc_retval = Qnil; } -static ALWAYS_INLINE void init_stack_frame(struct StackFrame *frame, - LispVal *name, LispVal *args) { - frame->name = name; - frame->args = args; - frame->lexenv = Qnil; -} - void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args) { assert(the_stack.depth < the_stack.max_depth); struct StackFrame *frame = &the_stack.frames[the_stack.depth++]; @@ -37,6 +31,7 @@ void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args) { frame->fobj = fobj; frame->args = args; frame->lexenv = Qnil; + frame->local_refs.num_refs = 0; } static void reset_local_refs(struct LocalReferences *refs) { @@ -45,13 +40,11 @@ static void reset_local_refs(struct LocalReferences *refs) { for (size_t i = 0; i < num_full_blocks; ++i) { for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) { assert(OBJECTP(refs->blocks[i]->refs[j])); - // TODO recurse into object SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[i]->refs[j], false); } } for (size_t i = 0; i < last_block_size; ++i) { assert(OBJECTP(refs->blocks[num_full_blocks]->refs[i])); - // TODO recurse into object SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[num_full_blocks]->refs[i], false); } @@ -63,8 +56,7 @@ void pop_stack_frame(void) { reset_local_refs(&frame->local_refs); } -// return true if we allocated a block -static bool store_local_reference_in_frame(struct StackFrame *frame, +static void store_local_reference_in_frame(struct StackFrame *frame, LispVal *obj) { struct LocalReferences *refs = &frame->local_refs; size_t num_full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH; @@ -76,21 +68,47 @@ static bool store_local_reference_in_frame(struct StackFrame *frame, lisp_malloc(sizeof(struct LocalReferencesBlock)); refs->blocks[refs->num_blocks - 1]->refs[0] = obj; refs->num_refs += 1; - return true; + the_stack.first_clear_local_refs = the_stack.depth; } else { refs->blocks[num_full_blocks] ->refs[refs->num_refs++ % LOCAL_REFERENCES_BLOCK_LENGTH] = obj; - return false; + } +} + +void add_local_reference_no_recurse(LispVal *obj) { + assert(the_stack.depth > 0); + if (OBJECTP(obj) && !OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { + store_local_reference_in_frame(LISP_STACK_TOP(), obj); } } void add_local_reference(LispVal *obj) { - assert(the_stack.depth > 0); - if (OBJECTP(obj) && OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { - if (store_local_reference_in_frame(LISP_STACK_TOP(), obj)) { - the_stack.first_clear_local_refs = the_stack.depth; + add_local_reference_no_recurse(obj); + LispVal *seen_objs = make_hash_table_no_gc(Qnil, Qnil); + ObjectProcessStack stack; + init_object_process_stack(&stack); + object_process_stack_push_held_objects(&stack, obj); + while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) { + LispVal *top = object_process_stack_pop(&stack); + assert(OBJECTP(top)); + if (!OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { + store_local_reference_in_frame(LISP_STACK_TOP(), top); + SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true); + } + if (NILP(Fgethash(seen_objs, obj, Qnil))) { + object_process_stack_push_held_objects(&stack, top); + Fputhash(seen_objs, obj, Qt); } - // TODO recurse into object - SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true); } + free_object_process_stack(&stack); + release_hash_table_no_gc(seen_objs); +} + +void compact_stack_frame(struct StackFrame *restrict frame) { + struct LocalReferences *restrict refs = &frame->local_refs; + for (size_t i = 1; i < refs->num_blocks; ++i) { + lisp_free(refs->blocks[i]); + } + lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *)); + refs->num_blocks = 1; } diff --git a/src/stack.h b/src/stack.h index 62f2984..c6945d2 100644 --- a/src/stack.h +++ b/src/stack.h @@ -36,13 +36,17 @@ struct LispStack { extern struct LispStack the_stack; -static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP() { +static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP(void) { return the_stack.depth ? &the_stack.frames[the_stack.depth - 1] : NULL; } void lisp_init_stack(void); void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args); void pop_stack_frame(void); +void add_local_reference_no_recurse(LispVal *obj); void add_local_reference(LispVal *obj); +// used by the GC +void compact_stack_frame(struct StackFrame *restrict frame); + #endif