/* byte-engine.c: -*- C -*-  DESCRIPTIVE TEXT. */

/*  Copyright (c) 1996 Universal Access Inc.
    Author: E. B. Gamble Jr. (ebg@ai.mit.edu) Thu Oct 10 22:53:12 1996.  */

#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
#include <stdarg.h>
#include <string.h>
#include <ctype.h>
#include <assert.h>
#include <sys/time.h>

#include "object.h"
#include "code.h"
#include "xmalloc.h"

extern void fail (void);

#if !defined (macintosh)
extern double strtod (const char *, char **);
#endif

struct bc_byte_code_spec
bc_byte_code_spec_table [1 + BC_NUMBER_OF_BYTEOPS] =
{
# define BYTEOP( code, name, length )		\
  {						\
    BC_##code##_OP,				\
    BC_##code##_OP_LEN,				\
    name					\
  },
# include "byte_ops.h"
# undef BYTEOP
};

static void 
bc_byte_code_instr_disassemble (bc_byte_code_t *cp, FILE *file);

#define BC_CONT_BUCKET_SIZE    5
#define BC_CONT_BUCKET_COUNT 100

/* Forward Declaration */
typedef struct bc_cont *bc_cont_t;

struct bc_cont {
  bc_cont_t      parent;
  unsigned int   size;
  bc_function_t  function;
  bc_byte_code_t *cp;
  bc_object_t   *sp;
  bc_object_t    stack [1];
};

#define BC_CONT_PARENT( cont )   ((cont)->parent)
#define BC_CONT_SIZE( cont )     ((cont)->size)
#define BC_CONT_FUNCTION( cont ) ((cont)->function)
#define BC_CONT_CODE( cont )     BC_FUNCTION_CODE((cont)->function)
#define BC_CONT_CP( cont )       ((cont)->cp)
#define BC_CONT_SP( cont )       ((cont)->sp)
#define BC_CONT_STACK( cont )    ((cont)->stack)

static bc_cont_t
bc_cont_cache [BC_CONT_BUCKET_COUNT];

static inline bc_cont_t
bc_cont_lookup (unsigned int size)
{
  bc_cont_t cont;
  unsigned int index = size / BC_CONT_BUCKET_SIZE;
  
  cont = (index < BC_CONT_BUCKET_COUNT && bc_cont_cache [index])
    ? bc_cont_cache [index]
    : (bc_cont_t) xmalloc (sizeof (struct bc_cont)
			   + (size - 1) * sizeof (bc_object_t));

    if (index < BC_CONT_BUCKET_COUNT)
      bc_cont_cache [index] = cont->parent;


    cont->parent = (bc_cont_t) NULL;
    cont->size   = size;
    return (cont);
}

static inline void
bc_cont_fill (bc_cont_t cont, bc_cont_t parent, bc_function_t function)
{
  BC_CONT_PARENT   (cont) = parent;
  BC_CONT_FUNCTION (cont) = function;
  BC_CONT_CP (cont) = BC_CONT_CODE (cont);
  BC_CONT_SP (cont) = BC_CONT_STACK (cont);
  assert (BC_CONT_SIZE (cont) == BC_FUNCTION_STACK_SIZE (function));
}

static inline void
bc_cont_return (bc_cont_t cont)
{
  unsigned int index = cont->size / BC_CONT_BUCKET_SIZE;

  if (index < BC_CONT_BUCKET_COUNT)
    {
      cont->parent = bc_cont_cache [index];
      bc_cont_cache [index] = cont;
    }
  else
    free (cont);
}

#if 0
/*
 * BC Environment 
 *
 *
 */
static bc_env_list_t
bc_env_lookup (bc_env_t env, bc_string_t name)
{
  bc_env_list_t values;

  for (values = BC_ENV_VALUES (env); values; values = values->next)
    if (0 == strcmp (name, values->name))
      return (values);
  return ((bc_env_list_t) NULL);
}

static bc_function_t
bc_env_lookup_function (bc_env_t env, bc_string_t name)
{
  bc_env_list_t value = bc_env_lookup (env, name);

  return (((! value) || value->type != BC_ENV_ITEM_FUNCTION)
	  ? (bc_function_t) NULL
	  : value->u.function);
}

