/* DO NOT EDIT  --- AUTO-GENERATED --- DO NOT EDIT */
#line 1 "bcode.cd"
/* -*-c-*- */
/* classes: src_files */

/*	Copyright (C) 1995 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 */




/* "Implementation is the sincerest version
 *  of flattery."
 *			LPD
 * 
 */



#include "scm.h"

#include "bc-inx.h"



#ifdef __GNUC__ 
#define LABEL(X)  X
#define SPAGHETTI_CODE(INIT) goto *INIT; 
#define NEXT_CYCLE goto **(pc++)
#else
#define LABEL(X)  case X
#define SPAGHETTI_CODE(INIT) switch (INIT)
#define NEXT_CYCLE goto instruction_cycle;
#endif



#define ipush(X)	((*(long *)sp = (X)), ++sp)
#define fpush(X)	((*(float *)sp = (X)), ++sp)
#define lpush(X)	((*(long long *)sp = (X)), (sp += 2))
#define dpush(X)	((*(double *)sp = (X)), (sp += 2))

#define ipop(X)		(--sp, (X = *(long *)sp))
#define fpop(X)		(--sp, (X = *(float *)sp))
#define lpop(X)		((sp -= 2), (X = *(long long *)sp))
#define dpop(X)		((sp -= 2), (X = *(double *)sp))

#define push_frame(a, b)  0
#define pop_frame()


/* {Bytecode Interpreter}
 *
 */

enum bytecode_status
{
  bc_ok = 0,
  bc_exception = 1,
  bc_alloc_failed = 2
};

#define INIT_CHUNK_SIZE 4096


/* Generic native format code.
 */
static SCM bootstrap_code = BOOL_F;


/* internal constant table elements. */
#define IC_LOADER_DATA 		0
#define IC_NLOCALS  		1
#define IC_NSTACK   		2
#define IC_SIGNATURE		3

#define IC_TYPE_FORMAT		"SIIS"
static SCM ic_type_format;
static SCM ic_type;

#define STACK_SIZE 1024
static char s_run_bytecode[] = "run-bytecode";

