Add stack walking to _do_gc
diff --git a/.vscode/launch.json b/.vscode/launch.json
index 57b1c71..2fd02c2 100644
--- a/.vscode/launch.json
+++ b/.vscode/launch.json
@@ -5,6 +5,26 @@
"version": "0.2.0",
"configurations": [
{
+ "name": "Debug test.lisp",
+ "type": "cppdbg",
+ "request": "launch",
+ "program": "${workspaceFolder}/src/lisp/lisp",
+ "args": ["test.lisp"],
+ "stopAtEntry": false,
+ "cwd": "${workspaceFolder}/src/lisp",
+ "environment": [],
+ "externalConsole": false,
+ "MIMode": "gdb",
+ "setupCommands": [
+ {
+ "description": "Enable pretty-printing for gdb",
+ "text": "-enable-pretty-printing",
+ "ignoreFailures": true
+ }
+ ],
+ "preLaunchTask": "buildLisp"
+ },
+ {
"type": "gdb",
"request": "attach",
"name": "Attach to QEMU",
diff --git a/.vscode/tasks.json b/.vscode/tasks.json
index 4052e94..8ccaf01 100644
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@@ -17,6 +17,11 @@
"type": "shell",
"label": "sphynx:watch",
"command": "make -C doc/ watch"
+ },
+ {
+ "type": "shell",
+ "label": "buildLisp",
+ "command": "make -C src/lisp"
}
],
}
\ No newline at end of file
diff --git a/src/lisp/Jmk b/src/lisp/Jmk
index 37fa788..ec4e5da 100644
--- a/src/lisp/Jmk
+++ b/src/lisp/Jmk
@@ -23,11 +23,11 @@
LUA = vendor/luajit/src/host/minilua
-vendor/luajit/src/host/minilua: vendor/luajit/src/host/minilua.c
+$(LUA): vendor/luajit/src/host/minilua.c
status_log(CC, $<)
@$(CC) $< -o $@ -lm
-compiler.c: compiler.dasc
+compiler.c: compiler.dasc | $(LUA)
status_log(DYNASM, $<)
@$(LUA) vendor/luajit/dynasm/dynasm.lua -o $@ $<
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 41b9ad1..b47ecf2 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -34,12 +34,12 @@
extern void _do_gc(unsigned int ebp, unsigned int esp);
-static void compile_gc()
-{
- | push esp;
- | push ebp;
- | call (_do_gc);
-}
+|.macro run_gc;
+| push esp;
+| push ebp;
+| mov eax, _do_gc;
+| call eax;
+|.endmacro;
struct function *find_function(struct environment *env, char *name)
{
diff --git a/src/lisp/gc.c b/src/lisp/gc.c
index 21e38e2..f3d01db 100644
--- a/src/lisp/gc.c
+++ b/src/lisp/gc.c
@@ -1,9 +1,22 @@
#include "gc.h"
#include "lisp.h"
-void _mark(unsigned int value)
-{
+value_t *gc_base;
+void __attribute__((noinline)) gc_set_base_here()
+{
+ // Move the current stack top address to gc_base. This works nicely because
+ // it means that when another (presumably lisp) function is called right
+ // after this, the stack top for it will be the same as for this function.
+ asm("movl %%esp, %0" : "=g"(gc_base));
+}
+
+void _mark(value_t value)
+{
+ if (heapp(value))
+ {
+
+ }
}
void _sweep()
@@ -13,11 +26,30 @@
void _do_gc(unsigned int esp, unsigned int ebp)
{
- unsigned int *esp_p = (unsigned int *)esp,
- *ebp_p = (unsigned int *)ebp;
+ value_t *esp_p = (value_t *)esp,
+ *ebp_p = (value_t *)ebp;
- for (int i = 0; esp_p + i < ebp_p; i++)
+ int num_marked = 0;
+
+ // For every stack frame until the base of the stack
+ while (esp_p < gc_base)
{
- _mark(esp_p[i]);
+ // Walk up the stack until we reach either the frame pointer or the base
+ // of the stack. Basically walk to the top of this function's stack
+ // frame.
+ for (; esp_p < ebp_p && esp_p < gc_base; esp_p++)
+ {
+ _mark(*esp_p);
+ num_marked++;
+ }
+
+ // Set the frame pointer to the frame pointer on the stack
+ ebp_p = (value_t *)*esp_p;
+
+ // Step up two stack slots, one for the frame pointer and one for the
+ // return address.
+ esp_p += 2;
}
+
+ fprintf(stderr, "Marked %d\n", num_marked);
}
diff --git a/src/lisp/gc.h b/src/lisp/gc.h
index da5982a..e535212 100644
--- a/src/lisp/gc.h
+++ b/src/lisp/gc.h
@@ -1,5 +1,12 @@
#pragma once
+#include "lisp.h"
+
+// I hate this
+extern value_t *gc_base;
+
+void gc_set_base_here();
+
void _do_gc(unsigned int esp, unsigned int ebp);
void _mark(unsigned int value);
void _sweep();
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 58e58e7..50da78a 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -7,7 +7,7 @@
#include <stdlib.h>
#include <string.h>
-struct alloc_list *first_a = NULL, *last_a = NULL;
+struct alloc *first_a = NULL, *last_a = NULL;
value_t nil = 0b00101111; // magic ;)
value_t t = 1 << 3;
@@ -27,24 +27,23 @@
value_t cons(value_t car, value_t cdr)
{
- struct cons *c = malloc_aligned(sizeof(struct cons));
+ struct cons_alloc *item = malloc_aligned(sizeof(struct cons_alloc));
+ struct cons *c = &item->cons;
c->car = car;
c->cdr = cdr;
- struct alloc_list *item = malloc(sizeof(struct alloc_list));
- item->type = T_CONS;
- item->cons_val = c;
+ item->alloc.type_tag = T_CONS;
if (last_a)
{
- item->prev = last_a;
+ item->alloc.prev = last_a;
last_a->next = item;
- item->next = NULL;
+ item->alloc.next = NULL;
}
else
{
- item->prev = item->next = NULL;
+ item->alloc.prev = item->alloc.next = NULL;
first_a = last_a = item;
}
@@ -323,6 +322,11 @@
return (v & HEAP_MASK) == CONS_TAG;
}
+bool heapp(value_t v)
+{
+ return consp(v) || stringp(v) || symbolp(v);
+}
+
bool listp(value_t v)
{
value_t next = v;
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 48de7d4..1424abe 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -39,18 +39,22 @@
struct cons
{
- int magic;
- int marked; // must be reserved
value_t car, cdr;
};
-struct alloc_list
+struct alloc
{
- int type;
- union {
- struct cons *cons_val;
- };
- struct alloc_list *next, *prev;
+ unsigned int type_tag;
+ struct alloc *prev, *next;
+ unsigned int marked;
+
+ // Whatever else
+};
+
+struct cons_alloc
+{
+ struct alloc alloc;
+ struct cons cons;
};
bool startswith(struct istream *s, char *pattern);
@@ -78,6 +82,7 @@
bool consp(value_t v);
bool listp(value_t v);
bool nilp(value_t v);
+bool heapp(value_t v);
int length(value_t v);
value_t elt(value_t v, int index);