[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. */
#elif defined __x86_64__
/* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
   well.  Tell it to keep the jump table in a r12, which is
   callee-saved.  */
#define JT_REG asm ("r12")
#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
#ifndef JT_REG
#define JT_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_is_eq (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 (scm_is_eq ((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 (current_thread, 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
a39b116f	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. */
37a5970c LC	60	#elif defined __x86_64__
	61	/* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
	62	well. Tell it to keep the jump table in a r12, which is
	63	callee-saved. */
	64	#define JT_REG asm ("r12")
893be93f	65	#endif
17e90c5e KN	66	#if defined(PPC) \|\| defined(_POWER) \|\| defined(_IBMR2)
	67	#define IP_REG asm("26")
	68	#define SP_REG asm("27")
	69	#define FP_REG asm("28")
	70	#endif
	71	#ifdef __hppa__
	72	#define IP_REG asm("%r18")
	73	#define SP_REG asm("%r17")
	74	#define FP_REG asm("%r16")
	75	#endif
	76	#ifdef __mc68000__
	77	#define IP_REG asm("a5")
	78	#define SP_REG asm("a4")
	79	#define FP_REG
	80	#endif
	81	#ifdef __arm__
	82	#define IP_REG asm("r9")
	83	#define SP_REG asm("r8")
	84	#define FP_REG asm("r7")
	85	#endif
9df03fd0 KN	86	#endif
9df03fd0 KN	87
17d1b4bf AW	88	#ifndef IP_REG
	89	#define IP_REG
	90	#endif
	91	#ifndef SP_REG
	92	#define SP_REG
	93	#endif
	94	#ifndef FP_REG
	95	#define FP_REG
	96	#endif
37a5970c LC	97	#ifndef JT_REG
	98	#define JT_REG
	99	#endif
17d1b4bf	100
9df03fd0	101	\f
a98cef7e	102	/*
3d5ee0cd	103	* Cache/Sync
a98cef7e KN	104	*/
a98cef7e KN	105
11ea1aba	106	#ifdef VM_ENABLE_ASSERTIONS
9a8cc8e7 AW	107	# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
	108	#else
	109	# define ASSERT(condition)
	110	#endif
	111
	112
9823fd39	113	/* Cache the VM's instruction, stack, and frame pointer in local variables. */
3d5ee0cd	114	#define CACHE_REGISTER() \
17e90c5e	115	{ \
3d5ee0cd KN	116	ip = vp->ip; \
	117	sp = vp->sp; \
	118	fp = vp->fp; \
17e90c5e	119	}
a98cef7e	120
9823fd39 LC	121	/* Update the registers in VP, a pointer to the current VM. This must be done
	122	at least before any GC invocation so that `vp->sp' is up-to-date and the
	123	whole stack gets marked. */
3d5ee0cd	124	#define SYNC_REGISTER() \
a98cef7e	125	{ \
3d5ee0cd KN	126	vp->ip = ip; \
	127	vp->sp = sp; \
	128	vp->fp = fp; \
a98cef7e KN	129	}
a98cef7e KN	130
8d90b356 AW	131	/* FIXME */
	132	#define ASSERT_VARIABLE(x) \
	133	do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
	134	} while (0)
	135	#define ASSERT_BOUND_VARIABLE(x) \
	136	do { ASSERT_VARIABLE (x); \
d223c3fc	137	if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED)) \
8d90b356 AW	138	{ SYNC_REGISTER (); abort(); } \
	139	} while (0)
	140
11ea1aba	141	#ifdef VM_ENABLE_PARANOID_ASSERTIONS
7e4760e4	142	#define CHECK_IP() \
53e28ed9	143	do { if (ip < bp->base \|\| ip - bp->base > bp->len) abort (); } while (0)
28b119ee AW	144	#define ASSERT_ALIGNED_PROCEDURE() \
28b119ee AW	145	do { if ((scm_t_bits)bp % 8) abort (); } while (0)
a1a482e0	146	#define ASSERT_BOUND(x) \
d223c3fc	147	do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
a1a482e0	148	} while (0)
7e4760e4 AW	149	#else
7e4760e4 AW	150	#define CHECK_IP()
28b119ee	151	#define ASSERT_ALIGNED_PROCEDURE()
a1a482e0	152	#define ASSERT_BOUND(x)
7e4760e4 AW	153	#endif
7e4760e4 AW	154
eae2438d AW	155	#if VM_CHECK_OBJECT
	156	#define SET_OBJECT_COUNT(n) object_count = n
	157	#else
	158	#define SET_OBJECT_COUNT(n) /* nop */
	159	#endif
	160
