Initial tricolor implementation

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_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);