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
Makefile
+7 -3
View File
@@ -1,14 +1,18 @@
DEBUG=1 DEBUG=2
LLVM_SAN=1 LLVM_SAN=1
ifeq ($(DEBUG),1) ifeq ($(DEBUG),1)
DEBUG_CFLAGS=-g DEBUG_CFLAGS=-g -Og
else ifeq ($(DEBUG),2)
DEBUG_CFLAGS=-g -O0
else else
DEBUG_CFLAGS=-D_NDEBUG DEBUG_CFLAGS=-D_NDEBUG -O2
endif endif
ifeq ($(LLVM_SAN),1) ifeq ($(LLVM_SAN),1)
LLVM_SAN_FLAGS=-fsanitize=address,undefined LLVM_SAN_FLAGS=-fsanitize=address,undefined
else ifeq ($(LLVM_SAN),2)
LLVM_SAN_FLAGS=-fsanitize=thread,undefined
else else
LLVM_SAN_FLAGS= LLVM_SAN_FLAGS=
endif endif
src/base.c
+8 -25
View File
@@ -27,7 +27,7 @@ void *lisp_alloc_object_no_gc(size_t size, LispValType type) {
LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size); LispObject *obj = lisp_aligned_alloc(LISP_OBJECT_ALIGNMENT, size);
memset(obj, 0, size); memset(obj, 0, size);
obj->type = type; obj->type = type;
tss_create(&obj->gc.lowest_local_ref, NULL); obj->gc.lowest_local_ref = NULL;
return obj; return obj;
} }
@@ -45,8 +45,6 @@ void *lisp_alloc_object(size_t size, LispValType type) {
void lisp_release_object(LispVal *val) { void lisp_release_object(LispVal *val) {
assert(OBJECTP(val)); assert(OBJECTP(val));
LispObject *obj = val;
tss_delete(obj->gc.lowest_local_ref);
lisp_free(val); lisp_free(val);
} }
@@ -294,35 +292,20 @@ static void check_handler_bind_handlers(LispVal *handlers) {
} }
} }
static void lisp_handler_bind_handler(LispVal *name, LispVal *data,
LispVal *lisp_handler) {
CALL(lisp_handler, CONS(name, data));
}
DEFUN(handler_bind, "handler-bind", (LispVal * thunk, LispVal *handlers), DEFUN(handler_bind, "handler-bind", (LispVal * thunk, LispVal *handlers),
"(thunk &rest handlers)", "") { "(thunk &rest handlers)", "") {
check_handler_bind_handlers(handlers); check_handler_bind_handlers(handlers);
StackFrame *stack_ref = LISP_STACK_REF(); StackFrame *stack_ref = LISP_STACK_REF();
jmp_buf jmp_target;
size_t nhandlers = list_length(handlers);
LispVal **handler_vec = lisp_malloc(sizeof(LispVal *) * nhandlers);
bool **enabled_vec = lisp_malloc(sizeof(bool *) * nhandlers);
size_t idx = 0;
DOLIST(handler, handlers) { DOLIST(handler, handlers) {
handler_vec[idx] = XCDR(handler); push_handler_bind_frame(FIRST(handler), lisp_handler_bind_handler,
enabled_vec[idx] = SECOND(handler), NULL);
push_handler_bind_frame(&jmp_target, XCAR(handler), idx);
++idx;
} }
if (setjmp(jmp_target) == 0) {
return UNWIND_AND_RETURN(stack_ref, CALL0(thunk)); return UNWIND_AND_RETURN(stack_ref, CALL0(thunk));
} else {
size_t handler_idx = EXCEPTION_HANDLER_FRAME()->handler_bind.datum;
for (size_t i = 0; i < nhandlers; ++i) {
*enabled_vec[i] = false;
}
CALL(handler_vec[handler_idx],
CONS(EXCEPTION_NAME(), EXCEPTION_DATA()));
for (size_t i = 0; i < nhandlers; ++i) {
*enabled_vec[i] = true;
}
continue_unwinding();
}
} }
DEFUN(error, "error", (LispVal * data), "(data)", "") { DEFUN(error, "error", (LispVal * data), "(data)", "") {
src/base.h
+1 -1
View File
@@ -136,7 +136,7 @@ static ALWAYS_INLINE bool OBJECT_STATIC_P(LispVal *val) {
static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) { static inline void MARK_OBJECT_ADDED(LispVal *val, LispVal *into) {
if (OBJECTP(val) && OBJECTP(into) && OBJECT_GC_SET_P(into, GC_BLACK) if (OBJECTP(val) && OBJECTP(into) && OBJECT_GC_SET_P(into, GC_BLACK)
&& OBJECT_GC_SET_P(val, GC_WHITE)) { && OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY); gc_move_to_set(val, GC_GRAY);
} }
} }
src/function.c
+1 -1
View File
@@ -237,7 +237,7 @@ LispVal *make_builtin_function(LispVal *name, LispVal *(*cfunc)(void),
// Calling functions // Calling functions
static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) { static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) {
LispVal *start = Qnil; LispVal *start = Qnil;
LispVal *end; LispVal *end = NULL;
DOLIST(arg, args) { DOLIST(arg, args) {
if (NILP(start)) { if (NILP(start)) {
start = CONS(Feval(arg, Vlexical_environment), Qnil); start = CONS(Feval(arg, Vlexical_environment), Qnil);
src/gc.c
+31 -55
View File
@@ -23,17 +23,16 @@ static size_t free_objects_list_count;
static struct GCObjectList *free_objects_list; static struct GCObjectList *free_objects_list;
static struct GCObjectList *black_objects; static struct GCObjectList *black_objects;
static struct GCObjectList *grey_objects; static struct GCObjectList *GRAY_objects;
static struct GCObjectList *white_objects; static struct GCObjectList *white_objects;
static struct GCObjectList *static_objects; static struct GCObjectList *static_objects;
ObjectGCSet GC_BLACK = 0; ObjectGCSet GC_BLACK = 0;
ObjectGCSet GC_GREY = 1; ObjectGCSet GC_GRAY = 1;
ObjectGCSet GC_WHITE = 2; ObjectGCSet GC_WHITE = 2;
enum IncrementalGCSetp { enum IncrementalGCSetp {
GC_STEP_STATICS, GC_STEP_STATICS,
GC_STEP_UNWIND,
GC_STEP_STACK, GC_STEP_STACK,
GC_STEP_HEAP, GC_STEP_HEAP,
GC_STEP_FREE, GC_STEP_FREE,
@@ -52,8 +51,8 @@ static struct IncrementalGCState incremental_state = {
static ALWAYS_INLINE struct GCObjectList **HEAD_FOR_SET(ObjectGCSet set) { static ALWAYS_INLINE struct GCObjectList **HEAD_FOR_SET(ObjectGCSet set) {
if (set == GC_BLACK) { if (set == GC_BLACK) {
return &black_objects; return &black_objects;
} else if (set == GC_GREY) { } else if (set == GC_GRAY) {
return &grey_objects; return &GRAY_objects;
} else if (set == GC_WHITE) { } else if (set == GC_WHITE) {
return &white_objects; return &white_objects;
} else { } else {
@@ -188,9 +187,9 @@ static void free_object(LispVal *val) {
lisp_release_object(val); lisp_release_object(val);
} }
static inline void make_grey_if_white(LispVal *val) { static inline void make_GRAY_if_white(LispVal *val) {
if (OBJECTP(val) && OBJECT_GC_SET_P(val, GC_WHITE)) { if (OBJECTP(val) && OBJECT_GC_SET_P(val, GC_WHITE)) {
gc_move_to_set(val, GC_GREY); gc_move_to_set(val, GC_GRAY);
} }
} }
@@ -201,39 +200,39 @@ static void mark_object(LispVal *val) {
} }
switch (((LispObject *) val)->type) { switch (((LispObject *) val)->type) {
case TYPE_CONS: case TYPE_CONS:
make_grey_if_white(((LispCons *) val)->car); make_GRAY_if_white(((LispCons *) val)->car);
make_grey_if_white(((LispCons *) val)->cdr); make_GRAY_if_white(((LispCons *) val)->cdr);
break; break;
case TYPE_SYMBOL: { case TYPE_SYMBOL: {
LispSymbol *sym = val; LispSymbol *sym = val;
make_grey_if_white(sym->name); make_GRAY_if_white(sym->name);
make_grey_if_white(SYMBOL_VALUE(sym)); make_GRAY_if_white(SYMBOL_VALUE(sym));
make_grey_if_white(sym->function); make_GRAY_if_white(sym->function);
make_grey_if_white(sym->plist); make_GRAY_if_white(sym->plist);
break; break;
} }
case TYPE_VECTOR: { case TYPE_VECTOR: {
LispVector *vec = val; LispVector *vec = val;
for (size_t i = 0; i < vec->length; ++i) { for (size_t i = 0; i < vec->length; ++i) {
make_grey_if_white(vec->data[i]); make_GRAY_if_white(vec->data[i]);
} }
break; break;
} }
case TYPE_HASH_TABLE: { case TYPE_HASH_TABLE: {
HT_FOREACH_INDEX(val, i) { HT_FOREACH_INDEX(val, i) {
make_grey_if_white(HASH_KEY(val, i)); make_GRAY_if_white(HASH_KEY(val, i));
make_grey_if_white(HASH_VALUE(val, i)); make_GRAY_if_white(HASH_VALUE(val, i));
} }
break; break;
} }
case TYPE_FUNCTION: { case TYPE_FUNCTION: {
LispFunction *fobj = val; LispFunction *fobj = val;
make_grey_if_white(fobj->name); make_GRAY_if_white(fobj->name);
make_grey_if_white(fobj->docstr); make_GRAY_if_white(fobj->docstr);
make_grey_if_white(fobj->args.req); make_GRAY_if_white(fobj->args.req);
make_grey_if_white(fobj->args.opt); make_GRAY_if_white(fobj->args.opt);
make_grey_if_white(fobj->args.kw); make_GRAY_if_white(fobj->args.kw);
make_grey_if_white(fobj->args.rest); make_GRAY_if_white(fobj->args.rest);
break; break;
} }
case TYPE_STRING: case TYPE_STRING:
@@ -265,7 +264,7 @@ static void mark_statics(size_t *restrict limit) {
// we processed the whole list, move to the next step // we processed the whole list, move to the next step
if (!node) { if (!node) {
incremental_state.next_static = static_objects; incremental_state.next_static = static_objects;
incremental_state.step = GC_STEP_UNWIND; incremental_state.step = GC_STEP_STACK;
} }
} }
@@ -312,26 +311,6 @@ static void mark_stack_frame(StackFrame *frame, size_t *restrict limit) {
} }
} }
static void mark_unwind_info(size_t *restrict limit) {
if (the_stack.unwind_info.set) {
switch (the_stack.unwind_info.cause) {
case UNWIND_NORMAL:
mark_object(the_stack.unwind_info.target);
saturating_dec(limit, 1);
break;
case UNWIND_EXCEPTION:
mark_object(the_stack.unwind_info.exception.name);
mark_object(the_stack.unwind_info.exception.data);
saturating_dec(limit, 2);
break;
default:
abort();
break;
}
}
incremental_state.step = GC_STEP_STACK;
}
static void mark_the_stack(size_t *restrict limit) { static void mark_the_stack(size_t *restrict limit) {
size_t i; size_t i;
for (i = 0; i < the_stack.depth && *limit; ++i) { for (i = 0; i < the_stack.depth && *limit; ++i) {
@@ -351,11 +330,11 @@ static void unmark_the_stack(void) {
} }
} }
static void mark_grey_objects(size_t *restrict limit) { static void mark_GRAY_objects(size_t *restrict limit) {
while (grey_objects && saturating_dec(limit, 1)) { while (GRAY_objects && saturating_dec(limit, 1)) {
mark_object(grey_objects->obj); mark_object(GRAY_objects->obj);
} }
if (!grey_objects) { if (!GRAY_objects) {
incremental_state.step = GC_STEP_FREE; incremental_state.step = GC_STEP_FREE;
} }
} }
@@ -398,22 +377,19 @@ void lisp_gc_yield(struct timespec *restrict time_took, bool full) {
clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time); clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &start_time);
size_t limit = full ? SIZE_MAX : LISP_GC_INCREMENTAL_COUNT; size_t limit = full ? SIZE_MAX : LISP_GC_INCREMENTAL_COUNT;
while (limit) { while (limit) {
// there are more grey objects, mark them before we sweep // there are more GRAY objects, mark them before we sweep
if (incremental_state.step == GC_STEP_FREE && grey_objects) { if (incremental_state.step == GC_STEP_FREE && GRAY_objects) {
incremental_state.step = GC_STEP_HEAP; incremental_state.step = GC_STEP_HEAP;
} }
switch (incremental_state.step) { switch (incremental_state.step) {
case GC_STEP_STATICS: case GC_STEP_STATICS:
mark_statics(&limit); mark_statics(&limit);
break; break;
case GC_STEP_UNWIND:
mark_unwind_info(&limit);
break;
case GC_STEP_STACK: case GC_STEP_STACK:
mark_the_stack(&limit); mark_the_stack(&limit);
break; break;
case GC_STEP_HEAP: case GC_STEP_HEAP:
mark_grey_objects(&limit); mark_GRAY_objects(&limit);
break; break;
case GC_STEP_FREE: case GC_STEP_FREE:
gc_sweep_objects(&limit); gc_sweep_objects(&limit);
@@ -438,8 +414,8 @@ void lisp_gc_teardown(void) {
while (white_objects) { while (white_objects) {
free_object(white_objects->obj); free_object(white_objects->obj);
} }
while (grey_objects) { while (GRAY_objects) {
free_object(grey_objects->obj); free_object(GRAY_objects->obj);
} }
while (black_objects) { while (black_objects) {
free_object(black_objects->obj); free_object(black_objects->obj);
src/gc.h
+2 -2
View File
@@ -16,7 +16,7 @@ extern size_t lisp_gc_count;
typedef uint8_t ObjectGCSet; typedef uint8_t ObjectGCSet;
extern ObjectGCSet GC_BLACK; extern ObjectGCSet GC_BLACK;
extern ObjectGCSet GC_GREY; extern ObjectGCSet GC_GRAY;
extern ObjectGCSet GC_WHITE; extern ObjectGCSet GC_WHITE;
struct GCObjectList; struct GCObjectList;
@@ -24,7 +24,7 @@ struct GCObjectList;
typedef struct { typedef struct {
unsigned int is_static : 1; unsigned int is_static : 1;
ObjectGCSet set : 2; ObjectGCSet set : 2;
tss_t lowest_local_ref; void *lowest_local_ref; // Really a StackFrame *
struct GCObjectList *gc_node; struct GCObjectList *gc_node;
} ObjectGCInfo; } ObjectGCInfo;
src/main.c
+31 -29
View File
@@ -1,34 +1,15 @@
#include "lisp.h" #include "lisp.h"
#include "read.h" #include "read.h"
#include <setjmp.h>
#include <stdio.h> #include <stdio.h>
int main(int argc, const char **argv) { static jmp_buf toplevel_error_jmp_buf;
FILE *in = fopen(argv[1], "r");
fseek(in, 0, SEEK_END); static void toplevel_error_handler(LispVal *name, LispVal *data,
off_t src_len = ftello(in); void *ignored) {
char *src = malloc(src_len);
rewind(in);
fread(src, 1, src_len, in);
fclose(in);
lisp_init();
push_local_reference_frame();
StackFrame *toplevel = LISP_STACK_REF();
ReadStream s;
read_stream_init(&s, src, src_len);
LispVal *r;
bool had_toplevel_error = false;
HANDLER_BIND1(
LIST(Qt),
{
while ((r = read(&s))) {
Feval(r, Qnil);
}
},
{
fprintf(stderr, "Caught exception: "); fprintf(stderr, "Caught exception: ");
Fprint_condition(EXCEPTION_NAME(), EXCEPTION_DATA(), Fprint_condition(name, data, Qerror_write_byte);
Qerror_write_byte); //
fprintf(stderr, "\nBacktrace (toplevel comes last):\n"); fprintf(stderr, "\nBacktrace (toplevel comes last):\n");
LispVal *backtrace = Fbacktrace(); LispVal *backtrace = Fbacktrace();
DOLIST(frame, backtrace) { DOLIST(frame, backtrace) {
@@ -44,11 +25,32 @@ int main(int argc, const char **argv) {
fputc('\n', stderr); fputc('\n', stderr);
} }
} }
CLEAR_EXCEPTION(); longjmp(toplevel_error_jmp_buf, 1);
}
int main(int argc, const char **argv) {
FILE *in = fopen(argv[1], "r");
fseek(in, 0, SEEK_END);
off_t src_len = ftello(in);
char *src = malloc(src_len);
rewind(in);
fread(src, 1, src_len, in);
fclose(in);
lisp_init();
push_local_reference_frame();
StackFrame *toplevel = LISP_STACK_REF();
ReadStream s;
read_stream_init(&s, src, src_len);
LispVal *r;
push_handler_bind_frame(LIST(Qt), toplevel_error_handler, NULL, NULL);
volatile bool had_toplevel_error = false;
if (setjmp(toplevel_error_jmp_buf) == 0) {
while ((r = read(&s))) {
Feval(r, Qnil);
}
} else {
had_toplevel_error = true; had_toplevel_error = true;
goto toplevel_error; }
});
toplevel_error:
unwind_to(toplevel); unwind_to(toplevel);
lisp_shutdown(); lisp_shutdown();
free(src); free(src);
src/read.c
+1 -1
View File
@@ -89,7 +89,7 @@ LispVal *next_list(ReadStream *stream) {
pop_char(stream); // the ( pop_char(stream); // the (
skip_whitespace(stream); skip_whitespace(stream);
LispVal *start = Qnil; LispVal *start = Qnil;
LispVal *end; LispVal *end = NULL;
bool dotted = false; bool dotted = false;
while (peek_char(stream) != ')') { while (peek_char(stream) != ')') {
if (dotted) { if (dotted) {
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.max_depth = LISP_STACK_MAX_DEPTH;
the_stack.depth = 0; the_stack.depth = 0;
the_stack.frames = lisp_malloc(sizeof(StackFrame) * the_stack.max_depth); the_stack.frames = lisp_malloc(sizeof(StackFrame) * the_stack.max_depth);
the_stack.unwind_info.set = false;
} }
static inline void static inline void
@@ -85,18 +84,24 @@ void set_stack_evaluated_args(StackFrame *restrict frame, LispVal *fobj,
frame->call.evaled_args = true; 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); 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); 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; 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) { 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) { while (the_stack.depth && &the_stack.frames[the_stack.depth - 1] > frame) {
StackFrame *restrict top = &the_stack.frames[--the_stack.depth]; StackFrame *restrict top = &the_stack.frames[--the_stack.depth];
switch (top->kind) { switch (top->kind) {
@@ -283,7 +288,12 @@ static void do_unwind_to(StackFrame *frame) {
} }
break; break;
case STACK_FRAME_UNWIND_PROTECT: 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: case STACK_FRAME_LOCAL_REFERENCES:
teardown_local_references(top); teardown_local_references(top);
break; 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, static bool frame_handles_exception(StackFrame *restrict frame,
LispVal *exception_name) { LispVal *exception_name) {
assert(frame->kind == STACK_FRAME_HANDLER_BIND); assert(frame->kind == STACK_FRAME_HANDLER_BIND);
@@ -326,55 +328,38 @@ static StackFrame *find_exception_handler(StackFrame *from,
return NULL; 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))) { while ((start = find_exception_handler(start, name))) {
the_stack.unwind_info.exception.handler_frame = start; start->handler_bind.enabled = false;
longjmp(*start->handler_bind.target, LISP_LONGJMP_FOR_UNWIND); 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) { static noreturn void top_of_stack_exception_handler(LispVal *name,
assert(the_stack.unwind_info.set LispVal *data) {
&& the_stack.unwind_info.cause == UNWIND_EXCEPTION);
fprintf(stderr, fprintf(stderr,
"An exception has propagated to the top of the lisp stack!\n"); "An exception has propagated to the top of the lisp stack!\n");
fprintf(stderr, "Name: "); fprintf(stderr, "Name: ");
debug_print(stderr, the_stack.unwind_info.exception.name); debug_print(stderr, name);
fprintf(stderr, "\nData: "); fprintf(stderr, "\nData: ");
debug_print(stderr, the_stack.unwind_info.exception.data); debug_print(stderr, data);
fprintf(stderr, "\nLisp will now exit...\n"); fprintf(stderr, "\nLisp will now exit...\n");
abort(); 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) { noreturn void lisp_signal(LispVal *name, LispVal *data) {
CHECK_LISTP(data);
if (NILP(Fcondition_class_p(name))) { if (NILP(Fcondition_class_p(name))) {
signal_type_error(name, LIST(Qcondition_class)); signal_type_error(name, LIST(Qcondition_class));
} }
CHECK_LISTP(data); CHECK_LISTP(data);
the_stack.unwind_info.set = true; do_run_handler_cases(name, data, LISP_STACK_REF());
the_stack.unwind_info.cause = UNWIND_EXCEPTION; unwind_to(NULL);
the_stack.unwind_info.exception.name = name; top_of_stack_exception_handler(name, data);
the_stack.unwind_info.exception.data = data;
do_run_handler_cases(name, LISP_STACK_REF());
do_unwind_to(NULL);
top_of_stack_exception_handler();
} }
DEFUN(backtrace, "backtrace", (void), "()", "") { DEFUN(backtrace, "backtrace", (void), "()", "") {
@@ -382,7 +367,9 @@ DEFUN(backtrace, "backtrace", (void), "()", "") {
for (size_t i = 0; i < the_stack.depth; ++i) { for (size_t i = 0; i < the_stack.depth; ++i) {
StackFrame *restrict frame = &the_stack.frames[i]; StackFrame *restrict frame = &the_stack.frames[i];
if (frame->kind == STACK_FRAME_CALL) { 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.evaled_args ? Qt : Qnil,
frame->call.args), frame->call.args),
out); out);
src/stack.h
+15 -103
View File
@@ -3,7 +3,6 @@
#include "base.h" #include "base.h"
#include <setjmp.h>
#include <stdnoreturn.h> #include <stdnoreturn.h>
enum StackFrameKind { enum StackFrameKind {
@@ -44,13 +43,16 @@ struct _StackFrame {
LispVal *args; // arguments of the function call LispVal *args; // arguments of the function call
} call; } call;
struct { struct {
jmp_buf *target; void (*handler)(void *user_ptr);
void *user_ptr;
void (*cleanup_user_ptr)(void *data);
} unwind_protect; } unwind_protect;
struct { struct {
jmp_buf *target;
LispVal *exceptions; // list of exception symbols to catch LispVal *exceptions; // list of exception symbols to catch
size_t datum; // extra value to identify this case
bool enabled; bool enabled;
void (*handler)(LispVal *name, LispVal *data, void *user_ptr);
void *user_ptr;
void (*cleanup_user_ptr)(void *data);
} handler_bind; } handler_bind;
struct { struct {
LispVal *symbol; LispVal *symbol;
@@ -59,44 +61,22 @@ struct _StackFrame {
}; };
}; };
enum UnwindCause {
UNWIND_NORMAL,
UNWIND_EXCEPTION,
};
struct UnwindInformation {
bool set;
enum UnwindCause cause;
union {
StackFrame *target;
struct {
LispVal *name;
LispVal *data;
StackFrame *handler_frame;
} exception;
};
};
struct LispStack { struct LispStack {
size_t max_depth; size_t max_depth;
size_t depth; size_t depth;
StackFrame *frames; StackFrame *frames;
struct UnwindInformation unwind_info;
}; };
// ONLY APPLIES TO THE CALLING THREAD // ONLY APPLIES TO THE CALLING THREAD
static ALWAYS_INLINE StackFrame *OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val) { static ALWAYS_INLINE StackFrame *OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val) {
assert(OBJECTP(val)); assert(OBJECTP(val));
LispObject *obj = val; return ((LispObject *) val)->gc.lowest_local_ref;
return tss_get(obj->gc.lowest_local_ref);
} }
static ALWAYS_INLINE void SET_OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val, static ALWAYS_INLINE void SET_OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val,
StackFrame *frame) { StackFrame *frame) {
assert(OBJECTP(val)); assert(OBJECTP(val));
LispObject *obj = val; ((LispObject *) val)->gc.lowest_local_ref = frame;
tss_set(obj->gc.lowest_local_ref, frame);
} }
extern struct LispStack the_stack; extern struct LispStack the_stack;
@@ -111,32 +91,6 @@ static ALWAYS_INLINE StackFrame *LISP_STACK_REF(void) {
return &the_stack.frames[the_stack.depth - 1]; return &the_stack.frames[the_stack.depth - 1];
} }
static ALWAYS_INLINE void CLEAR_EXCEPTION(void) {
the_stack.unwind_info.set = false;
}
static ALWAYS_INLINE bool EXCEPTION_SET_P(void) {
return the_stack.unwind_info.set;
}
static ALWAYS_INLINE LispVal *EXCEPTION_NAME(void) {
assert(the_stack.unwind_info.set
&& the_stack.unwind_info.cause == UNWIND_EXCEPTION);
return the_stack.unwind_info.exception.name;
}
static ALWAYS_INLINE LispVal *EXCEPTION_DATA(void) {
assert(the_stack.unwind_info.set
&& the_stack.unwind_info.cause == UNWIND_EXCEPTION);
return the_stack.unwind_info.exception.data;
}
static ALWAYS_INLINE StackFrame *EXCEPTION_HANDLER_FRAME(void) {
assert(the_stack.unwind_info.set
&& the_stack.unwind_info.cause == UNWIND_EXCEPTION);
return the_stack.unwind_info.exception.handler_frame;
}
// functions // functions
void push_call_frame(LispVal *name, LispVal *args); void push_call_frame(LispVal *name, LispVal *args);
// replace the args in the top stack frame with ARGS and mark them as evaluated // replace the args in the top stack frame with ARGS and mark them as evaluated
@@ -145,10 +99,15 @@ void set_stack_evaluated_args(StackFrame *restrict ref, LispVal *fobj,
LispVal *args); LispVal *args);
// unwind protect // unwind protect
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));
// handler bind // handler bind
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 *data));
// local references // local references
void push_local_reference_frame(void); void push_local_reference_frame(void);
@@ -177,7 +136,6 @@ static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,
unwind_to(frame); unwind_to(frame);
return val; return val;
} }
noreturn void continue_unwinding(void);
noreturn void lisp_signal(LispVal *name, LispVal *data); noreturn void lisp_signal(LispVal *name, LispVal *data);
@@ -186,52 +144,6 @@ noreturn void lisp_signal(LispVal *name, LispVal *data);
*/ */
DECLARE_FUNCTION(backtrace, (void) ); DECLARE_FUNCTION(backtrace, (void) );
#define UNWIND_PROTECT(body, cleanup) \
{ \
jmp_buf _internal_jb; \
if (setjmp(_internal_jb) == 0) { \
push_unwind_protect_frame(&_internal_jb); \
StackFrame *_internal_target = LISP_STACK_REF(); \
{body}; \
unwind_to(_internal_target); \
} else { \
{cleanup}; \
continue_unwinding(); \
} \
};
#define HANDLER_BIND1(exceptions, body, handler) \
{ \
jmp_buf _internal_jb; \
StackFrame *_internal_target = LISP_STACK_REF(); \
bool *enabled; \
if (setjmp(_internal_jb) == 0) { \
enabled = push_handler_bind_frame(&_internal_jb, (exceptions), 0); \
{body}; \
unwind_to(_internal_target); \
} else { \
*enabled = false; \
{handler}; \
*enabled = true; \
continue_unwinding(); \
} \
};
#define CONDITION_CASE1(exceptions, body, handler) \
{ \
jmp_buf _internal_jb; \
StackFrame *_internal_target = LISP_STACK_REF(); \
if (setjmp(_internal_jb) == 0) { \
push_handler_bind_frame(&_internal_jb, (exceptions), 0); \
{body}; \
unwind_to(_internal_target); \
} else { \
unwind_to(_internal_target); \
{handler}; \
CLEAR_EXCEPTION(); \
} \
};
DECLARE_SYMBOL(excessive_lisp_nesting_error); DECLARE_SYMBOL(excessive_lisp_nesting_error);
MAKE_CONDITION_CLASS(excessive_lisp_nesting_error); MAKE_CONDITION_CLASS(excessive_lisp_nesting_error);