static void
bc_env_insert_function (bc_env_t env,
			bc_string_t name,
			bc_function_t function)
{
  bc_env_list_t value = (bc_env_list_t) xmalloc (sizeof (struct bc_env_list));

  value->name = name;
  value->type = BC_ENV_ITEM_FUNCTION;
  value->u.function = function;
  value->next = env->values;
  env->values = value;
}
#endif

/*
 * BC Engine Stepping, Tracing and Performance Monitoring
 *
 *
 */
#if defined (BC_DEBUG)

bc_boolean_t bc_engine_step_p      = bc_false;
bc_boolean_t bc_engine_perfmon_p   = bc_false;
bc_boolean_t bc_engine_trace_p     = bc_true;
unsigned int bc_engine_trace_depth = 0;

/*
 * Tracing
 *
 */
extern void
bc_engine_trace_call (bc_string_t   function_name,
		      bc_function_t function,
		      unsigned int  arg_count,
		      bc_object_t  *args)
{
  unsigned int count;

  for (count = 0; count < bc_engine_trace_depth; count++)
    puts ("| ");

  /* The function */
  putchar ('<');
  puts (function_name);
 
  /* Its args */
  for (count = 0; count < arg_count; count++)
    {
      putchar (' ');
      puts ((bc_string_t) args[count]);
    }
  putchar ('>');
  
  bc_engine_trace_depth++;
}

extern void
bc_engine_trace_return (bc_object_t return_value)
{
  unsigned int count;

  bc_engine_trace_depth--;
  for (count = 0; count < bc_engine_trace_depth; count++)
    puts ("| ");

  puts (">>");
  puts ((bc_string_t) return_value);
}

/*
 * (Single) Stepping
 *
 */
static void
bc_engine_step (bc_object_t   *stack, 
		bc_object_t   *sp,
		bc_byte_code_t *cp)
{
  
}

/*
 * Performance Monitoring
 *
 */
typedef struct bc_engine_perf 
{
  unsigned int pair_call_count [BC_NUMBER_OF_BYTEOPS];
  unsigned int   call_count;
  struct timeval call_time;
} *bc_engine_perf_t;

static struct bc_engine_perf
bc_engine_perf_data [BC_NUMBER_OF_BYTEOPS];

static void
bc_engine_perf_update (bc_byte_code_t  *codes,
		       struct timeval *interval)
{
  bc_byte_op_t        this_op   = *codes;
  bc_engine_perf_t   this_perf = & bc_engine_perf_data [this_op];
  bc_byte_code_spec_t this_spec = & bc_bytecode_spec_table [this_op];
  bc_byte_op_t        next_op   = *(codes + this_spec->length);

  this_perf->call_count++;
  /* Should be some macros to do this */
  this_perf->call_time.tv_sec  += interval->tv_sec;
  this_perf->call_time.tv_usec += interval->tv_usec;
  /* Recoord pairwise count */
  if (this_op != BC_RETURN_OP)
    this_perf->pair_call_count [next_op]++;
}

static void
bc_engine_perf_clear (void)
{
  memset ((void *) bc_engine_perf_data,
	  0,
	 BC_NUMBER_OF_BYTEOPS * sizeof (bc_engine_perf_t));
}
 
extern void
bc_engine_perf_report (void)
{
  bc_byte_op_t op, next_op;
  for (op = 0; op < BC_NUMBER_OF_BYTEOPS; op++)
    {
      bc_engine_perf_t   perf = & bc_engine_perf_data [op];
      bc_byte_code_spec_t spec = & bc_bytecode_spec_table [op];
      
      printf ("%s\n  count: %d\n  time : %d.%6d,  pairs:\n",
	      spec->name,
	      perf->call_count,
	      perf->call_time.tv_sec,
	      perf->call_time.tv_usec);
      if (op != BC_RETURN_OP)
	for (next_op = 0; next_op < BC_NUMBER_OF_BYTEOPS; next_op++)
	  printf ("    %s: %d\n",
		  bc_byte_code_spec_table[next_op].name,
		  perf->pair_call_count [next_op]);
    }
}


#endif /* defined (BC_DEBUG) */
  

