Exceptions!!!

src/stack.c

@@ -4,8 +4,10 @@
 #include "hashtable.h"
 #include "list.h"
 #include "memory.h"
+#include "print.h"
 
 #include <assert.h>
+#include <stdio.h>
 
 struct LispStack the_stack;
 
@@ -89,13 +91,12 @@ void push_unwind_protect_frame(jmp_buf *buf) {
     frame->unwind_protect.target = buf;
 }
 
-void push_condition_case_frame(jmp_buf *buf, LispVal **variable,
-                               LispVal *exceptions) {
+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.variable = variable;
     frame->condition_case.exceptions = exceptions;
-    *variable = Qnil;
+    frame->condition_case.datum = datum;
 }
 
 void push_local_reference_frame(void) {
@@ -271,11 +272,20 @@ void new_lexical_variable(LispVal *name, LispVal *value) {
     }
 }
 
-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) {
+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) {
+    while (the_stack.depth && &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:
@@ -291,24 +301,66 @@ void unwind_to(StackFrame *frame) {
         case STACK_FRAME_LOCAL_REFERENCES:
             teardown_local_references(top);
             break;
-        case STACK_FRAME_CALL:
         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_CALL:
             // nothing to do
             break;
         }
     }
+}
+
+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);
     the_stack.unwind_info.set = false;
 }
 
+static noreturn void top_of_stack_exception_handler(void) {
+    assert(the_stack.unwind_info.set
+           && the_stack.unwind_info.cause == UNWIND_EXCEPTION);
+    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);
+    fprintf(stderr, "\nData: ");
+    debug_print(stderr, the_stack.unwind_info.exception.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:
-        unwind_to(the_stack.unwind_info.target);
-    case UNWIND_EXCEPTION:
-        // TODO implement
+        do_unwind_to(the_stack.unwind_info.target, NULL, NULL);
         abort();
+    case UNWIND_EXCEPTION:
+        do_unwind_to(NULL, the_stack.unwind_info.exception.name,
+                     the_stack.unwind_info.exception.data);
+        top_of_stack_exception_handler();
     default:
         abort();
     }
 }
+
+noreturn void lisp_signal(LispVal *name, LispVal *data) {
+    if (NILP(Fcondition_class_p(name))) {
+        // TODO type ERROR
+    }
+    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);
+    top_of_stack_exception_handler();
+}