[bpt/guile.git] / libguile / vm-engine.h

/* Copyright (C) 2001 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 */

/*
 * Options
 */

#define VM_USE_HOOKS		1	/* Various hooks */
#define VM_USE_CLOCK		1	/* Bogoclock */
#define VM_CHECK_EXTERNAL	1	/* Check external link */
#define VM_CHECK_OBJECT         1       /* Check object table */

\f
/*
 * Registers
 */

/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]

   Some compilers underestimate the use of the local variables representing
   the abstract machine registers, and don't put them in hardware registers,
   which slows down the interpreter considerably.
   For GCC, I have hand-assigned hardware registers for several architectures.
*/

#ifdef __GNUC__
#ifdef __mips__
#define IP_REG asm("$16")
#define SP_REG asm("$17")
#define FP_REG asm("$18")
#endif
#ifdef __sparc__
#define IP_REG asm("%l0")
#define SP_REG asm("%l1")
#define FP_REG asm("%l2")
#endif
#ifdef __alpha__
#ifdef __CRAY__
#define IP_REG asm("r9")
#define SP_REG asm("r10")
#define FP_REG asm("r11")
#else
#define IP_REG asm("$9")
#define SP_REG asm("$10")
#define FP_REG asm("$11")
#endif
#endif
#ifdef __i386__
#define IP_REG asm("%esi")
#define SP_REG asm("%edi")
#define FP_REG
#endif
#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
#define IP_REG asm("26")
#define SP_REG asm("27")
#define FP_REG asm("28")
#endif
#ifdef __hppa__
#define IP_REG asm("%r18")
#define SP_REG asm("%r17")
#define FP_REG asm("%r16")
#endif
#ifdef __mc68000__
#define IP_REG asm("a5")
#define SP_REG asm("a4")
#define FP_REG
#endif
#ifdef __arm__
#define IP_REG asm("r9")
#define SP_REG asm("r8")
#define FP_REG asm("r7")
#endif
#endif

#ifndef IP_REG
#define IP_REG
#endif
#ifndef SP_REG
#define SP_REG
#endif
#ifndef FP_REG
#define FP_REG
#endif

\f
/*
 * Cache/Sync
 */

#ifdef VM_ENABLE_ASSERTIONS
# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
#else
# define ASSERT(condition)
#endif


#define CACHE_REGISTER()			\
{						\
  ip = vp->ip;					\
  sp = vp->sp;					\
  fp = vp->fp;					\
  stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
}

#define SYNC_REGISTER()				\
{						\
  vp->ip = ip;					\
  vp->sp = sp;					\
  vp->fp = fp;					\
}

#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
  do { if (ip < bp->base || ip - bp->base > bp->size) abort (); } while (0)
#else
#define CHECK_IP()
#endif

/* Get a local copy of the program's "object table" (i.e. the vector of
   external bindings that are referenced by the program), initialized by
   `load-program'.  */
/* XXX:  We could instead use the "simple vector macros", thus not having to
   call `scm_vector_writable_elements ()' and the likes.  */
#define CACHE_PROGRAM()							\
{									\
  if (bp != SCM_PROGRAM_DATA (program)) {                               \
    bp = SCM_PROGRAM_DATA (program);					\
    if (SCM_I_IS_VECTOR (bp->objs)) {                                   \
      objects = SCM_I_VECTOR_WELTS (bp->objs);                          \
      object_count = SCM_I_VECTOR_LENGTH (bp->objs);                    \
    } else {                                                            \
      objects = NULL;                                                   \
      object_count = 0;                                                 \
    }                                                                   \
  }                                                                     \
}

#define SYNC_BEFORE_GC()			\
{						\
  SYNC_REGISTER ();				\
}

#define SYNC_ALL()				\
{						\
  SYNC_REGISTER ();				\
}

\f
/*
 * Error check
 */

#undef CHECK_EXTERNAL
#if VM_CHECK_EXTERNAL
#define CHECK_EXTERNAL(e) \
  do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