20d47c39	161	/* Cache the object table and free variables. */
a52b2d3d LC	162	#define CACHE_PROGRAM() \
a52b2d3d LC	163	{ \
e677365c AW	164	if (bp != SCM_PROGRAM_DATA (program)) { \
e677365c AW	165	bp = SCM_PROGRAM_DATA (program); \
28b119ee	166	ASSERT_ALIGNED_PROCEDURE (); \
53e28ed9 AW	167	if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
53e28ed9 AW	168	objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
eae2438d	169	SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
2fda0242 AW	170	} else { \
2fda0242 AW	171	objects = NULL; \
eae2438d	172	SET_OBJECT_COUNT (0); \
2fda0242	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
0b5f0e49 LC	192	/* Accesses to a program's object table. */
	193	#if VM_CHECK_OBJECT
	194	#define CHECK_OBJECT(_num) \
6d14383e	195	do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
0b5f0e49 LC	196	#else
	197	#define CHECK_OBJECT(_num)
	198	#endif
	199
57ab0671	200	#if VM_CHECK_FREE_VARIABLES
6f16379e AW	201	#define CHECK_FREE_VARIABLE(_num) \
	202	do { \
	203	if (SCM_UNLIKELY ((_num) >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))) \
	204	goto vm_error_free_variable; \
	205	} while (0)
8d90b356	206	#else
57ab0671	207	#define CHECK_FREE_VARIABLE(_num)
8d90b356 AW	208	#endif
8d90b356 AW	209
ac02b386	210	\f
3d5ee0cd KN	211	/*
	212	* Hooks
	213	*/
	214
	215	#undef RUN_HOOK
45cc4867	216	#undef RUN_HOOK1
3d5ee0cd	217	#if VM_USE_HOOKS
7656f194 AW	218	#define RUN_HOOK(h) \
	219	{ \
	220	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	221	{ \
	222	SYNC_REGISTER (); \
	223	vm_dispatch_hook (vm, h); \
	224	} \
	225	}
45cc4867 AW	226	#define RUN_HOOK1(h, x) \
	227	{ \
	228	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	229	{ \
	230	PUSH (x); \
	231	SYNC_REGISTER (); \
	232	vm_dispatch_hook (vm, h); \
	233	DROP(); \
	234	} \
	235	}
3d5ee0cd KN	236	#else
3d5ee0cd KN	237	#define RUN_HOOK(h)
45cc4867	238	#define RUN_HOOK1(h, x)
3d5ee0cd KN	239	#endif
3d5ee0cd KN	240
c45d4d77 AW	241	#define APPLY_HOOK() \
	242	RUN_HOOK (SCM_VM_APPLY_HOOK)
	243	#define PUSH_CONTINUATION_HOOK() \
	244	RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
	245	#define POP_CONTINUATION_HOOK(n) \
	246	RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
	247	#define NEXT_HOOK() \
	248	RUN_HOOK (SCM_VM_NEXT_HOOK)
f3120251 AW	249	#define ABORT_CONTINUATION_HOOK() \
	250	RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
	251	#define RESTORE_CONTINUATION_HOOK() \
	252	RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
3d5ee0cd	253
e8c37772	254	#define VM_HANDLE_INTERRUPTS \
a2a6c0e3	255	SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
e8c37772	256
3d5ee0cd	257	\f
a98cef7e KN	258	/*
	259	* Stack operation
	260	*/
	261
11ea1aba AW	262	#ifdef VM_ENABLE_STACK_NULLING
	263	# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
	264	# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
	265	# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
66db076a AW	266	/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
	267	inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
	268	that continuation doesn't have a chance to run. It's not important on a
	269	semantic level, but it does mess up our stack nulling -- so this macro is to
	270	fix that. */
	271	# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
11ea1aba AW	272	#else
	273	# define CHECK_STACK_LEAKN(_n)
	274	# define CHECK_STACK_LEAK()
	275	# define NULLSTACK(_n)
66db076a	276	# define NULLSTACK_FOR_NONLOCAL_EXIT()
11ea1aba AW	277	#endif
11ea1aba AW	278
17e90c5e	279	#define CHECK_OVERFLOW() \
ba2d9603	280	if (SCM_UNLIKELY (sp >= stack_limit)) \
17e90c5e KN	281	goto vm_error_stack_overflow
17e90c5e KN	282
eae2438d AW	283
eae2438d AW	284	#ifdef VM_CHECK_UNDERFLOW
7e4760e4	285	#define CHECK_UNDERFLOW() \
ba2d9603	286	if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp))) \
eae2438d	287	goto vm_error_stack_underflow
ba2d9603 AW	288	#define PRE_CHECK_UNDERFLOW(N) \
ba2d9603 AW	289	if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp))) \
eae2438d AW	290	goto vm_error_stack_underflow
	291	#else
	292	#define CHECK_UNDERFLOW() /* nop */
	293	#define PRE_CHECK_UNDERFLOW(N) /* nop */
	294	#endif
	295
