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

/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
 * 
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library 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
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */

/* 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__
/* too few registers! because of register allocation errors with various gcs,
   just punt on explicit assignments on i386, hoping that the "register"
   declaration will be sufficient. */
#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


/* Cache the VM's instruction, stack, and frame pointer in local variables.  */
#define CACHE_REGISTER()			\
{						\
  ip = vp->ip;					\
  sp = vp->sp;					\
  fp = vp->fp;					\
}

/* Update the registers in VP, a pointer to the current VM.  This must be done
   at least before any GC invocation so that `vp->sp' is up-to-date and the
   whole stack gets marked.  */
#define SYNC_REGISTER()				\
{						\
  vp->ip = ip;					\
  vp->sp = sp;					\
  vp->fp = fp;					\
}

/* FIXME */
#define ASSERT_VARIABLE(x)                                              \
  do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); }           \
  } while (0)
#define ASSERT_BOUND_VARIABLE(x)                                        \
  do { ASSERT_VARIABLE (x);                                             \
    if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED)                          \
      { SYNC_REGISTER (); abort(); }                                    \
  } while (0)

#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
  do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
#define ASSERT_ALIGNED_PROCEDURE() \
  do { if ((scm_t_bits)bp % 8) abort (); } while (0)
#define ASSERT_BOUND(x) \
  do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
  } while (0)
#else
#define CHECK_IP()
#define ASSERT_ALIGNED_PROCEDURE()
#define ASSERT_BOUND(x)
#endif

#if VM_CHECK_OBJECT
#define SET_OBJECT_COUNT(n) object_count = n
#else
#define SET_OBJECT_COUNT(n) /* nop */
#endif

/* Cache the object table and free variables.  */
#define CACHE_PROGRAM()							\
{									\
  if (bp != SCM_PROGRAM_DATA (program)) {                               \
    bp = SCM_PROGRAM_DATA (program);					\
    ASSERT_ALIGNED_PROCEDURE ();                                        \
    if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
      objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
      SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
    } else {                                                            \
      objects = NULL;                                                   \
      SET_OBJECT_COUNT (0);                                             \
    }                                                                   \
  }                                                                     \
}

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

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

\f
/*
 * Error check
 */

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

#if VM_CHECK_FREE_VARIABLES
#define CHECK_FREE_VARIABLE(_num)                                       \
  do {                                                                  \
    if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
      goto vm_error_free_variable;                                      \
  } while (0)
#else
#define CHECK_FREE_VARIABLE(_num)
#endif

\f
/*
 * Hooks
 */

#undef RUN_HOOK
#undef RUN_HOOK1
#if VM_USE_HOOKS
#define RUN_HOOK(h)                                     \
  {                                                     \
    if (SCM_UNLIKELY (vp->trace_level > 0))             \
      {                                                 \
        SYNC_REGISTER ();				\
        vm_dispatch_hook (vm, h);                       \
      }                                                 \
  }
#define RUN_HOOK1(h, x)                                 \
  {                                                     \
    if (SCM_UNLIKELY (vp->trace_level > 0))             \
      {                                                 \
        PUSH (x);                                       \
        SYNC_REGISTER ();				\
        vm_dispatch_hook (vm, h);                       \
        DROP();                                         \
      }                                                 \
  }
#else
#define RUN_HOOK(h)
#define RUN_HOOK1(h, x)
#endif

#define APPLY_HOOK()                            \
  RUN_HOOK (SCM_VM_APPLY_HOOK)
#define PUSH_CONTINUATION_HOOK()                \
  RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
#define POP_CONTINUATION_HOOK(n)                \
  RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
#define NEXT_HOOK()                             \
  RUN_HOOK (SCM_VM_NEXT_HOOK)
#define ABORT_CONTINUATION_HOOK()               \
  RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
#define RESTORE_CONTINUATION_HOOK()            \
  RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)

#define VM_HANDLE_INTERRUPTS                     \
  SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())

\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 (SCM_UNLIKELY (sp >= stack_limit))         \
    goto vm_error_stack_overflow


#ifdef VM_CHECK_UNDERFLOW
#define CHECK_UNDERFLOW()                       \
  if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp)))        \
    goto vm_error_stack_underflow