#else
#define CHECK_EXTERNAL(e)
#endif

/* Accesses to a program's object table.  */
#if VM_CHECK_OBJECT
#define CHECK_OBJECT(_num) \
  do { if ((_num) >= object_count) goto vm_error_object; } while (0)
#else
#define CHECK_OBJECT(_num)
#endif

\f
/*
 * Hooks
 */

#undef RUN_HOOK
#if VM_USE_HOOKS
#define RUN_HOOK(h)				\
{						\
  if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
    {						\
      SYNC_REGISTER ();				\
      vm_dispatch_hook (vm, vp->hooks[h], hook_args);      \
      CACHE_REGISTER ();			\
    }						\
}
#else
#define RUN_HOOK(h)
#endif

#define BOOT_HOOK()	RUN_HOOK (SCM_VM_BOOT_HOOK)
#define HALT_HOOK()	RUN_HOOK (SCM_VM_HALT_HOOK)
#define NEXT_HOOK()	RUN_HOOK (SCM_VM_NEXT_HOOK)
#define BREAK_HOOK()	RUN_HOOK (SCM_VM_BREAK_HOOK)
#define ENTER_HOOK()	RUN_HOOK (SCM_VM_ENTER_HOOK)
#define APPLY_HOOK()	RUN_HOOK (SCM_VM_APPLY_HOOK)
#define EXIT_HOOK()	RUN_HOOK (SCM_VM_EXIT_HOOK)
#define RETURN_HOOK()	RUN_HOOK (SCM_VM_RETURN_HOOK)

\f
/*
 * Stack operation
 */

#ifdef VM_ENABLE_STACK_NULLING
# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
   inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
   that continuation doesn't have a chance to run. It's not important on a
   semantic level, but it does mess up our stack nulling -- so this macro is to
   fix that. */
# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
#else
# define CHECK_STACK_LEAKN(_n)
# define CHECK_STACK_LEAK()
# define NULLSTACK(_n)
# define NULLSTACK_FOR_NONLOCAL_EXIT()
#endif

#define CHECK_OVERFLOW()			\
  if (sp > stack_limit)				\
    goto vm_error_stack_overflow

#define CHECK_UNDERFLOW()                       \
  if (sp < stack_base)                          \
    goto vm_error_stack_underflow;

#define PUSH(x)	do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP()	do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
#define DROPN(_n)	do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
#define POP(x)	do { x = *sp; DROP (); } while (0)

/* A fast CONS.  This has to be fast since its used, for instance, by
   POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
   inlined function in Guile 1.7.  Unfortunately, it calls
   `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
   heap.  XXX  */
#define CONS(x,y,z)					\
{							\
  SYNC_BEFORE_GC ();					\
  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
}

/* Pop the N objects on top of the stack and push a list that contains
   them.  */
#define POP_LIST(n)				\
do						\
{						\
  int i;					\
  SCM l = SCM_EOL, x;				\
  for (i = n; i; i--)                           \
    {                                           \
      POP (x);                                  \
      CONS (l, x, l);                           \
    }                                           \
  PUSH (l);					\
} while (0)

/* The opposite: push all of the elements in L onto the list. */
#define PUSH_LIST(l, NILP)			\
do						\
{						\
  for (; scm_is_pair (l); l = SCM_CDR (l))      \
    PUSH (SCM_CAR (l));                         \
  if (SCM_UNLIKELY (!NILP (l))) {               \
    err_args = scm_list_1 (l);                  \
    goto vm_error_improper_list;                \
  }                                             \
} while (0)

\f
#define POP_LIST_MARK()				\
do {						\
  SCM o;					\
  SCM l = SCM_EOL;				\
  POP (o);					\
  while (!SCM_UNBNDP (o))			\
    {						\
      CONS (l, o, l);				\
      POP (o);					\
    }						\
  PUSH (l);					\
} while (0)

