summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--pit/src/native.c12
-rw-r--r--pit/src/runtime/eval.c11
-rw-r--r--pit/src/runtime/gc.c11
-rw-r--r--pit/src/runtime/macroexpand.c3
-rw-r--r--pit/src/runtime/value.c3
-rw-r--r--pit/test/test2.pit2
-rw-r--r--pit/test/test3.pit2
7 files changed, 37 insertions, 7 deletions
diff --git a/pit/src/native.c b/pit/src/native.c
index 2d28679..d0989a5 100644
--- a/pit/src/native.c
+++ b/pit/src/native.c
@@ -98,16 +98,26 @@ pit_value pit_value_bytes_new_file(pit_runtime *rt, char *path) {
return ret;
}
+/* check invariants - these should always hold between top-level evaluations! */
static void check_invariants(pit_runtime *rt) {
+ if (rt->saved_bindings->next != 0) {
+ pit_error(rt, "leaked saved_bindings memory! %ld", rt->result_stack->next);
+ }
if (rt->expr_stack->next != 0) {
pit_error(rt, "leaked expr_stack memory! %ld", rt->expr_stack->next);
}
if (rt->result_stack->next != 0) {
pit_error(rt, "leaked result_stack memory! %ld", rt->result_stack->next);
}
+ if (rt->compilation_stack->next != 0) {
+ pit_error(rt, "leaked compilation_stack memory! %ld", rt->result_stack->next);
+ }
if (rt->traversal->next != 0) {
pit_error(rt, "leaked traversal memory! %ld", rt->traversal->next);
}
+ if (rt->callstack->next != 0) {
+ pit_error(rt, "leaked callstack memory! %ld", rt->result_stack->next);
+ }
}
pit_value pit_load_file(pit_runtime *rt, char *path) {
pit_lexer lex;
@@ -127,8 +137,6 @@ pit_value pit_load_file(pit_runtime *rt, char *path) {
check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
ret = pit_vm_eval(rt, compiled);
check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
- // pit_gc(rt);
- // check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
}
check_invariants(rt); if (pit_runtime_print_error(rt)) return PIT_NIL;
return ret;
diff --git a/pit/src/runtime/eval.c b/pit/src/runtime/eval.c
index f62f4e8..eba9715 100644
--- a/pit/src/runtime/eval.c
+++ b/pit/src/runtime/eval.c
@@ -1,6 +1,7 @@
#include <lcq/pit/runtime/eval.h>
-/* add a new stack frame to the vm (with a tag and callsite annotation) */
+/* add a new code frame to the vm (with a tag and callsite annotation) */
+/* bound is a list of symbols to be unbound when this frame ends */
static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pit_annotation ann, pit_value bound) {
pit_callstack_entry ent;
ent.tag = tag;
@@ -12,7 +13,7 @@ static void vm_push_code_func(pit_runtime *rt, pit_value code, pit_value tag, pi
}
}
-/* add a new stack frame to the vm (with no annotation) */
+/* add a new code frame to the vm (with no annotation) */
static void vm_push_code(pit_runtime *rt, pit_value code, pit_value bound) {
pit_annotation ann;
ann.line = -1;
@@ -20,12 +21,14 @@ static void vm_push_code(pit_runtime *rt, pit_value code, pit_value bound) {
vm_push_code_func(rt, code, PIT_NIL, ann, bound);
}
+/* push a value to the result stack */
static void vm_push(pit_runtime *rt, pit_value v) {
if (pit_vec_push(pit_value)(rt->result_stack, v) < 0) {
pit_error(rt, "vm stack overflow");
}
}
+/* pop a value from the result stack */
static pit_value vm_pop(pit_runtime *rt) {
pit_value ret = PIT_NIL;
if (pit_vec_pop(pit_value)(rt->result_stack, &ret) < 0) {
@@ -46,6 +49,7 @@ static pit_value vm_bind_or_replace(pit_runtime *rt, pit_value nm, pit_value cel
return bound;
}
+/* bind variables and push code for a call to the given lisp closure */
static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_value args, pit_value bound) {
pit_value env = pit_value_array_get(rt, closure, 0);
pit_value anames = pit_value_array_get(rt, closure, 1);
@@ -78,6 +82,7 @@ static void vm_call_lisp(pit_runtime *rt, pit_value tag, pit_value closure, pit_
vm_push_code_func(rt, body, tag, ann, bound);
}
+/* call the function f - this could be a native function or a lisp closure */
static bool vm_call(pit_runtime *rt, pit_value f, pit_value args, pit_value bound) {
char buf[256] = {0};
if (pit_value_is_symbol(rt, f)) f = pit_symtab_fget(rt, f);
@@ -147,7 +152,7 @@ static pit_value vm_erase_empty(pit_runtime *rt, bool unbind) {
/* run one instruction of the VM */
bool pit_vm_run_one(pit_runtime *rt) {
vm_erase_empty(rt, true);
- if (rt->callstack->next < 1) return false;
+ if (rt->callstack->next < 1 || rt->error != PIT_NIL) return false;
pit_callstack_entry *ent = pit_vec_get(pit_callstack_entry)(rt->callstack, rt->callstack->next - 1);
if (ent == NULL) { pit_error(rt, "malformed call stack"); return false; }
pit_value ins = pit_value_cons_car(rt, ent->code);
diff --git a/pit/src/runtime/gc.c b/pit/src/runtime/gc.c
index 7fd42fa..e7b9e8d 100644
--- a/pit/src/runtime/gc.c
+++ b/pit/src/runtime/gc.c
@@ -1,6 +1,7 @@
#include <lcq/pit/arena.h>
#include <lcq/pit/runtime/gc.h>
+/* copy a heavy value from fromspace to tospace, returning its new index */
static i64 gc_copy(pit_runtime *rt, pit_value_heavy *h) {
if (h->hsort == PIT_VALUE_HEAVY_SORT_FORWARDING_POINTER) {
return h->in.forwarding_pointer;
@@ -13,6 +14,8 @@ static i64 gc_copy(pit_runtime *rt, pit_value_heavy *h) {
return ret;
}
}
+/* copy some lisp value from fromspace to tospace, returning the new value */
+/* (this only changes heavy values, since they live on the heap) */
static pit_value gc_copy_value(pit_runtime *rt, pit_value v) {
if (pit_value_sort(v) == PIT_VALUE_SORT_REF) {
pit_ref r = pit_value_as_ref(rt, v);
@@ -29,6 +32,10 @@ static pit_value gc_copy_value(pit_runtime *rt, pit_value v) {
}
}
+/* collect garbage */
+/* this uses Cheney's algorithm: https://en.wikipedia.org/wiki/Cheney%27s_algorithm */
+/* note that only the symbol table, saved bindings, and VM state (code / value stacks) are roots */
+/* any pit_value saved elsewhere could be invalidated by garbage collection if it is unreachable! */
void pit_gc(pit_runtime *rt) {
rt->frozen_values = 0;
rt->frozen_symtab = 0;
@@ -115,6 +122,10 @@ void pit_gc(pit_runtime *rt) {
pit_hashtable_reset(pit_ref, pit_annotation)(rt->annotations_backbuffer);
}
+/* collect garbage if necessary. this is run between every instruction evaluation in the VM. */
+/* currently we use a simple heuristic: if the heap is using more than 80% of the available space */
+/* note that this is could be weird in a heap with very few heavy values but a lot of data (strings etc.) */
+/* TODO do research on better heuristics */
void pit_gc_if_necessary(pit_runtime *rt) {
if (pit_arena_byte_idx(rt->heap, rt->heap->next * 5) > rt->heap->back * 4) {
pit_gc(rt);
diff --git a/pit/src/runtime/macroexpand.c b/pit/src/runtime/macroexpand.c
index 9a557dd..042a972 100644
--- a/pit/src/runtime/macroexpand.c
+++ b/pit/src/runtime/macroexpand.c
@@ -1,5 +1,6 @@
#include <lcq/pit/runtime/macroexpand.h>
+/* perform a single round of macro expansion */
pit_value pit_macroexpand_1(pit_runtime *rt, pit_value top) {
i64 expr_stack_reset = rt->expr_stack->next;
i64 result_stack_reset = rt->result_stack->next;
@@ -95,6 +96,8 @@ end: {
}
}
+/* repeatedly macroexpand_1 until we arrive at a fixpoint */
+/* (hopefully this expands all macros :] ) */
pit_value pit_macroexpand(pit_runtime *rt, pit_value prev) {
pit_value next = prev;
do {
diff --git a/pit/src/runtime/value.c b/pit/src/runtime/value.c
index b32d154..6354f60 100644
--- a/pit/src/runtime/value.c
+++ b/pit/src/runtime/value.c
@@ -18,10 +18,13 @@ pit_value pit_value_new(pit_runtime *rt, enum pit_value_sort s, u64 data) {
| (data & 0x1ffffffffffff);
}
+/* shallow equality - are these references to the same thing? */
bool pit_value_eq(pit_value a, pit_value b) {
return a == b;
}
+/* deep equality - are all components of these structures equal, recursively? */
+/* TODO eliminate C recursion here */
bool pit_value_equal(pit_runtime *rt, pit_value a, pit_value b) {
if (pit_value_sort(a) != pit_value_sort(b)) return false;
switch (pit_value_sort(a)) {
diff --git a/pit/test/test2.pit b/pit/test/test2.pit
index 79a9791..a86f8d2 100644
--- a/pit/test/test2.pit
+++ b/pit/test/test2.pit
@@ -1 +1 @@
-(print "hello from test2")
+(print! "hello from test2")
diff --git a/pit/test/test3.pit b/pit/test/test3.pit
index 2febb75..1964242 100644
--- a/pit/test/test3.pit
+++ b/pit/test/test3.pit
@@ -1,6 +1,6 @@
(let ((bs (bs/new!)))
(print! bs)
- (bs/grow! 1 bs)
+ ;; (bs/grow! 1 bs)
(bs/write8! bs 0 67)
(bs/spit! "test3.bin" bs)
;; (bs/delete! bs)