Finish stack walking, mark+sweep for GC
diff --git a/doc/filesystem.rst b/doc/filesystem.rst
index fc8a025..df5373e 100644
--- a/doc/filesystem.rst
+++ b/doc/filesystem.rst
@@ -3,15 +3,15 @@
Filesystem drivers are still a work in progress. To test a file system you will
want to create and mount a virtual block device. The makefile in ``src/kernel``
-will generate an ``hd0.img`` EXT2 disk image for you automatically. The default
-size is 32 megabytes, but you can create your own of any size if you want. Once
-the image has been created it will be loaded by QEMU automatically.
+will generate an ``hd0_ext2.img`` EXT2 disk image for you automatically. The
+default size is 32 megabytes, but you can create your own of any size if you
+want. Once the image has been created it will be loaded by QEMU automatically.
In order to write to the virtual hard disk from your host operating system you
should mount it. The ``make mount`` command in ``src/kernel`` mount the image to
-``$(BLUEJAY_ROOT)/mnt``. It will automatically give read and write permissions
-to the current user. This operation uses ``sudo`` internally, you will be
-prompted for your password.
+``$(BLUEJAY_ROOT)/mnt``. If you are using an EXT2 filesystem you should probably
+change the owner of that directory once it is mounted so that you can write to
+it.
Virtual Filesystem
------------------
diff --git a/doc/lisp-std.rst b/doc/lisp-std.rst
new file mode 100644
index 0000000..b0a33f8
--- /dev/null
+++ b/doc/lisp-std.rst
@@ -0,0 +1,54 @@
+Lisp Standard Library
+=====================
+
+This provides documentation for every built-in function in the Lisp standard
+library. It is not auto-generated, please update this documentation if you
+change the API in any way.
+
+In general every user-facing API in the standard library should be documented
+here.
+
+Built-in "functions"
+--------------------
+
+.. function:: (if condition true-condition [false-condition])
+
+ Evaluates ``condition``, if it is truthy (non-``nil``) ``true-condition`` is
+ evaluated. Otherwise ``false-condition`` is evaluated. If
+ ``false-condition`` is not provided, ``if`` will evaluate to ``nil``.
+
+.. function:: (let1 (variable binding) & body)
+
+ Evaluates ``binding`` and binds it to ``variable``, then evaluates ``body``.
+ After ``body`` is evaluated ``variable`` is unbound.
+
+ .. code-block:: lisp
+
+ (let1 (greeting (greet "John"))
+ (do-something greeting)
+ (print greeting))
+ ; greeting is no longer bound
+
+.. function:: (gc)
+
+ Force the garbage collector (GC) to run.
+
+Functions
+---------
+
+.. function:: (car pair)
+
+ Return the first item in ``pair``.
+
+.. function:: (cdr pair)
+
+ Return the second (last) item in ``pair``.
+
+.. function:: (cons a b)
+
+ Return a cons-pair containing ``a`` and ``b``.
+
+.. function:: (print val)
+
+ Print out ``val`` to standard output. This will not be formatted as an
+ s-expression, but in a manner more similar to the internal representation.
\ No newline at end of file
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index b47ecf2..b3cdb9a 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -35,8 +35,9 @@
extern void _do_gc(unsigned int ebp, unsigned int esp);
|.macro run_gc;
-| push esp;
+| mov eax, esp;
| push ebp;
+| push eax;
| mov eax, _do_gc;
| call eax;
|.endmacro;
@@ -296,6 +297,15 @@
local_free(local, i);
}
+ else if (symstreq(fsym, "gc"))
+ {
+ if (nargs)
+ {
+ err("gc takes no arguments");
+ }
+
+ | run_gc;
+ }
else
{
struct function *func =
@@ -325,7 +335,10 @@
struct variable *v = find_variable(local, (char *)(val ^ SYMBOL_TAG));
if (!v)
+ {
+ fprintf(stderr, "var: %s\n", (char *)(val ^ SYMBOL_TAG));
err("Variable unbound");
+ }
switch (v->type)
{
@@ -333,7 +346,7 @@
| mov eax, dword [ebp + (value_size * (v->number + 2))];
break;
case V_BOUND:
- | mov eax, dword [ebp - ((v->number + 1) * value_size)]
+ | mov eax, dword [ebp - ((v->number + 1) * value_size)];
break;
default:
err("Sorry, can only access V_ARGUMENT and V_BOUND variables for now :(");
diff --git a/src/lisp/gc.c b/src/lisp/gc.c
index f3d01db..84df7aa 100644
--- a/src/lisp/gc.c
+++ b/src/lisp/gc.c
@@ -1,7 +1,9 @@
#include "gc.h"
#include "lisp.h"
+#include "plat/plat.h"
value_t *gc_base;
+THREAD_LOCAL static unsigned int gc_mark;
void __attribute__((noinline)) gc_set_base_here()
{
@@ -11,17 +13,52 @@
asm("movl %%esp, %0" : "=g"(gc_base));
}
-void _mark(value_t value)
+void _mark(value_t value, unsigned int *marked)
{
if (heapp(value))
{
+ void *pointer = (void *)(value & ~HEAP_MASK);
+ struct alloc *alloc = pointer - sizeof(struct alloc);
+ fprintf(stderr, "[ GC ] Marking 0x%p\n", pointer);
+
+ // Only recursively mark if this hasn't been marked yet. i.e. prevent
+ // marking circular references twice
+ if (alloc->mark != gc_mark)
+ {
+ ++*marked;
+
+ alloc->mark = gc_mark;
+
+ // printf("[ GC ] val =");
+ // printval(alloc_to_value(alloc), 2);
+
+ switch (alloc->type_tag)
+ {
+ case CONS_TAG: {
+ struct cons_alloc *cons = (struct cons_alloc *)alloc;
+ _mark(cons->cons.car, marked);
+ _mark(cons->cons.cdr, marked);
+ break;
+ }
+ }
+ }
}
}
+value_t alloc_to_value(struct alloc *a)
+{
+ void *val = ((void *)a) + sizeof(struct alloc);
+ return (unsigned int)val | a->type_tag;
+}
+
void _sweep()
{
-
+ for (struct alloc *a = first_a; a; a = a->next)
+ {
+ fprintf(stderr, "[ GC ] %s %p\n", (a->mark != gc_mark) ? "Unmarked" : "Marked", a);
+ printval(alloc_to_value(a), 2);
+ }
}
void _do_gc(unsigned int esp, unsigned int ebp)
@@ -29,7 +66,11 @@
value_t *esp_p = (value_t *)esp,
*ebp_p = (value_t *)ebp;
- int num_marked = 0;
+ unsigned int num_marked = 0;
+
+ gc_mark++;
+
+ fprintf(stderr, "[ GC ] %d (esp 0x%p, ebp 0x%p)\n", gc_mark, esp_p, ebp_p);
// For every stack frame until the base of the stack
while (esp_p < gc_base)
@@ -39,8 +80,7 @@
// frame.
for (; esp_p < ebp_p && esp_p < gc_base; esp_p++)
{
- _mark(*esp_p);
- num_marked++;
+ _mark(*esp_p, &num_marked);
}
// Set the frame pointer to the frame pointer on the stack
@@ -52,4 +92,6 @@
}
fprintf(stderr, "Marked %d\n", num_marked);
+
+ _sweep();
}
diff --git a/src/lisp/gc.h b/src/lisp/gc.h
index e535212..a75cadd 100644
--- a/src/lisp/gc.h
+++ b/src/lisp/gc.h
@@ -7,6 +7,7 @@
void gc_set_base_here();
+value_t alloc_to_value(struct alloc *a);
void _do_gc(unsigned int esp, unsigned int ebp);
-void _mark(unsigned int value);
+void _mark(value_t value, unsigned int *marked);
void _sweep();
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index 50da78a..a015d4e 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -33,13 +33,14 @@
c->car = car;
c->cdr = cdr;
- item->alloc.type_tag = T_CONS;
+ item->alloc.type_tag = CONS_TAG;
if (last_a)
{
item->alloc.prev = last_a;
last_a->next = item;
item->alloc.next = NULL;
+ last_a = item;
}
else
{
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 1424abe..03ab75e 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -4,18 +4,6 @@
#include <stdbool.h>
#include <stdio.h>
-enum type
-{
- T_INT = 0,
- T_FLOAT,
- T_NIL,
- T_SYMBOL,
- T_STRING,
- T_VECTOR,
- T_CLASS,
- T_CONS,
-};
-
#define INT_MASK 0b11
#define INT_TAG 0b00
@@ -42,15 +30,20 @@
value_t car, cdr;
};
+
+// It is integral that this be 16 bytes long so that whatever follows it is
+// still aligned to 4 bits.
struct alloc
{
- unsigned int type_tag;
- struct alloc *prev, *next;
- unsigned int marked;
+ unsigned int type_tag; // 4
+ struct alloc *prev, *next; // + 8
+ unsigned int mark; // + 4 = 16
// Whatever else
};
+extern struct alloc *first_a, *last_a;
+
struct cons_alloc
{
struct alloc alloc;
diff --git a/src/lisp/main.c b/src/lisp/main.c
index 8a50a5e..d0ddeef 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -1,11 +1,12 @@
#include "compiler.h"
#include "lisp.h"
+#include "gc.h"
int main(int argc, char **argv)
{
if (argc < 2)
{
- puts("pass the string you want to parse as the first argument please");
+ puts("pass the program you want to run as the first argument please");
return 1;
}
@@ -17,7 +18,9 @@
return 1;
}
- struct environment env = compile_all (is);
- value_t (*lisp_main) () = find_function(&env, "main")->def0;
- lisp_main ();
+ struct environment env = compile_all(is);
+ value_t (*lisp_main)() = find_function(&env, "main")->def0;
+
+ gc_set_base_here();
+ lisp_main();
}
diff --git a/src/lisp/plat/plat.h b/src/lisp/plat/plat.h
index f10676c..3640005 100644
--- a/src/lisp/plat/plat.h
+++ b/src/lisp/plat/plat.h
@@ -12,3 +12,5 @@
void free_aligned(void *addr);
void *link(dasm_State **Dst);
+
+#define THREAD_LOCAL
diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp
index a8ad05e..f51ef99 100644
--- a/src/lisp/test.lisp
+++ b/src/lisp/test.lisp
@@ -1,12 +1,15 @@
(defun add-two (a)
(+ a 2))
-(defun main-old ()
- (if t
- (print (add-two (* 4 3)))
- (print (- 3 6))))
+(defun calls-gc (whatever)
+ (print whatever)
+ (gc))
(defun main ()
- (let1 (a 3)
+ (let1 (a (add-two 3))
(print "a is")
- (print a)))
+ (print a))
+
+ (let1 (unused-but-bound (cons 5 6))
+ (let1 (val (cons 1 (cons 2 (cons 3 nil))))
+ (calls-gc val))))