/* -*- Mode: C; tab-width: 4 -*- */

#include <stdio.h>
#include "machine.h"

static INLINE
void *
lookup_lexical_variable (
  lexical_environment * lex_env,
  int depth,
  int index
  )
{
  value_list * val;
  while (depth--) {
	lex_env = lex_env->next;
  }
  val = lex_env->values;
  while (index--) {
	val = val->next;
  }
  return val->value;
}
  
static INLINE
void
assign_lexical_variable (
  lexical_environment * lex_env,
  int depth,
  int index,
  void * value
  )
{
  value_list * val;
  while (depth--) {
	lex_env = lex_env->next;
  }
  val = lex_env->values;
  while (index--) {
	val = val->next;
  }
  val->value = value;
}

static symbol_table * symbols = NULL;

static INLINE
int
lookup_dynamic_variable (unsigned char * name, void ** result)
{
  symbol_table * searching = symbols;
  while (searching) {
	if (strcmp (searching->symbol, name) == 0) {
	  *result = searching->value;
	  return 1;
	  break;
	} else {
	  searching = searching->next;
	}
  }
  return 0;
}
						 
static INLINE
int
assign_dynamic_variable (unsigned char * name, void * value)
{
  symbol_table * searching = symbols;
  while (searching) {
	if (strcmp (searching->symbol, name) == 0) {
	  searching->value = value;
	  return 1;
	  break;
	} else {
	  searching = searching->next;
	}
  }
  return 0;
}

void
define_dynamic_variable (unsigned char * name, void * value)
{
  symbol_table * search = symbols;
  /* create a new symbol table entry */
  symbol_table * new_entry = (symbol_table *) GC_MALLOC (sizeof (symbol_table));
  /* copy the symbol name */
  new_entry->symbol = (unsigned char *) GC_MALLOC_ATOMIC (strlen (name));
  strcpy (new_entry->symbol, name);
  new_entry->value = value;
  /* link in the new entry */
  new_entry->next = symbols;
  symbols = new_entry;
}

int
machine (unsigned char * code)
{
  register void * acc = NULL;
  long acc2 = 0;
  register value_list * val	= NULL;
  register lexical_environment * lex_env	= NULL;
  int insn_count = 0;
  
  continuation halting_continuation = {
	"H",  /* HALT */
	NULL, /* val */
	NULL, /* lex_env */
	NULL  /* k */
  };

  register continuation * k = & halting_continuation;

  while (1) {
    
    char opcode = (*code++);
	insn_count++;
	
	/* fprintf (stderr, "opcode: %c\n", opcode); */

    switch (opcode) {

    case OP_LIT:
      (long) acc = (long)(UNPACK_LONG (code));
      code += 4;
      break;

    case OP_TEST:
      if (!((int)acc)) {
		int delta = (int)UNPACK_WORD (code);
		code += delta;
      }
	  code += 2;
      break;

    case OP_PRIMOP: {
      char primop = *(code++);
      switch (primop) {
      case PRIM_ADD:
		(int)acc = (int)acc + (int)acc2;
		break;
      case PRIM_SUB:
		(int)acc = (int)acc - (int)acc2;
		break;
      case PRIM_MUL:
		(int)acc = (int)acc * (int)acc2;
		break;
      case PRIM_DIV:
		(int)acc = (int)acc / (int)acc2;
		break;
      case PRIM_EQ:
		(int)acc = (int)acc == (int)acc2;
		break;
      case PRIM_GT:
		(int)acc = (int)acc > (int)acc2;
		break;
      case PRIM_LT:
		(int)acc = (int)acc < (int)acc2;
		break;
      }
    }
	break;

    case OP_DYNREF: {
	  int symbol_length = (int)(*code++);
	  void * temp;
	  if (!lookup_dynamic_variable (code, &temp)) {
		fprintf (stderr, "undefined symbol: %s\n", code);
		return -1;
	  } else {
		acc = temp;
	  }
	  code += symbol_length;
    }
	break;

    case OP_DYNASSIGN: {
	  int symbol_length = (int)(*code++);
	  if (!assign_dynamic_variable (code, acc)) {
		fprintf (stderr, "undefined symbol: %s\n", code);
		return -1;
	  }
	  code += symbol_length;
    }
	break;

    case OP_DEFINE: {
	  int symbol_length = (int)(*code++);
	  define_dynamic_variable (code, acc);
	  /* advance the instruction pointer */
	  code += symbol_length;
	}
	break;

    case OP_VARREF: {
	  int depth, index;
	  depth = UNPACK_WORD (code); code += 2;
	  index = UNPACK_WORD (code); code += 2;
	  acc = lookup_lexical_variable (lex_env, depth, index);
	}
	break;

    case OP_ASSIGN: {
	  int depth, index;
	  depth = UNPACK_WORD (code); code += 2;
	  index = UNPACK_WORD (code); code += 2;
	  assign_lexical_variable (lex_env, depth, index, acc);
	}
	break;


    case OP_PUSH: {
	  value_list * new_val = (value_list *) GC_MALLOC (sizeof (value_list));
	  new_val->next = val;
	  new_val->value = acc;
	  val = new_val;
	}
	break;

    case OP_MOVE_ACC2:
	  (void *)acc2 = (void *)acc;
	  break;

	case OP_HALT:
	  fprintf (stderr, "=> acc = %ld, %p\n", acc, acc);
	  return (int)acc;

    case OP_PROC: {
	  closure * proc = (closure *) GC_MALLOC (sizeof (closure));
	  int proc_length = (int) UNPACK_WORD (code);
	  code += 2;
	  proc->code = code;
	  proc->lex_env = lex_env;
	  acc = (void *) proc;
	  /* skip over procedure code */
	  code += proc_length;
	}
	break;

    case OP_SAVE: {
	  int save_length = (int) UNPACK_WORD (code);
	  /* build a new continuation */
	  continuation * k2 = (continuation *) GC_MALLOC (sizeof (continuation));
	  code += 2;
	  /* k = code2, val, lex_env, k */
	  k2->code = code + save_length;
	  k2->val = val;
	  k2->lex_env = lex_env;
	  k2->next = k;
	  k = k2;
	}
	break;

    case OP_RESTORE: {
	  code = k->code;
	  val  = k->val;
	  lex_env = k->lex_env;
	  k = k->next;
	}
	break;

	case OP_INVOKE: {
	  lexical_environment * arguments = (lexical_environment *) GC_MALLOC (sizeof (lexical_environment));
	  closure * proc = (closure *) acc;
	  code = proc->code;
	  lex_env = proc->lex_env;

	  /* extend the procedure's lexical environment
	   * with the argument list in <val>
	   */

	  arguments->values = val;
	  arguments->next = lex_env;
	  lex_env = arguments;
	  val = NULL;
	}
	break;

	default:
	  fprintf (stderr, "unknown opcode: %c/%d\n", opcode, opcode);
	  return -1;
	  break;

	}
  }
}

int
main (int argc, char *argv[])
{
  unsigned char * code;
  int code_length = 0;
  FILE * code_file;

  if (argc == 2) {
	code_file = fopen (argv[1], "rb");
  } else {
	code_file = stdin;
  }
  while (fscanf (code_file, "%d", &code_length) == 1) {
	fprintf (stderr, "reading %d code bytes\n", code_length);
	/* skip over space after number */
	fgetc (code_file);
	code = (unsigned char *) GC_MALLOC (code_length);
	if (fread (code, (size_t) 1, (size_t) code_length, code_file) != code_length) {
	  fprintf (stderr, "error reading code\n");
	} else {
	  machine (code);
	}
  }
  return 1;
}
