Add GC segments to differentiate C stack space from Lisp
diff --git a/src/lisp/compiler.dasc b/src/lisp/compiler.dasc
index 122538c..e0e4eff 100644
--- a/src/lisp/compiler.dasc
+++ b/src/lisp/compiler.dasc
@@ -531,9 +531,12 @@
value_t eval(struct environment *env, value_t form)
{
+ gc_push_segment(&form, 1);
// Eval!
value_t function = cons(nil, cons(form, nil));
+ gc_set_retained(0, function);
+
struct local local;
struct args *args;
@@ -550,7 +553,13 @@
del_local(&local);
value_t (*f)() = link_program(&d);
- return f();
+
+ gc_prepare_call(0);
+ value_t val = f();
+
+ gc_pop_segment();
+
+ return val;
}
struct error compile_variable(struct variable *v, dasm_State *Dst)
diff --git a/src/lisp/gc.c b/src/lisp/gc.c
index 140bc3f..a6d88ac 100644
--- a/src/lisp/gc.c
+++ b/src/lisp/gc.c
@@ -1,8 +1,10 @@
#include "gc.h"
#include "lisp.h"
#include "plat/plat.h"
+#include <stdlib.h>
value_t *gc_base;
+struct gc_segment *gc_last_segment = NULL;
THREAD_LOCAL static unsigned int gc_mark;
THREAD_LOCAL static unsigned long gc_runs = 0;
@@ -14,6 +16,52 @@
asm("movl %%esp, %0" : "=g"(gc_base));
}
+void gc_push_segment(void *last_arg_addr, int nretained)
+{
+ // base will be the address below (at higher memory than) the ret
+ // pointer when lisp func is called.
+ struct gc_segment *seg = malloc(sizeof(struct gc_segment) + sizeof(value_t) * nretained);
+
+ if (last_arg_addr)
+ seg->seg_start = last_arg_addr + 4;
+ else
+ seg->seg_start = NULL;
+
+ seg->nretained = nretained;
+ seg->prev = gc_last_segment;
+ gc_last_segment = seg;
+
+ // remember, stack looks like this:
+ // ret
+ // old ebp <- current ebp points here
+ // ...
+ void **ebp;
+ asm("movl %%ebp, %0" : "=g"(ebp));
+ seg->old_ebp = *ebp; // could do this in one mov but whatever
+}
+
+void gc_pop_segment()
+{
+ struct gc_segment *prev = gc_last_segment->prev;
+ free(gc_last_segment);
+ gc_last_segment = prev;
+}
+
+void gc_prepare_call_(void *esp, int nargs)
+{
+ gc_last_segment->nargs = nargs;
+ // esp points to its position BEFORE the lisp function is
+ // called. So seg_end is that + return pointer + arguments.
+ gc_last_segment->seg_end = esp + 4 + sizeof(value_t) * nargs;
+}
+
+void gc_set_retained(int index, value_t retained)
+{
+ gc_last_segment->retained[index] = retained;
+}
+
+void gc_set_retained(int index, value_t retained);
+
void _mark(value_t value, unsigned int *marked)
{
if (heapp(value))
@@ -134,23 +182,47 @@
gc_mark++;
gc_runs++;
- // For every stack frame until the base of the stack
- while (esp_p < gc_base)
+ for (struct gc_segment *seg = gc_last_segment; seg && seg->seg_start; seg = seg->prev)
{
- // 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++)
+ // For every stack frame until the base of the stack
+ while (esp_p < (value_t *)seg->seg_end)
{
- _mark(*esp_p, &num_marked);
+ // 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;
}
- // Set the frame pointer to the frame pointer on the stack
- ebp_p = (value_t *)*esp_p;
+ // skip above ret pointer
+ value_t *args = seg->seg_end + 4;
+ for (int i = 0; i < seg->nargs; i++)
+ {
+ fprintf(stderr, "Marking arg %d\n", i);
- // Step up two stack slots, one for the frame pointer and one for the
- // return address.
- esp_p += 2;
+ // mark arguments
+ _mark(args[i], &num_marked);
+ }
+
+ for (int i = 0; i < seg->nretained; i++)
+ {
+ fprintf(stderr, "Marking retained %d\n", i);
+ printval(seg->retained[i], 0);
+
+ _mark(seg->retained[i], &num_marked);
+ }
+
+ esp_p = seg->seg_start;
+ ebp_p = seg->old_ebp;
}
_sweep();
diff --git a/src/lisp/gc.h b/src/lisp/gc.h
index 789e124..77e382a 100644
--- a/src/lisp/gc.h
+++ b/src/lisp/gc.h
@@ -4,6 +4,47 @@
// I hate this
extern value_t *gc_base;
+extern struct gc_segment *gc_last_segment;
+
+struct gc_segment
+{
+ struct gc_segment *prev;
+
+ // The address of the first dword on the stack below the return
+ // pointer for this function (i.e. when the procedure is first
+ // `call`'d, this is esp+4)
+ void *seg_start;
+
+ // The address of the return pointer for the subsequently called
+ // function on the stack. When the lisp function is called,
+ // seg_end=esp.
+ void *seg_end;
+
+ // The number of arguments passed to the lisp function. These are
+ // stored in order on the stack, starting at seg_end+4, each
+ // taking 1 dword of memory.
+ int nargs;
+
+ // The value of ebp as it was when the function was first
+ // invoked. This denotes the caller's stack frame.
+ void *old_ebp;
+
+ // The number of lisp values which are retained by this C
+ // function.
+ int nretained;
+ value_t retained[];
+};
+
+#define gc_prepare_call(nargs) \
+ { \
+ void *__gc_segment_base; \
+ asm("movl %%esp, %0" : "=g"(__gc_segment_base)); \
+ gc_prepare_call_(__gc_segment_base, nargs); \
+ }
+void gc_push_segment(void *last_arg_addr, int nretained);
+void gc_pop_segment();
+void gc_prepare_call_(void *esp, int nargs);
+void gc_set_retained(int index, value_t retained);
struct gc_stats
{
diff --git a/src/lisp/main.c b/src/lisp/main.c
index a9231b8..2a37b4c 100644
--- a/src/lisp/main.c
+++ b/src/lisp/main.c
@@ -5,6 +5,8 @@
int main(int argc, char **argv)
{
+ gc_push_segment(NULL, 0);
+
if (argc < 2)
{
puts("pass the program you want to run as the first argument please");
@@ -25,7 +27,7 @@
if (lisp_main_f)
{
value_t (*lisp_main)() = lisp_main_f->def0;
- gc_set_base_here();
+ gc_prepare_call(0);
lisp_main();
}
else
diff --git a/src/lisp/test-gc.lisp b/src/lisp/test-gc.lisp
index a41e146..af4795f 100644
--- a/src/lisp/test-gc.lisp
+++ b/src/lisp/test-gc.lisp
@@ -1,3 +1,8 @@
+(defun test-gc-eval ()
+ (eval '(progn
+ (list "hello" "world")
+ (gc))))
+
(defun main ()
;; Allocate some garbage
(let1 (used "this should NOT be freed")
@@ -5,7 +10,9 @@
(list "this" "is" "a" "list")
(gc)
(print (list "Current allocations" "GC runs"))
- (print (gc-stats))))
+ (print (gc-stats)))
+ (print "testing gc in eval")
+ (test-gc-eval))
;; Note: This should print that it is freeing both lists, but not the
;; string