enum bytecode_status
execute_bytecodes (retplace, retsize, closure, arguments)
     SCM * retplace;
     int retsize;
     SCM closure;
     SCM arguments;
{
  SCM * lp;
  SCM * sp;
  SCM * pc;
#include "bc-map.h"

  SCM free_stack_chunks = BOOL_F;  /* concurrency foo */
  SCM stack_obj;
  SCM * stack;

  SCM * constants;
  SCM * i_constants;

  SCM s0;


#define _new_stack_(_into, _size) \
  { \
    if (free_stack_chunks == BOOL_F) \
      { \
	_into = scm_malloc_root_obj (_size); \
      } \
    else \
      { \
	_into = free_stack_chunks; \
	free_stack_chunks = *(SCM *)MALLOCDATA (free_stack_chunks); \
      } \
  } \



  /* Init the VM 
   *
   */

  constants = (SCM *)CDR (BYTECODE_CONSTANTS (closure));
  i_constants = (SCM *)MALLOCDATA (constants[0]);
  _new_stack_(stack_obj, STACK_SIZE);
  stack = (SCM *)MALLOCDATA (stack_obj);

  {
    long nlocals;

    nlocals = (long)i_constants[IC_NLOCALS];
    lp = stack;
    sp = stack + nlocals;
  }


  {
    char * sig;
    int lpos;
    sig = CHARS (i_constants[IC_SIGNATURE]);
    ++sig; /* over '(' */
    for (lpos = 0; arguments != EOL; ++lpos, arguments = CDR (arguments))
      {
	switch (*sig)
	  {
	  case ')':
	    goto done_args;

	  case 'i':
	    lp[lpos] = scm_num2long (CAR (arguments),
				     ARGERR (1 + lpos),
				     CHARS (BYTECODE_NAME (closure)));
	    break;
	    
	  case 'f':
	    lp[lpos] = scm_num2dbl (CAR (arguments),
				    ARGERR (1 + lpos),
				    CHARS (BYTECODE_NAME (closure)));
	    break;

	  case 'S':
	    lp[lpos] = CAR (arguments);
	    break;

	  case 'T':
	    {
	      char * need;
	      int needlen;
	      SCM obj;
	      SCM format;

	      /* One structure type can be cast to another
	       * if they are structurally similar.
	       */
	      need = sig + 1;
	      for (needlen = 0; need[needlen] != ';'; ++needlen)
		;
	      obj = CAR (arguments);
	      ASSERT (NIMP (obj) && STRUCTP (obj), obj,
		      ARGERR (1 + lpos),
		      CHARS (BYTECODE_NAME (closure)));
	      format = STRUCT_TYPE_FORMAT (STRUCT_TYPE (obj));
	      ASSERT (   (LENGTH (format) >= needlen)
		      && (!strncmp (CHARS (format), need, needlen)),
		      obj,
		      ARGERR (1 + lpos),
		      CHARS (BYTECODE_NAME (closure)));
	      lp[lpos] = obj;
	    }
	  }
      }
  }

 done_args:
  {
    SCM code;
    code = BYTECODE_CODE (closure);
    if (code == bootstrap_code)
      goto net2internal_assembler;
    else
      pc = (SCM *)CDR (code);
  }

 instruction_cycle:

  SPAGHETTI_CODE(*(pc++))
    {
    LABEL(_ili_nop):
      NEXT_CYCLE;
    LABEL(_ili_push_0):
      ipush (0L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_m1):
      ipush (-1L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_0):
      ipush (0L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_1):
      ipush (1L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_2):
      ipush (2L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_3):
      ipush (3L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_4):
      ipush (4L);
      NEXT_CYCLE;
    LABEL(_ili_iconst_5):
      ipush (5L);
      NEXT_CYCLE;
    LABEL(_ili_lconst_0):
      lpush (0L);
      NEXT_CYCLE;
    LABEL(_ili_lconst_1):
      lpush (1L);
      NEXT_CYCLE;
    LABEL(_ili_fconst_0):
      fpush (0.0);
      NEXT_CYCLE;
    LABEL(_ili_fconst_1):
      fpush (1.0);
      NEXT_CYCLE;
    LABEL(_ili_fconst_2):
      fpush (2.0);
      NEXT_CYCLE;
    LABEL(_ili_dconst_0):
      dpush (0.0);
      NEXT_CYCLE;
    LABEL(_ili_dconst_1):
      dpush (1.0);
      NEXT_CYCLE;
    LABEL(_ili_push_literal):
      {
	SCM val;
	val = *pc++;
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_push_literal2):
      {
	SCM val;
	SCM val2;
	val = *pc++;
	val2 = *pc++;
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }
    LABEL(_ili_push_constant):
      {
	long index;
	SCM val;

#if 0
	/* Warning, this instruction will self distruct
	 * in 8 cycles.
	 */
	pc[-1] = _ili_push_literal;
	index = *pc;
	val = constants[index];
	if (IMP (val))
	  resolve_constant (constants, index);
	val = constants[index];
	ASSERT (NIMP (val), MAKINUM (index),
		"unable to resolve constant", s_intern_bytecode);
	val = WORDDATA (val);
	*pc++ = val;
	ipush (val);
	NEXT_CYCLE;
#endif
      }
    LABEL(_ili_push_constant2):
      {
	long index;
	SCM val;
	index = *pc++;
	val = constants[index];
	exit (99);
#if 0
	ipush (val);
#endif
	NEXT_CYCLE;
      }
    LABEL(_ili_iload):
      {
	long index;
	SCM val;
	index = *pc++;
	val = lp[index];
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_lload):
      {
	long index;
	SCM val;
	SCM val2;
	index = *pc++;
	val = lp[index];
	val2 = lp[index + 1];
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }
    LABEL(_ili_iload_0):
      {
	SCM val;
	val = lp[0];
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_iload_1):
      {
	SCM val;
	val = lp[1];
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_iload_2):
      {
	SCM val;
	val = lp[2];
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_iload_3):
      {
	SCM val;
	val = lp[3];
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_lload_0):
      {
	SCM val;
	SCM val2;
	val = lp[0];
	val2 = lp[0 + 1];
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }      
    LABEL(_ili_lload_1):
      {
	SCM val;
	SCM val2;
	val = lp[1];
	val2 = lp[1 + 1];
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }      
    LABEL(_ili_lload_2):
      {
	SCM val;
	SCM val2;
	val = lp[2];
	val2 = lp[2 + 1];
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }      
    LABEL(_ili_lload_3):
      {
	SCM val;
	SCM val2;
	val = lp[3];
	val2 = lp[3 + 1];
	ipush (val);
	ipush (val2);
	NEXT_CYCLE;
      }      

    LABEL(_ili_istore):
      {
	long index;
	SCM val;
	index = *pc++;
	ipop (val);
	lp[index] = val;
	NEXT_CYCLE;
      }
    LABEL(_ili_lstore):
      {
	long index;
	SCM val;
	SCM val2;
	index = *pc++;
	ipop (val);
	ipop (val2);
	lp[index] = val;
	lp[index + 1] = val2;
	NEXT_CYCLE;
      }
    LABEL(_ili_istore_0):
      {
	SCM val;
	ipop (val);
	lp[0] = val;
	NEXT_CYCLE;
      }
    LABEL(_ili_istore_1):
      {
	SCM val;
	ipop (val);
	lp[1] = val;
	NEXT_CYCLE;
      }
    LABEL(_ili_istore_2):
      {
	SCM val;
	ipop (val);
	lp[2] = val;
	NEXT_CYCLE;
      }
    LABEL(_ili_istore_3):
      {
	SCM val;
	ipop (val);
	lp[3] = val;
	NEXT_CYCLE;
      }
    LABEL(_ili_lstore_0):
      {
	SCM val;
	SCM val2;
	ipop (val);
	ipop (val2);
	lp[0] = val;
	lp[0 + 1] = val2;
	NEXT_CYCLE;
      }      
    LABEL(_ili_lstore_1):
      {
	SCM val;
	SCM val2;
	ipop (val);
	ipop (val2);
	lp[1] = val;
	lp[1 + 1] = val2;
	NEXT_CYCLE;
      }      
    LABEL(_ili_lstore_2):
      {
	SCM val;
	SCM val2;
	ipop (val);
	ipop (val2);
	lp[2] = val;
	lp[2 + 1] = val2;
	NEXT_CYCLE;
      }      
    LABEL(_ili_lstore_3):
      {
	SCM val;
	SCM val2;
	ipop (val);
	ipop (val2);
	lp[3] = val;
	lp[3 + 1] = val2;
	NEXT_CYCLE;
      }      
    LABEL(_ili_iinc):
      {
	long index;
	long amt;
	long was;
	index = *pc++;
	was = lp[index];
	amt = *pc++;
	lp[index] = was + amt;
	NEXT_CYCLE;
      }
    LABEL(_ili_pop):
      {
	SCM ignore;
	ipop (ignore);
	NEXT_CYCLE;
      }
    LABEL(_ili_pop2):
      {
	SCM ignore;
	ipop (ignore);
	ipop (ignore);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup):
      {
	SCM x;
	ipop (x);
	ipush (x);
	ipush (x);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup2):
      {
	long long x;
	lpop (x);
	lpush (x);
	lpush (x);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup_x1):
      {
	SCM t;
	SCM t2;
	ipop (t);
	ipop (t2);
	ipush (t);
	ipush (t2);
	ipush (t);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup_x2):
      {
	SCM t;
	SCM t2;
	SCM t3;
	ipop (t);
	ipop (t2);
	ipop (t3);
	ipush (t);
	ipush (t2);
	ipush (t3);
	ipush (t);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup2_x1):
      {
	SCM t;
	SCM t2;
	SCM t3;
	ipop (t);
	ipop (t2);
	ipop (t3);
	ipush (t2);
	ipush (t);
	ipush (t3);
	ipush (t2);
	ipush (t);
	NEXT_CYCLE;
      }
    LABEL(_ili_dup2_x2):
      {
	SCM t;
	SCM t2;
	SCM t3;
	SCM t4;
	ipop (t);
	ipop (t2);
	ipop (t3);
	ipop (t4);
	ipush (t2);
	ipush (t);
	ipush (t4);
	ipush (t3);
	ipush (t2);
	ipush (t);
	NEXT_CYCLE;
      }
    LABEL(_ili_swap):
      {
	SCM t;
	SCM t2;

	ipop (t);
	ipop (t2);
	ipush (t);
	ipush (t2);
	NEXT_CYCLE;
      }

#define _binop_(_v1t, _v1po, _v2t, _v2po, _op, _pu) \
    { \
      _v1t _val1; \
      _v2t _val2; \
      _v1po; \
      _v2po; \
      _val1 _op _val2; \
      _pu; \
      NEXT_CYCLE; \
    } \

    
    LABEL(_ili_lshr):
      {
	_binop_ (long long, lpop(_val1),
		 unsigned long, ipop(_val2),
		 >>=, lpush(_val1));
      }
    LABEL(_ili_lshl):
      {
	_binop_ (long long, lpop(_val1),
		 unsigned long, ipop(_val2),
		 <<=, lpush(_val1));
      }
    LABEL(_ili_lushr):
      {
	_binop_ (unsigned long long, lpop(_val1),
		 unsigned long, ipop(_val2),
		 >>=, lpush(_val1));
      }
    LABEL(_ili_land):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 &=, lpush(_val1));
      }
    LABEL(_ili_lxor):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 ^=, lpush(_val1));
      }
    LABEL(_ili_lor):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 |=, lpush(_val1));
      }
    
    
    LABEL(_ili_ishr):
      {
	_binop_ (long, ipop(_val1),
		 unsigned long, ipop(_val2),
		 >>=, ipush(_val1));
      }
    LABEL(_ili_ishl):
      {
	_binop_ (long, ipop(_val1),
		 unsigned long, ipop(_val2),
		 <<=, ipush(_val1));
      }
    LABEL(_ili_iushr):
      {
	_binop_ (unsigned long, ipop(_val1),
		 unsigned long, ipop(_val2),
		 >>=, ipush(_val1));
      }
    LABEL(_ili_iand):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 &=, ipush(_val1));
      }
    LABEL(_ili_icand):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 = _val1 && , ipush(_val1));
      }
    LABEL(_ili_icor):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 = _val1 || , ipush(_val1));
      }
    LABEL(_ili_ixor):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 ^=, ipush(_val1));
      }
    LABEL(_ili_ior):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 |=, ipush(_val1));
      }
    
    LABEL(_ili_ldiv):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 /=, lpush(_val1));
      }
    LABEL(_ili_lmul):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 *=, lpush(_val1));
      }
    LABEL(_ili_ladd):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 +=, lpush(_val1));
      }
    LABEL(_ili_lsub):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 -=, lpush(_val1));
      }
    LABEL(_ili_lmod):
      {
	_binop_ (long long, lpop(_val1),
		 long long, lpop(_val2),
		 %=, lpush(_val1));
      }
    
    LABEL(_ili_idiv):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 /=, ipush(_val1));
      }
    LABEL(_ili_imul):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 *=, ipush(_val1));
      }
    LABEL(_ili_iadd):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 +=, ipush(_val1));
      }
    LABEL(_ili_isub):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 -=, ipush(_val1));
      }
    LABEL(_ili_imod):
      {
	_binop_ (long, ipop(_val1),
		 long, ipop(_val2),
		 %=, ipush(_val1));
      }
    
    LABEL(_ili_fdiv):
      {
	_binop_ (float, fpop(_val1),
		 float, fpop(_val2),
		 /=, fpush(_val1));
      }
    LABEL(_ili_fmul):
      {
	_binop_ (float, fpop(_val1),
		 float, fpop(_val2),
		 *=, fpush(_val1));
      }
    LABEL(_ili_fadd):
      {
	_binop_ (float, fpop(_val1),
		 float, fpop(_val2),
		 +=, fpush(_val1));
      }
    LABEL(_ili_fsub):
      {
	_binop_ (float, fpop(_val1),
		 float, fpop(_val2),
		 -=, fpush(_val1));
      }
    LABEL(_ili_fmod):
      {
#if 0
	!!!
	  _binop_ (float, fpop(_val1),
		   float, fpop(_val2),
		   %=, fpush(_val1));
#endif
	*(int *)0 = 69;
      }
    
    
    
    LABEL(_ili_ddiv):
      {
	_binop_ (double, dpop(_val1),
		 double, dpop(_val2),
		 /=, dpush(_val1));
      }
    LABEL(_ili_dmul):
      {
	_binop_ (double, dpop(_val1),
		 double, dpop(_val2),
		 *=, dpush(_val1));
      }
    LABEL(_ili_dadd):
      {
	_binop_ (double, dpop(_val1),
		 double, dpop(_val2),
		 +=, dpush(_val1));
      }
    LABEL(_ili_dsub):
      {
	_binop_ (double, dpop(_val1),
		 double, dpop(_val2),
		 -=, dpush(_val1));
      }
    LABEL(_ili_dmod):
      {
#if 0
	_binop_ (double, dpop(_val1),
		 double, dpop(_val2),
		 %=, dpush(_val1));
#endif
	*(int *)0 = 69;
      }
    
