/* Copyright (C) 2000 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, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */

/* This file is included in vm_engine.c */

/*
 * VM Options
 */

#undef VM_USE_BOOT_HOOK
#undef VM_USE_HALT_HOOK
#undef VM_USE_NEXT_HOOK
#undef VM_USE_CALL_HOOK
#undef VM_USE_APPLY_HOOK
#undef VM_USE_RETURN_HOOK
#undef VM_INIT_LOCAL_VARIABLES
#undef VM_CHECK_LINK
#undef VM_CHECK_BINDING
#undef VM_CHECK_PROGRAM_COUNTER

#if VM_ENGINE == SCM_VM_REGULAR_ENGINE
#define VM_USE_BOOT_HOOK		0
#define	VM_USE_HALT_HOOK		0
#define	VM_USE_NEXT_HOOK		0
#define	VM_USE_CALL_HOOK		0
#define	VM_USE_APPLY_HOOK		0
#define	VM_USE_RETURN_HOOK		0
#define VM_INIT_LOCAL_VARIABLES		0
#define VM_CHECK_LINK			0
#define VM_CHECK_BINDING		1
#define VM_CHECK_PROGRAM_COUNTER	0
#else
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
#define VM_USE_BOOT_HOOK		1
#define	VM_USE_HALT_HOOK		1
#define	VM_USE_NEXT_HOOK		1
#define	VM_USE_CALL_HOOK		1
#define	VM_USE_APPLY_HOOK		1
#define	VM_USE_RETURN_HOOK		1
#define VM_INIT_LOCAL_VARIABLES		1
#define VM_CHECK_LINK			1
#define VM_CHECK_BINDING		1
#define	VM_CHECK_PROGRAM_COUNTER	1
#endif
#endif

#undef VM_USE_HOOK
#if VM_USE_BOOT_HOOK || VM_USE_HALT_HOOK || VM_USE_NEXT_HOOK \
    || VM_USE_CALL_HOOK || VM_USE_APPLY_HOOK || VM_USE_RETURN_HOOK
#define VM_USE_HOOK 1
#else
#define VM_USE_HOOK 0
#endif


/*
 * Type checking
 */

#define VM_ASSERT_PROGRAM(OBJ)	SCM_VALIDATE_PROGRAM (1, OBJ)

#undef VM_ASSERT_BOUND
#if VM_CHECK_BINDING
#define VM_ASSERT_BOUND(CELL)					\
  if (SCM_UNBNDP (SCM_CDR (CELL)))				\
    SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL)))
#else
#define VM_ASSERT_BOUND(CELL)
#endif

#undef VM_ASSERT_LINK
#if VM_CHECK_LINK
#define VM_ASSERT_LINK(OBJ)				\
  if (SCM_FALSEP (OBJ))					\
    SCM_MISC_ERROR ("VM broken link", SCM_EOL)
#else
#define VM_ASSERT_LINK(OBJ)
#endif


/*
 * Hooks
 */

#undef VM_BOOT_HOOK
#if VM_USE_BOOT_HOOK
#define VM_BOOT_HOOK()	SYNC (); scm_c_run_hook (vmp->boot_hook, hook_args)
#else
#define VM_BOOT_HOOK()
#endif

#undef VM_HALT_HOOK
#if VM_USE_HALT_HOOK
#define VM_HALT_HOOK()	SYNC (); scm_c_run_hook (vmp->halt_hook, hook_args)
#else
#define VM_HALT_HOOK()
#endif

#undef VM_NEXT_HOOK
#if VM_USE_NEXT_HOOK
#define VM_NEXT_HOOK()	SYNC (); scm_c_run_hook (vmp->next_hook, hook_args)
#else
#define VM_NEXT_HOOK()
#endif

#undef VM_CALL_HOOK
#if VM_USE_CALL_HOOK
#define VM_CALL_HOOK()	SYNC (); scm_c_run_hook (vmp->call_hook, hook_args)
#else
#define VM_CALL_HOOK()
#endif

#undef VM_APPLY_HOOK
#if VM_USE_APPLY_HOOK
#define VM_APPLY_HOOK()	SYNC (); scm_c_run_hook (vmp->apply_hook, hook_args)
#else
#define VM_APPLY_HOOK()
#endif

#undef VM_RETURN_HOOK
#if VM_USE_RETURN_HOOK
#define VM_RETURN_HOOK() SYNC (); scm_c_run_hook (vmp->return_hook, hook_args)
#else
#define VM_RETURN_HOOK()
#endif


/*
 * Basic operations
 */

#define LOAD()					\
{						\
  ac = vmp->ac;					\
  pc = vmp->pc;					\
  sp = vmp->sp;					\
  fp = vmp->fp;					\
  stack_base  = vmp->stack_base;		\
  stack_limit = vmp->stack_limit;		\
}

#define SYNC()					\
{						\
  vmp->ac = ac;					\
  vmp->pc = pc;					\
  vmp->sp = sp;					\
  vmp->fp = fp;					\
}

#define FETCH()		*pc++

#define CONS(X,Y,Z)				\
{						\
  SCM cell;					\
  SYNC ();					\
  SCM_NEWCELL (cell);				\
  SCM_SET_CELL_OBJECT_0 (cell, Y);		\
  SCM_SET_CELL_OBJECT_1 (cell, Z);		\
  X = cell;					\
}