static bc_string_t
bc_engine_format (bc_format_t  format,
		  bc_object_t *stack)
{
  bc_string_t string;
  bc_format_t format_save = format;
  size_t size = 0;

  printf ("\n");
  
  /* Compute the size of the result */
  for (format = format_save; format; format = BC_FORMAT_NEXT (format))
    switch (BC_FORMAT_TYPE (format))
      {
      case BC_INDEX_TYPE:
	{
	  unsigned int dex =
	    ((bc_index_t) BC_FORMAT_OBJECT (format));

	  printf ("INDEX: Dex is %d, String is %s, Size by %d\n",
		  dex,
		  (bc_string_t) stack [dex],
		  strlen (stack [dex]));

	  size += strlen (stack [dex]);
	  break;
	}

      case BC_STRING_TYPE:
	printf ("STRING: String is %s, Size by %d\n", 
		(bc_string_t) BC_FORMAT_OBJECT (format),
		strlen (BC_FORMAT_OBJECT (format)));
	  
	size += strlen (BC_FORMAT_OBJECT (format));
	break;
      default:
	printf ("Strange format type of %d\n",
		BC_FORMAT_TYPE (format));
	break;
      }

  string = (char *) malloc (size);
  if (! string)
    {
      printf ("OUT OF MEMORY\n");
      fail ();
    }
  string[0] = '\0';

  for (format = format_save; format; format = BC_FORMAT_NEXT (format))
    switch (BC_FORMAT_TYPE (format))
      {
      case BC_INDEX_TYPE:
	{
	  unsigned int dex =
	    ((bc_index_t) BC_FORMAT_OBJECT (format));
	  strcat (string, (bc_string_t) stack [dex]);
	  break;
	}
      
      case BC_STRING_TYPE:
	strcat (string, (bc_string_t) BC_FORMAT_OBJECT (format));
	break;
      default:
	printf ("Strange format type of %d\n",
		BC_FORMAT_TYPE (format));
	break;
      }
  printf ("String is %s.\n", string);
  return (string);
}
  
/*
 *
 * BC_WELCOME_TO_THE_MACHINE
 *
 */