a98cef7e	296
3616e9e9	297	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
11ea1aba	298	#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
ba2d9603 AW	299	#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
ba2d9603 AW	300	#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
eae2438d AW	301	#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = sp--; y = sp--; NULLSTACK (2); } while (0)
eae2438d AW	302	#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = sp--; y = sp--; z = *sp--; NULLSTACK (3); } while (0)
17e90c5e	303
2d80426a LC	304	/* A fast CONS. This has to be fast since its used, for instance, by
	305	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	306	inlined function in Guile 1.7. Unfortunately, it calls
	307	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	308	heap. XXX */
	309	#define CONS(x,y,z) \
	310	{ \
	311	SYNC_BEFORE_GC (); \
	312	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	313	}
a98cef7e KN	314
f41cb00c LC	315	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	316	them. */
17e90c5e	317	#define POP_LIST(n) \
f41cb00c LC	318	do \
f41cb00c LC	319	{ \
17e90c5e	320	int i; \
11ea1aba AW	321	SCM l = SCM_EOL, x; \
	322	for (i = n; i; i--) \
	323	{ \
	324	POP (x); \
	325	CONS (l, x, l); \
	326	} \
3616e9e9	327	PUSH (l); \
17e90c5e KN	328	} while (0)
17e90c5e KN	329
1f40459f	330	/* The opposite: push all of the elements in L onto the list. */
fb10a008	331	#define PUSH_LIST(l, NILP) \
1f40459f AW	332	do \
	333	{ \
	334	for (; scm_is_pair (l); l = SCM_CDR (l)) \
	335	PUSH (SCM_CAR (l)); \
fb10a008	336	if (SCM_UNLIKELY (!NILP (l))) { \
e06e857c	337	finish_args = scm_list_1 (l); \
1f40459f AW	338	goto vm_error_improper_list; \
	339	} \
	340	} while (0)
	341
135b32ee	342	\f
cb4cca12 KN	343	#define POP_LIST_MARK() \
	344	do { \
	345	SCM o; \
	346	SCM l = SCM_EOL; \
	347	POP (o); \
	348	while (!SCM_UNBNDP (o)) \
	349	{ \
	350	CONS (l, o, l); \
	351	POP (o); \
	352	} \
	353	PUSH (l); \
	354	} while (0)
	355
2bd859c8 AW	356	#define POP_CONS_MARK() \
	357	do { \
	358	SCM o, l; \
	359	POP (l); \
	360	POP (o); \
	361	while (!SCM_UNBNDP (o)) \
	362	{ \
	363	CONS (l, o, l); \
	364	POP (o); \
	365	} \
	366	PUSH (l); \
	367	} while (0)
	368
a98cef7e KN	369	\f
a98cef7e KN	370	/*
17e90c5e	371	* Instruction operation
a98cef7e KN	372	*/
a98cef7e KN	373
17e90c5e	374	#define FETCH() (*ip++)
53e28ed9	375	#define FETCH_LENGTH(len) do { len=ip++; len<<=8; len+=ip++; len<<=8; len+=*ip++; } while (0)
17e90c5e	376
17e90c5e KN	377	#undef NEXT_JUMP
17e90c5e KN	378	#ifdef HAVE_LABELS_AS_VALUES
53e28ed9	379	#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
17e90c5e KN	380	#else
	381	#define NEXT_JUMP() goto vm_start
	382	#endif
	383
	384	#define NEXT \
	385	{ \
17e90c5e	386	NEXT_HOOK (); \
11ea1aba	387	CHECK_STACK_LEAK (); \
17e90c5e	388	NEXT_JUMP (); \
a98cef7e KN	389	}
	390
	391	\f
ac99cb0c	392	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	393	/* When this is called, bp points to the new program data,
2cdb8cdc AW	394	and the arguments are already on the stack */
03e6c165 AW	395	#define DROP_FRAME() \
	396	{ \
	397	sp -= 3; \
	398	NULLSTACK (3); \
	399	CHECK_UNDERFLOW (); \
	400	}
	401
	402
17e90c5e KN	403	/*
	404	Local Variables:
	405	c-file-style: "gnu"
	406	End:
	407	*/