[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 */

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