Exception handling

src/stack.h

@@ -10,7 +10,7 @@ enum StackFrameKind {
     STACK_FRAME_LOCAL_REFERENCES,
     STACK_FRAME_CALL,
     STACK_FRAME_UNWIND_PROTECT,
-    STACK_FRAME_CONDITION_CASE,
+    STACK_FRAME_HANDLER_BIND,
     STACK_FRAME_DYNAMIC_BINDING,
 };
 
@@ -44,13 +44,13 @@ struct _StackFrame {
         } call;
         struct {
             jmp_buf *target;
-            StackFrame **unwind_target;
         } unwind_protect;
         struct {
             jmp_buf *target;
             LispVal *exceptions; // list of exception symbols to catch
             size_t datum; // extra value to identify this case
-        } condition_case;
+            bool enabled;
+        } handler_bind;
         struct {
             LispVal *symbol;
             LispVal *old_value;
@@ -71,7 +71,7 @@ struct UnwindInformation {
         struct {
             LispVal *name;
             LispVal *data;
-            size_t handler_datum;
+            StackFrame *handler_frame;
         } exception;
     };
 };
@@ -110,6 +110,14 @@ 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);
@@ -122,10 +130,10 @@ static ALWAYS_INLINE LispVal *EXCEPTION_DATA(void) {
     return the_stack.unwind_info.exception.data;
 }
 
-static ALWAYS_INLINE size_t EXCEPTION_HANDLER_DATUM(void) {
+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_datum;
+    return the_stack.unwind_info.exception.handler_frame;
 }
 
 // functions
@@ -138,8 +146,8 @@ void set_stack_evaluated_args(StackFrame *restrict ref, LispVal *fobj,
 // unwind protect
 void push_unwind_protect_frame(jmp_buf *buf);
 
-// condition case
-void push_condition_case_frame(jmp_buf *buf, LispVal *exceptions, size_t datum);
+// handler bind
+bool *push_handler_bind_frame(jmp_buf *buf, LispVal *exceptions, size_t datum);
 
 // local references
 void push_local_reference_frame(void);
@@ -172,6 +180,11 @@ noreturn void continue_unwinding(void);
 
 noreturn void lisp_signal(LispVal *name, LispVal *data);
 
+/**
+ * Backtraces have the form (name fobj evaled? args)
+ */
+DECLARE_FUNCTION(backtrace, (void) );
+
 #define UNWIND_PROTECT(body, cleanup)                        \
     {                                                        \
         jmp_buf _internal_jb;                                \
@@ -186,17 +199,35 @@ noreturn void lisp_signal(LispVal *name, LispVal *data);
         }                                                    \
     };
 
-#define CONDITION_CASE(exceptions, body, handler)                    \
+#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_condition_case_frame(&_internal_jb, exceptions, 0); \
+            push_handler_bind_frame(&_internal_jb, (exceptions), 0); \
             {body};                                                  \
             unwind_to(_internal_target);                             \
         } else {                                                     \
-            {handler};                                               \
             unwind_to(_internal_target);                             \
+            {handler};                                               \
+            CLEAR_EXCEPTION();                                       \
         }                                                            \
     };