#include "stack.h" #include "hashtable.h" #include "memory.h" #include struct LispStack the_stack; void lisp_init_stack(void) { the_stack.max_depth = DEFAULT_MAX_LISP_EVAL_DEPTH; the_stack.depth = 0; the_stack.first_clear_local_refs = 0; the_stack.frames = lisp_malloc(sizeof(struct StackFrame) * the_stack.max_depth); for (size_t i = 0; i < the_stack.max_depth; ++i) { the_stack.frames[i].local_refs.num_refs = 0; the_stack.frames[i].local_refs.num_blocks = 1; the_stack.frames[i].local_refs.blocks = lisp_malloc(sizeof(struct LocalReferencesBlock *)); the_stack.frames[i].local_refs.blocks[0] = lisp_malloc(sizeof(struct LocalReferencesBlock)); } the_stack.nogc_retval = Qnil; } void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args) { assert(the_stack.depth < the_stack.max_depth); struct StackFrame *frame = &the_stack.frames[the_stack.depth++]; frame->name = name; frame->fobj = fobj; frame->args = args; frame->lexenv = Qnil; frame->local_refs.num_refs = 0; } static void reset_local_refs(struct LocalReferences *refs) { size_t last_block_size = refs->num_refs % LOCAL_REFERENCES_BLOCK_LENGTH; size_t num_full_blocks = refs->num_blocks / 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); } } 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); } } void pop_stack_frame(void) { assert(the_stack.depth > 0); struct StackFrame *frame = &the_stack.frames[--the_stack.depth]; reset_local_refs(&frame->local_refs); } static void store_local_reference_in_frame(struct StackFrame *frame, LispVal *obj) { struct LocalReferences *refs = &frame->local_refs; 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; the_stack.first_clear_local_refs = the_stack.depth; } else { refs->blocks[num_full_blocks] ->refs[refs->num_refs++ % LOCAL_REFERENCES_BLOCK_LENGTH] = obj; } } void add_local_reference_no_recurse(LispVal *obj) { assert(the_stack.depth > 0); if (OBJECTP(obj) && !OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { store_local_reference_in_frame(LISP_STACK_TOP(), obj); } } void add_local_reference(LispVal *obj) { add_local_reference_no_recurse(obj); LispVal *seen_objs = make_hash_table_no_gc(Qnil, Qnil); ObjectProcessStack stack; init_object_process_stack(&stack); object_process_stack_push_held_objects(&stack, obj); while (!OBJECT_PROCESS_STACK_EMPTY_P(&stack)) { LispVal *top = object_process_stack_pop(&stack); assert(OBJECTP(top)); if (!OBJECT_HAS_LOCAL_REFERENCE_P(obj)) { store_local_reference_in_frame(LISP_STACK_TOP(), top); SET_OBJECT_HAS_LOCAL_REFERENCE(obj, true); } if (NILP(Fgethash(seen_objs, obj, Qnil))) { object_process_stack_push_held_objects(&stack, top); Fputhash(seen_objs, obj, Qt); } } free_object_process_stack(&stack); release_hash_table_no_gc(seen_objs); } void compact_stack_frame(struct StackFrame *restrict frame) { struct LocalReferences *restrict refs = &frame->local_refs; for (size_t i = 1; i < refs->num_blocks; ++i) { lisp_free(refs->blocks[i]); } lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *)); refs->num_blocks = 1; }