Simple mark and sweep GC for C host

src/host/c/rvm.c

@@ -2,6 +2,8 @@
  * The Ribbit VM implementation in C
  */
 
+// TODO move GC algorithms to their own respective files
+
 // @@(feature debug
 #define DEBUG_I_CALL
 // )@@
@@ -10,6 +12,10 @@
 #define DEBUG_GC
 // )@@
 
+// @@(feature mark-sweep-gc
+#define MAKE_SWEEP
+// )@@
+
 #ifdef DEBUG_I_CALL
 #define DEBUG
 #endif
@@ -125,7 +131,6 @@ void decompress(){
   }
 }
 
-
 // )@@
 
 #endif
@@ -157,27 +162,42 @@ typedef struct {
   obj fields[RIB_NB_FIELDS];
 } rib;
 
-
 // GC constants
 rib *heap_start;
-obj *alloc_limit;
 #define MAX_NB_OBJS 100000000 // 48000 is minimum for bootstrap
 #define SPACE_SZ (MAX_NB_OBJS * RIB_NB_FIELDS)
 #define heap_bot ((obj *)(heap_start))
+#ifdef MARK_SWEEP
+#define heap_top (heap_bot + (SPACE_SZ))
+#define _NULL ((obj) NULL)
+#else
+obj *alloc_limit;
 #define heap_mid (heap_bot + (SPACE_SZ))
 #define heap_top (heap_bot + (SPACE_SZ << 1))
+#endif
 // end GC constants
 
 #define EXIT_ILLEGAL_INSTR 6
 #define EXIT_NO_MEMORY 7
 
+#ifdef MARK_SWEEP
+// if the mark and sweep GC is used, the third field of a rib uses 2 bits: one
+// to mark the rib during the marking phase of the GC and the other one to
+// distinguish between rib pointers and integers
+#define UNTAG(x) ((x) >> 2)
+#define TAG_NUM(num) ((((obj)(num)) << 2) | 1)
+#define MARK(x) ((x)|2) // assumes x is a tagged obj (ul)
+#define UNMARK(x) ((x)^2)
+#define IS_MARKED(x) ((x)&2)
+#else
 #define UNTAG(x) ((x) >> 1)
+#define TAG_NUM(num) ((((obj)(num)) << 1) | 1)
+#endif
 #define RIB(x) ((rib *)(x))
 #define NUM(x) ((num)(UNTAG((num)(x))))
 #define IS_NUM(x) ((x)&1)
 #define IS_RIB(x) (!IS_NUM(x))
 #define TAG_RIB(c_ptr) (((obj)(c_ptr)))
-#define TAG_NUM(num) ((((obj)(num)) << 1) | 1)
 
 #define PRIM1() obj x = pop()
 #define PRIM2()                                                                \
@@ -188,7 +208,7 @@ obj *alloc_limit;
   PRIM2()
 
 // CHECK_ACCESS will check if pointers are in the right space range when 
-//  accessing them with CAR, CDR or TAG
+// accessing them with CAR, CDR or TAG -- should only be used with stop and copy
 // #define CHECK_ACCESS
 #ifdef CHECK_ACCESS
 obj check_access(obj x){
@@ -201,8 +221,6 @@ obj check_access(obj x){
   if (to_space_start < x && x < to_space_end){
     printf("ERROR ACCESSING OUTSIDE SPACE %ld\n", NUM(x));
   }
-
-
   return x;
 }
 
@@ -242,7 +260,6 @@ obj symbol_table = NUM_0;
 size_t pos = 0;
 
 
-
 #ifdef NO_STD
 #define vm_exit(code)                                                          \
   do {                                                                         \
@@ -258,7 +275,7 @@ size_t pos = 0;
 #if defined(NO_STD) && !defined(NO_REG)
 register obj *alloc asm("edi");
 #else
-obj *alloc;
+obj *alloc; 
 #endif
 obj *alloc_limit;
 obj *scan;
@@ -290,18 +307,87 @@ void init_heap() {
   }
 
 #else
-  heap_start = malloc(sizeof(obj) * (SPACE_SZ << 1));
 
+#ifdef MARK_SWEEP
+  heap_start = malloc(sizeof(obj) * SPACE_SZ);
+#else
+  heap_start = malloc(sizeof(obj) * (SPACE_SZ << 1));
+#endif
+
   if (!heap_start) {
     vm_exit(EXIT_NO_MEMORY);
   }
 #endif
 
+#ifdef MARK_SWEEP
+  // initialize freelist
+  scan = heap_bot;
+  *scan = _NULL; 
+
+  while (scan != heap_top) {
+    alloc = scan; // alloc <- address of previous slot
+    scan += 3; // scan <- address of next rib slot
+    *scan = alloc; // CAR(next rib) <- address of previous slot
+  }
+  alloc = scan; 
+#else
   alloc = heap_bot;
   alloc_limit = heap_mid;
+#endif
   stack = NUM_0;
 }
 
+// GC algorithms
+#ifdef MARK_SWEEP 
+void mark(obj o) {
+
+  // TODO Deutsch-Schorr-Waite marking scheme
+
+  if (IS_RIB(o)) { 
+    obj *ptr = RIB(o)->fields;
+
+    if (!IS_MARKED(ptr[2])) { 
+      // third field could be an address
+      obj tmp = ptr[2]; 
+      ptr[2] = MARK(ptr[2]);
+
+      mark(ptr[0]);
+      mark(ptr[1]);
+      mark(tmp);
+    }
+  }
+}
+
+void gc() {
+#ifdef DEBUG_GC
+  printf("\t--GC called \n ");
+#endif
+  // Mark (only 3 possible roots)
+  mark(stack);
+  mark(pc);
+  mark(FALSE);
+
+  // Sweep
+  scan=heap_bot;
+  scan+=3; // first rib is always the NULL rib
+
+  while (scan != heap_top) {
+    obj tag = *(scan+2);
+    if (IS_MARKED(tag)) {
+      *(scan+2) = UNMARK(tag);
+    } else {
+      *scan = alloc;
+      alloc = scan;
+    }
+    scan += 3; // next rib object
+  }
+  if (*alloc == _NULL){
+    printf("Heap is full\n");
+  }
+}
+
+#else
+
 // NULL is a pointer (0) but would represent NULL
 // so it is never present in an obj field, and
 // cannot be a number because it is even. This
@@ -374,6 +460,7 @@ void gc() {
 
 #endif
 }
+#endif // end of GC algorithms
 
 obj pop() {
   obj x = CAR(stack);
@@ -382,16 +469,27 @@ obj pop() {
 }
 
 void push2(obj car, obj tag) {
+#ifdef MARK_SWEEP
+  obj tmp = *alloc; // next available slot in freelist
+#endif
+
   // default stack frame is (value, ->, NUM_0)
   *alloc++ = car;
   *alloc++ = stack;
   *alloc++ = tag;
 
   stack = TAG_RIB((rib *)(alloc - RIB_NB_FIELDS));
-
+
+#ifdef MARK_SWEEP
+  alloc = tmp; 
+  if (*alloc == _NULL) { // empty freelist?
+    gc(); 
+  } 
+#else
   if (alloc == alloc_limit) {
     gc();
   }
+#endif
 }
 
 /**
@@ -556,6 +654,9 @@ obj list2scm(char **s, int length) {
 obj bool2scm(bool x) { return x ? CAR(FALSE) : FALSE; }
 // )@@
 
+// used for nums library
+// @@(location decl)@@
+
 obj prim(int no) {
   switch (no) { 
   // @@(primitives (gen "case " index ":" body)