#if 0    
     (ili_sadd			())
     (ili_ssub			())
     (ili_smul			())
     (ili_sdiv			())
     (ili_smod			())
     (ili_scand			())
     (ili_scor			())
     (ili_sneg			())
#endif
    LABEL(_ili_halt):
      {
	ASSERT (0, closure, "VM halted by halt instruction.", s_run_bytecode);
      }
    LABEL(_ili_ibitnot):
      {
	long val;
	ipop (val);
	val = ~val;
	ipush (val);
	NEXT_CYCLE;
      }
    
    LABEL(_ili_icnot):
      {
	long val;
	ipop (val);
	val = !val;
	ipush (val);
	NEXT_CYCLE;
      }
    
    LABEL(_ili_ineg):
      {
	long val;
	ipop (val);
	val = -val;
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_lneg):
      {
	long long val;
	lpop (val);
	val = -val;
	lpush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_dneg):
      {
	double val;
	dpop (val);
	val = -val;
	dpush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_fneg):
      {
	float val;
	fpop (val);
	val = -val;
	fpush (val);
	NEXT_CYCLE;
      }


#define CONVERT(FRM, FPO, TO, TOPU) \
      FRM from; \
	TO to; \
	  FPO; \
	    to = (TO)from; \
	      TOPU; \
		NEXT_CYCLE;

    LABEL(_ili_i2f):
      {
	CONVERT (long, ipop(from), float, fpush(to));
      }
    LABEL(_ili_i2l):
      {
	CONVERT (long, ipop(from), long long, lpush(to));
      }
    LABEL(_ili_i2d):
      {
	CONVERT (long, ipop(from), double, dpush(to));
      }


    LABEL(_ili_f2i):
      {
	CONVERT (float, fpop(from), long, ipush(to));
      }
    LABEL(_ili_f2l):
      {
	CONVERT (float, fpop(from), long long, lpush(to));
      }
    LABEL(_ili_f2d):
      {
	CONVERT (float, fpop(from), double, dpush(to));
      }


    LABEL(_ili_l2i):
      {
	CONVERT (long long, lpop(from), long, ipush(to));
      }
    LABEL(_ili_l2f):
      {
	CONVERT (long long, lpop(from), float, fpush(to));
      }
    LABEL(_ili_l2d):
      {
	CONVERT (long long, lpop(from), double, dpush(to));
      }

    LABEL(_ili_d2i):
      {
	CONVERT (double, dpop(from), long, ipush(to));
      }
    LABEL(_ili_d2f):
      {
	CONVERT (double, dpop(from), float, fpush(to));
      }

    LABEL(_ili_d2l):
      {
	CONVERT (double, dpop(from), long long, lpush(to));
      }


    LABEL(_ili_int2byte):
      {
	char x;
	long val;
	ipop (val);
	x = val & 255;
	val = x;
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_int2char):
      {
	unsigned short x;
	long val;
	ipop (val);
	x = val & 255;
	val = x;
	ipush (val);
	NEXT_CYCLE;
      }
    LABEL(_ili_int2short):
      {
	short x;
	long val;
	ipop (val);
	x = val & 255;
	val = x;
	ipush (val);
	NEXT_CYCLE;
      }


    LABEL(_ili_goto):
      {
	pc = (SCM *)*pc;
	NEXT_CYCLE;
      }
    LABEL(_ili_jsr):
      {
	SCM * new_pc;
	new_pc = (SCM *)*pc++;
	ipush ((SCM)pc);
	NEXT_CYCLE;
      }
    LABEL(_ili_ret):
      {
	long index;
	index = *pc;
	pc = (SCM *)lp[index];
	NEXT_CYCLE;
      }
    LABEL(_ili_tableswitch):
      *(int *)0 = 69;
    LABEL(_ili_lookupswitch):
      *(int *)0 = 69;