#define PRE_CHECK_UNDERFLOW(N)                  \
  if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp)))    \
    goto vm_error_stack_underflow
#else
#define CHECK_UNDERFLOW() /* nop */
#define PRE_CHECK_UNDERFLOW(N) /* nop */
#endif


#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 { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } 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 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					\
{						\
  NEXT_HOOK ();					\
  CHECK_STACK_LEAK ();                          \
  NEXT_JUMP ();					\
}

\f
/* 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 DROP_FRAME()                            \
  {                                             \
    sp -= 3;                                    \
    NULLSTACK (3);                              \
    CHECK_UNDERFLOW ();                         \
  }
    

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
eae2438d	1	/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
a98cef7e	2	*
560b9c25	3	* This library is free software; you can redistribute it and/or
53befeb7 NJ	4	* modify it under the terms of the GNU Lesser General Public License
	5	* as published by the Free Software Foundation; either version 3 of
	6	* the License, or (at your option) any later version.
a98cef7e	7	*
53befeb7 NJ	8	* This library is distributed in the hope that it will be useful, but
53befeb7 NJ	9	* WITHOUT ANY WARRANTY; without even the implied warranty of
560b9c25 AW	10	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
560b9c25 AW	11	* Lesser General Public License for more details.
a98cef7e	12	*
560b9c25 AW	13	* You should have received a copy of the GNU Lesser General Public
560b9c25 AW	14	* License along with this library; if not, write to the Free Software
53befeb7 NJ	15	* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
53befeb7 NJ	16	* 02110-1301 USA
560b9c25	17	*/
a98cef7e KN	18
	19	/* This file is included in vm_engine.c */
	20
a98cef7e KN	21	\f
a98cef7e KN	22	/*
17e90c5e	23	* Registers
a98cef7e KN	24	*/
a98cef7e KN	25
17e90c5e	26	/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
9df03fd0	27
17e90c5e KN	28	Some compilers underestimate the use of the local variables representing
	29	the abstract machine registers, and don't put them in hardware registers,
	30	which slows down the interpreter considerably.
	31	For GCC, I have hand-assigned hardware registers for several architectures.
	32	*/
9df03fd0	33
17e90c5e KN	34	#ifdef __GNUC__
	35	#ifdef __mips__
	36	#define IP_REG asm("$16")
	37	#define SP_REG asm("$17")
	38	#define FP_REG asm("$18")
	39	#endif
	40	#ifdef __sparc__
	41	#define IP_REG asm("%l0")
	42	#define SP_REG asm("%l1")
	43	#define FP_REG asm("%l2")
	44	#endif
	45	#ifdef __alpha__
	46	#ifdef __CRAY__
	47	#define IP_REG asm("r9")
	48	#define SP_REG asm("r10")
	49	#define FP_REG asm("r11")
9df03fd0	50	#else
17e90c5e KN	51	#define IP_REG asm("$9")
	52	#define SP_REG asm("$10")
	53	#define FP_REG asm("$11")
	54	#endif
	55	#endif
	56	#ifdef __i386__
e6eb2467 AW	57	/* too few registers! because of register allocation errors with various gcs,
	58	just punt on explicit assignments on i386, hoping that the "register"
	59	declaration will be sufficient. */
893be93f	60	#endif
17e90c5e KN	61	#if defined(PPC) \|\| defined(_POWER) \|\| defined(_IBMR2)
	62	#define IP_REG asm("26")
	63	#define SP_REG asm("27")
	64	#define FP_REG asm("28")
	65	#endif
	66	#ifdef __hppa__
	67	#define IP_REG asm("%r18")
	68	#define SP_REG asm("%r17")
	69	#define FP_REG asm("%r16")
	70	#endif
	71	#ifdef __mc68000__
	72	#define IP_REG asm("a5")
	73	#define SP_REG asm("a4")
	74	#define FP_REG
	75	#endif
	76	#ifdef __arm__
	77	#define IP_REG asm("r9")
	78	#define SP_REG asm("r8")
	79	#define FP_REG asm("r7")
	80	#endif
9df03fd0 KN	81	#endif
9df03fd0 KN	82
17d1b4bf AW	83	#ifndef IP_REG
	84	#define IP_REG
	85	#endif
	86	#ifndef SP_REG
	87	#define SP_REG
	88	#endif
	89	#ifndef FP_REG
	90	#define FP_REG
	91	#endif
	92
