diff --git a/interp.c b/interp.c index 4c431ec..8b6f042 100644 --- a/interp.c +++ b/interp.c @@ -1,6 +1,7 @@ #include #include #include +#include #include "builtin.h" #include "gc.h" @@ -9,6 +10,11 @@ #define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s]) #define _LAMBDA_SLOT(v,s) _SLOT_VALUE(LAMBDA, v, s) +/* Shorthand for frequently-used fields */ +#define ST1 (state->in1.value) +#define ST2 (state->in2.value) +#define ST3 (state->in3.value) + typedef struct interp_state { gc_root_t lambda; @@ -16,6 +22,9 @@ typedef struct interp_state gc_root_t argv; gc_root_t k; gc_root_t ctx; + gc_root_t in1; + gc_root_t in2; + gc_root_t in3; } interp_state_t; /* Quick references to main builtins */ @@ -23,16 +32,39 @@ static gc_root_t structure_type_root; static gc_root_t template_type_root; static gc_root_t lambda_type_root; -/* Local helper routines */ +/* + * Local helper routines + */ + static bool struct_is_a(value_t s, value_t type); + +static value_t vector_ref(value_t v, fixnum_t idx); +static char byte_string_ref(value_t v, fixnum_t idx); +static value_t struct_ref(value_t v, fixnum_t idx); + +static void vector_set(value_t v, fixnum_t idx, value_t newval); +static void byte_string_set(value_t v, fixnum_t idx, char newval); +static void struct_set(value_t v, fixnum_t idx, value_t newval); + +static value_t make_lambda(interp_state_t *state, value_t templ); + 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 eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2); +static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uint8_t in); + +static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint32_t in3); + 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)); @@ -90,10 +122,10 @@ value_t run_interpreter(value_t lambda, value_t argv) return state.argv.value; } -/* TODO: Check for cycles (besides 'structure') and permit derivatives of 'structure'. */ +/* TODO: Permit derivatives of 'structure'. */ static bool struct_is_a(value_t s, value_t type) { - /* To prevent unbounded loops w/ cyclic 'parent' links. */ + /* Detect unbounded loops w/ cyclic 'parent' links. */ int ttl = 256; if (!is_struct(s)) @@ -114,6 +146,110 @@ static bool struct_is_a(value_t s, value_t type) return true; } +static value_t vector_ref(value_t v, fixnum_t idx) +{ + vector_t *vec = get_vector(v); + + if (idx < 0 || idx >= vec->size) + abort(); + + return vec->elements[idx]; +} + +static char byte_string_ref(value_t v, fixnum_t idx) +{ + byte_string_t *str = get_byte_string(v); + + if (idx < 0 || idx >= str->size) + abort(); + + return str->bytes[idx]; +} + +static value_t struct_ref(value_t v, fixnum_t idx) +{ + struct_t *s = get_struct(v); + + if (idx < 0 || idx >= s->nslots) + abort(); + + return s->slots[idx]; +} + +static void vector_set(value_t v, fixnum_t idx, value_t newval) +{ + vector_t *vec = get_vector(v); + + if (idx < 0 || idx >= vec->size) + abort(); + + vec->elements[idx] = newval; +} + +static void byte_string_set(value_t v, fixnum_t idx, char newval) +{ + byte_string_t *str = get_byte_string(v); + + if (idx < 0 || idx >= str->size) + abort(); + + str->bytes[idx] = newval; +} + +static void struct_set(value_t v, fixnum_t idx, value_t newval) +{ + struct_t *s = get_struct(v); + + if (idx < 0 || idx >= s->nslots) + abort(); + + s->slots[idx] = newval; +} + +static value_t make_lambda(interp_state_t *state, value_t templ) +{ + gc_root_t templ_root, lambda_root; + value_t lval; + struct_t *ls; + struct_t *ts; + vector_t *l_inst; + byte_string_t *t_inst; + + register_gc_root(&templ_root, templ); + register_gc_root(&lambda_root, make_struct(lambda_type_root.value, LAMBDA_SLOTS)); + + /* Need to do this first, since it can call the garbage collector. */ + _get_struct(lambda_root.value)->slots[LAMBDA_SLOT_INSTANCE_VARS] = + make_vector(get_vector(get_struct(templ_root.value) + ->slots[TEMPLATE_SLOT_INSTANCE_VARS]) + ->size, + NIL); + + ls = _get_struct(lambda_root.value); + ts = _get_struct(templ_root.value); + l_inst = _get_vector(ls->slots[LAMBDA_SLOT_INSTANCE_VARS]); + t_inst = get_byte_string(ts->slots[TEMPLATE_SLOT_INSTANCE_VARS]); + + /* All but the instance variables are just shallow-copied. */ + ls->slots[LAMBDA_SLOT_GLOBAL_VARS] = ts->slots[TEMPLATE_SLOT_GLOBAL_VARS]; + ls->slots[LAMBDA_SLOT_FRAME_VARS] = ts->slots[TEMPLATE_SLOT_FRAME_VARS]; + ls->slots[LAMBDA_SLOT_BYTE_CODE] = ts->slots[TEMPLATE_SLOT_BYTE_CODE]; + ls->slots[LAMBDA_SLOT_TAIL_CALL] = ts->slots[TEMPLATE_SLOT_TAIL_CALL]; + ls->slots[LAMBDA_SLOT_ARG_LIST] = ts->slots[TEMPLATE_SLOT_ARG_LIST]; + ls->slots[LAMBDA_SLOT_CONTINUATION] = ts->slots[TEMPLATE_SLOT_CONTINUATION]; + ls->slots[LAMBDA_SLOT_CONTEXT] = ts->slots[TEMPLATE_SLOT_CONTEXT]; + + for (size_t i = 0; i < t_inst->size; ++i) + { + l_inst->elements[i] = get_input(state, t_inst->bytes[i]); + } + + unregister_gc_root(&templ_root); + unregister_gc_root(&lambda_root); + + return lambda_root.value; +} + static void translate_callable(interp_state_t *state) { while (!struct_is_a(state->lambda.value, lambda_type_root.value)) @@ -131,7 +267,33 @@ static void translate_callable(interp_state_t *state) static void run_byte_code(interp_state_t *state) { - /* TODO */ + gc_root_t bc_root; + + register_gc_root(&bc_root, _LAMBDA_SLOT(state->lambda.value, BYTE_CODE)); + + for (size_t offset = 0; (offset+3) < _get_byte_string(bc_root.value)->size; offset += 4) + { + uint8_t bytes[4]; + + memcpy(bytes, _get_byte_string(bc_root.value)->bytes + offset, 4); + + switch (bytes[0]) + { + case 0 ... 63: /* expression */ + set_output(state, bytes[1], eval_expression(state, bytes[0], bytes[2], bytes[3])); + break; + case 64 ... 127: /* statement */ + run_statement(state, bytes[0], bytes[1], bytes[2], bytes[3]); + break; + case 128 ... 255: /* conditional */ + set_output(state, bytes[0], + get_input(state, + is_true(get_input(state, bytes[1])) ? bytes[2] : bytes[3])); + break; + } + } + + unregister_gc_root(&bc_root); } static void perform_tail_call(interp_state_t *state) @@ -149,67 +311,221 @@ static void perform_tail_call(interp_state_t *state) state->ctx.value = new_ctx; } +static value_t eval_expression(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2) +{ + if (code == 0) + { + return eval_unary_expression(state, in1, in2); + } + + ST1 = get_input(state, in1); + ST2 = get_input(state, in2); + + switch (code) + { + case 0x01: + return cons(ST1, ST2); + case 0x02: + return make_vector(get_fixnum(ST1), ST2); + case 0x03: + return make_byte_string(get_fixnum(ST1), (char)get_fixnum(ST2)); + case 0x04: + return vector_ref(ST1, get_fixnum(ST2)); + case 0x05: + return make_fixnum(byte_string_ref(ST1, get_fixnum(ST2))); + case 0x06: + return struct_ref(ST1, get_fixnum(ST2)); + case 0x07: + return ST1 == ST2; + case 0x08: + return make_fixnum(get_fixnum(ST1) + get_fixnum(ST2)); + case 0x09: + return make_fixnum(get_fixnum(ST1) - get_fixnum(ST2)); + case 0x0a: + return make_fixnum(get_fixnum(ST1) * get_fixnum(ST2)); + case 0x0b: + return make_fixnum(get_fixnum(ST1) / get_fixnum(ST2)); + case 0x0c: + return make_fixnum(get_fixnum(ST1) % get_fixnum(ST2)); + case 0x0d: + return make_fixnum(get_fixnum(ST1) < get_fixnum(ST2)); + case 0x0e: + return make_fixnum(get_fixnum(ST1) >= get_fixnum(ST2)); + case 0x0f: + return make_fixnum(get_fixnum(ST1) & get_fixnum(ST2)); + case 0x10: + return make_fixnum(get_fixnum(ST1) | get_fixnum(ST2)); + case 0x11: + return make_fixnum(get_fixnum(ST1) ^ get_fixnum(ST2)); + case 0x12: + return make_fixnum(get_fixnum(ST1) << get_fixnum(ST2)); + case 0x13: + return make_fixnum(get_fixnum(ST1) >> get_fixnum(ST2)); + case 0x14: + return make_fixnum((unsigned long)get_fixnum(ST1) >> get_fixnum(ST2)); + case 0x15 ... 0x24: + return UNDEFINED; + default: + abort(); + } + + return UNDEFINED; +} + +static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uint8_t in) +{ + if (subcode == 0) + { + abort(); + } + + ST1 = get_input(state, in); + + switch (subcode) + { + case 0x01: + return ST1; + case 0x02: + return get_pair(ST1)->car; + case 0x03: + return get_pair(ST1)->cdr; + case 0x04: + return get_box(ST1)->value; + case 0x05: + return make_boolean(is_false(ST1)); + case 0x06: + return make_boolean(is_nil(ST1)); + case 0x07: + return make_boolean(is_pair(ST1)); + case 0x08: + return make_boolean(is_box(ST1)); + case 0x09: + return make_boolean(is_vector(ST1)); + case 0x0a: + return make_boolean(is_byte_string(ST1)); + case 0x0b: + return make_boolean(is_struct(ST1)); + case 0x0c: + return make_boolean(is_fixnum(ST1)); + case 0x0d: + //return make_boolean(is_float(ST1)); + return FALSE_VALUE; + case 0x0e: + return make_box(ST1); + case 0x0f: + if (!struct_is_a(ST1, structure_type_root.value)) + abort(); + return make_struct(ST1, get_vector(_get_struct(ST1)->slots[STRUCTURE_SLOT_SLOTS])->size); + case 0x10: + //return make_float((float_t)get_fixnum(ST1)); + return UNDEFINED; + case 0x11: + return make_lambda(state, ST1); + case 0x12: + return make_fixnum(~get_fixnum(ST1)); + case 0x13: + return make_fixnum(-get_fixnum(ST1)); + case 0x14: + //return make_float(-from_float(ST1)); + return UNDEFINED; + case 0x20 ... 0x31: + case 0x40 ... 0x4e: + return UNDEFINED; + default: + abort(); + } +} + +static void run_statement(interp_state_t *state, uint8_t code, uint8_t in1, uint8_t in2, uint32_t in3) +{ + ST1 = get_input(state, in1); + ST2 = get_input(state, in2); + + if (code >= 0x60) + { + ST3 = get_input(state, in3); + } + + switch (code) + { + case 0x40: + get_box(ST1)->value = ST2; + break; + case 0x41: + get_pair(ST1)->car = ST2; + break; + case 0x42: + get_pair(ST1)->cdr = ST2; + break; + case 0x60: + vector_set(ST1, get_fixnum(ST2), ST3); + break; + case 0x61: + byte_string_set(ST1, get_fixnum(ST2), (char)get_fixnum(ST3)); + break; + case 0x62: + struct_set(ST1, get_fixnum(ST2), ST3); + } +} + 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) + switch (var) { - 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) + case 0: return NIL; - else + case 1 ... 63: + { + vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, GLOBAL_VARS)); + var -= 1; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + case 64 ... 127: + { + vector_t *vec = get_vector(_LAMBDA_SLOT(state->lambda.value, INSTANCE_VARS)); + var -= 64; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + case 128 ... 247: + { + /* Frame is allocated by interpreter, so we know it's a vector already. */ + vector_t *vec = _get_vector(state->frame.value); + var -= 128; + + if (var >= vec->size) + abort(); + + return vec->elements[var]; + } + /* 248 ... 252 are reserved */ + case 253: + return state->argv.value; + case 254: + return state->k.value; + case 255: + return state->ctx.value; + default: 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) + /* Only frame variables can be output targets for bytecode instructions. */ + if (var < 128 || var >= (128 + vec->size)) abort(); - var -= 128; - - if (var >= vec->size) - abort(); - - vec->elements[var] = val; + vec->elements[var-128] = val; } static void register_state(interp_state_t *state, value_t lambda, value_t argv) @@ -219,6 +535,9 @@ static void register_state(interp_state_t *state, value_t lambda, value_t argv) register_gc_root(&state->argv, argv); register_gc_root(&state->k, NIL); register_gc_root(&state->ctx, NIL); + register_gc_root(&state->in1, NIL); + register_gc_root(&state->in2, NIL); + register_gc_root(&state->in3, NIL); } static void unregister_state(interp_state_t *state) @@ -228,6 +547,9 @@ static void unregister_state(interp_state_t *state) unregister_gc_root(&state->argv); unregister_gc_root(&state->k); unregister_gc_root(&state->ctx); + unregister_gc_root(&state->in1); + unregister_gc_root(&state->in2); + unregister_gc_root(&state->in3); } /* vim:set sw=2 expandtab: */