#define POP_CONS_MARK()				\
do {						\
  SCM o, l;					\
  POP (l);                                      \
  POP (o);					\
  while (!SCM_UNBNDP (o))			\
    {						\
      CONS (l, o, l);				\
      POP (o);					\
    }						\
  PUSH (l);					\
} while (0)

\f
/*
 * Instruction operation
 */

#define FETCH()		(*ip++)
#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)

#undef CLOCK
#if VM_USE_CLOCK
#define CLOCK(n)	vp->clock += n
#else
#define CLOCK(n)
#endif

#undef NEXT_JUMP
#ifdef HAVE_LABELS_AS_VALUES
#define NEXT_JUMP()		goto *jump_table[FETCH ()]
#else
#define NEXT_JUMP()		goto vm_start
#endif

#define NEXT					\
{						\
  CLOCK (1);					\
  NEXT_HOOK ();					\
  CHECK_STACK_LEAK ();                          \
  NEXT_JUMP ();					\
}

\f
/*
 * Stack frame
 */

#define INIT_ARGS()				\
{						\
  if (bp->nrest)				\
    {						\
      int n = nargs - (bp->nargs - 1);		\
      if (n < 0)				\
	goto vm_error_wrong_num_args;		\
      /* NB, can cause GC while setting up the  \
         stack frame */                         \
      POP_LIST (n);				\
    }						\
  else						\
    {						\
      if (nargs != bp->nargs)			\
	goto vm_error_wrong_num_args;		\
    }						\
}

/* See frames.h for the layout of stack frames */
/* When this is called, bp points to the new program data,
   and the arguments are already on the stack */
#define NEW_FRAME()				\
{						\
  int i;					\
  SCM *dl, *data;                               \
  scm_byte_t *ra = ip;                          \
						\
  /* Save old registers */                      \
  ra = ip;                                      \
  dl = fp;                                      \
						\
  /* New registers */                           \
  fp = sp - bp->nargs + 1;                      \
  data = SCM_FRAME_DATA_ADDRESS (fp);           \
  sp = data + 3;                                \
  CHECK_OVERFLOW ();				\
  stack_base = sp;				\
  ip = bp->base;				\
						\
  /* Init local variables */			\
  for (i=bp->nlocs; i; i--)                     \
    data[-i] = SCM_UNDEFINED;                   \
						\
  /* Set frame data */				\
  data[3] = (SCM)ra;                            \
  data[2] = 0x0;                                \
  data[1] = (SCM)dl;                            \
                                                \
  /* Postpone initializing external vars,       \
     because if the CONS causes a GC, we        \
     want the stack marker to see the data      \
     array formatted as expected. */            \
  data[0] = SCM_UNDEFINED;                      \
  external = bp->external;                      \
  for (i = 0; i < bp->nexts; i++)               \
    CONS (external, SCM_UNDEFINED, external);   \
  data[0] = external;                           \
}

#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
8f5cfc81	1	/* Copyright (C) 2001 Free Software Foundation, Inc.
a98cef7e KN	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program is distributed in the hope that it will be useful,
	9	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
	15	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	16	* Boston, MA 02111-1307 USA
	17	*
	18	* As a special exception, the Free Software Foundation gives permission
	19	* for additional uses of the text contained in its release of GUILE.
	20	*
	21	* The exception is that, if you link the GUILE library with other files
	22	* to produce an executable, this does not by itself cause the
	23	* resulting executable to be covered by the GNU General Public License.
	24	* Your use of that executable is in no way restricted on account of
	25	* linking the GUILE library code into it.
	26	*
	27	* This exception does not however invalidate any other reasons why
	28	* the executable file might be covered by the GNU General Public License.
	29	*
	30	* This exception applies only to the code released by the
	31	* Free Software Foundation under the name GUILE. If you copy
	32	* code from other Free Software Foundation releases into a copy of
	33	* GUILE, as the General Public License permits, the exception does
	34	* not apply to the code that you add in this way. To avoid misleading
	35	* anyone as to the status of such modified files, you must delete
	36	* this exception notice from them.
	37	*
	38	* If you write modifications of your own for GUILE, it is your choice
	39	* whether to permit this exception to apply to your modifications.
	40	* If you do not wish that, delete this exception notice. */
	41
	42	/* This file is included in vm_engine.c */
	43
	44	/*
3d5ee0cd	45	* Options
a98cef7e KN	46	*/
a98cef7e KN	47
ac02b386 KN	48	#define VM_USE_HOOKS 1 /* Various hooks */
	49	#define VM_USE_CLOCK 1 /* Bogoclock */
	50	#define VM_CHECK_EXTERNAL 1 /* Check external link */