9df03fd0	93	\f
a98cef7e	94	/*
3d5ee0cd	95	* Cache/Sync
a98cef7e KN	96	*/
a98cef7e KN	97
11ea1aba	98	#ifdef VM_ENABLE_ASSERTIONS
9a8cc8e7 AW	99	# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
	100	#else
	101	# define ASSERT(condition)
	102	#endif
	103
	104
9823fd39	105	/* Cache the VM's instruction, stack, and frame pointer in local variables. */
3d5ee0cd	106	#define CACHE_REGISTER() \
17e90c5e	107	{ \
3d5ee0cd KN	108	ip = vp->ip; \
	109	sp = vp->sp; \
	110	fp = vp->fp; \
17e90c5e	111	}
a98cef7e	112
9823fd39 LC	113	/* Update the registers in VP, a pointer to the current VM. This must be done
	114	at least before any GC invocation so that `vp->sp' is up-to-date and the
	115	whole stack gets marked. */
3d5ee0cd	116	#define SYNC_REGISTER() \
a98cef7e	117	{ \
3d5ee0cd KN	118	vp->ip = ip; \
	119	vp->sp = sp; \
	120	vp->fp = fp; \
a98cef7e KN	121	}
a98cef7e KN	122
8d90b356 AW	123	/* FIXME */
	124	#define ASSERT_VARIABLE(x) \
	125	do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
	126	} while (0)
	127	#define ASSERT_BOUND_VARIABLE(x) \
	128	do { ASSERT_VARIABLE (x); \
	129	if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED) \
	130	{ SYNC_REGISTER (); abort(); } \
	131	} while (0)
	132
11ea1aba	133	#ifdef VM_ENABLE_PARANOID_ASSERTIONS
7e4760e4	134	#define CHECK_IP() \
53e28ed9	135	do { if (ip < bp->base \|\| ip - bp->base > bp->len) abort (); } while (0)
28b119ee AW	136	#define ASSERT_ALIGNED_PROCEDURE() \
28b119ee AW	137	do { if ((scm_t_bits)bp % 8) abort (); } while (0)
a1a482e0 AW	138	#define ASSERT_BOUND(x) \
	139	do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
	140	} while (0)
7e4760e4 AW	141	#else
7e4760e4 AW	142	#define CHECK_IP()
28b119ee	143	#define ASSERT_ALIGNED_PROCEDURE()
a1a482e0	144	#define ASSERT_BOUND(x)
7e4760e4 AW	145	#endif
7e4760e4 AW	146
eae2438d AW	147	#if VM_CHECK_OBJECT
	148	#define SET_OBJECT_COUNT(n) object_count = n
	149	#else
	150	#define SET_OBJECT_COUNT(n) /* nop */
	151	#endif
	152
20d47c39	153	/* Cache the object table and free variables. */
a52b2d3d LC	154	#define CACHE_PROGRAM() \
a52b2d3d LC	155	{ \
e677365c AW	156	if (bp != SCM_PROGRAM_DATA (program)) { \
e677365c AW	157	bp = SCM_PROGRAM_DATA (program); \
28b119ee	158	ASSERT_ALIGNED_PROCEDURE (); \
53e28ed9 AW	159	if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
53e28ed9 AW	160	objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
eae2438d	161	SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
2fda0242 AW	162	} else { \
2fda0242 AW	163	objects = NULL; \
eae2438d	164	SET_OBJECT_COUNT (0); \
2fda0242	165	} \
e677365c	166	} \
41f248a8 KN	167	}
41f248a8 KN	168
3d5ee0cd KN	169	#define SYNC_BEFORE_GC() \
	170	{ \
	171	SYNC_REGISTER (); \
17e90c5e	172	}
a98cef7e	173
17e90c5e	174	#define SYNC_ALL() \
a98cef7e	175	{ \
3d5ee0cd	176	SYNC_REGISTER (); \
a98cef7e KN	177	}
a98cef7e KN	178
a98cef7e	179	\f
ac02b386 KN	180	/*
	181	* Error check
	182	*/
	183