#define CMP(T, PO1, PO2, CMP1, A1, A3) \
      { \
	T val1; \
	  T val2; \
	    long answer; \
	      PO1; \
		PO2; \
		  answer = ((val1 CMP1 val2) \
			    ? A1 \
			    : (val1 == val2 \
			       ? 0 \
			       : A3)); \
				 ipush (answer); \
				   NEXT_CYCLE; \
    }

#define CMPL(T, PO1, PO2)  CMP(T, PO1, PO2, >, 1, -1)
#define CMPG(T, PO1, PO2)  CMP(T, PO1, PO2, <, -1, 1)

    LABEL(_ili_icmp):
      CMPL (long, ipop(val1), ipop(val2))
	NEXT_CYCLE;
    LABEL(_ili_lcmp):
      CMPL (long long, lpop(val1), lpop(val2))
	NEXT_CYCLE;

    LABEL(_ili_fcmpl):
      CMPL (float, fpop(val1), fpop(val2))
	NEXT_CYCLE;
    LABEL(_ili_dcmpl):
      CMPL (double, dpop(val1), dpop(val2))
	NEXT_CYCLE;

    LABEL(_ili_fcmpg):
      CMPG (float, fpop(val1), fpop(val2))
	NEXT_CYCLE;
    LABEL(_ili_dcmpg):
      CMPG (double, dpop(val1), dpop(val2))
	NEXT_CYCLE;

