Rewrite the stack

src/stack.h

@@ -4,9 +4,22 @@
 #include "base.h"
 #include "list.h"
 
-#define DEFAULT_MAX_LISP_EVAL_DEPTH   1000
+#include <setjmp.h>
+#include <stdnoreturn.h>
+
+enum StackFrameKind {
+    STACK_FRAME_LOCAL_REFERENCES,
+    STACK_FRAME_CALL,
+    STACK_FRAME_UNWIND_PROTECT,
+    STACK_FRAME_CONDITION_CASE,
+    STACK_FRAME_DYNAMIC_BINDING,
+};
+
+#define LISP_STACK_MAX_DEPTH          4096
 #define LOCAL_REFERENCES_BLOCK_LENGTH 64
 
+#define LISP_LONGJMP_FOR_UNWIND 1
+
 struct LocalReferencesBlock {
     LispVal *refs[LOCAL_REFERENCES_BLOCK_LENGTH];
 };
@@ -17,68 +30,109 @@ struct LocalReferences {
     struct LocalReferencesBlock **blocks;
 };
 
-struct StackFrame {
-    LispVal *name; // name of function call
-    LispVal *fobj; // the function object
-    bool evaled_args; // whether args have been evaluated yet
-    LispVal *args; // arguments of the function call
-    LispVal *lexenv; // lexical environment (plist)
-    struct LocalReferences local_refs;
-
+typedef struct _StackFrame StackFrame;
+struct _StackFrame {
+    enum StackFrameKind kind;
     bool marked; // whether we have GC'ed this frame
+    StackFrame *last_references;
+    union {
+        struct LocalReferences local_references;
+        struct {
+            LispVal *name; // name of function call
+            LispVal *fobj; // the function object
+            bool evaled_args; // whether args have been evaluated yet
+            LispVal *args; // arguments of the function call
+        } call;
+        struct {
+            jmp_buf *target;
+            StackFrame **unwind_target;
+        } unwind_protect;
+        struct {
+            jmp_buf *target;
+            LispVal **variable;
+            LispVal *exceptions; // list of exception symbols to catch
+        } condition_case;
+        struct {
+            LispVal *symbol;
+            LispVal *old_value;
+        } dynamic_binding;
+    };
+};
+
+enum UnwindCause {
+    UNWIND_NORMAL,
+    UNWIND_EXCEPTION,
+};
+
+struct UnwindInformation {
+    bool set;
+    enum UnwindCause cause;
+    union {
+        StackFrame *target;
+        struct {
+            LispVal *name;
+            LispVal *data;
+        } exception;
+    };
 };
 
 struct LispStack {
     size_t max_depth;
     size_t depth;
-    size_t first_clear_local_refs; // index of the first frame that has local
-                                   // refs that has not been grown
-    struct StackFrame *frames;
+    StackFrame *frames;
 
     LispVal *nogc_retval;
+    struct UnwindInformation unwind_info;
 };
 
 extern struct LispStack the_stack;
 
-static ALWAYS_INLINE struct StackFrame *LISP_STACK_TOP(void) {
-    return the_stack.depth ? &the_stack.frames[the_stack.depth - 1] : NULL;
-}
-
-static ALWAYS_INLINE LispVal *TOP_LEXENV(void) {
-    return the_stack.depth ? LISP_STACK_TOP()->lexenv : Qnil;
-}
-
-static ALWAYS_INLINE LispVal *PARENT_LEXENV(void) {
-    return the_stack.depth > 1 ? the_stack.frames[the_stack.depth - 2].lexenv
-                               : Qnil;
-}
-
 void lisp_init_stack(void);
 void lisp_teardown_stack(void);
-void push_stack_frame(LispVal *name, LispVal *fobj, LispVal *args);
-void pop_stack_frame(void);
-void add_local_reference_no_recurse(LispVal *obj);
-void add_local_reference(LispVal *obj);
 
-// replace the args in the top stack frame with ARGS and mark them as evaluted
+static ALWAYS_INLINE StackFrame *LISP_STACK_REF(void) {
+    if (!the_stack.depth) {
+        return NULL;
+    }
+    return &the_stack.frames[the_stack.depth - 1];
+}
+void unwind_to(StackFrame *frame);
+noreturn void continue_unwinding(void);
+
+// functions
+void push_call_frame(LispVal *name, LispVal *fobj, LispVal *args);
+// replace the args in the top stack frame with ARGS and mark them as evaluated
 // (this is for backtraces)
-void set_stack_evaluated_args(LispVal *args);
+void set_stack_evaluated_args(StackFrame *restrict ref, LispVal *args);
 
-// Return true if successful, false if not found and not created
-bool set_lexical_variable(LispVal *name, LispVal *value, bool create_if_absent);
-// Just add a new lexical variable without any checking
-static inline void new_lexical_variable(LispVal *name, LispVal *value) {
-    assert(the_stack.depth != 0);
-    LISP_STACK_TOP()->lexenv =
-        CONS(name, CONS(value, LISP_STACK_TOP()->lexenv));
-    LISP_STACK_TOP()->marked = false;
-    gc_mark_stack_for_rescan();
+// unwind protect
+void push_unwind_protect_frame(jmp_buf *buf);
+
+// condition case
+void push_condition_case_frame(jmp_buf *buf, LispVal **variable,
+                               LispVal *exceptions);
+
+// local references
+void push_local_reference_frame(void);
+void add_local_reference_no_recurse(StackFrame *restrict frame, LispVal *obj);
+void add_local_reference(StackFrame *restrict frame, LispVal *obj);
+
+static ALWAYS_INLINE struct LocalReferences *TOP_LOCAL_REFERENCES(void) {
+    assert(the_stack.depth > 0);
+    return &the_stack.frames[the_stack.depth - 1].local_references;
 }
 
-// Copy the previous frame's lexenv to the top of the stack.
-void copy_parent_lexenv(void);
+// dynamic binding
+void push_dynamic_binding(LispVal *name, LispVal *new_value);
+static ALWAYS_INLINE void push_copy_lexenv(void) {
+    push_dynamic_binding(Qlexical_environment, Vlexical_environment);
+}
 
-// used by the GC
-void compact_stack_frame(struct StackFrame *restrict frame);
+void set_lexical_variable(LispVal *name, LispVal *value);
+// Just add a new lexical variable without any checking
+static inline void new_lexical_variable(LispVal *name, LispVal *value) {
+    LispSymbol *lexenv = (LispSymbol *) Qlexical_environment;
+    lexenv->value = CONS(name, CONS(value, lexenv->value));
+}
 
 #endif