Exception handling

src/stack.c

@@ -91,12 +91,13 @@ void push_unwind_protect_frame(jmp_buf *buf) {
     frame->unwind_protect.target = buf;
 }
 
-void push_condition_case_frame(jmp_buf *buf, LispVal *exceptions,
-                               size_t datum) {
-    StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_CONDITION_CASE);
-    frame->condition_case.target = buf;
-    frame->condition_case.exceptions = exceptions;
-    frame->condition_case.datum = datum;
+bool *push_handler_bind_frame(jmp_buf *buf, LispVal *exceptions, size_t datum) {
+    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;
 }
 
 void push_local_reference_frame(void) {
@@ -272,19 +273,7 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
     }
 }
 
-static bool frame_handles_exception(StackFrame *restrict frame,
-                                    LispVal *exception_name) {
-    assert(frame->kind == STACK_FRAME_CONDITION_CASE);
-    DOLIST(fe, frame->condition_case.exceptions) {
-        if (!NILP(Fcondition_subclass_p(exception_name, fe))) {
-            return true;
-        }
-    }
-    return false;
-}
-
-void do_unwind_to(StackFrame *frame, LispVal *exception_name,
-                  LispVal *exception_data) {
+static void do_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) {
@@ -301,14 +290,7 @@ void do_unwind_to(StackFrame *frame, LispVal *exception_name,
         case STACK_FRAME_LOCAL_REFERENCES:
             teardown_local_references(top);
             break;
-        case STACK_FRAME_CONDITION_CASE:
-            if (exception_name
-                && frame_handles_exception(top, exception_name)) {
-                the_stack.unwind_info.exception.handler_datum =
-                    top->condition_case.datum;
-                longjmp(*top->condition_case.target, LISP_LONGJMP_FOR_UNWIND);
-            }
-            break;
+        case STACK_FRAME_HANDLER_BIND:
         case STACK_FRAME_CALL:
             // nothing to do
             break;
@@ -320,10 +302,40 @@ 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, NULL, NULL);
+    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);
+    DOLIST(fe, frame->handler_bind.exceptions) {
+        if (!NILP(Fcondition_subclass_p(exception_name, fe))) {
+            return true;
+        }
+    }
+    return false;
+}
+
+static StackFrame *find_exception_handler(StackFrame *from,
+                                          LispVal *exception_name) {
+    for (ptrdiff_t i = from - the_stack.frames; i >= 0; --i) {
+        StackFrame *restrict top = &the_stack.frames[i];
+        if (top->kind == STACK_FRAME_HANDLER_BIND && top->handler_bind.enabled
+            && frame_handles_exception(top, exception_name)) {
+            return top;
+        }
+    }
+    return NULL;
+}
+
+static void do_run_handler_cases(LispVal *name, 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);
+    }
+}
+
 static noreturn void top_of_stack_exception_handler(void) {
     assert(the_stack.unwind_info.set
            && the_stack.unwind_info.cause == UNWIND_EXCEPTION);
@@ -341,11 +353,12 @@ 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, NULL, NULL);
+        do_unwind_to(the_stack.unwind_info.target);
         abort();
     case UNWIND_EXCEPTION:
-        do_unwind_to(NULL, the_stack.unwind_info.exception.name,
-                     the_stack.unwind_info.exception.data);
+        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();
@@ -354,13 +367,28 @@ noreturn void continue_unwinding(void) {
 
 noreturn void lisp_signal(LispVal *name, LispVal *data) {
     if (NILP(Fcondition_class_p(name))) {
-        // TODO type ERROR
+        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_unwind_to(NULL, name, data);
+    do_run_handler_cases(name, LISP_STACK_REF());
+    do_unwind_to(NULL);
     top_of_stack_exception_handler();
 }
+
+DEFUN(backtrace, "backtrace", (void), "()", "") {
+    LispVal *out = Qnil;
+    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,
+                            frame->call.evaled_args ? Qt : Qnil,
+                            frame->call.args),
+                       out);
+        }
+    }
+    return out;
+}