#define CONDBR(TEST) \
      { \
	long top; \
	  ipop (top); \
	    if (TEST) \
	      pc = (SCM *)*pc; \
		else \
		  ++pc; \
		    NEXT_CYCLE; \
    }

    LABEL(_ili_ifeq):
      CONDBR(top == 0)
	NEXT_CYCLE;
    LABEL(_ili_ifne):
      CONDBR(top != 0)
	NEXT_CYCLE;
    LABEL(_ili_iflt):
      CONDBR(top < 0)
	NEXT_CYCLE;
    LABEL(_ili_ifgt):
      CONDBR(top > 0)
	NEXT_CYCLE;
    LABEL(_ili_ifge):
      CONDBR(top >= 0)
	NEXT_CYCLE;
    LABEL(_ili_ifle):
      CONDBR(top <= 0)
	NEXT_CYCLE;

#define CMPBR(TEST) \
      { \
	long val1; \
	  long val2; \
	    ipop (val2); \
	      ipop (val1); \
		if (TEST) \
		  pc = (SCM *)*pc; \
		    else \
		      ++pc; \
			NEXT_CYCLE; \
    }

    LABEL(_ili_if_icmpeq):
      CMPBR (val1 == val2)
	NEXT_CYCLE;
    LABEL(_ili_if_icmpne):
      CMPBR (val1 != val2)
	NEXT_CYCLE;
    LABEL(_ili_if_icmplt):
      CMPBR (val1 < val2)
	NEXT_CYCLE;
    LABEL(_ili_if_icmpgt):
      CMPBR (val1 > val2)
	NEXT_CYCLE;
    LABEL(_ili_if_icmple):
      CMPBR (val1 <= val2)
	NEXT_CYCLE;
    LABEL(_ili_if_icmpge):
      CMPBR (val1 >= val2)
	NEXT_CYCLE;

    LABEL(_ili_newfromname):
      *(int *)0 = 69;
    LABEL(_ili_new):
      *(int *)0 = 69;
    LABEL(_ili_ds_new):
      *(int *)0 = 69;
    LABEL(_ili_getfield):
      *(int *)0 = 69;
    LABEL(_ili_ds_getfield):
      {
	long offset;
	SCM obj;
	SCM * data;
	long answer;
	ipop (obj);
	offset = *pc++;
	data = (SCM *)CDR (obj);
	answer = data[offset];
	ipush (answer);
	NEXT_CYCLE;
      }
    LABEL(_ili_ds_lgetfield):
      {
	long offset;
	SCM obj;
	SCM * data;
	long long answer;

	ipop (obj);
	offset = *pc++;
	data = (SCM *)CDR (obj);
	answer = *(long long *)&(data[offset]);
	lpush (answer);
	NEXT_CYCLE;
      }
    LABEL(_ili_putfield):
      *(int *)0 = 69;
    LABEL(_ili_ds_putfield):
      {
	long offset;
	SCM obj;
	SCM * data;
	long answer;
	ipop (answer);
	ipop (obj);
	offset = *pc++;
	data = (SCM *)CDR (obj);
	data[offset] = answer;
	NEXT_CYCLE;
      }
    LABEL(_ili_ds_lputfield):
      {
	long offset;
	SCM obj;
	SCM * data;
	long long answer;

	lpop (answer);
	ipop (obj);
	offset = *pc++;
	data = (SCM *)CDR (obj);
	*(long long *)(&data[offset]) = answer;
	NEXT_CYCLE;
      }
    LABEL(_ili_getstatic):
      *(int *)0 = 69;
    LABEL(_ili_ds_getstatic):
      {
	SCM * addr;
	SCM answer;
	addr = (SCM *)*pc++;
	answer = *addr;
	ipush (answer);
	NEXT_CYCLE;
      }
    LABEL(_ili_ds_lgetstatic):
      {
	long long * addr;
	long long answer;
	addr = (long long *)*pc++;
	answer = *addr;
	lpush (answer);
	NEXT_CYCLE;
      }
    LABEL(_ili_putstatic):
      *(int *)0 = 69;
    LABEL(_ili_ds_putstatic):
      {
	SCM * addr;
	SCM answer;
	addr = (SCM *)*pc++;
	ipop (answer);
	*addr = answer;
	NEXT_CYCLE;
      }
    LABEL(_ili_ds_lputstatic):
      {
	SCM * addr;
	long long answer;
	addr = (SCM *)*pc++;
	lpop (answer);
	*addr = answer;
	NEXT_CYCLE;
      }
      
    LABEL(_ili_newarray):
      *(int *)0 = 69;
    LABEL(_ili_anewarray):
      *(int *)0 = 69;
    LABEL(_ili_arraylength):
      *(int *)0 = 69;
    LABEL(_ili_multianewarray):
      *(int *)0 = 69;
      
    LABEL(_ili_iaload):
      *(int *)0 = 69;
    LABEL(_ili_laload):
      *(int *)0 = 69;
    LABEL(_ili_faload):
      *(int *)0 = 69;
    LABEL(_ili_daload):
      *(int *)0 = 69;
    LABEL(_ili_aaload):
      *(int *)0 = 69;
    LABEL(_ili_baload):
      *(int *)0 = 69;
    LABEL(_ili_caload):
      *(int *)0 = 69;
    LABEL(_ili_saload):
      *(int *)0 = 69;
      
    LABEL(_ili_iastore):
      *(int *)0 = 69;
    LABEL(_ili_lastore):
      *(int *)0 = 69;
    LABEL(_ili_fastore):
      *(int *)0 = 69;
    LABEL(_ili_dastore):
      *(int *)0 = 69;
    LABEL(_ili_aastore):
      *(int *)0 = 69;
    LABEL(_ili_bastore):
      *(int *)0 = 69;
    LABEL(_ili_castore):
      *(int *)0 = 69;
    LABEL(_ili_sastore):
      *(int *)0 = 69;


    LABEL(_ili_invokevirtual):
      *(int *)0 = 69;
    LABEL(_ili_ds_invokevirtual):
      {
	long obj_pos;
	long vtab_offset;
	SCM obj;
	SCM method_block;

	obj_pos = *pc++;
	vtab_offset = *pc++;
	obj = stack[obj_pos];
#if 0
	method_block = METHODREF (obj, vtab_offset);
#endif
	push_frame (method_block, obj_pos);
	NEXT_CYCLE;
      }
    LABEL(_ili_invokenonvirtual):
      *(int *)0 = 69;
    LABEL(_ili_invokestatic):
      *(int *)0 = 69;
    LABEL(_ili_ds_invoke_known):
      {
	long obj_pos;
	SCM method_block;

	obj_pos = *pc++;
	method_block = *pc++;
	push_frame (method_block, obj_pos);
	NEXT_CYCLE;
      }
    LABEL(_ili_invokeinterface):
      *(int *)0 = 69;
    LABEL(_ili_ds_invokeinterface):
      *(int *)0 = 69;

    LABEL(_ili_vreturn):
      {
	pop_frame ();
	NEXT_CYCLE;
      }
    LABEL(_ili_ireturn):
      {
	SCM val;
	ipop (val);
	lp += 1;
	lp[-1] = val;

	*((long *)retplace) = val;
	scm_free_malloc_obj (stack_obj);
	return;

	/* !!!
	   ipop_frame ();
	   */

	return lp[-1];
	NEXT_CYCLE;
      }
    LABEL(_ili_lreturn):
      {
	long long val;
	lpop (val);
	lp += 2;
	*(long long *)&(lp[-1]) = val;
	pop_frame ();
	NEXT_CYCLE;
      }

    LABEL(_ili_instanceof):
      *(int *)0 = 69;
    LABEL(_ili_ds_instanceof):
      *(int *)0 = 69;
    LABEL(_ili_checkcast):
      *(int *)0 = 69;
    LABEL(_ili_ds_checkcast):
      *(int *)0 = 69;
    LABEL(_ili_athrow):
      *(int *)0 = 69;

    LABEL(_ili_monitorenter):
      NEXT_CYCLE;
    LABEL(_ili_monitorexit):
      NEXT_CYCLE;
    LABEL(_ili_verifystack):
      NEXT_CYCLE;
    LABEL(_ili_breakpoint):
      NEXT_CYCLE;
    }




 net2internal_assembler:
  /* This translates portable compact bytecodes into
   * fast internal bytecodes.
   */
  {
    SCM relocs;
    SCM bcode;
    int srclen;
    SCM * relocv;
    unsigned char * src;
    SCM code;


    bcode = BYTECODE_BCODE (closure);
    src = CHARS (bcode);
    srclen = LENGTH (bcode);
    relocs = scm_malloc_obj (sizeof (long *) * srclen);
    relocv = (long *)MALLOCDATA (relocs);
    DEFER_INTS;
    bzero (relocv, sizeof (long *) * srclen);
    ALLOW_INTS;
    scm_remember (&relocs);
    scm_remember (&bcode);


    {
      SCM out;
      int x;
      SCM * outp;
      SCM * constantv;
      long inx_len;
      
      /* Tricky: use the wrong code vector's LENGTH
       * because it is easy to compute and is always
       * greater than or equal to the real answer.
       * The approx should almost never be way off, but if it
       * it is, it is fixed after translation when the
       * precise length is known.
       */
      out = scm_malloc_obj (sizeof (SCM) * LENGTH (bcode));
      constantv = VELTS (constants);
      scm_remember (&code);
      
      for (x = 0,  outp = (SCM *)MALLOCDATA (out);
	   x < srclen;
	   (outp += inx_len), ++x)
	{
	  int inx;
	  SCM this;
	  SCM next;

	  inx_len = li_desc[src[x]].len;
	  this = relocv[x];
	  while (this)
	    {
	      next = *(SCM *)this;
	      *((SCM *)this) = (SCM)outp;
	      this = next;
	    }
	  relocv[x] = (SCM)outp;
	  
	  inx = src[x];
	  /* verify here */
	  outp[0] = (SCM)ili_instruction_mapping[li_desc[inx].internal_opcode];
	  
	  {
	    int rand_pos;
	    char * args;

	    rand_pos = 1;
	    args = li_desc[inx].operands;

	  translate_next_operand:
	    switch (*args++)
	      {
	      case 0:
		break;

		/* verify each clause: */
	      case array_typecode:
		outp[rand_pos] = (long)src[x];
		++rand_pos;
		x += 1;
		goto translate_next_operand;
		
	      case branch_offset:
		{
		  long offset;
		  offset = (((char *)src)[x + 1] << 8) | src[x + 2];
		  if (offset < 0)
		    outp[rand_pos] = (SCM)relocv[x + offset];
		  else
		    {
		      outp[rand_pos] = relocv[x + offset];
		      relocv[x + offset] = (SCM)&outp[rand_pos];
		    }
		  ++rand_pos;
		  x += 2;
		  goto translate_next_operand;
		}

	      case byte_constant_index:
		outp[rand_pos] = (SCM)(constantv + src[x]);
		++rand_pos;
		x += 1;
		goto translate_next_operand;

	      case constant_field_index:
	      case constant_index:
	      case constant_index_w:
	      case constant_method_index:
	      case constant_type_index:
		outp[rand_pos] = (SCM)(constantv + ((src[x + 1] << 8) | src[x]));
		++rand_pos;
		x += 2;
		goto translate_next_operand;

	      case local_index:
/* !!! right? */
		outp[rand_pos] = src[x+1];
		++rand_pos;
		x += 1;
		goto translate_next_operand;

	      case jump_table:
		exit (13);
		goto translate_next_operand;

	      case lookup_table:
		exit (13);
		goto translate_next_operand;

	      case signed_byte:
		outp[rand_pos] = ((char *)src)[x + 1];
		++rand_pos;
		x += 1;
		goto translate_next_operand;

	      case unsigned_byte:
		outp[rand_pos] = ((unsigned char *)src)[x + 1];
		++rand_pos;
		x += 1;
		goto translate_next_operand;

	      case signed_short:
		outp[rand_pos] = (((char *)src)[x + 1] << 8) | src[x];
		++rand_pos;
		x += 2;
		goto translate_next_operand;
	      }
	  }
#if 0
	  /* 
	     if ((gen_code_size + (gen_code_size / 8)) < LENGTH (bcode))
	     out = scm_realloc_obj (out, sizeof (SCM) * gen_code_size);
	     
	     This needs to fix-up branch targets sometimes.
	     */
#endif
	  
	}
      BYTECODE_CODE(closure) = out;
      scm_free_malloc_obj (relocs);
      pc = VELTS (out);
      goto instruction_cycle;
    }
  }
}



