gc and cons pairs

Makefile

@@ -1,9 +1,9 @@
 CFLAGS	:= -std=c99 -Og -g -Wpedantic -Wall
-OBJS	:= main.o sym.o
+OBJS	:= symbol.o object.o gc.o print.o main.o
 
 wscm: $(OBJS)
 	$(CC) $(OBJS) -o wscm
 
 .PHONY: clean
 clean:
-	rm -f wscm main.o sym.o
+	rm -f wscm $(OBJS)

gc.c

@@ -0,0 +1,138 @@
+#include <assert.h>
+#include <stdio.h>
+#include <string.h>
+
+#include "inttypes.h"
+#include "stdlib.h"
+#include "wscm.h"
+
+E heap;
+
+#define ALIGN(n) (((n) + 7) & ~7)
+#define INFROM(x)                                                              \
+  (((const U8 *)x) >= heap.from.start && ((const U8 *)x) < heap.from.end)
+
+// roots management
+void addroot(O *ptr) {
+  if (heap.root_count >= heap.root_capacity) {
+    Z cap = heap.root_capacity == 0 ? 16 : heap.root_capacity * 2;
+    O **roots = realloc(heap.roots, cap * sizeof(O *));
+    if (!roots)
+      abort();
+    heap.roots = roots;
+    heap.root_capacity = cap;
+  }
+  heap.roots[heap.root_count++] = ptr;
+}
+
+I rootmark(void) { return heap.root_count; }
+void rootreset(I mark) { heap.root_count = mark; }
+
+// garbage collection
+static O copy(H *obj, U8 **freep) {
+  assert(INFROM(obj));
+  assert(obj->type != OBJ_FWD);
+
+  Z sz = ALIGN(obj->size);
+  H *new = (H *)*freep;
+  *freep += sz;
+  memcpy(new, obj, sz);
+  obj->type = OBJ_FWD;
+  O *o = (O *)(obj + 1);
+  *o = BOX(new);
+  return *o;
+}
+
+static O forward(O obj, U8 **freep) {
+  if (obj == NIL)
+    return NIL;
+  if (IMM(obj))
+    return obj;
+
+  H *h = UNBOX(obj);
+  if (!INFROM(h))
+    return obj;
+
+  if (h->type == OBJ_FWD) {
+    O *o = (O *)(h + 1);
+    return *o;
+  } else {
+    return copy(h, freep);
+  }
+}
+
+void collect(void) {
+  U8 *freep = heap.to.start;
+  U8 *scan = freep;
+
+  for (I i = 0; i < heap.root_count; i++) {
+    O *o = heap.roots[i];
+    *o = forward(*o, &freep);
+  }
+
+  while (scan < freep) {
+    H *h = (H *)scan;
+    switch (h->type) {
+    case OBJ_CONS: {
+      C *c = (C *)(h + 1);
+      c->head = forward(c->head, &freep);
+      c->tail = forward(c->tail, &freep);
+      break;
+    }
+    case OBJ_SYM:
+      break;
+    case OBJ_FWD:
+      fprintf(stderr, "gc internal error: forwarding pointer in to-space\n");
+      abort();
+    default:
+      fprintf(stderr, "gc internal error: junk object type %" PRIdPTR "\n",
+              h->type);
+      abort();
+    }
+    scan += ALIGN(h->size);
+  }
+
+  U8 *tmp_start, *tmp_end;
+  tmp_start = heap.from.start;
+  tmp_end = heap.from.end;
+
+  heap.from = heap.to;
+  heap.from.free = freep;
+
+  heap.to.start = tmp_start;
+  heap.to.end = tmp_end;
+  heap.to.free = tmp_start;
+}
+
+// allocation
+H *alloc(Z sz) {
+  sz = ALIGN(sz);
+  if (heap.from.free + sz > heap.from.end) {
+    collect();
+    if (heap.from.free + sz > heap.from.end) {
+      fprintf(stderr, "out of memory (requested %zu bytes)\n", sz);
+      abort();
+    }
+  }
+  H *p = (H *)heap.from.free;
+  heap.from.free += sz;
+  p->size = sz;
+  return p;
+}
+
+void gcinit(void) {
+  heap.from.start = malloc(GC_HEAP_BYTES);
+  if (!heap.from.start) abort();
+  heap.from.free = heap.from.start;
+  heap.from.end = heap.from.start + GC_HEAP_BYTES;
+
+  heap.to.start = malloc(GC_HEAP_BYTES);
+  if (!heap.to.start) abort();
+  heap.to.free = heap.to.start;
+  heap.to.end = heap.to.start + GC_HEAP_BYTES;
+}
+
+void gcfinalize(void) {
+  free(heap.from.start);
+  free(heap.to.start);
+}

