Add allocation pools, release memory in GC
diff --git a/doc/index.rst b/doc/index.rst
index 5baa0ef..043078f 100644
--- a/doc/index.rst
+++ b/doc/index.rst
@@ -13,11 +13,18 @@
:maxdepth: 2
:caption: Contents:
:glob:
+ :hidden:
- *
+ build
+ architecture
+ filesystem
+ lisp-std
+ lisp-api
+ logging
+ kernel-api
Bluejay is an operating system inspired by UNIX and early Lisp machines.
Currently it only targets x86. There are no plans to port to other platforms.
-This documentation is incomplete, but should provide a general introduction to
-compiling and developing Bluejay.
+This documentation should provide an introduction to compiling, developing, and
+using Bluejay.
diff --git a/doc/kernel.doxyfile b/doc/kernel.doxyfile
index 5d5f1e1..7c84a84 100644
--- a/doc/kernel.doxyfile
+++ b/doc/kernel.doxyfile
@@ -829,7 +829,7 @@
# spaces. See also FILE_PATTERNS and EXTENSION_MAPPING
# Note: If this tag is empty the current directory is searched.
-INPUT = ../src/kernel
+INPUT = ../src/kernel ../include/kernel
# This tag can be used to specify the character encoding of the source files
# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses
@@ -898,7 +898,7 @@
# Note that the wildcards are matched against the file with absolute path, so to
# exclude all test directories use the pattern */test/*
-EXCLUDE_SYMBOLS =
+EXCLUDE_SYMBOLS = isr* irq* KBD_* MULTIBOOT_* _*
# The EXAMPLE_PATH tag can be used to specify one or more files or directories
# that contain example code fragments that are included (see the \include
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index b3cdb9a..bc5aec8 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -195,6 +195,9 @@
struct environment compile_all(struct istream *is)
{
+ unsigned char pool = make_pool();
+ unsigned char pop = push_pool(pool);
+
value_t val;
struct environment env;
env.first = NULL;
@@ -205,6 +208,8 @@
compile_tl(val, &env);
}
+ pop_pool(pop);
+
return env;
}
diff --git a/src/lisp/gc.c b/src/lisp/gc.c
index 84df7aa..b9e9574 100644
--- a/src/lisp/gc.c
+++ b/src/lisp/gc.c
@@ -56,8 +56,27 @@
{
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);
+ if (pool_alive(a->pool) || a->mark == gc_mark)
+ {
+ // Marked or in living pool
+ }
+ else
+ {
+ printf("Freeing:\n");
+ printval(alloc_to_value(a), 2);
+
+ // Free and remove from allocation list
+ struct alloc *p = a->prev, *n = a->next;
+ free_aligned(a);
+
+ a = n;
+
+ if (p)
+ p->next = n;
+
+ if (n)
+ n->prev = p;
+ }
}
}
@@ -95,3 +114,13 @@
_sweep();
}
+
+void free_all()
+{
+ for (struct alloc *a = first_a; a;)
+ {
+ struct alloc *next = a->next;
+ free_aligned(a);
+ a = next;
+ }
+}
diff --git a/src/lisp/gc.h b/src/lisp/gc.h
index a75cadd..8623cba 100644
--- a/src/lisp/gc.h
+++ b/src/lisp/gc.h
@@ -11,3 +11,4 @@
void _do_gc(unsigned int esp, unsigned int ebp);
void _mark(value_t value, unsigned int *marked);
void _sweep();
+void free_all();
diff --git a/src/lisp/lisp.c b/src/lisp/lisp.c
index a015d4e..2d920ea 100644
--- a/src/lisp/lisp.c
+++ b/src/lisp/lisp.c
@@ -12,6 +12,8 @@
value_t nil = 0b00101111; // magic ;)
value_t t = 1 << 3;
+unsigned char max_pool = 0, current_pool = 0;
+
void err(const char *msg)
{
fprintf(stderr, "ERROR: %s\n", msg);
@@ -34,6 +36,7 @@
c->cdr = cdr;
item->alloc.type_tag = CONS_TAG;
+ item->alloc.pool = current_pool;
if (last_a)
{
@@ -56,8 +59,20 @@
void skipws(struct istream *is)
{
+start:
while (isspace(is->peek(is)))
is->get(is);
+
+ if (is->peek(is) == ';')
+ {
+ while (is->get(is) != '\n')
+ {}
+
+ // Only time I ever use labels is for stuff like this. Compiler would
+ // probably optimize this if I used recursion but I don't want to
+ // bother.
+ goto start;
+ }
}
bool isallowedchar(char c)
@@ -406,3 +421,25 @@
return strcmp((char *)(sym ^ SYMBOL_TAG), str) == 0;
}
+
+unsigned char make_pool()
+{
+ return ++max_pool;
+}
+
+unsigned char push_pool(unsigned char pool)
+{
+ unsigned char old = current_pool;
+ current_pool = pool;
+ return old;
+}
+
+void pop_pool(unsigned char pool)
+{
+ current_pool = pool;
+}
+
+bool pool_alive(unsigned char pool)
+{
+ return pool != 0;
+}
diff --git a/src/lisp/lisp.h b/src/lisp/lisp.h
index 03ab75e..9078b45 100644
--- a/src/lisp/lisp.h
+++ b/src/lisp/lisp.h
@@ -30,14 +30,36 @@
value_t car, cdr;
};
+/// Default pool (no pool)
+#define NO_POOL 0
+
+/**
+ * The max used pool number, don't touch this.
+ */
+extern unsigned char max_pool;
+
+/**
+ * Current allocation pool, default 0 (no pool)
+ */
+extern unsigned char current_pool;
// It is integral that this be 16 bytes long so that whatever follows it is
// still aligned to 4 bits.
struct alloc
{
+ /**
+ * One of the type tags, eg CONS_TAG, etc
+ */
unsigned int type_tag; // 4
struct alloc *prev, *next; // + 8
- unsigned int mark; // + 4 = 16
+ /**
+ * Zero if this is not part of a release pool, pool number otherwise.
+ */
+ unsigned char pool; // + 1
+ /**
+ * Reserved for the GC.
+ */
+ unsigned int mark : 24; // + 2 = 16
// Whatever else
};
@@ -50,6 +72,27 @@
struct cons cons;
};
+/**
+ * Create a new allocation pool.
+ */
+unsigned char make_pool();
+
+/**
+ * Set the allocation pull
+ * @returns the old pool, you should reset this later with pop_pool.
+ */
+unsigned char push_pool(unsigned char pool);
+
+/**
+ * Set the allocation pool and throw away the old value.
+ */
+void pop_pool(unsigned char pool);
+
+/**
+ * @returns true if pool is still alive (in scope).
+ */
+bool pool_alive(unsigned char pool);
+
bool startswith(struct istream *s, char *pattern);
bool readsym(struct istream *is, value_t *val);
diff --git a/src/lisp/main.c b/src/lisp/main.c
index d0ddeef..95eb196 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -23,4 +23,6 @@
gc_set_base_here();
lisp_main();
+
+ free_all();
}
diff --git a/src/lisp/test.lisp b/src/lisp/test.lisp
index f51ef99..9cfb8b7 100644
--- a/src/lisp/test.lisp
+++ b/src/lisp/test.lisp
@@ -9,7 +9,11 @@
(let1 (a (add-two 3))
(print "a is")
(print a))
+
+ ; These allocations should be freed
+ (cons 12 (cons 34 (cons 45 nil)))
+ ; But these should not
(let1 (unused-but-bound (cons 5 6))
(let1 (val (cons 1 (cons 2 (cons 3 nil))))
(calls-gc val))))