static SCM rb_proc;

static char s_intern_bytecode[] = "intern-bytecode";
SCM
scm_intern_bytecode (constants, name, signature, nlocals, nstack, bcode)
     SCM constants;
     SCM name;
     SCM signature;
     SCM nlocals;
     SCM nstack;
     SCM bcode;
{
  SCM answer;

  ASSERT (NIMP (constants), constants, ARG1, s_intern_bytecode);
  ASSERT (INUM (nlocals), nlocals, ARG4, s_intern_bytecode);
  ASSERT (INUM (nstack), nstack, ARG6, s_intern_bytecode);
  ASSERT (NIMP (bcode) && SYMBOLP (bcode), bcode, ARG6, s_intern_bytecode);
  
  answer = scm_makcclo (rb_proc, BYTECODE_ELTS);
  {
    SCM internal_constant_table;
    SCM constant_table;
    SCM * ictab;
    SCM * ctab;
    internal_constant_table = _scm_make_struct (ic_type,
						MAKINUM (0),
						1,
						0);
    ictab = VELTS (internal_constant_table);
    ictab[IC_LOADER_DATA] = constants;
    ictab[IC_NLOCALS] = INUM (nlocals);
    ictab[IC_NSTACK] = INUM (nstack);
    ictab[IC_SIGNATURE] = signature;

    constant_table = scm_make_vector (MAKINUM (LENGTH (constants)), BOOL_F);
    VELTS(constant_table)[0] = internal_constant_table;
    BYTECODE_CONSTANTS(answer) = constant_table;
  }
  BYTECODE_CODE(answer) = bootstrap_code;
  BYTECODE_NAME(answer) = name;
  BYTECODE_BCODE(answer) = bcode;
  return answer;
}