main.c

@@ -1,12 +1,15 @@
-#include <stdio.h>
 #include "wscm.h"
 
 int main(void) {
+  gcinit();
+
   const S *hello = intern("hello", -1);
-  printf("hello  = %p\n", (void *)hello);
+  const S *goodbye = intern("goodbye", -1);
+  O p = cons(BOX(hello), BOX(goodbye));
+  addroot(&p);
 
-  const S *hello2 = intern("hello", -1);
+  collect();
-  printf("hello2 = %p (should be equal to hello)\n", (void *)hello2);
 
+  gcfinalize();
   return 0;
 }

object.c

@@ -0,0 +1,39 @@
+#include <stdio.h>
+#include <stdlib.h>
+
+#include "inttypes.h"
+#include "wscm.h"
+
+// cons lists
+O cons(O head, O tail) {
+  I mark = rootmark();
+  addroot(&head);
+  addroot(&tail);
+
+  const Z sz = sizeof(H) + sizeof(C);
+  H *h = alloc(sz);
+  h->size = sz;
+  h->type = OBJ_CONS;
+
+  C *c = (C *)(h + 1);
+  c->head = head;
+  c->tail = tail;
+
+  rootreset(mark);
+  return BOX(h);
+}
+
+C *uncons(O obj) {
+  if (obj == NIL)
+    return NULL;
+  if (IMM(obj)) {
+    fprintf(stderr, "unpair: expected pair, got integer\n");
+    abort();
+  }
+  H *h = UNBOX(obj);
+  if (h->type != OBJ_CONS) {
+    fprintf(stderr, "unpair: expected pair, got type %" PRIdPTR "\n", h->type);
+    abort();
+  }
+  return (C *)(h + 1);
+}

print.c

@@ -0,0 +1,3 @@
+#include "wscm.h"
+
+// TODO.

shell.nix

@@ -3,6 +3,6 @@ pkgs.mkShell {
   packages = with pkgs; [
     clang-tools
     bear
+    gdb
   ];
 }
-

symbol.c

@@ -43,9 +43,9 @@ static void symtabresize(void) {
   syms.data = nb;
 }
 
-U32 hashstring(const char *data, Z len) {
+U32 hashstring(const char *data, I len) {
   U32 hash = 2166136261u;
-  for (Z i = 0; i < len; i++) {
+  for (I i = 0; i < len; i++) {
     hash ^= (uint8_t)data[i];
     hash *= 16777619u;
   }

wscm.h

@@ -36,10 +36,12 @@ struct St {
 };
 
 // gc header
+enum { OBJ_CONS, OBJ_SYM, OBJ_FWD };
+
 typedef struct H H;
 struct H {
   I type;
-  Z len;
+  Z size;
 };
 
 // heap
@@ -58,4 +60,26 @@ struct E {
 extern E heap;
 extern St syms;
 
+#define IMM(x) ((x) & 1)
+#define NUM(x) (((O)((I)(x) << 1)) | (V)1)
+#define ORD(x) ((I)(x) >> 1)
+#define BOX(x) ((O)(x))
+#define UNBOX(x) ((H *)(x))
+
+#define NIL ((O)0)
+#define GC_HEAP_BYTES (1024 * 1024)
+
+// GC
+void addroot(O *ptr);
+I rootmark(void);
+void rootreset(I mark);
+void collect(void);
+H *alloc(Z sz);
+void gcinit(void);
+void gcfinalize(void);
+
 S *intern(const char *str, I len);
+O mksym(const char *str);
+
+O cons(O head, O tail);
+C *uncons(O obj);