Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial (bad) gc

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-21 20:52:18 -08:00
parent 4c04e71078
commit 656846ddc0
16 changed files with 650 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

362
src/gc.c
View File

@ -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 <stdlib.h>
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);
}