static char s_bytecodep[] = "bytecode?";
SCM
scm_bytecodep (obj)
     SCM obj;
{
  return ((NIMP (obj) && BYTECODEP (obj))
	  ? BOOL_T
	  : BOOL_F);
}




static SCM
run_bytecode (cclo, args)
     SCM cclo;
     SCM args;
{
  long ret;
  ASSERT (NIMP (cclo) && BYTECODEP (cclo),
	  cclo, ARG1, s_run_bytecode);

  ret = 69;
  execute_bytecodes (&ret, 1, cclo, args);
  return MAKINUM (ret);
}
     

void
scm_init_bytecode ()
{
  rb_proc = scm_make_gsubr (s_run_bytecode, 1, 0, 1, run_bytecode);
  scm_permenant_object (rb_proc);
  scm_make_gsubr (s_intern_bytecode, 6, 0, 0, scm_intern_bytecode);
  scm_make_gsubr (s_bytecodep, 1, 0, 0, scm_bytecodep);
  ic_type_format = CAR (scm_intern0 (IC_TYPE_FORMAT));
  ic_type = scm_make_struct_type (CAR (scm_intern0 ("bc-internal-type")),
				  ic_type_format,
				  BOOL_F,
				  EOL);
  scm_permenant_object (ic_type);
}
