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

Work on GC

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-24 22:37:14 -08:00
parent f67ed56d52
commit 05bcb77f24
5 changed files with 186 additions and 259 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/base.h
View File

@ -134,7 +134,7 @@ static ALWAYS_INLINE bool OBJECT_STATIC_P(LispVal *val) {
} }
static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) { static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) {
if ((!OBJECT_GC_SET_P(into, GC_WHITE) || OBJECT_STATIC_P(into)) if (OBJECTP(val) && OBJECTP(into) && OBJECT_GC_SET_P(into, GC_BLACK)
&& OBJECT_GC_SET_P(val, GC_WHITE)) { && OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY); gc_move_to_set(val, GC_GREY);
} }

257
src/gc.c
View File

@ -8,127 +8,6 @@
#include <stdlib.h> #include <stdlib.h>
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_object(ObjectProcessStack *restrict stack,
void *obj) {
if (OBJECTP(obj)) {
ensure_object_process_stack_size(stack, 1);
add_to_object_process_stack(stack, obj);
}
}
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];
}
bool lisp_doing_gc; bool lisp_doing_gc;
struct timespec total_gc_time; struct timespec total_gc_time;
size_t total_gc_count; size_t total_gc_count;
@ -279,60 +158,96 @@ static void free_object(LispVal *val) {
lisp_release_object(val); lisp_release_object(val);
} }
static void mark_object_recurse(LispGCStats *restrict stats, LispVal *val) { static inline void make_grey_if_while(LispVal *val) {
if (OBJECTP(val) && OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY);
}
}
static void mark_object(LispVal *val) {
if (!OBJECTP(val) || OBJECT_GC_SET_P(val, GC_BLACK)) { if (!OBJECTP(val) || OBJECT_GC_SET_P(val, GC_BLACK)) {
return; return;
} }
ObjectProcessStack stack; switch (((LispObject *) val)->type) {
init_object_process_stack(&stack); case TYPE_CONS:
object_process_stack_push_object(&stack, val); make_grey_if_while(((LispCons *) val)->car);
while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) { make_grey_if_while(((LispCons *) val)->cdr);
LispVal *cur = object_process_stack_pop(&stack); break;
if (!OBJECT_GC_SET_P(cur, GC_BLACK)) { case TYPE_SYMBOL: {
if (!OBJECT_STATIC_P(val)) { LispSymbol *sym = val;
++stats->non_statics_kept; make_grey_if_while(sym->name);
} make_grey_if_while(sym->value);
gc_move_to_set(cur, GC_BLACK); make_grey_if_while(sym->function);
object_process_stack_push_held_objects(&stack, cur); make_grey_if_while(sym->plist);
break;
}
case TYPE_VECTOR: {
LispVector *vec = val;
for (size_t i = 0; i < vec->length; ++i) {
make_grey_if_while(vec->data[i]);
} }
break;
} }
free_object_process_stack(&stack); case TYPE_HASH_TABLE: {
HT_FOREACH_INDEX(val, i) {
make_grey_if_while(HASH_KEY(val, i));
make_grey_if_while(HASH_VALUE(val, i));
}
break;
}
case TYPE_FUNCTION: {
LispFunction *fobj = val;
make_grey_if_while(fobj->name);
make_grey_if_while(fobj->docstr);
make_grey_if_while(fobj->args.req);
make_grey_if_while(fobj->args.opt);
make_grey_if_while(fobj->args.kw);
make_grey_if_while(fobj->args.rest);
break;
}
case TYPE_STRING:
// no held refs
break;
case TYPE_FIXNUM:
case TYPE_FLOAT:
default:
abort();
}
gc_move_to_set(val, GC_BLACK);
} }
static void mark_statics(LispGCStats *restrict stats) { static void mark_statics(void) {
for (struct GCObjectList *node = static_objects; node; node = node->next) { for (struct GCObjectList *node = static_objects; node; node = node->next) {
mark_object_recurse(stats, node->obj); mark_object(node->obj);
} }
} }
static void mark_stack_local_refs(LispGCStats *restrict stats, static void mark_stack_local_refs(struct LocalReferences *restrict refs) {
struct LocalReferences *restrict refs) {
size_t full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH; size_t full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH;
size_t last_block_len = 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 i = 0; i < full_blocks; ++i) {
for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) { for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) {
mark_object_recurse(stats, refs->blocks[i]->refs[j]); mark_object(refs->blocks[i]->refs[j]);
} }
} }
for (size_t i = 0; i < last_block_len; ++i) { for (size_t i = 0; i < last_block_len; ++i) {
mark_object_recurse(stats, refs->blocks[full_blocks]->refs[i]); mark_object(refs->blocks[full_blocks]->refs[i]);
} }
} }
static void mark_stack_frame(LispGCStats *restrict stats, static void mark_stack_frame(struct StackFrame *frame) {
struct StackFrame *frame) { mark_object(frame->name);
mark_object_recurse(stats, frame->name); mark_object(frame->args);
mark_object_recurse(stats, frame->args); mark_object(frame->fobj);
mark_object_recurse(stats, frame->fobj); mark_object(frame->lexenv);
mark_object_recurse(stats, frame->lexenv); mark_stack_local_refs(&frame->local_refs);
mark_stack_local_refs(stats, &frame->local_refs);
} }
static void mark_and_compact_the_stack(LispGCStats *restrict stats) { static void mark_and_compact_the_stack(void) {
mark_object_recurse(stats, the_stack.nogc_retval); mark_object(the_stack.nogc_retval);
size_t i; size_t i;
for (i = 0; i < the_stack.depth; ++i) { for (i = 0; i < the_stack.depth; ++i) {
mark_stack_frame(stats, &the_stack.frames[i]); mark_stack_frame(&the_stack.frames[i]);
} }
for (; i < the_stack.first_clear_local_refs; ++i) { for (; i < the_stack.first_clear_local_refs; ++i) {
compact_stack_frame(&the_stack.frames[i]); compact_stack_frame(&the_stack.frames[i]);
@ -340,9 +255,14 @@ static void mark_and_compact_the_stack(LispGCStats *restrict stats) {
the_stack.first_clear_local_refs = the_stack.depth; the_stack.first_clear_local_refs = the_stack.depth;
} }
static void gc_sweep_objects(LispGCStats *restrict stats) { static void mark_grey_objects(void) {
while (grey_objects) {
mark_object(grey_objects->obj);
}
}
static void gc_sweep_objects(void) {
while (white_objects) { while (white_objects) {
++stats->objects_cleaned;
free_object(white_objects->obj); free_object(white_objects->obj);
} }
} }
@ -365,34 +285,25 @@ static void swap_white_black_sets(void) {
GC_BLACK = tmp_id; GC_BLACK = tmp_id;
} }
void lisp_gc_now(LispGCStats *restrict stats) { void lisp_gc_now(struct timespec *restrict time_took) {
lisp_doing_gc = true; lisp_doing_gc = true;
LispGCStats backup_stats;
if (!stats) {
stats = &backup_stats;
}
stats->objects_cleaned = 0;
stats->non_statics_kept = 0;
struct timespec start_time; struct timespec start_time;
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time); clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time);
mark_statics(stats); mark_statics();
mark_object_recurse(stats, obarray); mark_object(obarray);
mark_and_compact_the_stack(stats); mark_and_compact_the_stack();
gc_sweep_objects(stats); mark_grey_objects();
gc_sweep_objects();
maybe_free_some_object_list_nodes(); maybe_free_some_object_list_nodes();
swap_white_black_sets(); swap_white_black_sets();
struct timespec end_time; struct timespec end_time;
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &end_time); clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &end_time);
sub_timespecs(&end_time, &start_time, &stats->ellapsed_time); struct timespec backup_time_took;
add_timespecs(&stats->ellapsed_time, &total_gc_time, &total_gc_time); if (!time_took) {
time_took = &backup_time_took;
}
sub_timespecs(&end_time, &start_time, time_took);
add_timespecs(time_took, &total_gc_time, &total_gc_time);
++total_gc_count; ++total_gc_count;
lisp_doing_gc = false; lisp_doing_gc = false;
} }
void debug_print_gc_stats(FILE *stream, const LispGCStats *stats) {
fprintf(stream, "Non-Statics Kept: %zu\n", stats->non_statics_kept);
fprintf(stream, "Objects Cleaned: %zu\n", stats->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);
}