0b5f0e49 LC	184	/* Accesses to a program's object table. */
	185	#if VM_CHECK_OBJECT
	186	#define CHECK_OBJECT(_num) \
6d14383e	187	do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
0b5f0e49 LC	188	#else
	189	#define CHECK_OBJECT(_num)
	190	#endif
	191
57ab0671	192	#if VM_CHECK_FREE_VARIABLES
6f16379e AW	193	#define CHECK_FREE_VARIABLE(_num) \
	194	do { \
	195	if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
	196	goto vm_error_free_variable; \
	197	} while (0)
8d90b356	198	#else
57ab0671	199	#define CHECK_FREE_VARIABLE(_num)
8d90b356 AW	200	#endif
8d90b356 AW	201
ac02b386	202	\f
3d5ee0cd KN	203	/*
	204	* Hooks
	205	*/
	206
	207	#undef RUN_HOOK
45cc4867	208	#undef RUN_HOOK1
3d5ee0cd	209	#if VM_USE_HOOKS
7656f194 AW	210	#define RUN_HOOK(h) \
	211	{ \
	212	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	213	{ \
	214	SYNC_REGISTER (); \
	215	vm_dispatch_hook (vm, h); \
	216	} \
	217	}
45cc4867 AW	218	#define RUN_HOOK1(h, x) \
	219	{ \
	220	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	221	{ \
	222	PUSH (x); \
	223	SYNC_REGISTER (); \
	224	vm_dispatch_hook (vm, h); \
	225	DROP(); \
	226	} \
	227	}
3d5ee0cd KN	228	#else
3d5ee0cd KN	229	#define RUN_HOOK(h)
45cc4867	230	#define RUN_HOOK1(h, x)
3d5ee0cd KN	231	#endif
3d5ee0cd KN	232
c45d4d77 AW	233	#define APPLY_HOOK() \
	234	RUN_HOOK (SCM_VM_APPLY_HOOK)
	235	#define PUSH_CONTINUATION_HOOK() \
	236	RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
	237	#define POP_CONTINUATION_HOOK(n) \
	238	RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
	239	#define NEXT_HOOK() \
	240	RUN_HOOK (SCM_VM_NEXT_HOOK)
f3120251 AW	241	#define ABORT_CONTINUATION_HOOK() \
	242	RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
	243	#define RESTORE_CONTINUATION_HOOK() \
	244	RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
3d5ee0cd	245
e8c37772 AW	246	#define VM_HANDLE_INTERRUPTS \
	247	SCM_ASYNC_TICK_WITH_CODE (SYNC_REGISTER ())
	248
3d5ee0cd	249	\f
a98cef7e KN	250	/*
	251	* Stack operation
	252	*/
	253
11ea1aba AW	254	#ifdef VM_ENABLE_STACK_NULLING
	255	# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
	256	# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
	257	# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
66db076a AW	258	/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
	259	inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
	260	that continuation doesn't have a chance to run. It's not important on a
	261	semantic level, but it does mess up our stack nulling -- so this macro is to
	262	fix that. */
	263	# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
11ea1aba AW	264	#else
	265	# define CHECK_STACK_LEAKN(_n)
	266	# define CHECK_STACK_LEAK()
	267	# define NULLSTACK(_n)
66db076a	268	# define NULLSTACK_FOR_NONLOCAL_EXIT()
11ea1aba AW	269	#endif
11ea1aba AW	270
17e90c5e	271	#define CHECK_OVERFLOW() \
ba2d9603	272	if (SCM_UNLIKELY (sp >= stack_limit)) \
17e90c5e KN	273	goto vm_error_stack_overflow
17e90c5e KN	274
eae2438d AW	275
eae2438d AW	276	#ifdef VM_CHECK_UNDERFLOW
7e4760e4	277	#define CHECK_UNDERFLOW() \
ba2d9603	278	if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp))) \
eae2438d	279	goto vm_error_stack_underflow
ba2d9603 AW	280	#define PRE_CHECK_UNDERFLOW(N) \
ba2d9603 AW	281	if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp))) \
eae2438d AW	282	goto vm_error_stack_underflow
	283	#else
	284	#define CHECK_UNDERFLOW() /* nop */
	285	#define PRE_CHECK_UNDERFLOW(N) /* nop */
	286	#endif
	287
