#ifndef INCLUDED_STACK_H #define INCLUDED_STACK_H #include "base.h" #include #include enum StackFrameKind { STACK_FRAME_LOCAL_REFERENCES, STACK_FRAME_CALL, STACK_FRAME_UNWIND_PROTECT, STACK_FRAME_HANDLER_BIND, STACK_FRAME_DYNAMIC_BINDING, STACK_FRAME_BLOCK, }; #define LISP_STACK_MAX_DEPTH 4096 #define LISP_STACK_SOFT_MAX_DEPTH 4000 #define LOCAL_REFERENCES_BLOCK_LENGTH 64 #define LISP_LONGJMP_FOR_UNWIND 1 struct LocalReferencesBlock { LispVal *refs[LOCAL_REFERENCES_BLOCK_LENGTH]; }; struct LocalReferences { size_t num_blocks; size_t num_refs; struct LocalReferencesBlock **blocks; }; 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 { void (*handler)(void *user_ptr); void *user_ptr; void (*cleanup_user_ptr)(void *data); } unwind_protect; struct { LispVal *exceptions; // list of exception symbols to catch 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; LispVal *old_value; } dynamic_binding; struct { LispVal *tag; jmp_buf *target; LispVal *volatile *value_ptr; StackFrame *unwind_to; } block; }; }; struct LispStack { size_t max_depth; size_t depth; StackFrame *frames; }; // ONLY APPLIES TO THE CALLING THREAD static ALWAYS_INLINE StackFrame *OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val) { assert(OBJECTP(val)); return ((LispObject *) val)->gc.lowest_local_ref; } static ALWAYS_INLINE void SET_OBJECT_LOWEST_LOCAL_REFERENCE(LispVal *val, StackFrame *frame) { assert(OBJECTP(val)); ((LispObject *) val)->gc.lowest_local_ref = frame; } extern struct LispStack the_stack; void lisp_init_stack(void); void lisp_teardown_stack(void); static ALWAYS_INLINE StackFrame *LISP_STACK_REF(void) { if (!the_stack.depth) { return NULL; } return &the_stack.frames[the_stack.depth - 1]; } // functions void push_call_frame(LispVal *name, 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(StackFrame *restrict ref, LispVal *fobj, LispVal *args); // unwind protect void push_unwind_protect_frame(void (*handler)(void *user_ptr), void *user_ptr, void (*cleanup_user_ptr)(void *data)); // handler bind 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); 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; } // 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); } void set_lexical_variable(LispVal *name, LispVal *value); // Just add a new lexical variable without any checking void new_lexical_variable(LispVal *name, LispVal *value); void unwind_to(StackFrame *frame); static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame, LispVal *val) { add_local_reference(frame, val); unwind_to(frame); return val; } noreturn void lisp_signal(LispVal *name, LispVal *data); DECLARE_FUNCTION(block, (LispVal * name, LispVal *body)); DECLARE_FUNCTION(return_from, (LispVal * name, LispVal *value)); /** * Backtraces have the form (name fobj evaled? args) */ DECLARE_FUNCTION(backtrace, (void) ); DECLARE_SYMBOL(no_such_block_error); MAKE_CONDITION_CLASS(no_such_block_error); DECLARE_SYMBOL(excessive_lisp_nesting_error); MAKE_CONDITION_CLASS(excessive_lisp_nesting_error); #endif