#include #include #include #include "builtin.h" #include "gc.h" /* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */ #define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s]) #define _LAMBDA_SLOT(v,s) _SLOT_VALUE(LAMBDA, v, s) typedef struct interp_state { gc_root_t lambda; gc_root_t frame; gc_root_t argv; gc_root_t k; gc_root_t ctx; } interp_state_t; /* Quick references to main builtins */ static gc_root_t structure_type_root; static gc_root_t template_type_root; static gc_root_t lambda_type_root; /* Local helper routines */ static bool struct_is_a(value_t s, value_t type); static void translate_callable(interp_state_t *state); static void run_byte_code(interp_state_t *state); static void perform_tail_call(interp_state_t *state); static value_t get_input(const interp_state_t *state, fixnum_t var); static void set_output(const interp_state_t *state, fixnum_t var, value_t val); static void register_state(interp_state_t *state, value_t lambda, value_t argv); static void unregister_state(interp_state_t *state); void interpreter_init(void) { register_gc_root(&structure_type_root, lookup_builtin(BI_STRUCTURE)); register_gc_root(&template_type_root, lookup_builtin(BI_TEMPLATE)); register_gc_root(&lambda_type_root, lookup_builtin(BI_LAMBDA)); } value_t run_interpreter(value_t lambda, value_t argv) { static bool run_finalizers = true; interp_state_t state; register_state(&state, lambda, argv); /* Keep going until something attempt to tail-call NIL, the original 'k', indicating completion. */ while (!is_nil(state.lambda.value)) { /* 'lambda' may be a callable structure; if so, follow the 'callable' proxies and update argv. */ translate_callable(&state); /* * Now 'lambda' really is a lambda structure instance. */ /* Allocate frame variables */ state.frame.value = make_vector(get_fixnum(_LAMBDA_SLOT(state.lambda.value, FRAME_VARS)), NIL); run_byte_code(&state); perform_tail_call(&state); if (run_finalizers) { value_t v, f; get_next_finalizer(&v, &f); if (is_object(v)) { gc_root_t f_root; register_gc_root(&f_root, f); run_finalizers = false; /* Note that recursion is limited to a single level by the static variable. */ run_interpreter(f_root.value, cons(v, NIL)); run_finalizers = true; unregister_gc_root(&f_root); } } } unregister_state(&state); /* The arguments passed to NIL continuation are the final return value. */ return state.argv.value; } /* TODO: Check for cycles (besides 'structure') and permit derivatives of 'structure'. */ static bool struct_is_a(value_t s, value_t type) { /* To prevent unbounded loops w/ cyclic 'parent' links. */ int ttl = 256; if (!is_struct(s)) return false; for (value_t t = _get_struct(s)->type; t != type; t = _SLOT_VALUE(STRUCTURE, t, SUPER), --ttl) { if (is_nil(t)) return false; if (get_struct(t)->type != structure_type_root.value) abort(); if (ttl <= 0) abort(); } return true; } static void translate_callable(interp_state_t *state) { while (!struct_is_a(state->lambda.value, lambda_type_root.value)) { if (!struct_is_a(get_struct(state->lambda.value)->type, structure_type_root.value)) abort(); /* Prepend structure instance to argument list, per proxy protocol. */ state->argv.value = cons(state->lambda.value, state->argv.value); /* Follow link to next callable. */ state->lambda.value = _SLOT_VALUE(STRUCTURE, _get_struct(state->lambda.value)->type, CALLABLE); } } static void run_byte_code(interp_state_t *state) { /* TODO */ } static void perform_tail_call(interp_state_t *state) { value_t new_lambda, new_argv, new_ctx, new_k; new_lambda = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, TAIL_CALL))); new_argv = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, ARG_LIST))); new_k = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTINUATION))); new_ctx = get_input(state, get_fixnum(_LAMBDA_SLOT(state->lambda.value, CONTEXT))); state->lambda.value = new_lambda; state->argv.value = new_argv; state->k.value = new_k; state->ctx.value = new_ctx; } static value_t get_input(const interp_state_t *state, fixnum_t var) { if (var >= 256) abort(); else if (var == 255) return state->ctx.value; else if (var == 254) return state->k.value; else if (var == 253) return state->argv.value; else if (var >= 248) abort(); /* reserved */ else if (var >= 128) { vector_t *vec = _get_vector(state->frame.value); var -= 128; if (var >= vec->size) abort(); return vec->elements[var]; } else if (var >= 64) { vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, INSTANCE_VARS)); var -= 64; if (var >= vec->size) abort(); return vec->elements[var]; } else if (var >= 1) { vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, GLOBAL_VARS)); var -= 1; if (var >= vec->size) abort(); return vec->elements[var]; } else if (var == 0) return NIL; else abort(); } static void set_output(const interp_state_t *state, fixnum_t var, value_t val) { vector_t *vec = _get_vector(state->frame.value); if (var < 128) abort(); var -= 128; if (var >= vec->size) abort(); vec->elements[var] = val; } static void register_state(interp_state_t *state, value_t lambda, value_t argv) { register_gc_root(&state->lambda, lambda); register_gc_root(&state->frame, NIL); register_gc_root(&state->argv, argv); register_gc_root(&state->k, NIL); register_gc_root(&state->ctx, NIL); } static void unregister_state(interp_state_t *state) { unregister_gc_root(&state->lambda); unregister_gc_root(&state->frame); unregister_gc_root(&state->argv); unregister_gc_root(&state->k); unregister_gc_root(&state->ctx); } /* vim:set sw=2 expandtab: */