Change to incremental GC

src/base.c

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

src/base.h

@@ -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
+// 0b10
-#define LISP_FLOAT_TAG ((uintptr_t) 3)
+#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);

src/gc.c

@@ -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_white(((LispCons *) val)->car);
-        make_grey_if_while(((LispCons *) val)->cdr);
+        make_grey_if_white(((LispCons *) val)->cdr);
         break;
     case TYPE_SYMBOL: {
         LispSymbol *sym = val;
-        make_grey_if_while(sym->name);
+        make_grey_if_white(sym->name);
-        make_grey_if_while(sym->value);
+        make_grey_if_white(sym->value);
-        make_grey_if_while(sym->function);
+        make_grey_if_white(sym->function);
-        make_grey_if_while(sym->plist);
+        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_white(HASH_KEY(val, i));
-            make_grey_if_while(HASH_VALUE(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_white(fobj->name);
-        make_grey_if_while(fobj->docstr);
+        make_grey_if_white(fobj->docstr);
-        make_grey_if_while(fobj->args.req);
+        make_grey_if_white(fobj->args.req);
-        make_grey_if_while(fobj->args.opt);
+        make_grey_if_white(fobj->args.opt);
-        make_grey_if_while(fobj->args.kw);
+        make_grey_if_white(fobj->args.kw);
-        make_grey_if_while(fobj->args.rest);
+        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) {
+static inline size_t saturating_dec(size_t *restrict limit, size_t amount) {
-    for (struct GCObjectList *node = static_objects; node; node = node->next) {
+    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) {
+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]);
     }
+    size_t 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;
+        }
+    }
+    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;
+    }
 }
 
-static void mark_grey_objects(void) {
+static void unmark_the_stack(void) {
-    while (grey_objects) {
+    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);
     }
-}
+    if (!grey_objects) {
-
+        incremental_state.step = GC_STEP_FREE;
-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;
     }
 }
 
@@ -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();
+    size_t limit = full ? SIZE_MAX : LISP_GC_INCREMENTAL_COUNT;
-    mark_object(obarray);
+    while (limit) {
-    mark_and_compact_the_stack();
+        // there are more grey objects, mark them before we sweep
-    mark_grey_objects();
+        if (incremental_state.step == GC_STEP_FREE && grey_objects) {
-    gc_sweep_objects();
+            incremental_state.step = GC_STEP_HEAP;
-    maybe_free_some_object_list_nodes();
+        }
-    swap_white_black_sets();
+        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) {

src/gc.h

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

src/lisp.c

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

src/main.c

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

src/stack.c

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

src/stack.h

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