45
src/gc.h
View File

@ -1,51 +1,16 @@
#ifndef INCLUDED_GC_H #ifndef INCLUDED_GC_H
#define INCLUDED_GC_H #define INCLUDED_GC_H
#include "memory.h" #include <stdbool.h>
#include <stddef.h> #include <stddef.h>
#include <stdint.h>
#include <stdio.h> #include <stdio.h>
#include <threads.h> #include <threads.h>
#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_object(ObjectProcessStack *restrict stack,
void *obj);
void object_process_stack_push_held_objects(ObjectProcessStack *restrict stack,
void *obj);
void *object_process_stack_pop(ObjectProcessStack *restrict stack);
extern bool lisp_doing_gc; extern bool lisp_doing_gc;
extern struct timespec total_gc_time; extern struct timespec total_gc_time;
extern size_t total_gc_count; extern size_t total_gc_count;
typedef struct {
size_t non_statics_kept;
size_t objects_cleaned;
struct timespec ellapsed_time;
} LispGCStats;
typedef uint8_t ObjectGCSet; typedef uint8_t ObjectGCSet;
extern ObjectGCSet GC_BLACK; extern ObjectGCSet GC_BLACK;
@ -66,10 +31,6 @@ void lisp_gc_register_object(void *val);
void lisp_gc_register_static_object(void *val); void lisp_gc_register_static_object(void *val);
void gc_move_to_set(void *val, ObjectGCSet new_set); void gc_move_to_set(void *val, ObjectGCSet new_set);
// note that the argument is restrict! void lisp_gc_now(struct timespec *restrict time_took);
void lisp_gc_now(LispGCStats *restrict stats);
// Debug
void debug_print_gc_stats(FILE *stream, const LispGCStats *stats);
#endif #endif

