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/base.c
+4 -1
View File
@@ -37,7 +37,7 @@ void *lisp_alloc_object(size_t size, LispValType type) {
lisp_gc_yield(NULL, false);
}
if (the_stack.depth > 0) {
add_local_reference_no_recurse(obj);
add_local_reference_no_recurse(LISP_STACK_REF(), obj);
}
lisp_gc_register_object(obj);
return obj;
@@ -74,6 +74,9 @@ noreturn void signal_type_error(LispVal *obj, LispVal *typespec) {
DEFINE_SYMBOL(nil, "nil");
DEFINE_SYMBOL(t, "t");
DEFINE_SYMBOL(unbound, "unbound");
DEFINE_SYMBOL(lexical_environment, "lexical-environment");
LispVal *Vlexical_environment;
DEFUN(id, "id", (LispVal * obj), "(id)", "") {
// TODO not all values are handled here
src/base.h
+13
View File
@@ -278,6 +278,9 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
DECLARE_SYMBOL(nil);
DECLARE_SYMBOL(t);
DECLARE_SYMBOL(unbound);
DECLARE_SYMBOL(lexical_environment);
extern LispVal *Vlexical_environment;
static ALWAYS_INLINE bool NILP(LispVal *val) {
return val == Qnil;
@@ -302,6 +305,16 @@ DECLARE_FUNCTION(setplist, (LispVal * sym, LispVal *plist));
DECLARE_FUNCTION(get, (LispVal * sym, LispVal *key, LispVal *def));
DECLARE_FUNCTION(put, (LispVal * sym, LispVal *key, LispVal *val));
static ALWAYS_INLINE LispVal *SYMBOL_VALUE(LispVal *sym) {
assert(SYMBOLP(sym));
return ((LispSymbol *) sym)->value;
}
static ALWAYS_INLINE void SET_SYMBOL_VALUE(LispVal *sym, LispVal *value) {
assert(SYMBOLP(sym));
((LispSymbol *) sym)->value = value;
}
// condition stuff
DECLARE_SYMBOL(condition_class);
DECLARE_FUNCTION(condition_class_p, (LispVal * val));
src/function.c
+20 -16
View File
@@ -240,10 +240,10 @@ static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) {
LispVal *end;
DOLIST(arg, args) {
if (NILP(start)) {
start = CONS(Feval(arg, PARENT_LEXENV()), Qnil);
start = CONS(Feval(arg, Vlexical_environment), Qnil);
end = start;
} else {
RPLACD(end, CONS(Feval(arg, PARENT_LEXENV()), Qnil));
RPLACD(end, CONS(Feval(arg, Vlexical_environment), Qnil));
end = XCDR(end);
}
}
@@ -330,11 +330,12 @@ process_complex_native_args(LispFunction *fobj, LispVal *args,
static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
LispFunction *fobj, LispVal *args) {
push_stack_frame(orig_func, fobj, args);
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(orig_func, fobj, args);
if (!fobj->impl.native.no_eval_args) {
args = evaluate_function_arguments(args);
}
set_stack_evaluated_args(args);
set_stack_evaluated_args(LISP_STACK_REF(), args);
LispVal *arg_arr[MAX_NATIVE_FUNCTION_ARGS] = {NULL};
size_t count = NATIVE_FUNCTION_TOTAL_ARG_COUNT(fobj);
intptr_t rest_idx;
@@ -351,7 +352,7 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
if (!arg_arr[i]) {
arg_arr[i] = Qnil;
}
add_local_reference(arg_arr[i]);
add_local_reference(LISP_STACK_REF(), arg_arr[i]);
}
LispVal *retval;
switch (count) {
@@ -380,8 +381,8 @@ static ALWAYS_INLINE LispVal *call_native(LispVal *orig_func,
abort();
}
the_stack.nogc_retval = retval;
pop_stack_frame();
add_local_reference(the_stack.nogc_retval);
unwind_to(stack_ref);
add_local_reference(LISP_STACK_REF(), the_stack.nogc_retval);
return retval;
}
@@ -395,7 +396,7 @@ static ALWAYS_INLINE void push_optional_argument_to_lexenv(LispVal *spec,
static ALWAYS_INLINE void
push_missing_optional_argument_to_lexenv(LispVal *spec) {
new_lexical_variable(XCAR(spec), Feval(SECOND(spec), TOP_LEXENV()));
new_lexical_variable(XCAR(spec), Feval(SECOND(spec), Vlexical_environment));
if (!NILP(THIRD(spec))) {
new_lexical_variable(THIRD(spec), Qnil);
}
@@ -403,7 +404,6 @@ push_missing_optional_argument_to_lexenv(LispVal *spec) {
static ALWAYS_INLINE enum ProcessArgsResult
push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
LISP_STACK_TOP()->lexenv = fobj->impl.interp.lexenv;
LispVal *rem_req = fobj->args.req;
LispVal *rem_opt = fobj->args.opt;
while (!NILP(rem_req)) {
@@ -459,10 +459,13 @@ push_interpreted_args_to_lexenv(LispFunction *fobj, LispVal *args) {
static ALWAYS_INLINE LispVal *
call_interpreted(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
push_stack_frame(orig_func, fobj, args);
StackFrame *stack_ref = LISP_STACK_REF();
push_call_frame(orig_func, fobj, args);
LispVal *evaled_args = evaluate_function_arguments(args);
set_stack_evaluated_args(evaled_args);
enum ProcessArgsResult par = push_interpreted_args_to_lexenv(fobj, args);
set_stack_evaluated_args(LISP_STACK_REF(), evaled_args);
push_dynamic_binding(Qlexical_environment, fobj->impl.interp.lexenv);
enum ProcessArgsResult par =
push_interpreted_args_to_lexenv(fobj, evaled_args);
if (par != PROCESS_ARGS_OK) {
// TODO better error handling
fprintf(stderr, "Bad args to interp func: %s\n",
@@ -471,8 +474,8 @@ call_interpreted(LispVal *orig_func, LispFunction *fobj, LispVal *args) {
}
LispVal *rval = Fprogn(fobj->impl.interp.body);
the_stack.nogc_retval = rval;
pop_stack_frame();
add_local_reference(rval);
unwind_to(stack_ref);
add_local_reference(LISP_STACK_REF(), rval);
return rval;
}
@@ -482,10 +485,11 @@ DEFUN(funcall, "funcall", (LispVal * func, LispVal *args), "(func &rest args)",
if (SYMBOLP(func)) {
fobj = Fsymbol_function(func, Qt);
} else if (CONSP(func) && EQ(XCAR(func), Qlambda)) {
fobj = Feval(func, TOP_LEXENV());
fobj = Feval(func, Vlexical_environment);
}
// include symbol here for the error message
CHECK_TYPE(fobj, TYPE_FUNCTION, TYPE_SYMBOL);
assert(FUNCTIONP(fobj));
switch (fobj->type) {
case FUNCTION_NATIVE:
return call_native(func, fobj, args);
@@ -542,7 +546,7 @@ DEFSPECIAL(lambda, "lambda", (LispVal * args, LispVal *body),
}
body = parse_lambda_declare_form(fobj, body);
fobj->impl.interp.body = body;
fobj->impl.interp.lexenv = PARENT_LEXENV();
fobj->impl.interp.lexenv = Vlexical_environment;
return fobj;
}
src/gc.c
+24 -13
View File
@@ -285,13 +285,30 @@ static void mark_stack_local_refs(struct LocalReferences *restrict refs,
saturating_dec(limit, refs->num_refs);
}
static void mark_stack_frame(struct StackFrame *frame, size_t *restrict limit) {
mark_object(frame->name);
mark_object(frame->args);
mark_object(frame->fobj);
mark_object(frame->lexenv);
saturating_dec(limit, 4);
mark_stack_local_refs(&frame->local_refs, limit);
static void mark_stack_frame(StackFrame *frame, size_t *restrict limit) {
switch (frame->kind) {
case STACK_FRAME_LOCAL_REFERENCES:
mark_stack_local_refs(&frame->local_references, limit);
break;
case STACK_FRAME_CALL:
mark_object(frame->call.name);
mark_object(frame->call.args);
mark_object(frame->call.fobj);
saturating_dec(limit, 3);
break;
case STACK_FRAME_UNWIND_PROTECT:
// nothing to do
break;
case STACK_FRAME_CONDITION_CASE:
mark_object(frame->condition_case.exceptions);
saturating_dec(limit, 1);
break;
case STACK_FRAME_DYNAMIC_BINDING:
mark_object(frame->dynamic_binding.symbol);
mark_object(frame->dynamic_binding.old_value);
saturating_dec(limit, 2);
break;
}
}
static void mark_and_compact_the_stack(size_t *restrict limit) {
@@ -306,11 +323,6 @@ static void mark_and_compact_the_stack(size_t *restrict limit) {
}
}
if (i == the_stack.depth) {
for (; i < the_stack.first_clear_local_refs; ++i) {
compact_stack_frame(&the_stack.frames[i]);
}
the_stack.first_clear_local_refs = the_stack.depth;
// move to the next step
incremental_state.step = GC_STEP_HEAP;
}
}
@@ -402,7 +414,6 @@ void lisp_gc_yield(struct timespec *restrict time_took, bool full) {
}
void lisp_gc_teardown(void) {
assert(the_stack.depth == 0);
while (white_objects) {
free_object(white_objects->obj);
}
src/gen-init-globals.awk
+1
View File
@@ -4,6 +4,7 @@ BEGIN {
special_syms["t"] = 1
special_syms["nil"] = 1
special_syms["unbound"] = 1
special_syms["lexical_environment"] = 1
special_syms["hash_string"] = 1
special_syms["strings_equal"] = 1
special_syms["and_rest"] = 1
src/lisp.c
+12 -7
View File
@@ -19,8 +19,10 @@ static void construct_manual_symbols(void) {
lisp_gc_register_static_object(Qt);
Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
((LispSymbol *) Qunbound)->value = Qunbound;
((LispSymbol *) Qunbound)->value = Qunbound;
lisp_gc_register_static_object(Qunbound);
Qlexical_environment = Fmake_symbol(LISP_LITSTR("lexical-environment"));
((LispSymbol *) Qlexical_environment)->value = Qnil;
lisp_gc_register_static_object(Qlexical_environment);
Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
lisp_gc_register_static_object(Qhash_string);
@@ -41,6 +43,7 @@ static void register_manual_symbols(void) {
void lisp_init(void) {
construct_manual_symbols();
Vlexical_environment = Qnil;
obarray = Fmake_hash_table(Qhash_string, Qstrings_equal);
lisp_gc_register_static_object(obarray);
@@ -63,8 +66,8 @@ void lisp_init(void) {
}
void lisp_shutdown(void) {
lisp_gc_teardown();
lisp_teardown_stack();
lisp_gc_teardown();
}
static inline LispVal *lookup_variable(LispSymbol *name, LispVal *lexenv) {
@@ -120,7 +123,7 @@ DEFUN(eval, "eval", (LispVal * form, LispVal *lexenv),
DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") {
LispVal *rval = Qnil;
DOLIST(form, forms) {
rval = Feval(form, TOP_LEXENV());
rval = Feval(form, Vlexical_environment);
}
return rval;
}
@@ -128,18 +131,20 @@ DEFSPECIAL(progn, "progn", (LispVal * forms), "(&rest forms)", "") {
DEFSPECIAL(let, "let", (LispVal * bindings, LispVal *body),
"(bindings &rest body)", "") {
CHECK_LISTP(bindings);
copy_parent_lexenv();
LispVal *lexenv = Vlexical_environment;
DOLIST(binding, bindings) {
if (SYMBOLP(binding)) {
new_lexical_variable(binding, Qnil);
lexenv = CONS(binding, CONS(Qnil, lexenv));
} else if (CONSP(binding) && list_length_eq(binding, 2)) {
new_lexical_variable(FIRST(binding),
Feval(SECOND(binding), TOP_LEXENV()));
lexenv = CONS(
FIRST(binding),
CONS(Feval(SECOND(binding), Vlexical_environment), lexenv));
} else {
// TODO better error
abort();
}
}
push_dynamic_binding(Qlexical_environment, lexenv);
return Fprogn(body);
}
src/main.c
+3 -2
View File
@@ -18,14 +18,15 @@ int main(int argc, const char **argv) {
fclose(in);
lisp_init();
REGISTER_GLOBAL_FUNCTION(print);
push_stack_frame(Qnil, Qnil, Qnil);
push_local_reference_frame();
StackFrame *toplevel = LISP_STACK_REF();
ReadStream s;
read_stream_init(&s, src, src_len);
LispVal *r;
while ((r = read(&s))) {
Feval(r, Qnil);
}
pop_stack_frame();
unwind_to(toplevel);
lisp_shutdown();
free(src);
return 0;
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);
}
src/stack.h
+94 -40
View File
@@ -4,9 +4,22 @@
#include "base.h"
#include "list.h"
#define DEFAULT_MAX_LISP_EVAL_DEPTH 1000
#include <setjmp.h>
#include <stdnoreturn.h>
enum StackFrameKind {
STACK_FRAME_LOCAL_REFERENCES,
STACK_FRAME_CALL,
STACK_FRAME_UNWIND_PROTECT,
STACK_FRAME_CONDITION_CASE,
STACK_FRAME_DYNAMIC_BINDING,
};
#define LISP_STACK_MAX_DEPTH 4096
#define LOCAL_REFERENCES_BLOCK_LENGTH 64
#define LISP_LONGJMP_FOR_UNWIND 1
struct LocalReferencesBlock {
LispVal *refs[LOCAL_REFERENCES_BLOCK_LENGTH];
};
@@ -17,68 +30,109 @@ struct LocalReferences {
struct LocalReferencesBlock **blocks;
};
struct StackFrame {
typedef struct _StackFrame StackFrame;
struct _StackFrame {
enum StackFrameKind kind;
bool marked; // whether we have GC'ed this frame
StackFrame *last_references;
union {
struct LocalReferences local_references;
struct {
LispVal *name; // name of function call
LispVal *fobj; // the function object
bool evaled_args; // whether args have been evaluated yet
LispVal *args; // arguments of the function call
LispVal *lexenv; // lexical environment (plist)
struct LocalReferences local_refs;
} call;
struct {
jmp_buf *target;
StackFrame **unwind_target;
} unwind_protect;
struct {
jmp_buf *target;
LispVal **variable;
LispVal *exceptions; // list of exception symbols to catch
} condition_case;
struct {
LispVal *symbol;
LispVal *old_value;
} dynamic_binding;
};
};
bool marked; // whether we have GC'ed this frame
enum UnwindCause {
UNWIND_NORMAL,
UNWIND_EXCEPTION,
};
struct UnwindInformation {
bool set;
enum UnwindCause cause;
union {
StackFrame *target;
struct {
LispVal *name;
LispVal *data;
} exception;
};
};
struct LispStack {
size_t max_depth;
size_t depth;
size_t first_clear_local_refs; // index of the first frame that has local
// refs that has not been grown
struct StackFrame *frames;
StackFrame *frames;
LispVal *nogc_retval;
struct UnwindInformation unwind_info;
};
extern struct LispStack the_stack;
static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP(void) {
return the_stack.depth ? &the_stack.frames[the_stack.depth - 1] : NULL;
}
static ALWAYS_INLINE LispVal *TOP_LEXENV(void) {
return the_stack.depth ? LISP_STACK_TOP()->lexenv : Qnil;
}
static ALWAYS_INLINE LispVal *PARENT_LEXENV(void) {
return the_stack.depth > 1 ? the_stack.frames[the_stack.depth - 2].lexenv
: Qnil;
}
void lisp_init_stack(void);
void lisp_teardown_stack(void);
void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args);
void pop_stack_frame(void);
void add_local_reference_no_recurse(LispVal *obj);
void add_local_reference(LispVal *obj);
// replace the args in the top stack frame with ARGS and mark them as evaluted
static ALWAYS_INLINE StackFrame *LISP_STACK_REF(void) {
if (!the_stack.depth) {
return NULL;
}
return &the_stack.frames[the_stack.depth - 1];
}
void unwind_to(StackFrame *frame);
noreturn void continue_unwinding(void);
// functions
void push_call_frame(LispVal *name, LispVal *fobj, LispVal *args);
// replace the args in the top stack frame with ARGS and mark them as evaluated
// (this is for backtraces)
void set_stack_evaluated_args(LispVal *args);
void set_stack_evaluated_args(StackFrame *restrict ref, LispVal *args);
// Return true if successful, false if not found and not created
bool set_lexical_variable(LispVal *name, LispVal *value, bool create_if_absent);
// Just add a new lexical variable without any checking
static inline void new_lexical_variable(LispVal *name, LispVal *value) {
assert(the_stack.depth != 0);
LISP_STACK_TOP()->lexenv =
CONS(name, CONS(value, LISP_STACK_TOP()->lexenv));
LISP_STACK_TOP()->marked = false;
gc_mark_stack_for_rescan();
// unwind protect
void push_unwind_protect_frame(jmp_buf *buf);
// condition case
void push_condition_case_frame(jmp_buf *buf, LispVal **variable,
LispVal *exceptions);
// local references
void push_local_reference_frame(void);
void add_local_reference_no_recurse(StackFrame *restrict frame, LispVal *obj);
void add_local_reference(StackFrame *restrict frame, LispVal *obj);
static ALWAYS_INLINE struct LocalReferences *TOP_LOCAL_REFERENCES(void) {
assert(the_stack.depth > 0);
return &the_stack.frames[the_stack.depth - 1].local_references;
}
// Copy the previous frame's lexenv to the top of the stack.
void copy_parent_lexenv(void);
// dynamic binding
void push_dynamic_binding(LispVal *name, LispVal *new_value);
static ALWAYS_INLINE void push_copy_lexenv(void) {
push_dynamic_binding(Qlexical_environment, Vlexical_environment);
}
// used by the GC
void compact_stack_frame(struct StackFrame *restrict frame);
void set_lexical_variable(LispVal *name, LispVal *value);
// Just add a new lexical variable without any checking
static inline void new_lexical_variable(LispVal *name, LispVal *value) {
LispSymbol *lexenv = (LispSymbol *) Qlexical_environment;
lexenv->value = CONS(name, CONS(value, lexenv->value));
}
#endif