WIP runtime more. How do I mark primitives+broken hearts?

asm/runtime.scm

@@ -3,9 +3,9 @@
 ;; These need to be initialized with the runtime
 (variable scan 0)
 (variable free 0)
-(variable root 0)
 (variable old 0) 
 (variable new 0)
+(variable root 0)
 
 (push main)
 (jmp)
@@ -36,21 +36,81 @@ alloc-do-gc
 (push alloc)
 (jmp)
 
-gc-start ;; ( -- )
+gc-run ;; ( -- )
 ; Move scan & free to start of new memory
 (ref new)
 (dup)
 (set! free)
 (set! scan)
 (ref root)
-(push relocate-object)
+(push relocate-cons)
 (call)
 (push gc-loop)
 (call)
+; Flip old and new
+(ref old)
+(ref new)
+(set! old)
+(set! new)
 (return)
 
-relocate-object ;; (o -- )
-;; TODO
+relocate-cons ;; (o -- )
+(dup)
+(@)
+(push relocate-reg)
+(call)
+(push 4)
+(+)
+(@)
+(push relocate-reg)
 
+relocate-reg ;; (r -- )
+(dup)
+(push cons?)
+(call)
+(push reg-relocated)
+(if)
+(dup)
+(push eol?)
+(call)
+(not)
+(push reg-relocated)
+(if)
+(dup)
+(push broken-heart?)
+(call)
+(push copy-and-construct)
+(if)
+(dup) ;; Broken heart, copy updated address from cdr
+(push 4)
+(+)
+(@)   ;; Retrieve new address
+(dup)
+(!)   ;; Write it here
+(push reg-relocated)
+(jmp)
+copy-and-construct
+(dup) ;; Wasn't a broken heart, move car to new memory
+(@) 
+(push free)
+(!)
+(dup) ;; Push cdr to new memory
+(push 4)
+(+)
+(@)
+(push free)
+(push 4)
+(+)
+(!)
+(dup) ;; Construct the broken heart
+(push install-broken-heart)
+(call)
+(ref free) ;; Move free pointer
+(push 8)
+(+)
+(set! free)
+reg-relocated
+(drop)
+(return)
 main
 ;; TODO

reference/Makefile

@@ -0,0 +1,6 @@
+CFLAGS=-g
+
+all: gctest
+
+gctest: gc.o
+	$(CC) $(CFLAGS) -o $@ $<

reference/gc.c

@@ -0,0 +1,88 @@
+// Cheney style stop and copy garbage collector
+#include "gc.h"
+
+static cons_t *old, *new, *scanptr, *freeptr, *eom, *root;
+static cons_t *the_empty_list = NULL;
+size_t tos;
+
+void init() {
+  old = calloc(sizeof(cons_t), SIZE);
+  freeptr = old;
+  eom = old + (SIZE / 2);
+  new = eom + 1;
+  root = alloc();
+}
+
+cons_t *alloc() {
+  if (freeptr < eom) {
+    cons_t *retval = freeptr;
+    freeptr++;
+    return retval;
+  } else {
+    gc_run();
+    return alloc();
+  }
+}
+
+void gc_run() {
+  freeptr = new;
+  scanptr = new;
+  // Relocate root
+  relocate(root);
+  // Enter the main GC loop
+  gc_loop();
+  // Flip old and new;
+  cons_t *temp = old;
+  old = new;
+  new = temp;
+}
+
+void gc_loop() {
+  while (scanptr < freeptr) {
+    relocate(scanptr);
+    scanptr++;
+  }
+}
+
+void move(box_t box) {
+  if (box.type == CONS && box.cons != the_empty_list) {
+    if (box.cons->car.type == BROKEN_HEART) {
+      box.cons = box.cons->cdr.cons;
+    } else {
+      memcpy(freeptr, box.cons, sizeof(cons_t));
+      box.cons->car.type = BROKEN_HEART;
+      box.cons->cdr.cons = freeptr;
+      freeptr++;
+    }
+  }
+}
+
+void relocate(cons_t* cons) {
+  move(cons->car);
+  move(cons->cdr);
+}
+
+int main() {
+  init();
+  // Simulate running linear fibonnaci
+  root->car.type = INTEGER;
+  root->car.integer = 1;
+  root->cdr.type = CONS;
+  root->cdr.cons = alloc();
+  root->cdr.cons->car.type = INTEGER;
+  root->cdr.cons->car.integer = 0;
+  root->cdr.cons->cdr.type = CONS;
+  root->cdr.cons->cdr.cons = the_empty_list;
+  for (size_t i = 0; i < 29; i++) {
+    cons_t *cons = alloc();
+    cons->car.type = INTEGER;
+    cons->car.integer = root->car.integer + root->cdr.cons->car.integer;
+    
+    cons->cdr.type = CONS;
+    cons->cdr.cons = root;
+    root->cdr.cons = the_empty_list;
+    root = cons;
+  };
+  printf("%d\n", root->car.integer); // 832040, and we've definitely run gc a few times
+}
+

reference/gc.h

@@ -0,0 +1,28 @@
+#include <stdint.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#define SIZE 8
+#define BROKEN_HEART 1
+#define CONS 2
+#define INTEGER 3
+
+typedef struct box_t {
+  char type;
+  union {
+    int integer;
+    struct cons_t* cons;
+  };
+} box_t;
+
+typedef struct cons_t {
+  box_t car;
+  box_t cdr;
+} cons_t;
+
+void init();
+cons_t *alloc();
+void gc_run();
+void gc_loop();
+void relocate(cons_t*);