Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Rewrite the stack

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-07-18 22:31:01 -07:00
parent 891e5359bf
commit bd7ca2fa25
9 changed files with 343 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/stack.c
+168 -117
View File
@@ -2,6 +2,7 @@
#include "function.h"
#include "hashtable.h"
#include "list.h"
#include "memory.h"
#include <assert.h>
@@ -9,51 +10,14 @@
struct LispStack the_stack;
void lisp_init_stack(void) {
the_stack.max_depth = DEFAULT_MAX_LISP_EVAL_DEPTH;
the_stack.max_depth = LISP_STACK_MAX_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.frames = lisp_malloc(sizeof(StackFrame) * the_stack.max_depth);
the_stack.nogc_retval = Qnil;
the_stack.unwind_info.set = false;
}
static void teardown_stack_frame(struct StackFrame *restrict frame) {
for (size_t i = 0; i < frame->local_refs.num_blocks; ++i) {
lisp_free(frame->local_refs.blocks[i]);
}
lisp_free(frame->local_refs.blocks);
}
void lisp_teardown_stack(void) {
assert(the_stack.depth == 0);
for (size_t i = 0; i < the_stack.max_depth; ++i) {
teardown_stack_frame(&the_stack.frames[i]);
}
lisp_free(the_stack.frames);
}
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->evaled_args = false;
frame->args = args;
frame->lexenv = Qnil;
frame->local_refs.num_refs = 0;
frame->marked = false;
gc_mark_stack_for_rescan();
}
static void reset_local_refs(struct LocalReferences *refs) {
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) {
@@ -61,23 +25,125 @@ static void reset_local_refs(struct LocalReferences *refs) {
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 pop_stack_frame(void) {
assert(the_stack.depth > 0);
struct StackFrame *frame = &the_stack.frames[--the_stack.depth];
reset_local_refs(&frame->local_refs);
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);
}
static void store_local_reference_in_frame(struct StackFrame *frame,
LispVal *obj) {
struct LocalReferences *refs = &frame->local_refs;
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 =
@@ -87,7 +153,6 @@ static void store_local_reference_in_frame(struct StackFrame *frame,
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;
@@ -98,72 +163,78 @@ static void store_local_reference_in_frame(struct StackFrame *frame,
gc_mark_stack_for_rescan();
}
void add_local_reference_no_recurse(LispVal *obj) {
assert(the_stack.depth > 0);
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(LISP_STACK_TOP(), obj);
store_local_reference_in_frame(frame, obj);
}
}
static LispVal *next_local_reference(size_t *restrict i) {
if (*i >= LISP_STACK_TOP()->local_refs.num_refs) {
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 =
LISP_STACK_TOP()->local_refs.blocks[block_idx]->refs[small_idx];
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(LispVal *seen_objs,
LispVal *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(obj);
add_local_reference_no_recurse(frame, obj);
Fputhash(seen_objs, obj, Qt);
}
}
static inline void add_local_refs_for_object_sub_vals(LispVal *seen_objs,
LispVal *val) {
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(seen_objs,
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
((LispCons *) val)->car);
add_local_ref_if_not_seen_no_recurse(seen_objs,
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(seen_objs, sym->name);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->value);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->function);
add_local_ref_if_not_seen_no_recurse(seen_objs, sym->plist);
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(seen_objs, vec->data[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(seen_objs, HASH_KEY(val, i));
add_local_ref_if_not_seen_no_recurse(seen_objs, HASH_VALUE(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(seen_objs, fobj->name);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->docstr);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.req);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.opt);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.kw);
add_local_ref_if_not_seen_no_recurse(seen_objs, fobj->args.rest);
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:
@@ -176,54 +247,34 @@ static inline void add_local_refs_for_object_sub_vals(LispVal *seen_objs,
}
}
void add_local_reference(LispVal *obj) {
add_local_reference_no_recurse(obj);
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 = LISP_STACK_TOP()->local_refs.num_refs - 1;
size_t i = frame->local_references.num_refs - 1;
LispVal *cur;
while ((cur = next_local_reference(&i))) {
add_local_refs_for_object_sub_vals(seen_objs, 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 set_stack_evaluated_args(LispVal *args) {
assert(the_stack.depth > 0);
LISP_STACK_TOP()->evaled_args = true;
LISP_STACK_TOP()->args = args;
LISP_STACK_TOP()->marked = false;
gc_mark_stack_for_rescan();
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 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]);
}
refs->blocks =
lisp_realloc(refs->blocks, sizeof(struct LocalReferencesBlock *));
refs->num_blocks = 1;
}
bool set_lexical_variable(LispVal *name, LispVal *value,
bool create_if_absent) {
assert(the_stack.depth != 0);
DOTAILS(rest, LISP_STACK_TOP()->lexenv) {
if (EQ(XCAR(rest), name)) {
RPLACA(XCDR(rest), value);
return true;
}
}
if (create_if_absent) {
new_lexical_variable(name, value);
}
return create_if_absent;
}
void copy_parent_lexenv(void) {
assert(the_stack.depth != 0);
if (the_stack.depth > 1) {
LISP_STACK_TOP()->lexenv = the_stack.frames[the_stack.depth - 2].lexenv;
}
void set_lexical_variable(LispVal *name, LispVal *value) {
assert(SYMBOLP(name));
Vlexical_environment = Fplist_put(Vlexical_environment, name, value);
}