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
ifeq ($(DEBUG),1)
DEBUG_CFLAGS=-g
DEBUG_CFLAGS=-g -Og
else ifeq ($(DEBUG),2)
DEBUG_CFLAGS=-g -O0
else
DEBUG_CFLAGS=-D_NDEBUG
DEBUG_CFLAGS=-D_NDEBUG -O2
endif
ifeq ($(LLVM_SAN),1)
LLVM_SAN_FLAGS=-fsanitize=address,undefined
else ifeq ($(LLVM_SAN),2)
LLVM_SAN_FLAGS=-fsanitize=thread,undefined
else
LLVM_SAN_FLAGS=
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);
memset(obj, 0, size);
obj->type = type;
tss_create(&obj->gc.lowest_local_ref, NULL);
obj->gc.lowest_local_ref = NULL;
return obj;
}
@@ -45,8 +45,6 @@ void *lisp_alloc_object(size_t size, LispValType type) {
void lisp_release_object(LispVal *val) {
assert(OBJECTP(val));
LispObject *obj = val;
tss_delete(obj->gc.lowest_local_ref);
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),
"(thunk &rest handlers)", "") {
check_handler_bind_handlers(handlers);
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) {
handler_vec[idx] = XCDR(handler);
enabled_vec[idx] =
push_handler_bind_frame(&jmp_target, XCAR(handler), idx);
++idx;
push_handler_bind_frame(FIRST(handler), lisp_handler_bind_handler,
SECOND(handler), NULL);
}
if (setjmp(jmp_target) == 0) {
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)", "") {
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) {
if (OBJECTP(val) && OBJECTP(into) && OBJECT_GC_SET_P(into, GC_BLACK)
&& 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
static ALWAYS_INLINE LispVal *evaluate_function_arguments(LispVal *args) {
LispVal *start = Qnil;
LispVal *end;
LispVal *end = NULL;
DOLIST(arg, args) {
if (NILP(start)) {
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 *black_objects;
static struct GCObjectList *grey_objects;
static struct GCObjectList *GRAY_objects;
static struct GCObjectList *white_objects;
static struct GCObjectList *static_objects;
ObjectGCSet GC_BLACK = 0;
ObjectGCSet GC_GREY = 1;
ObjectGCSet GC_GRAY = 1;
ObjectGCSet GC_WHITE = 2;
enum IncrementalGCSetp {
GC_STEP_STATICS,
GC_STEP_UNWIND,
GC_STEP_STACK,
GC_STEP_HEAP,
GC_STEP_FREE,
@@ -52,8 +51,8 @@ static struct IncrementalGCState incremental_state = {
static ALWAYS_INLINE struct GCObjectList **HEAD_FOR_SET(ObjectGCSet set) {
if (set == GC_BLACK) {
return &black_objects;
} else if (set == GC_GREY) {
return &grey_objects;
} else if (set == GC_GRAY) {
return &GRAY_objects;
} else if (set == GC_WHITE) {
return &white_objects;
} else {
@@ -188,9 +187,9 @@ static void free_object(LispVal *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)) {
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) {
case TYPE_CONS:
make_grey_if_white(((LispCons *) val)->car);
make_grey_if_white(((LispCons *) val)->cdr);
make_GRAY_if_white(((LispCons *) val)->car);
make_GRAY_if_white(((LispCons *) val)->cdr);
break;
case TYPE_SYMBOL: {
LispSymbol *sym = val;
make_grey_if_white(sym->name);
make_grey_if_white(SYMBOL_VALUE(sym));
make_grey_if_white(sym->function);
make_grey_if_white(sym->plist);
make_GRAY_if_white(sym->name);
make_GRAY_if_white(SYMBOL_VALUE(sym));
make_GRAY_if_white(sym->function);
make_GRAY_if_white(sym->plist);
break;
}
case TYPE_VECTOR: {
LispVector *vec = val;
for (size_t i = 0; i < vec->length; ++i) {
make_grey_if_white(vec->data[i]);
make_GRAY_if_white(vec->data[i]);
}
break;
}
case TYPE_HASH_TABLE: {
HT_FOREACH_INDEX(val, i) {
make_grey_if_white(HASH_KEY(val, i));
make_grey_if_white(HASH_VALUE(val, i));
make_GRAY_if_white(HASH_KEY(val, i));
make_GRAY_if_white(HASH_VALUE(val, i));
}
break;
}
case TYPE_FUNCTION: {
LispFunction *fobj = val;
make_grey_if_white(fobj->name);
make_grey_if_white(fobj->docstr);
make_grey_if_white(fobj->args.req);
make_grey_if_white(fobj->args.opt);
make_grey_if_white(fobj->args.kw);
make_grey_if_white(fobj->args.rest);
make_GRAY_if_white(fobj->name);
make_GRAY_if_white(fobj->docstr);
make_GRAY_if_white(fobj->args.req);
make_GRAY_if_white(fobj->args.opt);
make_GRAY_if_white(fobj->args.kw);
make_GRAY_if_white(fobj->args.rest);
break;
}
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
if (!node) {
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) {
size_t 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) {
while (grey_objects && saturating_dec(limit, 1)) {
mark_object(grey_objects->obj);
static void mark_GRAY_objects(size_t *restrict limit) {
while (GRAY_objects && saturating_dec(limit, 1)) {
mark_object(GRAY_objects->obj);
}
if (!grey_objects) {
if (!GRAY_objects) {
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);
size_t limit = full ? SIZE_MAX : LISP_GC_INCREMENTAL_COUNT;
while (limit) {
// there are more grey objects, mark them before we sweep
if (incremental_state.step == GC_STEP_FREE && grey_objects) {
// there are more GRAY objects, mark them before we sweep
if (incremental_state.step == GC_STEP_FREE && GRAY_objects) {
incremental_state.step = GC_STEP_HEAP;
}
switch (incremental_state.step) {
case GC_STEP_STATICS:
mark_statics(&limit);
break;
case GC_STEP_UNWIND:
mark_unwind_info(&limit);
break;
case GC_STEP_STACK:
mark_the_stack(&limit);
break;
case GC_STEP_HEAP:
mark_grey_objects(&limit);
mark_GRAY_objects(&limit);
break;
case GC_STEP_FREE:
gc_sweep_objects(&limit);
@@ -438,8 +414,8 @@ void lisp_gc_teardown(void) {
while (white_objects) {
free_object(white_objects->obj);
}
while (grey_objects) {
free_object(grey_objects->obj);
while (GRAY_objects) {
free_object(GRAY_objects->obj);
}
while (black_objects) {
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;
extern ObjectGCSet GC_BLACK;
extern ObjectGCSet GC_GREY;
extern ObjectGCSet GC_GRAY;
extern ObjectGCSet GC_WHITE;
struct GCObjectList;
@@ -24,7 +24,7 @@ struct GCObjectList;
typedef struct {
unsigned int is_static : 1;
ObjectGCSet set : 2;
tss_t lowest_local_ref;
void *lowest_local_ref; // Really a StackFrame *
struct GCObjectList *gc_node;
} ObjectGCInfo;
src/main.c
+31 -29
View File
@@ -1,34 +1,15 @@
#include "lisp.h"
#include "read.h"
#include <setjmp.h>
#include <stdio.h>
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;
bool had_toplevel_error = false;
HANDLER_BIND1(
LIST(Qt),
{
while ((r = read(&s))) {
Feval(r, Qnil);
}
},
{
static jmp_buf toplevel_error_jmp_buf;
static void toplevel_error_handler(LispVal *name, LispVal *data,
void *ignored) {
fprintf(stderr, "Caught exception: ");
Fprint_condition(EXCEPTION_NAME(), EXCEPTION_DATA(),
Qerror_write_byte); //
Fprint_condition(name, data, Qerror_write_byte);
fprintf(stderr, "\nBacktrace (toplevel comes last):\n");
LispVal *backtrace = Fbacktrace();
DOLIST(frame, backtrace) {
@@ -44,11 +25,32 @@ int main(int argc, const char **argv) {
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;
goto toplevel_error;
});
toplevel_error:
}
unwind_to(toplevel);
lisp_shutdown();
free(src);
src/read.c
+1 -1
View File
@@ -89,7 +89,7 @@ LispVal *next_list(ReadStream *stream) {
pop_char(stream); // the (
skip_whitespace(stream);
LispVal *start = Qnil;
LispVal *end;
LispVal *end = NULL;
bool dotted = false;
while (peek_char(stream) != ')') {
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.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);
src/stack.h
+15 -103
View File
@@ -3,7 +3,6 @@
#include "base.h"
#include <setjmp.h>
#include <stdnoreturn.h>
enum StackFrameKind {
@@ -44,13 +43,16 @@ struct _StackFrame {
LispVal *args; // arguments of the function call
} call;
struct {
jmp_buf *target;
void (*handler)(void *user_ptr);
void *user_ptr;
void (*cleanup_user_ptr)(void *data);
} unwind_protect;
struct {
jmp_buf *target;
LispVal *exceptions; // list of exception symbols to catch
size_t datum; // extra value to identify this case
bool enabled;
void (*handler)(LispVal *name, LispVal *data, void *user_ptr);
void *user_ptr;
void (*cleanup_user_ptr)(void *data);
} handler_bind;
struct {
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 {
size_t max_depth;
size_t depth;
StackFrame *frames;
struct UnwindInformation unwind_info;
};
// ONLY APPLIES TO THE CALLING THREAD
static ALWAYS_INLINE StackFrame *OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val) {
assert(OBJECTP(val));
LispObject *obj = val;
return tss_get(obj->gc.lowest_local_ref);
return ((LispObject *) val)->gc.lowest_local_ref;
}
static ALWAYS_INLINE void SET_OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val,
StackFrame *frame) {
assert(OBJECTP(val));
LispObject *obj = val;
tss_set(obj->gc.lowest_local_ref, frame);
((LispObject *) val)->gc.lowest_local_ref = frame;
}
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];
}
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
void push_call_frame(LispVal *name, LispVal *args);
// 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);
// 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
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
void push_local_reference_frame(void);
@@ -177,7 +136,6 @@ static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,
unwind_to(frame);
return val;
}
noreturn void continue_unwinding(void);
noreturn void lisp_signal(LispVal *name, LispVal *data);
@@ -186,52 +144,6 @@ noreturn void lisp_signal(LispVal *name, LispVal *data);
*/
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);
MAKE_CONDITION_CLASS(excessive_lisp_nesting_error);