0b5f0e49	51	#define VM_CHECK_OBJECT 1 /* Check object table */
a98cef7e KN	52
	53	\f
	54	/*
17e90c5e	55	* Registers
a98cef7e KN	56	*/
a98cef7e KN	57
17e90c5e	58	/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
9df03fd0	59
17e90c5e KN	60	Some compilers underestimate the use of the local variables representing
	61	the abstract machine registers, and don't put them in hardware registers,
	62	which slows down the interpreter considerably.
	63	For GCC, I have hand-assigned hardware registers for several architectures.
	64	*/
9df03fd0	65
17e90c5e KN	66	#ifdef __GNUC__
	67	#ifdef __mips__
	68	#define IP_REG asm("$16")
	69	#define SP_REG asm("$17")
	70	#define FP_REG asm("$18")
	71	#endif
	72	#ifdef __sparc__
	73	#define IP_REG asm("%l0")
	74	#define SP_REG asm("%l1")
	75	#define FP_REG asm("%l2")
	76	#endif
	77	#ifdef __alpha__
	78	#ifdef __CRAY__
	79	#define IP_REG asm("r9")
	80	#define SP_REG asm("r10")
	81	#define FP_REG asm("r11")
9df03fd0	82	#else
17e90c5e KN	83	#define IP_REG asm("$9")
	84	#define SP_REG asm("$10")
	85	#define FP_REG asm("$11")
	86	#endif
	87	#endif
	88	#ifdef __i386__
	89	#define IP_REG asm("%esi")
	90	#define SP_REG asm("%edi")
	91	#define FP_REG
	92	#endif
	93	#if defined(PPC) \|\| defined(_POWER) \|\| defined(_IBMR2)
	94	#define IP_REG asm("26")
	95	#define SP_REG asm("27")
	96	#define FP_REG asm("28")
	97	#endif
	98	#ifdef __hppa__
	99	#define IP_REG asm("%r18")
	100	#define SP_REG asm("%r17")
	101	#define FP_REG asm("%r16")
	102	#endif
	103	#ifdef __mc68000__
	104	#define IP_REG asm("a5")
	105	#define SP_REG asm("a4")
	106	#define FP_REG
	107	#endif
	108	#ifdef __arm__
	109	#define IP_REG asm("r9")
	110	#define SP_REG asm("r8")
	111	#define FP_REG asm("r7")
	112	#endif
9df03fd0 KN	113	#endif
9df03fd0 KN	114
17d1b4bf AW	115	#ifndef IP_REG
	116	#define IP_REG
	117	#endif
	118	#ifndef SP_REG
	119	#define SP_REG
	120	#endif
	121	#ifndef FP_REG
	122	#define FP_REG
	123	#endif
	124
9df03fd0	125	\f
a98cef7e	126	/*
3d5ee0cd	127	* Cache/Sync
a98cef7e KN	128	*/
a98cef7e KN	129
11ea1aba	130	#ifdef VM_ENABLE_ASSERTIONS
9a8cc8e7 AW	131	# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
	132	#else
	133	# define ASSERT(condition)
	134	#endif
	135
	136
