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

Change to incremental GC

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-02-28 09:11:21 -08:00
parent a76e6a335d
commit 45f6d7a53d
8 changed files with 176 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
src/base.c
View File

@ -20,6 +20,8 @@ const char *LISP_TYPE_NAMES[N_LISP_TYPES] = {
[TYPE_FUNCTION] = "function",
};
bool lisp_gc_on_alloc;
void *lisp_alloc_object_no_gc(size_t size, LispValType type) {
assert(size >= sizeof(LispObject));
LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size);
@ -31,6 +33,9 @@ void *lisp_alloc_object_no_gc(size_t size, LispValType type) {
void *lisp_alloc_object(size_t size, LispValType type) {
LispObject *obj = lisp_alloc_object_no_gc(size, type);
if (lisp_gc_on_alloc && the_stack.depth) {
lisp_gc_yield(NULL, false);
}
if (the_stack.depth > 0) {
add_local_reference_no_recurse(obj);
}

7
src/base.h
View File

@ -37,8 +37,8 @@ static ALWAYS_INLINE uintptr_t EXTRACT_TAG(LispVal *val) {
#define LISP_OBJECT_TAG ((uintptr_t) 0)
// 0b01
#define FIXNUM_TAG ((uintptr_t) 1)
// 0b11
#define LISP_FLOAT_TAG ((uintptr_t) 3)
// 0b10
#define LISP_FLOAT_TAG ((uintptr_t) 2)
static ALWAYS_INLINE bool LISP_OBJECT_P(LispVal *val) {
return EXTRACT_TAG(val) == LISP_OBJECT_TAG;
@ -76,7 +76,6 @@ static ALWAYS_INLINE LispVal *MAKE_LISP_FLOAT(lisp_float_t flt) {
// ###############
// # Other types #
// ###############
// Make sure this is kept up to date with byterun.h
typedef enum {
TYPE_FIXNUM = 0,
TYPE_FLOAT = 1,
@ -95,6 +94,8 @@ typedef struct {
ObjectGCInfo gc;
} LispObject;
extern bool lisp_gc_on_alloc;
#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);

197
src/gc.c
View File

@ -10,7 +10,7 @@
bool lisp_doing_gc;
struct timespec total_gc_time;
size_t total_gc_count;
size_t lisp_gc_count;
struct GCObjectList {
LispVal *obj;
@ -31,6 +31,23 @@ ObjectGCSet GC_BLACK = 0;
ObjectGCSet GC_GREY = 1;
ObjectGCSet GC_WHITE = 2;
enum IncrementalGCSetp {
GC_STEP_STATICS,
GC_STEP_STACK,
GC_STEP_HEAP,
GC_STEP_FREE,
};
struct IncrementalGCState {
enum IncrementalGCSetp step;
struct GCObjectList *next_static;
};
static struct IncrementalGCState incremental_state = {
.step = GC_STEP_STATICS,
.next_static = NULL,
};
static ALWAYS_INLINE struct GCObjectList **HEAD_FOR_SET(ObjectGCSet set) {
if (set == GC_BLACK) {
return &black_objects;
@ -92,6 +109,9 @@ void lisp_gc_register_static_object(void *val) {
}
node->obj = obj;
static_objects = node;
// reset incremental GC to ensure we scan the new static
incremental_state.step = GC_STEP_STATICS;
incremental_state.next_static = static_objects;
}
static void unregister_object_node(LispObject *obj) {
@ -124,7 +144,14 @@ void gc_move_to_set(void *val, ObjectGCSet new_set) {
}
}
void gc_mark_stack_for_rescan(void) {
if (incremental_state.step > GC_STEP_STACK) {
incremental_state.step = GC_STEP_STACK;
}
}
static void free_object(LispVal *val) {
assert(!OBJECT_HAS_LOCAL_REFERENCE_P(val));
switch (((LispObject *) val)->type) {
case TYPE_HASH_TABLE: {
LispHashTable *ht = val;
@ -158,7 +185,7 @@ static void free_object(LispVal *val) {
lisp_release_object(val);
}
static inline void make_grey_if_while(LispVal *val) {
static inline void make_grey_if_white(LispVal *val) {
if (OBJECTP(val) && OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY);
}
@ -171,39 +198,39 @@ static void mark_object(LispVal *val) {
}
switch (((LispObject *) val)->type) {
case TYPE_CONS:
make_grey_if_while(((LispCons *) val)->car);
make_grey_if_while(((LispCons *) val)->cdr);
make_grey_if_white(((LispCons *) val)->car);
make_grey_if_white(((LispCons *) val)->cdr);
break;
case TYPE_SYMBOL: {
LispSymbol *sym = val;
make_grey_if_while(sym->name);
make_grey_if_while(sym->value);
make_grey_if_while(sym->function);
make_grey_if_while(sym->plist);
make_grey_if_white(sym->name);
make_grey_if_white(sym->value);
make_grey_if_white(sym->function);
make_grey_if_white(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]);
make_grey_if_white(vec->data[i]);
}
break;
}
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));
make_grey_if_white(HASH_KEY(val, i));
make_grey_if_white(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);
make_grey_if_white(fobj->name);
make_grey_if_white(fobj->docstr);
make_grey_if_white(fobj->args.req);
make_grey_if_white(fobj->args.opt);
make_grey_if_white(fobj->args.kw);
make_grey_if_white(fobj->args.rest);
break;
}
case TYPE_STRING:
@ -217,13 +244,32 @@ static void mark_object(LispVal *val) {
gc_move_to_set(val, GC_BLACK);
}
static void mark_statics(void) {
for (struct GCObjectList *node = static_objects; node; node = node->next) {
static inline size_t saturating_dec(size_t *restrict limit, size_t amount) {
if (amount >= *limit) {
*limit = 0;
} else {
*limit -= amount;
}
return *limit;
}
static void mark_statics(size_t *restrict limit) {
struct GCObjectList *node = incremental_state.next_static;
while (node && saturating_dec(limit, 1)) {
mark_object(node->obj);
node = node->next;
}
// we processed the whole list, move to the next step
if (!node) {
incremental_state.next_static = static_objects;
incremental_state.step = GC_STEP_STACK;
}
}
static void mark_stack_local_refs(struct LocalReferences *restrict refs) {
// This mark_stack_local_refs and mark_stack_frame mark the whole frame,
// ignoring limit. However, they update limit with how many objects the marked.
static void mark_stack_local_refs(struct LocalReferences *restrict refs,
size_t *restrict limit) {
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) {
@ -234,46 +280,51 @@ static void mark_stack_local_refs(struct LocalReferences *restrict refs) {
for (size_t i = 0; i < last_block_len; ++i) {
mark_object(refs->blocks[full_blocks]->refs[i]);
}
saturating_dec(limit, refs->num_refs);
}
static void mark_stack_frame(struct StackFrame *frame) {
static void mark_stack_frame(struct StackFrame *frame, size_t *restrict limit) {
mark_object(frame->name);
mark_object(frame->args);
mark_object(frame->fobj);
mark_object(frame->lexenv);
mark_stack_local_refs(&frame->local_refs);
saturating_dec(limit, 4);
mark_stack_local_refs(&frame->local_refs, limit);
}
static void mark_and_compact_the_stack(void) {
mark_object(the_stack.nogc_retval);
static void mark_and_compact_the_stack(size_t *restrict limit) {
if ((*limit)--) {
mark_object(the_stack.nogc_retval);
}
size_t i;
for (i = 0; i < the_stack.depth; ++i) {
mark_stack_frame(&the_stack.frames[i]);
for (i = 0; i < the_stack.depth && *limit; ++i) {
if (!the_stack.frames[i].marked) {
mark_stack_frame(&the_stack.frames[i], limit);
the_stack.frames[i].marked = true;
}
}
for (; i < the_stack.first_clear_local_refs; ++i) {
compact_stack_frame(&the_stack.frames[i]);
if (i == the_stack.depth) {
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;
// move to the next step
incremental_state.step = GC_STEP_HEAP;
}
the_stack.first_clear_local_refs = the_stack.depth;
}
static void mark_grey_objects(void) {
while (grey_objects) {
static void unmark_the_stack(void) {
for (size_t i = 0; i < the_stack.depth; ++i) {
the_stack.frames[i].marked = false;
}
}
static void mark_grey_objects(size_t *restrict limit) {
while (grey_objects && saturating_dec(limit, 1)) {
mark_object(grey_objects->obj);
}
}
static void gc_sweep_objects(void) {
while (white_objects) {
free_object(white_objects->obj);
}
}
static void maybe_free_some_object_list_nodes(void) {
while (free_objects_list_count > FREE_OBJECTS_LIST_LIMIT) {
struct GCObjectList *to_free = free_objects_list;
free_objects_list = free_objects_list->next;
lisp_free(to_free);
--free_objects_list_count;
if (!grey_objects) {
incremental_state.step = GC_STEP_FREE;
}
}
@ -286,17 +337,55 @@ static void swap_white_black_sets(void) {
GC_BLACK = tmp_id;
}
void lisp_gc_now(struct timespec *restrict time_took) {
static void maybe_free_some_object_list_nodes(void) {
while (free_objects_list_count > FREE_OBJECTS_LIST_LIMIT) {
struct GCObjectList *to_free = free_objects_list;
free_objects_list = free_objects_list->next;
lisp_free(to_free);
--free_objects_list_count;
}
}
static void gc_sweep_objects(size_t *restrict limit) {
while (white_objects && saturating_dec(limit, 1)) {
free_object(white_objects->obj);
}
// reset the gc
if (!white_objects) {
swap_white_black_sets();
maybe_free_some_object_list_nodes();
unmark_the_stack();
incremental_state.step = GC_STEP_STATICS;
}
}
void lisp_gc_yield(struct timespec *restrict time_took, bool full) {
lisp_doing_gc = true;
struct timespec start_time;
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time);
mark_statics();
mark_object(obarray);
mark_and_compact_the_stack();
mark_grey_objects();
gc_sweep_objects();
maybe_free_some_object_list_nodes();
swap_white_black_sets();
size_t limit = full ? SIZE_MAX : LISP_GC_INCREMENTAL_COUNT;
while (limit) {
// there are more grey objects, mark them before we sweep
if (incremental_state.step == GC_STEP_FREE && grey_objects) {
incremental_state.step = GC_STEP_HEAP;
}
switch (incremental_state.step) {
case GC_STEP_STATICS:
mark_statics(&limit);
break;
case GC_STEP_STACK:
mark_and_compact_the_stack(&limit);
break;
case GC_STEP_HEAP:
mark_grey_objects(&limit);
break;
case GC_STEP_FREE:
gc_sweep_objects(&limit);
// force being done
limit = 0;
break;
}
}
struct timespec end_time;
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &end_time);
struct timespec backup_time_took;
@ -305,8 +394,8 @@ void lisp_gc_now(struct timespec *restrict time_took) {
}
sub_timespecs(&end_time, &start_time, time_took);
add_timespecs(time_took, &total_gc_time, &total_gc_time);
++total_gc_count;
lisp_doing_gc = false;
++lisp_gc_count;
}
void lisp_gc_teardown(void) {

12
src/gc.h
View File

@ -4,12 +4,14 @@
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <threads.h>
// number of objects to process each time we do incremental GC
#define LISP_GC_INCREMENTAL_COUNT 128
extern bool lisp_doing_gc;
extern struct timespec total_gc_time;
extern size_t total_gc_count;
extern size_t lisp_gc_count;
typedef uint8_t ObjectGCSet;
@ -31,7 +33,11 @@ void lisp_gc_register_object(void *val);
void lisp_gc_register_static_object(void *val);
void gc_move_to_set(void *val, ObjectGCSet new_set);
void lisp_gc_now(struct timespec *restrict time_took);
// notify the GC that the stack's referenced objects have changed.
void gc_mark_stack_for_rescan(void);
// do some incremental GC, with FULL, do full gc
void lisp_gc_yield(struct timespec *restrict time_took, bool full);
// Unregister all static objects and prepare for shutdown
// The stack MUST be empty when this is called

2
src/lisp.c
View File

@ -42,6 +42,7 @@ static void register_manual_symbols(void) {
void lisp_init(void) {
construct_manual_symbols();
obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
lisp_gc_register_static_object(obarray);
// Needed to register functions
REGISTER_GLOBAL_SYMBOL(and_allow_other_keys);
@ -58,6 +59,7 @@ void lisp_init(void) {
register_globals();
lisp_init_stack();
lisp_gc_on_alloc = true;
}
void lisp_shutdown(void) {

2
src/main.c
View File

@ -23,7 +23,7 @@ int main(int argc, const char **argv) {
read_stream_init(&s, src, src_len);
LispVal *l = read(&s);
Feval(l, Qnil);
lisp_gc_now(NULL);
lisp_gc_yield(NULL, true);
pop_stack_frame();
lisp_shutdown();
free(src);

8
src/stack.c
View File

@ -49,6 +49,8 @@ void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args) {
frame->args = args;
frame->lexenv = Qnil;
frame->local_refs.num_refs = 0;
frame->marked = false;
gc_mark_stack_for_rescan();
}
static void reset_local_refs(struct LocalReferences *refs) {
@ -90,6 +92,10 @@ static void store_local_reference_in_frame(struct StackFrame *frame,
refs->blocks[num_full_blocks]
->refs[refs->num_refs++ % LOCAL_REFERENCES_BLOCK_LENGTH] = obj;
}
SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true);
// mark the frame for rescan
frame->marked = false;
gc_mark_stack_for_rescan();
}
void add_local_reference_no_recurse(LispVal *obj) {
@ -186,6 +192,8 @@ void set_stack_evaluated_args(LispVal *args) {
assert(the_stack.depth > 0);
LISP_STACK_TOP()->evaled_args = true;
LISP_STACK_TOP()->args = args;
LISP_STACK_TOP()->marked = false;
gc_mark_stack_for_rescan();
}
void compact_stack_frame(struct StackFrame *restrict frame) {

4
src/stack.h
View File

@ -24,6 +24,8 @@ struct StackFrame {
LispVal *args; // arguments of the function call
LispVal *lexenv; // lexical environment (plist)
struct LocalReferences local_refs;
bool marked; // whether we have GC'ed this frame
};
struct LispStack {
@ -69,6 +71,8 @@ static inline void new_lexical_variable(LispVal *name, LispVal *value) {
assert(the_stack.depth != 0);
LISP_STACK_TOP()->lexenv =
CONS(name, CONS(value, LISP_STACK_TOP()->lexenv));
LISP_STACK_TOP()->marked = false;
gc_mark_stack_for_rescan();
}
// Copy the previous frame's lexenv to the top of the stack.