Initial tricolor implementation

.clangd

@@ -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:

Makefile

@@ -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)

src/base.h

@@ -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);
+    if ((!OBJECT_GC_SET_P(into, GC_WHITE) || OBJECT_STATIC_P(into))
-    ObjectGCSet into_set = OBJECT_GET_GC_SET(into);
+        && OBJECT_GC_SET_P(val, GC_WHITE)) {
-    if (into_set == GC_BLACK && val_set == GC_WHITE) {
         gc_move_to_set(val, GC_GREY);
     }
 }

src/gc.c

@@ -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_object(&stack, val);
-    object_process_stack_push_held_objects(&stack, val);
-    ++stats->total_objects_searched;
     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) {
+    while (white_objects) {
-        ++stats->total_objects_cleaned;
+        ++stats->objects_cleaned;
-        free_object(black_objects->obj);
+        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 Searched: %zu\n", stats->objects_searched);
-    fprintf(stream, "Objects Cleaned: %zu\n", stats->total_objects_cleaned);
+    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);

src/gc.h

@@ -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 objects_searched;
-    size_t total_objects_cleaned;
+    size_t objects_cleaned;
     struct timespec ellapsed_time;
 } LispGCStats;
 

src/lisp.h

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

src/main.c

@@ -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();

src/stack.c

@@ -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[i].local_refs.num_refs = 0;
-        the_stack.frames->local_refs.num_blocks = 1;
+        the_stack.frames[i].local_refs.num_blocks = 1;
-        the_stack.frames->local_refs.blocks =
+        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;