#include "stack.h" #include "function.h" #include "hashtable.h" #include "list.h" #include "memory.h" #include 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); }