3d5ee0cd	137	#define CACHE_REGISTER() \
17e90c5e	138	{ \
3d5ee0cd KN	139	ip = vp->ip; \
	140	sp = vp->sp; \
	141	fp = vp->fp; \
f13c269b	142	stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
17e90c5e	143	}
a98cef7e	144
3d5ee0cd	145	#define SYNC_REGISTER() \
a98cef7e	146	{ \
3d5ee0cd KN	147	vp->ip = ip; \
	148	vp->sp = sp; \
	149	vp->fp = fp; \
a98cef7e KN	150	}
a98cef7e KN	151
11ea1aba	152	#ifdef VM_ENABLE_PARANOID_ASSERTIONS
7e4760e4 AW	153	#define CHECK_IP() \
	154	do { if (ip < bp->base \|\| ip - bp->base > bp->size) abort (); } while (0)
	155	#else
	156	#define CHECK_IP()
	157	#endif
	158
238e7a11 LC	159	/* Get a local copy of the program's "object table" (i.e. the vector of
	160	external bindings that are referenced by the program), initialized by
	161	`load-program'. */
a52b2d3d LC	162	/* XXX: We could instead use the "simple vector macros", thus not having to
	163	call `scm_vector_writable_elements ()' and the likes. */
	164	#define CACHE_PROGRAM() \
	165	{ \
e677365c AW	166	if (bp != SCM_PROGRAM_DATA (program)) { \
e677365c AW	167	bp = SCM_PROGRAM_DATA (program); \
2fda0242 AW	168	if (SCM_I_IS_VECTOR (bp->objs)) { \
	169	objects = SCM_I_VECTOR_WELTS (bp->objs); \
	170	object_count = SCM_I_VECTOR_LENGTH (bp->objs); \
	171	} else { \
	172	objects = NULL; \
	173	object_count = 0; \
	174	} \
e677365c	175	} \
41f248a8 KN	176	}
41f248a8 KN	177
3d5ee0cd KN	178	#define SYNC_BEFORE_GC() \
	179	{ \
	180	SYNC_REGISTER (); \
17e90c5e	181	}
a98cef7e	182
17e90c5e	183	#define SYNC_ALL() \
a98cef7e	184	{ \
3d5ee0cd	185	SYNC_REGISTER (); \
a98cef7e KN	186	}
a98cef7e KN	187
a98cef7e	188	\f
ac02b386 KN	189	/*
	190	* Error check
	191	*/
	192
	193	#undef CHECK_EXTERNAL
	194	#if VM_CHECK_EXTERNAL
	195	#define CHECK_EXTERNAL(e) \
	196	do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
	197	#else
	198	#define CHECK_EXTERNAL(e)
	199	#endif
	200
0b5f0e49 LC	201	/* Accesses to a program's object table. */
	202	#if VM_CHECK_OBJECT
	203	#define CHECK_OBJECT(_num) \
	204	do { if ((_num) >= object_count) goto vm_error_object; } while (0)
	205	#else
	206	#define CHECK_OBJECT(_num)
	207	#endif
	208
ac02b386	209	\f
3d5ee0cd KN	210	/*
	211	* Hooks
	212	*/
	213
	214	#undef RUN_HOOK
	215	#if VM_USE_HOOKS
	216	#define RUN_HOOK(h) \
	217	{ \
b1b942b7	218	if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
3d5ee0cd	219	{ \
af988bbf	220	SYNC_REGISTER (); \
b1b942b7	221	vm_dispatch_hook (vm, vp->hooks[h], hook_args); \
af988bbf	222	CACHE_REGISTER (); \
3d5ee0cd KN	223	} \
	224	}
	225	#else
	226	#define RUN_HOOK(h)
	227	#endif
	228
ac02b386 KN	229	#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
	230	#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
	231	#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
7a0d0cee	232	#define BREAK_HOOK() RUN_HOOK (SCM_VM_BREAK_HOOK)
ac02b386 KN	233	#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
	234	#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
	235	#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
	236	#define RETURN_HOOK() RUN_HOOK (SCM_VM_RETURN_HOOK)