extern bc_object_t
bc_welcome_to_the_machine (bc_function_t function)
{
  /* STACK */
  bc_object_t *stack;		/* Stack Base */
  bc_object_t *sp;		/* Stack Pointer */
#define STACK_PUSH(o)      (*++sp = (o))
#define STACK_POP()        (*sp--)
#define STACK_REF(n)       (*(sp+(n)))
#define STACK_SET(o,n)     (*(sp+(n)) = (o))
#define STACK_TOP()        (*sp)
#define STACK_SET_TOP(o)   (*sp  = (o))
#define STACK_ADDR(n)      ( sp  + (n))
#define STACK_POP_N(n)     ( sp -= (n))

  /* CODE */
  bc_byte_code_t *code;		/* Code Vector */
  bc_byte_code_t *cp;		/* Code Pointer */
#define OPERATOR()    (cp[0])
#define OPERAND(n)    (cp[(n)])
#define NEXTOP(code)  cp += BC_##code##_OP_LEN; break

  /* Code Constants */
  struct bc_tagged_object *constants;
#define CONSTANT(n)  (& constants[(n)])	/* skip '&' */

  /* Current continuation */
  bc_cont_t cont;

#define BC_CONT_SAVE( cont_to_save )		\
  BC_CONT_CP (cont_to_save) = cp;		\
  BC_CONT_SP (cont_to_save) = sp;

#define BC_CONT_RESTORE( cont_to_restore )		\
  cp = BC_CONT_CP (cont_to_restore);			\
  sp = BC_CONT_SP (cont_to_restore);			\
  stack     = BC_CONT_STACK (cont_to_restore);		\
  function  = BC_CONT_FUNCTION (cont_to_restore);	\
  code      = BC_FUNCTION_CODE (function);		\
  constants = BC_FUNCTION_CONSTANTS (function);		\
  cont      = cont_to_restore
  
#if defined (BC_DEBUG)
  
#endif
  /* Shorthand */
  bc_object_t object, object1, object2, object3;
  bc_tagged_object_t tagged_object;

  /* OFFSET/INDEX into CONSTANTS/STACK; COUNT of arguments */
  unsigned int offset, index, count;

  /* Axe when integrated with MHTML */
  static bc_boolean_t randomized_p = bc_false;
  
  /* Get a continuation with the required stack size */
  cont = bc_cont_lookup (BC_FUNCTION_STACK_SIZE (function));

  /* Fill out the continuation */
  bc_cont_fill (cont, (bc_cont_t) NULL, function);

  /* Restore CONT the first time to initialize all the locals */
  BC_CONT_RESTORE (cont);

  /* Initialize a random number generator */
  if (randomized_p == bc_false)
    {
      randomized_p = bc_true;
      srandom ((unsigned int) getpid ());
    }

  while (1)
    {

#if defined (BC_DEBUG)
      if (bc_engine_perfmon_p)
	{
	  static struct timeval last_time = {0, 0};
	  static struct timeval this_time = {0, 0};

	  bc_engine_perf_update (cp, & last_time);
	}

      if (bc_engine_step_p)
	{
	}
#endif /* defined (BC_DEBUG) */
	  
      /* Tracing, Monitoring, */

      switch (OPERATOR())
	{
	case BC_CALL_OP:
	  {
	    /* Formatter when not a function */
	    unsigned int offset = OPERAND (1);

	    /* Argument count for the call */
	    unsigned int count  = OPERAND (2);

	    /* Function name for the call */
	    bc_string_t name = (bc_string_t) STACK_REF (- count);

	    /* Args */
	    bc_object_t *args = STACK_ADDR (1 - count);

	    /* Function bound to NAME in 'function package' */
	    bc_function_t function = 
	      (bc_function_t) STACK_REF (- count);

#if defined (BC_DEBUG)
	    /* Delay until after following (! function) conditional */
	    if (bc_engine_trace_p)
	      bc_engine_trace_call (name, function, count, args);
#endif /* defined (BC_DEBUG) */
	    printf ("\nWill%s make a function call\n",
		    function ? "" : " not");

	    /* If no function exists, then enclose the name and its args
	       between '<' and '>' and return them as a string. */
	    if (! function)
	      {
		bc_tagged_object_t tagged = CONSTANT (offset);
		bc_format_t        format   = 
		  (bc_format_t) BC_TAGGED_OBJECT_VALUE (tagged);

		bc_string_t string =
		  bc_engine_format (format, STACK_ADDR (1 - count));
		
		/* POP off all the CALL arguments */
		STACK_POP_N (count);

		/* Replace the FUNCTION with the RESULT */
		STACK_SET_TOP (string);
		NEXTOP (CALL);
	      }
	    /* Make a function call */
	    else
	      {
		/* Get a continuation with the proper stack size */
		unsigned int call_size  = BC_FUNCTION_STACK_SIZE (function);
		bc_cont_t    call_cont  = bc_cont_lookup (call_size);
		bc_object_t *call_stack = BC_CONT_STACK (call_cont);
		unsigned int call_count = count;

		bc_cont_fill (call_cont, cont, function);

		/* Pop all the args and function from the stack
		   Variable ARGS still points to the args */
		STACK_POP_N (1 + call_count);

		/* Increment the CP for eventual return */
		cp += BC_CALL_OP_LEN;

		/* Record the stack and code pointers in the 'parent' */
		BC_CONT_SAVE (cont);

		/* Change the machine stack and code pointers and the 
		   constants vector to reflect the new continuation */

		/* Goto the new continuation */
		BC_CONT_RESTORE (call_cont);

		/* Transfer the arguments */
		STACK_POP ();		/* Setup to PUSH */
		while (call_count--)
		  STACK_PUSH (*args++);

		break;
	      }
	    /* End of BC_CALL_OP */
	  }

	case BC_RETURN_OP:
	  object = STACK_TOP ();
	  {
	    bc_cont_t   
	      child  = cont,
	      parent = BC_CONT_PARENT (child);

	    if (parent == (bc_cont_t) NULL)
	      goto LABEL_bc_exit;

	    /* Restore the parent continuation */
	    BC_CONT_RESTORE (parent);

	    /* Discard the current continuation */
	    bc_cont_return (child);
	  }
	  /* Push the RETURN_VALUE */
	  STACK_PUSH (object);

#if defined (BC_DEBUG)
	  if (bc_engine_trace_p)
	    bc_engine_trace_return (object);
#endif /* defined (BC_DEBUG) */

	  /* Continue */
	  break;

	case BC_JUMP_OP:
	  cp = code + 256 * OPERAND (1) + OPERAND (2);
	  break;

	case BC_JUMP_IF_FALSE_OP:
	  object = STACK_POP ();
	  if (BC_OBJECT_IS_FALSE_P (object))
	    {
	      cp = code + 256 * OPERAND (1) + OPERAND (2);
	      break;
	    }
	  NEXTOP (JUMP_IF_FALSE);

	case BC_JUMP_IF_TRUE_OP:
	  object = STACK_POP ();
	  if (BC_OBJECT_IS_NOT_FALSE_P (object))
	    {
	      cp = code + 256 * OPERAND (1) + OPERAND (2);
	      break;
	    }
	  NEXTOP (JUMP_IF_TRUE);

	case BC_JUMP_IF_EQ_OP:
	  object1 = STACK_POP ();
	  object2 = STACK_POP ();

	  if (object1 == object2) /* no, not quite */
	    {
	      cp = code + 256 * OPERAND (1) + OPERAND (2);
	      break;
	    }
	  NEXTOP (JUMP_IF_EQ);

	case BC_POP_OP:
	  STACK_POP ();
	  NEXTOP (POP);

	case BC_DUP_OP:
	  object = STACK_TOP ();
	  STACK_PUSH (object);
	  NEXTOP (DUP);

	case BC_DATA_OP:
	  offset        = OPERAND (1);
	  tagged_object = CONSTANT (offset);
	  STACK_PUSH (BC_TAGGED_OBJECT_VALUE (tagged_object));
	  NEXTOP (DATA);

	case BC_PROG_OP:
	  {
	    unsigned int count = OPERAND (1);
	    unsigned int size  = 0;
	    unsigned int index;
	    bc_string_t  string;

	    /* Everything on the stack had best be a string */
	    while (count--)
	      /* Include 1 for '\n' or final NULL */
	      size += 1 + strlen (STACK_REF (- count));

	    /* Allocate a string */
	    string = (bc_string_t) malloc (size);
	    string [0] =
	      string [size] = '\0';

	    count   = OPERAND (1);
	    while (count--)
	      {
		/* Do the stupidest (I mean STUPIDEST) possible thing */
		strcat (string, STACK_REF (- count));
		if (count)
		  strcat (string, "\n");
	      }

	    count = OPERAND (1);
	    STACK_POP_N (count);
	    STACK_PUSH ((bc_object_t) string);
	    NEXTOP (PROG);
	  }
	
	case BC_FMT_OP:
	  offset = OPERAND (1);
	  count  = OPERAND (2);
	  tagged_object = CONSTANT (offset);
	  {
	    bc_format_t format   = 
	      (bc_format_t) BC_TAGGED_OBJECT_VALUE (tagged_object);

	    /* Result STRING */
	    object = (bc_object_t)
	      bc_engine_format (format, STACK_ADDR (1 - count));
	  }
	  STACK_POP_N (count);
	  STACK_PUSH (object);
	  NEXTOP (FMT);
	    
	  /*
	   *
	   * VGET // VSET  - Variable
	   *
	   */
	case BC_VGET_OP:
	  offset = OPERAND (1);
	  tagged_object = CONSTANT (offset);
	    /* OBJECT is surely a symbol */
	  assert (BC_SYMBOL_TYPE == BC_TAGGED_OBJECT_TYPE (tagged_object));
	  STACK_PUSH (BC_SYMBOL_VALUE
		      ((bc_symbol_t) BC_TAGGED_OBJECT_VALUE (tagged_object)));
	  printf ("\nVGET  : \"%s\"", (bc_string_t) STACK_TOP ());
	  NEXTOP (VGET);

	case BC_VSET_OP:
	  offset         = OPERAND (1);
	  tagged_object  = CONSTANT (offset);

	  /* NAME is surely a symbol */
	  assert (BC_SYMBOL_TYPE == BC_TAGGED_OBJECT_TYPE (tagged_object));

	  BC_SYMBOL_VALUE
	    ((bc_symbol_t) BC_TAGGED_OBJECT_VALUE (tagged_object)) =
	    STACK_TOP ();
	  NEXTOP (VSET);

	  /*
	   *
	   * FGET // FSET - Function
	   *
	   */
	case BC_FGET_OP:
	  {
	    unsigned int offset = OPERAND (1);
	    bc_tagged_object_t object = CONSTANT (offset);
	    /* OBJECT is surely a symbol */
	    assert (BC_SYMBOL_TYPE == BC_TAGGED_OBJECT_TYPE (object));
	    STACK_PUSH (BC_SYMBOL_VALUE
			((bc_symbol_t) BC_TAGGED_OBJECT_VALUE (object)));
	    printf ("\nFGET  : \"%s\"", (bc_string_t) STACK_TOP ());
	    NEXTOP (FGET);
	  }

	case BC_FSET_OP:
	  {
	    unsigned int       offset = OPERAND (1);
	    bc_tagged_object_t tobj   = CONSTANT (offset);
	    bc_function_t      func   = 
	      (bc_function_t) BC_TAGGED_OBJECT_VALUE (tobj);
	    
	    /* Name of the FUNCTION will get the value ... */
	    bc_string_t func_name = BC_FUNCTION_NAME (func);
	    
	    /* ... as the symbol value in the function package */
	    bc_symbol_t func_sym  = bc_symbol_intern (func_name);
	    
	    /* TOBJ is surely a function - a little later here. */
	    assert (BC_FUNCTION_TYPE == BC_TAGGED_OBJECT_TYPE (tobj));

	    /* Install FUNC on FUNC_SYM */
	    BC_SYMBOL_VALUE (func_sym) = (bc_object_t) func;
	    BC_SYMBOL_TYPE  (func_sym) = BC_FUNCTION_TYPE;

	    /* copy */
	    STACK_PUSH (func_name);
	    NEXTOP (FSET);
	  }

	  /*
	   *
	   * SGET // SSET  - Stack
	   *
	   */
	case BC_SGET_OP:
	  offset = OPERAND (1);
	  object = stack [offset];
	  STACK_PUSH (object);
	  NEXTOP (SGET);

	case BC_SSET_OP:
	  offset = OPERAND (1);
	  object = STACK_TOP ();
	  stack [offset] = object;
	  NEXTOP (SSET);

	/*
	 * Primitive Operators
	 *
	 */
	case BC_NOT_OP:
	  object = STACK_TOP ();
	  if (BC_OBJECT_IS_FALSE_P (object))
	    STACK_PUSH (bc_object_true);
	  else
	    STACK_PUSH (bc_object_false);
	  NEXTOP (NOT);

	case BC_ADD_OP:
	  object1 = STACK_POP ();
	  object2 = STACK_TOP ();
	  {
	    double result = 
	      strtod (object1, (char **) NULL) +
	      strtod (object2, (char **) NULL);
	    char buffer [1024];
	  
	    sprintf (buffer, "%g", result);
	    /* Not quite, copy buffer */
	    STACK_SET_TOP (buffer);
	  }
	  NEXTOP (ADD);

	case BC_RANDOM_OP:
	  {
	    bc_string_t maximum_string = (bc_string_t) STACK_TOP ();
	    long int maximum = strtol (maximum_string, (char **) NULL, 10);
	    long int result  = (maximum != 0)
	      ? random () % maximum
	      : random ();
	    char *result_string = malloc (1024);
	    
	    sprintf (result_string, "%ld", result);

#if defined (TEST)
	    printf ("\n<RANDOM \"%ld\">\n  => \"%s\"\n",
		    maximum,
		    result_string);
	    printf ("Doesn't appear random to me....\n");
#endif

	    /* Not quite, copy buffer */
	    STACK_SET_TOP (result_string);
	    NEXTOP (RANDOM);
	  }
	
	case BC_RANDOMIZE_OP:
	  {
	    bc_string_t seed_string = (bc_string_t) STACK_TOP ();
	    unsigned int seed = atoi (seed_string);
	    srandom (seed);
	    NEXTOP (RANDOMIZE);
	  }
	
	case BC_DOWNCASE_OP:
	  { /* Destructively to lowercase.  This can be very dangerous
	       if the stack top is anything but a string. */
	    bc_string_t 
	      str1  = (bc_string_t) STACK_POP (),
	      str2  = malloc (1 + strlen (str1)),
	      save1 = str1,
	      save2 = str2;

	    while (*str1)
	      *str2++ = tolower (*str1++);
	    *str2 = '\0';

#if defined (TEST)
	    printf ("\n<DOWNCASE \"%s\">\n  => \"%s\"\n", 
		    save1, save2);
#endif

	    STACK_PUSH (save2);
	    NEXTOP (DOWNCASE);
	  }

	case BC_GET_VAR_OP:
	  {
	    bc_string_t name   = (bc_string_t) STACK_TOP ();
	    bc_symbol_t symbol = bc_symbol_find (name);
	    bc_object_t value  = symbol
	      ? BC_SYMBOL_VALUE (symbol)
	      : bc_object_empty;
	    STACK_SET_TOP (value);
	    NEXTOP (GET_VAR);
	  }

	case BC_SET_VAR_OP:
	  {
	    bc_object_t value  = STACK_POP ();
	    bc_string_t name   = (bc_string_t) STACK_TOP ();
	    bc_symbol_t symbol = bc_symbol_find (name);
	    if (symbol)
	      BC_SYMBOL_VALUE (symbol) = value;
	    STACK_SET_TOP (value);
	    NEXTOP (GET_VAR);
	  }
	  
	default:
	  {
	    bc_byte_op_t        this_op = OPERATOR();
	    bc_byte_code_spec_t this_spec = 
	      & bc_byte_code_spec_table [this_op];

	    if (this_op >= BC_NUMBER_OF_BYTEOPS)
	      {
		printf ("Not a BYTE-OP: %d\n", this_op);
		exit (0);
	      }
	    else
	      {
		printf ("\n Unimplemented BYTE-OP: %d, %s\n",
			this_op,
			this_spec->name);
		cp += this_spec->length;
	      }
	  break;
	  }
	}

      /* Back for another OPERATOR */
    }

LABEL_bc_exit:
  {
    bc_object_t object = STACK_TOP ();
    
    /* Finally, time for output. */
    printf ("\nReturn: \"%s\"\n", (bc_string_t) object);

    /* End of the MACHINE */
    return (STACK_TOP ());
  }
}

