281 lines
10 KiB
C
281 lines
10 KiB
C
#include "stack.h"
|
|
|
|
#include "function.h"
|
|
#include "hashtable.h"
|
|
#include "list.h"
|
|
#include "memory.h"
|
|
|
|
#include <assert.h>
|
|
|
|
struct LispStack the_stack;
|
|
|
|
void lisp_init_stack(void) {
|
|
the_stack.max_depth = LISP_STACK_MAX_DEPTH;
|
|
the_stack.depth = 0;
|
|
the_stack.frames = lisp_malloc(sizeof(StackFrame) * the_stack.max_depth);
|
|
the_stack.nogc_retval = Qnil;
|
|
the_stack.unwind_info.set = false;
|
|
}
|
|
|
|
static void teardown_local_references(struct LocalReferences *restrict refs) {
|
|
size_t last_block_size = refs->num_refs % LOCAL_REFERENCES_BLOCK_LENGTH;
|
|
size_t num_full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH;
|
|
for (size_t i = 0; i < num_full_blocks; ++i) {
|
|
for (size_t j = 0; j < LOCAL_REFERENCES_BLOCK_LENGTH; ++j) {
|
|
assert(OBJECTP(refs->blocks[i]->refs[j]));
|
|
SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[i]->refs[j], false);
|
|
}
|
|
lisp_free(refs->blocks[i]);
|
|
}
|
|
for (size_t i = 0; i < last_block_size; ++i) {
|
|
assert(OBJECTP(refs->blocks[num_full_blocks]->refs[i]));
|
|
SET_OBJECT_HAS_LOCAL_REFERENCE(refs->blocks[num_full_blocks]->refs[i],
|
|
false);
|
|
}
|
|
lisp_free(refs->blocks[num_full_blocks]);
|
|
lisp_free(refs->blocks);
|
|
}
|
|
|
|
void lisp_teardown_stack(void) {
|
|
for (size_t i = 0; i < the_stack.depth; ++i) {
|
|
if (the_stack.frames[i].kind == STACK_FRAME_LOCAL_REFERENCES) {
|
|
teardown_local_references(&the_stack.frames[i].local_references);
|
|
}
|
|
}
|
|
lisp_free(the_stack.frames);
|
|
}
|
|
|
|
void unwind_to(StackFrame *frame) {
|
|
the_stack.unwind_info.set = true;
|
|
the_stack.unwind_info.cause = UNWIND_NORMAL;
|
|
the_stack.unwind_info.target = frame;
|
|
while (&the_stack.frames[the_stack.depth - 1] > frame) {
|
|
StackFrame *restrict top = &the_stack.frames[--the_stack.depth];
|
|
switch (top->kind) {
|
|
case STACK_FRAME_DYNAMIC_BINDING:
|
|
if (top->dynamic_binding.symbol == Qlexical_environment) {
|
|
Vlexical_environment = top->dynamic_binding.old_value;
|
|
} else {
|
|
SET_SYMBOL_VALUE(top->dynamic_binding.symbol,
|
|
top->dynamic_binding.old_value);
|
|
}
|
|
break;
|
|
case STACK_FRAME_UNWIND_PROTECT:
|
|
longjmp(*top->unwind_protect.target, LISP_LONGJMP_FOR_UNWIND);
|
|
case STACK_FRAME_LOCAL_REFERENCES:
|
|
teardown_local_references(&top->local_references);
|
|
break;
|
|
case STACK_FRAME_CALL:
|
|
case STACK_FRAME_CONDITION_CASE:
|
|
// nothing to do
|
|
break;
|
|
}
|
|
}
|
|
the_stack.unwind_info.set = false;
|
|
}
|
|
|
|
noreturn void continue_unwinding(void) {
|
|
assert(the_stack.unwind_info.set);
|
|
switch (the_stack.unwind_info.cause) {
|
|
case UNWIND_NORMAL:
|
|
unwind_to(the_stack.unwind_info.target);
|
|
case UNWIND_EXCEPTION:
|
|
// TODO implement
|
|
abort();
|
|
default:
|
|
abort();
|
|
}
|
|
}
|
|
|
|
static ALWAYS_INLINE StackFrame *PUSH_NEW_FRAME(enum StackFrameKind kind) {
|
|
if (the_stack.depth == the_stack.max_depth) {
|
|
// TODO error
|
|
abort();
|
|
}
|
|
StackFrame *last_refs =
|
|
the_stack.depth ? the_stack.frames[the_stack.depth - 1].last_references
|
|
: NULL;
|
|
StackFrame *frame = &the_stack.frames[the_stack.depth++];
|
|
frame->kind = kind;
|
|
frame->marked = false;
|
|
frame->last_references = last_refs;
|
|
gc_mark_stack_for_rescan();
|
|
return frame;
|
|
}
|
|
|
|
void push_call_frame(LispVal *name, LispVal *fobj, LispVal *args) {
|
|
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_CALL);
|
|
frame->call.name = name;
|
|
frame->call.fobj = fobj;
|
|
frame->call.args = args;
|
|
frame->call.evaled_args = false;
|
|
}
|
|
|
|
void set_stack_evaluated_args(StackFrame *restrict frame, LispVal *args) {
|
|
gc_mark_stack_for_rescan();
|
|
assert(frame->kind == STACK_FRAME_CALL);
|
|
frame->call.args = args;
|
|
frame->call.evaled_args = true;
|
|
}
|
|
|
|
void push_unwind_protect_frame(jmp_buf *buf) {
|
|
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_UNWIND_PROTECT);
|
|
frame->unwind_protect.target = buf;
|
|
}
|
|
|
|
void push_condition_case_frame(jmp_buf *buf, LispVal **variable,
|
|
LispVal *exceptions) {
|
|
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_CONDITION_CASE);
|
|
frame->condition_case.target = buf;
|
|
frame->condition_case.variable = variable;
|
|
frame->condition_case.exceptions = exceptions;
|
|
*variable = Qnil;
|
|
}
|
|
|
|
void push_local_reference_frame(void) {
|
|
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_LOCAL_REFERENCES);
|
|
struct LocalReferences *refs = &frame->local_references;
|
|
refs->num_refs = 0;
|
|
refs->num_blocks = 1;
|
|
refs->blocks = lisp_malloc(sizeof(struct LocalReferencesBlock *));
|
|
refs->blocks[0] = lisp_malloc(sizeof(struct LocalReferencesBlock));
|
|
frame->last_references = frame;
|
|
}
|
|
|
|
static void store_local_reference_in_frame(StackFrame *frame, LispVal *obj) {
|
|
struct LocalReferences *restrict refs = &frame->local_references;
|
|
size_t num_full_blocks = refs->num_refs / LOCAL_REFERENCES_BLOCK_LENGTH;
|
|
if (num_full_blocks == refs->num_blocks) {
|
|
refs->blocks =
|
|
lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *)
|
|
* ++refs->num_blocks);
|
|
refs->blocks[refs->num_blocks - 1] =
|
|
lisp_malloc(sizeof(struct LocalReferencesBlock));
|
|
refs->blocks[refs->num_blocks - 1]->refs[0] = obj;
|
|
refs->num_refs += 1;
|
|
} else {
|
|
refs->blocks[num_full_blocks]
|
|
->refs[refs->num_refs++ % LOCAL_REFERENCES_BLOCK_LENGTH] = obj;
|
|
}
|
|
SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true);
|
|
// mark the frame for rescan
|
|
frame->marked = false;
|
|
gc_mark_stack_for_rescan();
|
|
}
|
|
|
|
void add_local_reference_no_recurse(StackFrame *restrict frame, LispVal *obj) {
|
|
frame = frame->last_references;
|
|
assert(frame->kind == STACK_FRAME_LOCAL_REFERENCES);
|
|
if (OBJECTP(obj) && !OBJECT_HAS_LOCAL_REFERENCE_P(obj)) {
|
|
store_local_reference_in_frame(frame, obj);
|
|
}
|
|
}
|
|
|
|
static LispVal *next_local_reference(StackFrame *restrict frame,
|
|
size_t *restrict i) {
|
|
if (*i >= frame->local_references.num_refs) {
|
|
return NULL;
|
|
}
|
|
size_t block_idx = *i / LOCAL_REFERENCES_BLOCK_LENGTH;
|
|
size_t small_idx = *i % LOCAL_REFERENCES_BLOCK_LENGTH;
|
|
LispVal *obj = frame->local_references.blocks[block_idx]->refs[small_idx];
|
|
++*i;
|
|
return obj;
|
|
}
|
|
|
|
static inline void
|
|
add_local_ref_if_not_seen_no_recurse(StackFrame *restrict frame,
|
|
LispVal *seen_objs, LispVal *obj) {
|
|
if (NILP(Fgethash(seen_objs, obj, Qnil))) {
|
|
add_local_reference_no_recurse(frame, obj);
|
|
Fputhash(seen_objs, obj, Qt);
|
|
}
|
|
}
|
|
|
|
static inline void
|
|
add_local_refs_for_object_sub_vals(StackFrame *restrict frame,
|
|
LispVal *seen_objs, LispVal *val) {
|
|
switch (((LispObject *) val)->type) {
|
|
case TYPE_CONS:
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
|
|
((LispCons *) val)->car);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
|
|
((LispCons *) val)->cdr);
|
|
break;
|
|
case TYPE_SYMBOL: {
|
|
LispSymbol *sym = val;
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->name);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->value);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->function);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->plist);
|
|
break;
|
|
}
|
|
case TYPE_VECTOR: {
|
|
LispVector *vec = val;
|
|
for (size_t i = 0; i < vec->length; ++i) {
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
|
|
vec->data[i]);
|
|
}
|
|
break;
|
|
}
|
|
case TYPE_HASH_TABLE: {
|
|
HT_FOREACH_INDEX(val, i) {
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
|
|
HASH_KEY(val, i));
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
|
|
HASH_VALUE(val, i));
|
|
}
|
|
break;
|
|
}
|
|
case TYPE_FUNCTION: {
|
|
LispFunction *fobj = val;
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->name);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->docstr);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->args.req);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->args.opt);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->args.kw);
|
|
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, fobj->args.rest);
|
|
break;
|
|
}
|
|
case TYPE_STRING:
|
|
// no held refs
|
|
break;
|
|
case TYPE_FIXNUM:
|
|
case TYPE_FLOAT:
|
|
default:
|
|
abort();
|
|
}
|
|
}
|
|
|
|
void add_local_reference(StackFrame *restrict frame, LispVal *obj) {
|
|
frame = frame->last_references;
|
|
assert(frame->kind == STACK_FRAME_LOCAL_REFERENCES);
|
|
add_local_reference_no_recurse(frame, obj);
|
|
LispVal *seen_objs = make_hash_table_no_gc(Qnil, Qnil);
|
|
Fputhash(seen_objs, obj, Qt);
|
|
size_t i = frame->local_references.num_refs - 1;
|
|
LispVal *cur;
|
|
while ((cur = next_local_reference(frame, &i))) {
|
|
add_local_refs_for_object_sub_vals(frame, seen_objs, cur);
|
|
}
|
|
release_hash_table_no_gc(seen_objs);
|
|
}
|
|
|
|
void push_dynamic_binding(LispVal *name, LispVal *new_value) {
|
|
assert(SYMBOLP(name));
|
|
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_DYNAMIC_BINDING);
|
|
frame->dynamic_binding.symbol = name;
|
|
if (name == Qlexical_environment) {
|
|
frame->dynamic_binding.old_value = Vlexical_environment;
|
|
Vlexical_environment = new_value;
|
|
} else {
|
|
frame->dynamic_binding.old_value = SYMBOL_VALUE(name);
|
|
SET_SYMBOL_VALUE(name, new_value);
|
|
}
|
|
}
|
|
|
|
void set_lexical_variable(LispVal *name, LispVal *value) {
|
|
assert(SYMBOLP(name));
|
|
Vlexical_environment = Fplist_put(Vlexical_environment, name, value);
|
|
}
|