3d5ee0cd KN	237
3d5ee0cd KN	238	\f
a98cef7e KN	239	/*
	240	* Stack operation
	241	*/
	242
11ea1aba AW	243	#ifdef VM_ENABLE_STACK_NULLING
	244	# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
	245	# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
	246	# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
66db076a AW	247	/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
	248	inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
	249	that continuation doesn't have a chance to run. It's not important on a
	250	semantic level, but it does mess up our stack nulling -- so this macro is to
	251	fix that. */
	252	# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
11ea1aba AW	253	#else
	254	# define CHECK_STACK_LEAKN(_n)
	255	# define CHECK_STACK_LEAK()
	256	# define NULLSTACK(_n)
66db076a	257	# define NULLSTACK_FOR_NONLOCAL_EXIT()
11ea1aba AW	258	#endif
11ea1aba AW	259
17e90c5e	260	#define CHECK_OVERFLOW() \
3616e9e9	261	if (sp > stack_limit) \
17e90c5e KN	262	goto vm_error_stack_overflow
17e90c5e KN	263
7e4760e4 AW	264	#define CHECK_UNDERFLOW() \
	265	if (sp < stack_base) \
	266	goto vm_error_stack_underflow;
a98cef7e	267
3616e9e9	268	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
11ea1aba AW	269	#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
11ea1aba AW	270	#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
17e90c5e KN	271	#define POP(x) do { x = *sp; DROP (); } while (0)
17e90c5e KN	272
2d80426a LC	273	/* A fast CONS. This has to be fast since its used, for instance, by
	274	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	275	inlined function in Guile 1.7. Unfortunately, it calls
	276	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	277	heap. XXX */
	278	#define CONS(x,y,z) \
	279	{ \
	280	SYNC_BEFORE_GC (); \
	281	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	282	}
a98cef7e KN	283
f41cb00c LC	284	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	285	them. */
17e90c5e	286	#define POP_LIST(n) \
f41cb00c LC	287	do \
f41cb00c LC	288	{ \
17e90c5e	289	int i; \
11ea1aba AW	290	SCM l = SCM_EOL, x; \
	291	for (i = n; i; i--) \
	292	{ \
	293	POP (x); \
	294	CONS (l, x, l); \
	295	} \
3616e9e9	296	PUSH (l); \
17e90c5e KN	297	} while (0)
17e90c5e KN	298
1f40459f	299	/* The opposite: push all of the elements in L onto the list. */
fb10a008	300	#define PUSH_LIST(l, NILP) \
1f40459f AW	301	do \
	302	{ \
	303	for (; scm_is_pair (l); l = SCM_CDR (l)) \
	304	PUSH (SCM_CAR (l)); \
fb10a008	305	if (SCM_UNLIKELY (!NILP (l))) { \
1f40459f AW	306	err_args = scm_list_1 (l); \
	307	goto vm_error_improper_list; \
	308	} \
	309	} while (0)
	310
135b32ee	311	\f
cb4cca12 KN	312	#define POP_LIST_MARK() \
	313	do { \
	314	SCM o; \
	315	SCM l = SCM_EOL; \
	316	POP (o); \
	317	while (!SCM_UNBNDP (o)) \
	318	{ \
	319	CONS (l, o, l); \
	320	POP (o); \
	321	} \
	322	PUSH (l); \
	323	} while (0)
	324
2bd859c8 AW	325	#define POP_CONS_MARK() \
	326	do { \
	327	SCM o, l; \
	328	POP (l); \
	329	POP (o); \
	330	while (!SCM_UNBNDP (o)) \
	331	{ \
	332	CONS (l, o, l); \
	333	POP (o); \
	334	} \
	335	PUSH (l); \
	336	} while (0)
	337