a98cef7e	288
3616e9e9	289	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
11ea1aba	290	#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
ba2d9603 AW	291	#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
ba2d9603 AW	292	#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
eae2438d AW	293	#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = sp--; y = sp--; NULLSTACK (2); } while (0)
eae2438d AW	294	#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = sp--; y = sp--; z = *sp--; NULLSTACK (3); } while (0)
17e90c5e	295
2d80426a LC	296	/* A fast CONS. This has to be fast since its used, for instance, by
	297	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	298	inlined function in Guile 1.7. Unfortunately, it calls
	299	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	300	heap. XXX */
	301	#define CONS(x,y,z) \
	302	{ \
	303	SYNC_BEFORE_GC (); \
	304	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	305	}
a98cef7e KN	306
f41cb00c LC	307	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	308	them. */
17e90c5e	309	#define POP_LIST(n) \
f41cb00c LC	310	do \
f41cb00c LC	311	{ \
17e90c5e	312	int i; \
11ea1aba AW	313	SCM l = SCM_EOL, x; \
	314	for (i = n; i; i--) \
	315	{ \
	316	POP (x); \
	317	CONS (l, x, l); \
	318	} \
3616e9e9	319	PUSH (l); \
17e90c5e KN	320	} while (0)
17e90c5e KN	321
1f40459f	322	/* The opposite: push all of the elements in L onto the list. */
fb10a008	323	#define PUSH_LIST(l, NILP) \
1f40459f AW	324	do \
	325	{ \
	326	for (; scm_is_pair (l); l = SCM_CDR (l)) \
	327	PUSH (SCM_CAR (l)); \
fb10a008	328	if (SCM_UNLIKELY (!NILP (l))) { \
e06e857c	329	finish_args = scm_list_1 (l); \
1f40459f AW	330	goto vm_error_improper_list; \
	331	} \
	332	} while (0)
	333
135b32ee	334	\f
cb4cca12 KN	335	#define POP_LIST_MARK() \
	336	do { \
	337	SCM o; \
	338	SCM l = SCM_EOL; \
	339	POP (o); \
	340	while (!SCM_UNBNDP (o)) \
	341	{ \
	342	CONS (l, o, l); \
	343	POP (o); \
	344	} \
	345	PUSH (l); \
	346	} while (0)
	347
2bd859c8 AW	348	#define POP_CONS_MARK() \
	349	do { \
	350	SCM o, l; \
	351	POP (l); \
	352	POP (o); \
	353	while (!SCM_UNBNDP (o)) \
	354	{ \
	355	CONS (l, o, l); \
	356	POP (o); \
	357	} \
	358	PUSH (l); \
	359	} while (0)
	360
a98cef7e KN	361	\f
a98cef7e KN	362	/*
17e90c5e	363	* Instruction operation
a98cef7e KN	364	*/
a98cef7e KN	365
17e90c5e	366	#define FETCH() (*ip++)
53e28ed9	367	#define FETCH_LENGTH(len) do { len=ip++; len<<=8; len+=ip++; len<<=8; len+=*ip++; } while (0)
17e90c5e	368
17e90c5e KN	369	#undef NEXT_JUMP
17e90c5e KN	370	#ifdef HAVE_LABELS_AS_VALUES
53e28ed9	371	#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
17e90c5e KN	372	#else
	373	#define NEXT_JUMP() goto vm_start
	374	#endif
	375
	376	#define NEXT \
	377	{ \
17e90c5e	378	NEXT_HOOK (); \
11ea1aba	379	CHECK_STACK_LEAK (); \
17e90c5e	380	NEXT_JUMP (); \
a98cef7e KN	381	}
	382
	383	\f
ac99cb0c	384	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	385	/* When this is called, bp points to the new program data,
2cdb8cdc AW	386	and the arguments are already on the stack */
03e6c165 AW	387	#define DROP_FRAME() \
	388	{ \
	389	sp -= 3; \
	390	NULLSTACK (3); \
	391	CHECK_UNDERFLOW (); \
	392	}
	393
	394
17e90c5e KN	395	/*
	396	Local Variables:
	397	c-file-style: "gnu"
	398	End:
	399	*/