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

Initial tricolor implementation

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-01-22 07:49:30 -08:00
parent 1a0906206a
commit 6cc85491cf
8 changed files with 68 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
.clangd
View File

@ -1,5 +1,13 @@
CompileFlags:
Add: [-std=c11, -Wall, -Wpedantic, -xc, -D_POSIX_C_SOURCE=199309L]
Add:
[
-std=c11,
-Wall,
-Wpedantic,
-xc,
-D_POSIX_C_SOURCE=199309L,
"-fsanitize=address,undefined",
]
Compiler: gcc
---
If:

12
Makefile
View File

@ -1,4 +1,5 @@
DEBUG=1
LLVM_SAN=0
ifeq ($(DEBUG),1)
DEBUG_CFLAGS=-g
@ -6,10 +7,17 @@ else
DEBUG_CFLAGS=-D_NDEBUG
endif
ifeq ($(LLVM_SAN),1)
LLVM_SAN_FLAGS=-fsanitize=address,undefined
else
LLVM_SAN_FLAGS=
endif
CC=gcc
CFLAGS=$(DEBUG_CFLAGS) -std=c11 -Wall -Wpedantic -D_POSIX_C_SOURCE=199309L
CFLAGS=$(DEBUG_CFLAGS) $(LLVM_SAN_FLAGS) -std=c11 -Wall -Wpedantic $\
-D_POSIX_C_SOURCE=199309L
LD=gcc
LDFLAGS=
LDFLAGS=$(LLVM_SAN_FLAGS)
SRCS:=$(wildcard src/*.c)
OBJS:=$(SRCS:src/%.c=bin/%.o)

7
src/base.h
View File

@ -54,7 +54,7 @@ static ALWAYS_INLINE fixnum_t XFIXNUM(LispVal *val) {
}
static ALWAYS_INLINE LispVal *MAKE_FIXNUM(fixnum_t fn) {
return (LispVal *) ((fn << 2) | FIXNUM_TAG);
return (LispVal *) ((((uintptr_t) fn) << 2) | FIXNUM_TAG);
}
static ALWAYS_INLINE bool LISP_FLOAT_P(LispVal *val) {
@ -133,9 +133,8 @@ static ALWAYS_INLINE bool OBJECT_STATIC_P(LispVal *val) {
}
static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) {
ObjectGCSet val_set = OBJECT_GET_GC_SET(val);
ObjectGCSet into_set = OBJECT_GET_GC_SET(into);
if (into_set == GC_BLACK && val_set == GC_WHITE) {
if ((!OBJECT_GC_SET_P(into, GC_WHITE) || OBJECT_STATIC_P(into))
&& OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY);
}
}

51
src/gc.c
View File

@ -50,6 +50,14 @@ add_to_object_process_stack(ObjectProcessStack *restrict stack, void *obj) {
}
}
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)) {
@ -149,8 +157,10 @@ static ALWAYS_INLINE struct GCObjectList **HEAD_FOR_SET(ObjectGCSet set) {
return &black_objects;
} else if (set == GC_GREY) {
return &grey_objects;
} else {
} else if (set == GC_WHITE) {
return &white_objects;
} else {
abort();
}
}
@ -181,21 +191,28 @@ void lisp_gc_register_object(void *val) {
struct GCObjectList *node = alloc_gc_objects_list_node();
obj->gc.gc_node = node;
node->prev = NULL;
node->next = black_objects;
node->next = white_objects;
if (node->next) {
node->next->prev = node;
}
node->obj = val;
white_objects = node;
}
void lisp_gc_register_static_object(void *val) {
if (!OBJECTP(val)) {
return;
}
lisp_gc_register_object(val);
LispObject *obj = val;
obj->gc.is_static = true;
struct GCObjectList *node = alloc_gc_objects_list_node();
node->prev = NULL;
node->next = static_objects;
if (node->next) {
node->next->prev = node;
}
node->obj = obj;
static_objects = node;
}
static void unregister_object_node(LispObject *obj) {
@ -215,16 +232,15 @@ void gc_move_to_set(void *val, ObjectGCSet new_set) {
return;
}
LispObject *obj = val;
if (OBJECT_STATIC_P(obj) && new_set == GC_WHITE) {
// static objects are always reachable. do this to optimize the macros
// in base.h
new_set = GC_GREY;
}
if (obj->gc.set != new_set) {
struct GCObjectList *node = obj->gc.gc_node;
unregister_object_node(obj);
obj->gc.set = new_set;
node->prev = NULL;
node->next = *HEAD_FOR_SET(new_set);
if (node->next) {
node->next->prev = node;
}
*HEAD_FOR_SET(new_set) = node;
}
}
@ -269,13 +285,11 @@ static void mark_object_recurse(LispGCStats *restrict stats, LispVal *val) {
}
ObjectProcessStack stack;
init_object_process_stack(&stack);
gc_move_to_set(val, GC_BLACK);
object_process_stack_push_held_objects(&stack, val);
++stats->total_objects_searched;
object_process_stack_push_object(&stack, val);
while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) {
LispVal *cur = object_process_stack_pop(&stack);
if (!OBJECT_GC_SET_P(cur, GC_BLACK)) {
++stats->total_objects_searched;
++stats->objects_searched;
gc_move_to_set(cur, GC_BLACK);
object_process_stack_push_held_objects(&stack, cur);
}
@ -325,9 +339,9 @@ static void mark_and_compact_the_stack(LispGCStats *restrict stats) {
}
static void gc_sweep_objects(LispGCStats *restrict stats) {
while (black_objects) {
++stats->total_objects_cleaned;
free_object(black_objects->obj);
while (white_objects) {
++stats->objects_cleaned;
free_object(white_objects->obj);
}
}
@ -355,7 +369,8 @@ void lisp_gc_now(LispGCStats *restrict stats) {
if (!stats) {
stats = &backup_stats;
}
stats->total_objects_cleaned = 0;
stats->objects_cleaned = 0;
stats->objects_searched = 0;
struct timespec start_time;
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time);
mark_statics(stats);
@ -373,8 +388,8 @@ void lisp_gc_now(LispGCStats *restrict stats) {
}
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);
fprintf(stream, "Objects Searched: %zu\n", stats->objects_searched);
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);

7
src/gc.h
View File

@ -30,7 +30,8 @@ init_object_process_stack(ObjectProcessStack *restrict stack) {
}
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);
@ -40,8 +41,8 @@ extern struct timespec total_gc_time;
extern size_t total_gc_count;
typedef struct {
size_t total_objects_searched;
size_t total_objects_cleaned;
size_t objects_searched;
size_t objects_cleaned;
struct timespec ellapsed_time;
} LispGCStats;

7
src/lisp.h
View File

@ -18,7 +18,10 @@ void lisp_shutdown(void);
DECLARE_FUNCTION(eval, (LispVal * form));
void debug_print(FILE *file, LispVal *obj);
void debug_obj_info(FILE *file, LispVal *obj);
__attribute__((no_sanitize("address"))) void debug_print(FILE *file,
LispVal *obj);
__attribute__((no_sanitize("address"))) void debug_obj_info(FILE *file,
LispVal *obj);
#endif

5
src/main.c
View File

@ -22,11 +22,6 @@ int main(int argc, const char **argv) {
read_stream_init(&s, BUF, sizeof(BUF) - 1);
LispVal *l = read(&s);
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();

8
src/stack.c
View File

@ -14,11 +14,11 @@ void lisp_init_stack(void) {
the_stack.frames =
lisp_malloc(sizeof(struct StackFrame) * the_stack.max_depth);
for (size_t i = 0; i < the_stack.max_depth; ++i) {
the_stack.frames->local_refs.num_refs = 0;
the_stack.frames->local_refs.num_blocks = 1;
the_stack.frames->local_refs.blocks =
the_stack.frames[i].local_refs.num_refs = 0;
the_stack.frames[i].local_refs.num_blocks = 1;
the_stack.frames[i].local_refs.blocks =
lisp_malloc(sizeof(struct LocalReferencesBlock *));
the_stack.frames->local_refs.blocks[0] =
the_stack.frames[i].local_refs.blocks[0] =
lisp_malloc(sizeof(struct LocalReferencesBlock));
}
the_stack.nogc_retval = Qnil;