a98cef7e KN	338	\f
a98cef7e KN	339	/*
17e90c5e	340	* Instruction operation
a98cef7e KN	341	*/
a98cef7e KN	342
17e90c5e	343	#define FETCH() (*ip++)
17e90c5e KN	344	#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
	345
	346	#undef CLOCK
	347	#if VM_USE_CLOCK
3d5ee0cd	348	#define CLOCK(n) vp->clock += n
a98cef7e	349	#else
17e90c5e	350	#define CLOCK(n)
a98cef7e KN	351	#endif
a98cef7e KN	352
17e90c5e KN	353	#undef NEXT_JUMP
	354	#ifdef HAVE_LABELS_AS_VALUES
	355	#define NEXT_JUMP() goto *jump_table[FETCH ()]
	356	#else
	357	#define NEXT_JUMP() goto vm_start
	358	#endif
	359
	360	#define NEXT \
	361	{ \
	362	CLOCK (1); \
17e90c5e	363	NEXT_HOOK (); \
11ea1aba	364	CHECK_STACK_LEAK (); \
17e90c5e	365	NEXT_JUMP (); \
a98cef7e KN	366	}
	367
	368	\f
	369	/*
ac02b386	370	* Stack frame
17e90c5e KN	371	*/
17e90c5e KN	372
17e90c5e KN	373	#define INIT_ARGS() \
	374	{ \
	375	if (bp->nrest) \
	376	{ \
5315b862	377	int n = nargs - (bp->nargs - 1); \
17e90c5e KN	378	if (n < 0) \
17e90c5e KN	379	goto vm_error_wrong_num_args; \
11ea1aba AW	380	/* NB, can cause GC while setting up the \
11ea1aba AW	381	stack frame */ \
17e90c5e KN	382	POP_LIST (n); \
	383	} \
	384	else \
	385	{ \
	386	if (nargs != bp->nargs) \
	387	goto vm_error_wrong_num_args; \
	388	} \
	389	}
	390
ac99cb0c	391	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	392	/* When this is called, bp points to the new program data,
2cdb8cdc AW	393	and the arguments are already on the stack */
3616e9e9 KN	394	#define NEW_FRAME() \
3616e9e9 KN	395	{ \
24aa2715	396	int i; \
2cdb8cdc AW	397	SCM dl, data; \
2cdb8cdc AW	398	scm_byte_t *ra = ip; \
24aa2715	399	\
2cdb8cdc AW	400	/* Save old registers */ \
	401	ra = ip; \
	402	dl = fp; \
	403	\
	404	/* New registers */ \
	405	fp = sp - bp->nargs + 1; \
	406	data = SCM_FRAME_DATA_ADDRESS (fp); \
b1b942b7	407	sp = data + 3; \
3616e9e9	408	CHECK_OVERFLOW (); \
2cdb8cdc AW	409	stack_base = sp; \
2cdb8cdc AW	410	ip = bp->base; \
24aa2715 KN	411	\
24aa2715 KN	412	/* Init local variables */ \
2cdb8cdc AW	413	for (i=bp->nlocs; i; i--) \
2cdb8cdc AW	414	data[-i] = SCM_UNDEFINED; \
24aa2715	415	\
ac02b386	416	/* Set frame data */ \
b1b942b7 AW	417	data[3] = (SCM)ra; \
	418	data[2] = 0x0; \
	419	data[1] = (SCM)dl; \
11ea1aba AW	420	\
	421	/* Postpone initializing external vars, \
	422	because if the CONS causes a GC, we \
	423	want the stack marker to see the data \
	424	array formatted as expected. */ \
	425	data[0] = SCM_UNDEFINED; \
	426	external = bp->external; \
	427	for (i = 0; i < bp->nexts; i++) \
	428	CONS (external, SCM_UNDEFINED, external); \
	429	data[0] = external; \
3616e9e9 KN	430	}
3616e9e9 KN	431
af988bbf KN	432	#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
af988bbf KN	433
17e90c5e KN	434	/*
	435	Local Variables:
	436	c-file-style: "gnu"
	437	End:
	438	*/