47
src/main.c
View File

@ -4,33 +4,26 @@
#include <stdio.h> #include <stdio.h>
/* DEFUN(cool_func, "cool-func", (LispVal * a, LispVal *b), "(a &optional b)", DEFUN(cool_func, "cool-func", (LispVal * a, LispVal *b), "(a &optional b)",
*/ "") {
/* "") { */ printf("A: ");
/* printf("A: "); */ debug_obj_info(stdout, a);
/* debug_obj_info(stdout, a); */ printf("B: ");
/* printf("B: "); */ debug_obj_info(stdout, b);
/* debug_obj_info(stdout, b); */ return Qnil;
/* return Qnil; */ }
/* } */
/* int main(int argc, const cha-r **argv) { */ int main(int argc, const char **argv) {
/* LispGCStats gc_stats; */ lisp_init();
/* lisp_init(); */ REGISTER_GLOBAL_FUNCTION(cool_func);
/* REGISTER_GLOBAL_FUNCTION(cool_func); */ push_stack_frame(Qnil, Qnil, Qnil);
/* push_stack_frame(Qnil, Qnil, Qnil); */ ReadStream s;
/* ReadStream s; */ const char BUF[] = "(cool-func 1 (cons 1 2))";
/* const char BUF[] = "(cool-func 1 (cons 1 2))"; */ read_stream_init(&s, BUF, sizeof(BUF) - 1);
/* read_stream_init(&s, BUF, sizeof(BUF) - 1); */ LispVal *l = read(&s);
/* LispVal *l = read(&s); */ Feval(l);
/* Feval(l); */ lisp_gc_now(NULL);
/* lisp_gc_now(&gc_stats); */ pop_stack_frame();
/* debug_print_gc_stats(stdout, &gc_stats); */ lisp_shutdown();
/* pop_stack_frame(); */
/* lisp_shutdown(); */
/* return 0; */
/* } */
int main(int argc, const char **argvc) {
return 0; return 0;
} }

