glisp/src/stack.h

#ifndef INCLUDED_STACK_H
#define INCLUDED_STACK_H

#include "base.h"

#include <setjmp.h>
#include <stdnoreturn.h>

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