static void 
bc_byte_code_instr_disassemble (bc_byte_code_t *opcodes, FILE *file)
{
  bc_byte_code_spec_t spec =
    & bc_byte_code_spec_table [*opcodes];
	
  bc_byte_op_t     operator = spec->operator;
  bc_byte_op_len_t length   = spec->length;
  bc_string_t      name     = spec->name;

  fprintf (file, "%s", name);
  switch (length)
    {
#if BC_MAXIMUM_BYTEOP_LEN >= 4
    case 4:
      fprintf (file, " %d,", opcodes [length - 3]);
#endif
#if BC_MAXIMUM_BYTEOP_LEN >= 3
    case 3:
      fprintf (file, " %d,", opcodes [length - 2]);
#endif
    case 2:
      fprintf (file, " %d",  opcodes [length - 1]);
    case 1:
      fprintf (file, "\n");
      break;
    }
}

extern void 
bc_function_disassemble (bc_function_t function, FILE *file)
{
  bc_boolean_t function_in_constants_p = bc_false;

  if (! file) file = stdout;
  
  fprintf (file, ";; Name     : %s\n;; Address  : 0x%.8x",
	   BC_FUNCTION_NAME (function),
	   (int) function);

  /* Constants */
  {
    struct bc_tagged_object *constants  = BC_FUNCTION_CONSTANTS (function);
    unsigned int count, limit = BC_FUNCTION_CONSTANTS_COUNT (function);
    fprintf (file, "\n;; Constants:");
    for (count = 0; count < limit; count++, constants++)
      {
	bc_tagged_object_t tagged = constants;
	
	fprintf (file, "\n;; %9d: ", count);
	switch (BC_TAGGED_OBJECT_TYPE (tagged))
	  {
	  case BC_STRING_TYPE:
	    {
	      bc_string_t string =
		(bc_string_t) BC_TAGGED_OBJECT_VALUE (tagged);
	      fprintf (file, "\"%s\"", string);
	      break;
	    }
	  case BC_SYMBOL_TYPE:
	    {
	      bc_symbol_t symbol =
		(bc_symbol_t) BC_TAGGED_OBJECT_VALUE (tagged);
	      fprintf (file, "%s", BC_SYMBOL_NAME (symbol));
	      break;
	    }
	  case BC_FUNCTION_TYPE:
	    {
	      bc_function_t func =
		(bc_function_t) BC_TAGGED_OBJECT_VALUE (tagged);
	      fprintf (file, "<function %s ...>", BC_FUNCTION_NAME (func));
	      function_in_constants_p = bc_true;
	      break;
	    }
	  case BC_FORMAT_TYPE:
	    {
	      bc_format_t format =
		(bc_format_t) BC_TAGGED_OBJECT_VALUE (tagged);
	      fprintf (file ,"<format ");
	      bc_format_print (format);
	      fprintf (file, ">");
	      break;
	    }
#if 0
	  case BC_NUMBER_TYPE:
	    {
	      bc_number_t number =
		(bc_number_t) BC_TAGGED_OBJECT_VALUE (tagged);
	      fprintf (file, "%g", (double) number);
	      break;
	    }
#endif
	  default:
	    {
	      bc_type_t type = BC_TAGGED_OBJECT_TYPE (tagged);
	      fprintf (file, "{UNIMPLEMENTED ...}");
	      break;
	    }
	  }
      }
  }

  /* Code */
  {
    bc_byte_code_t *opcodes = BC_FUNCTION_CODE (function);
    bc_byte_code_t *opcodes_limit =
      opcodes + BC_FUNCTION_CODE_COUNT (function);
    bc_byte_code_t *opcodes_base = opcodes;

    fprintf (file, "\n;; Code     :\n");
    while (opcodes < opcodes_limit)
      {
	bc_byte_code_spec_t spec =
	  & bc_byte_code_spec_table [*opcodes];
	
	bc_byte_op_t     operator = spec->operator;
	bc_byte_op_len_t length   = spec->length;
	bc_string_t     name     = spec->name;
	unsigned int    index    = opcodes - opcodes_base;

	{
	  char buf [64];

	  if (1 == length)
	    sprintf (buf, "%d", index);
	  else
	    sprintf (buf, "%d-%d", index, index + length - 1);

	  fprintf (file, ";; %9s:  %s", buf, name);
	}

	switch (length)
	  {
#if BC_MAXIMUM_BYTEOP_LEN >= 4
	  case 4:
	    fprintf (file, " %d,", opcodes [length - 3]);
	    /* Fall through */
#endif
#if BC_MAXIMUM_BYTEOP_LEN >= 3
	  case 3:
	    fprintf (file, " %d,", opcodes [length - 2]);
	    /* Fall through */
#endif
	  case 2:
	    fprintf (file, " %d",  opcodes [length - 1]);
	  case 1:
	    fprintf (file, "\n");
	    break;
	  }
	opcodes += length;
      }
  }

  if (function_in_constants_p == bc_true)
    { /* Functions In Constants */
      struct bc_tagged_object *constants =
	BC_FUNCTION_CONSTANTS (function);
      unsigned int count, limit = 
	BC_FUNCTION_CONSTANTS_COUNT (function);

      for (count = 0; count < limit; count++, constants++)
	{
	  bc_tagged_object_t tagged = constants;
	  switch (BC_TAGGED_OBJECT_TYPE (tagged))
	    {
	    case BC_FUNCTION_TYPE:
	      {
		bc_function_t func =
		  (bc_function_t) BC_TAGGED_OBJECT_VALUE (tagged);
		/* Recursively Disassemble */
		fprintf (file, ";;\n;;\n");
		bc_function_disassemble (func, file);
		break;
	      }
	    default:
	      break;
	    }
	}
    }
}