94
src/stack.c
View File

@ -1,6 +1,8 @@
#include "stack.h" #include "stack.h"
#include "function.h"
#include "hashtable.h" #include "hashtable.h"
#include "list.h"
#include "memory.h" #include "memory.h"
#include <assert.h> #include <assert.h>
@ -82,26 +84,86 @@ void add_local_reference_no_recurse(LispVal *obj) {
} }
} }
static LispVal *next_local_reference(size_t *restrict i) {
if (*i >= LISP_STACK_TOP()->local_refs.num_refs) {
return NULL;
}
size_t block_idx = *i / LOCAL_REFERENCES_BLOCK_LENGTH;
size_t small_idx = *i % LOCAL_REFERENCES_BLOCK_LENGTH;
LispVal *obj =
LISP_STACK_TOP()->local_refs.blocks[block_idx]->refs[small_idx];
++*i;
return obj;
}
static inline void add_local_ref_if_not_seen_no_recurse(LispVal *seen_objs,
LispVal *obj) {
if (NILP(Fgethash(seen_objs, obj, Qnil))) {
add_local_reference_no_recurse(obj);
Fputhash(seen_objs, obj, Qt);
}
}
static inline void add_local_refs_for_object_sub_vals(LispVal *seen_objs,
LispVal *val) {
switch (((LispObject *) val)->type) {
case TYPE_CONS:
add_local_ref_if_not_seen_no_recurse(seen_objs,
((LispCons *) val)->car);
add_local_ref_if_not_seen_no_recurse(seen_objs,
((LispCons *) val)->cdr);
break;
case TYPE_SYMBOL: {
LispSymbol *sym = val;
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->name);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->value);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->function);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->plist);
break;
}
case TYPE_VECTOR: {
LispVector *vec = val;
for (size_t i = 0; i < vec->length; ++i) {
add_local_ref_if_not_seen_no_recurse(seen_objs, vec->data[i]);
}
break;
}
case TYPE_HASH_TABLE: {
HT_FOREACH_INDEX(val, i) {
add_local_ref_if_not_seen_no_recurse(seen_objs, HASH_KEY(val, i));
add_local_ref_if_not_seen_no_recurse(seen_objs, HASH_VALUE(val, i));
}
break;
}
case TYPE_FUNCTION: {
LispFunction *fobj = val;
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->name);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->docstr);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.req);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.opt);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.kw);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.rest);
break;
}
case TYPE_STRING:
// ho held refs
break;
case TYPE_FIXNUM:
case TYPE_FLOAT:
default:
abort();
}
}
void add_local_reference(LispVal *obj) { void add_local_reference(LispVal *obj) {
add_local_reference_no_recurse(obj); add_local_reference_no_recurse(obj);
LispVal *seen_objs = make_hash_table_no_gc(Qnil, Qnil); LispVal *seen_objs = make_hash_table_no_gc(Qnil, Qnil);
ObjectProcessStack stack; Fputhash(seen_objs, obj, Qt);
init_object_process_stack(&stack); size_t i = LISP_STACK_TOP()->local_refs.num_refs - 1;
object_process_stack_push_held_objects(&stack, obj); LispVal *cur;
while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) { while ((cur = next_local_reference(&i))) {
LispVal *top = object_process_stack_pop(&stack); add_local_refs_for_object_sub_vals(seen_objs, cur);
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);
}
} }
free_object_process_stack(&stack);
release_hash_table_no_gc(seen_objs);
} }
void compact_stack_frame(struct StackFrame *restrict frame) { void compact_stack_frame(struct StackFrame *restrict frame) {