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

Fix gc with exceptions

Browse Source
This commit is contained in:
Zander671
2026-09-03 21:04:46 -07:00
parent 2533b0db7d
commit 3b2ecf2b16
10 changed files with 139 additions and 275 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/stack.c
+38 -51
View File
@@ -15,7 +15,6 @@ 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.unwind_info.set = false;
}
static inline void
@@ -85,18 +84,24 @@ void set_stack_evaluated_args(StackFrame *restrict frame, LispVal *fobj,
frame->call.evaled_args = true;
}
void push_unwind_protect_frame(jmp_buf *buf) {
void push_unwind_protect_frame(void (*handler)(void *user_ptr), void *user_ptr,
void (*cleanup_user_ptr)(void *data)) {
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_UNWIND_PROTECT);
frame->unwind_protect.target = buf;
frame->unwind_protect.handler = handler;
frame->unwind_protect.user_ptr = user_ptr;
frame->unwind_protect.cleanup_user_ptr = cleanup_user_ptr;
}
bool *push_handler_bind_frame(jmp_buf *buf, LispVal *exceptions, size_t datum) {
void push_handler_bind_frame(LispVal *exceptions,
void (*handler)(LispVal *name, LispVal *data,
void *user_ptr),
void *user_ptr, void (*cleanup_user_ptr)(void *)) {
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_HANDLER_BIND);
frame->handler_bind.target = buf;
frame->handler_bind.exceptions = exceptions;
frame->handler_bind.datum = datum;
frame->handler_bind.enabled = true;
return &frame->handler_bind.enabled;
frame->handler_bind.exceptions = exceptions;
frame->handler_bind.handler = handler;
frame->handler_bind.user_ptr = user_ptr;
frame->handler_bind.cleanup_user_ptr = cleanup_user_ptr;
}
void push_local_reference_frame(void) {
@@ -270,7 +275,7 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
}
}
static void do_unwind_to(StackFrame *frame) {
void unwind_to(StackFrame *frame) {
while (the_stack.depth && &the_stack.frames[the_stack.depth - 1] > frame) {
StackFrame *restrict top = &the_stack.frames[--the_stack.depth];
switch (top->kind) {
@@ -283,7 +288,12 @@ static void do_unwind_to(StackFrame *frame) {
}
break;
case STACK_FRAME_UNWIND_PROTECT:
longjmp(*top->unwind_protect.target, LISP_LONGJMP_FOR_UNWIND);
top->unwind_protect.handler(top->unwind_protect.user_ptr);
if (top->unwind_protect.cleanup_user_ptr) {
top->unwind_protect.cleanup_user_ptr(
top->unwind_protect.user_ptr);
}
break;
case STACK_FRAME_LOCAL_REFERENCES:
teardown_local_references(top);
break;
@@ -295,14 +305,6 @@ static void do_unwind_to(StackFrame *frame) {
}
}
void unwind_to(StackFrame *frame) {
the_stack.unwind_info.set = true;
the_stack.unwind_info.cause = UNWIND_NORMAL;
the_stack.unwind_info.target = frame;
do_unwind_to(frame);
the_stack.unwind_info.set = false;
}
static bool frame_handles_exception(StackFrame *restrict frame,
LispVal *exception_name) {
assert(frame->kind == STACK_FRAME_HANDLER_BIND);
@@ -326,55 +328,38 @@ static StackFrame *find_exception_handler(StackFrame *from,
return NULL;
}
static void do_run_handler_cases(LispVal *name, StackFrame *start) {
static void do_run_handler_cases(LispVal *name, LispVal *data,
StackFrame *start) {
while ((start = find_exception_handler(start, name))) {
the_stack.unwind_info.exception.handler_frame = start;
longjmp(*start->handler_bind.target, LISP_LONGJMP_FOR_UNWIND);
start->handler_bind.enabled = false;
start->handler_bind.handler(name, data, start->handler_bind.user_ptr);
start->handler_bind.enabled = true;
if (start->handler_bind.cleanup_user_ptr) {
start->handler_bind.cleanup_user_ptr(start->handler_bind.user_ptr);
}
}
}
static noreturn void top_of_stack_exception_handler(void) {
assert(the_stack.unwind_info.set
&& the_stack.unwind_info.cause == UNWIND_EXCEPTION);
static noreturn void top_of_stack_exception_handler(LispVal *name,
LispVal *data) {
fprintf(stderr,
"An exception has propagated to the top of the lisp stack!\n");
fprintf(stderr, "Name: ");
debug_print(stderr, the_stack.unwind_info.exception.name);
debug_print(stderr, name);
fprintf(stderr, "\nData: ");
debug_print(stderr, the_stack.unwind_info.exception.data);
debug_print(stderr, data);
fprintf(stderr, "\nLisp will now exit...\n");
abort();
}
noreturn void continue_unwinding(void) {
assert(the_stack.unwind_info.set);
switch (the_stack.unwind_info.cause) {
case UNWIND_NORMAL:
do_unwind_to(the_stack.unwind_info.target);
abort();
case UNWIND_EXCEPTION:
do_run_handler_cases(the_stack.unwind_info.exception.name,
the_stack.unwind_info.exception.handler_frame - 1);
do_unwind_to(NULL);
top_of_stack_exception_handler();
default:
abort();
}
}
noreturn void lisp_signal(LispVal *name, LispVal *data) {
CHECK_LISTP(data);
if (NILP(Fcondition_class_p(name))) {
signal_type_error(name, LIST(Qcondition_class));
}
CHECK_LISTP(data);
the_stack.unwind_info.set = true;
the_stack.unwind_info.cause = UNWIND_EXCEPTION;
the_stack.unwind_info.exception.name = name;
the_stack.unwind_info.exception.data = data;
do_run_handler_cases(name, LISP_STACK_REF());
do_unwind_to(NULL);
top_of_stack_exception_handler();
do_run_handler_cases(name, data, LISP_STACK_REF());
unwind_to(NULL);
top_of_stack_exception_handler(name, data);
}
DEFUN(backtrace, "backtrace", (void), "()", "") {
@@ -382,7 +367,9 @@ DEFUN(backtrace, "backtrace", (void), "()", "") {
for (size_t i = 0; i < the_stack.depth; ++i) {
StackFrame *restrict frame = &the_stack.frames[i];
if (frame->kind == STACK_FRAME_CALL) {
out = CONS(LIST(frame->call.name, frame->call.fobj,
// fobj is NULL (not Qnil) if the arguments haven't been evaluated
out = CONS(LIST(frame->call.name,
frame->call.fobj ? frame->call.fobj : Qnil,
frame->call.evaled_args ? Qt : Qnil,
frame->call.args),
out);