Implement bytecode, other than floating-point operations.

interp.c

@@ -1,6 +1,7 @@
 #include <inttypes.h>
 #include <stdbool.h>
 #include <stdlib.h>
+#include <string.h>
 
 #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,39 +311,170 @@ 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)
+  switch (var)
-    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);
+  case 0:
-    var -= 128;
+    return NIL;
-
+  case 1 ... 63:
-    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;
@@ -191,25 +484,48 @@ static value_t get_input(const interp_state_t *state, fixnum_t var)
 
       return vec->elements[var];
     }
-  else if (var == 0)
+  case 64 ... 127:
-    return NIL;
+    {
-  else
+      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;
+  vec->elements[var-128] = val;
-
-  if (var >= vec->size)
-    abort();
-
-  vec->elements[var] = 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: */