#define VM_SETUP_ARGS2() an = 2; a2 = ac; POP (ac);
#define VM_SETUP_ARGS3() an = 3; a3 = ac; POP (a2); POP (ac);
#define VM_SETUP_ARGS4() an = 4; a4 = ac; POP (a3); POP (a2); POP (ac);
#define VM_SETUP_ARGSN() an = SCM_INUM (FETCH ());


/*
 * Stack operation
 */

#define PUSH(X)					\
{						\
  if (sp < stack_base)				\
    SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL);	\
  *sp-- = (X);					\
}

#define POP(X)					\
{						\
  if (sp == stack_limit)			\
    SCM_MISC_ERROR ("FIXME: Stack underflow", SCM_EOL);	\
  (X) = *++sp;					\
}

#define POP_LIST(N,L)				\
{						\
  while (N-- > 0)				\
    {						\
      SCM obj;					\
      POP (obj);				\
      CONS (L, obj, L);				\
    }						\
}


/*
 * Frame allocation
 */

/* an = the number of arguments */
#define VM_FRAME_INIT_ARGS(PROG,NREQS,RESTP)			\
{								\
  if (RESTP)							\
    /* have a rest argument */					\
    {								\
      SCM list;							\
      if (an < NREQS)						\
	scm_wrong_num_args (PROG);				\
								\
      /* Construct the rest argument list */			\
      an -= NREQS;	/* the number of rest arguments */	\
      list = SCM_EOL;	/* list of the rest arguments */	\
      POP_LIST (an, list);					\
      PUSH (list);						\
    }								\
  else								\
    /* not have a rest argument */				\
    {								\
      if (an != NREQS)						\
	scm_wrong_num_args (PROG);				\
    }								\
}

#undef VM_FRAME_INIT_LOCAL_VARIABLES
#if VM_INIT_LOCAL_VARIABLES
/* This is necessary when creating frame objects for debugging */
#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)		\
{							\
  int i;						\
  for (i = 0; i < NVARS; i++)				\
    SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED;	\
}
#else
#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)
#endif

#define VM_FRAME_INIT_EXTERNAL_VARIABLES(FP,PROG)	\
{							\
  int *exts = SCM_PROGRAM_EXTS (PROG);			\
  if (exts)						\
    {							\
      /* Export variables */				\
      int n = exts[0];					\
      while (n-- > 0)					\
	SCM_VM_EXTERNAL_VARIABLE (ext, n)		\
	  = SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]);	\
    }							\
}

#define VM_NEW_FRAME(FP,PROG,DL,SP,RA)					  \
{									  \
  int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */	  \
  int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
  int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
  int nexts = SCM_PROGRAM_NEXTS (PROG);	/* the number of external vars */ \
									  \
  VM_FRAME_INIT_ARGS (PROG, nreqs, restp);				  \
									  \
  /* Allocate the new frame */						  \
  if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1)		  \
    SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL);			  \
  sp -= nvars + SCM_VM_FRAME_DATA_SIZE;					  \
  FP = sp + SCM_VM_FRAME_DATA_SIZE + 1;					  \
									  \
  /* Setup the new external frame */					  \
  if (!SCM_FALSEP (SCM_PROGRAM_ENV (PROG)))				  \
    ext = SCM_PROGRAM_ENV (PROG);	/* Use program's environment */	  \
  if (nexts)								  \
    {									  \
      SCM new = SCM_VM_MAKE_EXTERNAL (nexts); /* new external */	  \
      SCM_VM_EXTERNAL_LINK (new) = ext;					  \
      ext = new;							  \
    }									  \
									  \
  /* Setup the new frame */						  \
  SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars);				  \
  SCM_VM_FRAME_PROGRAM (FP) = PROG;					  \
  SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL;					  \
  SCM_VM_FRAME_EXTERNAL_LINK (FP) = ext;				  \
  SCM_VM_FRAME_STACK_POINTER (FP) = SP;					  \
  SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA;				  \
  VM_FRAME_INIT_LOCAL_VARIABLES (FP, nvars);				  \
  VM_FRAME_INIT_EXTERNAL_VARIABLES (FP, PROG);				  \
}


/*
 * Goto next
 */

#undef VM_PROGRAM_COUNTER_CHECK
#if VM_CHECK_PROGRAM_COUNTER
#define VM_PROGRAM_COUNTER_CHECK()					\
{									\
  SCM prog = SCM_VM_FRAME_PROGRAM (fp);					\
  if (pc < SCM_PROGRAM_BASE (prog)					\
      || pc >= (SCM_PROGRAM_BASE (prog) + SCM_PROGRAM_SIZE (prog)))	\
    SCM_MISC_ERROR ("VM accessed invalid program address", SCM_EOL);	\
} 
#else
#define VM_PROGRAM_COUNTER_CHECK()
#endif

#undef VM_GOTO_NEXT
#if HAVE_LABELS_AS_VALUES
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
#define VM_GOTO_NEXT()		goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ())
#else /* not SCM_VM_DEBUG_ENGINE */
#define VM_GOTO_NEXT()		goto *SCM_CODE_TO_ADDR (FETCH ())
#endif
#else /* not HAVE_LABELS_AS_VALUES */
#define VM_GOTO_NEXT()		goto vm_start
#endif

#define NEXT					\
{						\
  VM_PROGRAM_COUNTER_CHECK ();			\
  VM_NEXT_HOOK ();				\
  VM_GOTO_NEXT ();				\
}

/* Just an abbreviation */
#define RETURN(X)	{ ac = (X); NEXT; }