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

/* Copyright (C) 2001, 2009-2012, 2014 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
#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
 */

#define VM_ASSERT(condition, handler) \
  do { if (SCM_UNLIKELY (!(condition))) { SYNC_ALL(); handler; } } while (0)

#ifdef VM_ENABLE_ASSERTIONS
# define ASSERT(condition) VM_ASSERT (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)                              \
  VM_ASSERT ((_num) < object_count, vm_error_object ())
#else
#define CHECK_OBJECT(_num)
#endif

#if VM_CHECK_FREE_VARIABLES
#define CHECK_FREE_VARIABLE(_num)                               \
  VM_ASSERT ((_num) < SCM_PROGRAM_NUM_FREE_VARIABLES (program), \
             vm_error_free_variable ())
#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

/* For this check, we don't use VM_ASSERT, because that leads to a
   per-site SYNC_ALL, which is too much code growth.  The real problem
   of course is having to check for overflow all the time... */
#define CHECK_OVERFLOW()                                                \
  do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)


#ifdef VM_CHECK_UNDERFLOW
#define PRE_CHECK_UNDERFLOW(N)                  \
  VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
#else
#define PRE_CHECK_UNDERFLOW(N) /* nop */
#define CHECK_UNDERFLOW() /* 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));                         \
  VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
} 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
bed025bd	1	/* Copyright (C) 2001, 2009-2012, 2014 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")
bed025bd	84	#define FP_REG
17e90c5e	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
53bdfcf0 AW	106	#define VM_ASSERT(condition, handler) \
	107	do { if (SCM_UNLIKELY (!(condition))) { SYNC_ALL(); handler; } } while (0)
	108
11ea1aba	109	#ifdef VM_ENABLE_ASSERTIONS
53bdfcf0	110	# define ASSERT(condition) VM_ASSERT (condition, abort())
9a8cc8e7 AW	111	#else
	112	# define ASSERT(condition)
	113	#endif
	114
	115
9823fd39	116	/* Cache the VM's instruction, stack, and frame pointer in local variables. */
3d5ee0cd	117	#define CACHE_REGISTER() \
17e90c5e	118	{ \
3d5ee0cd KN	119	ip = vp->ip; \
	120	sp = vp->sp; \
	121	fp = vp->fp; \
17e90c5e	122	}
a98cef7e	123
9823fd39 LC	124	/* Update the registers in VP, a pointer to the current VM. This must be done
	125	at least before any GC invocation so that `vp->sp' is up-to-date and the
	126	whole stack gets marked. */
3d5ee0cd	127	#define SYNC_REGISTER() \
a98cef7e	128	{ \
3d5ee0cd KN	129	vp->ip = ip; \
	130	vp->sp = sp; \
	131	vp->fp = fp; \
a98cef7e KN	132	}
a98cef7e KN	133
8d90b356 AW	134	/* FIXME */
	135	#define ASSERT_VARIABLE(x) \
	136	do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
	137	} while (0)
	138	#define ASSERT_BOUND_VARIABLE(x) \
	139	do { ASSERT_VARIABLE (x); \
d223c3fc	140	if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED)) \
8d90b356 AW	141	{ SYNC_REGISTER (); abort(); } \
	142	} while (0)
	143
11ea1aba	144	#ifdef VM_ENABLE_PARANOID_ASSERTIONS
7e4760e4	145	#define CHECK_IP() \
53e28ed9	146	do { if (ip < bp->base \|\| ip - bp->base > bp->len) abort (); } while (0)
28b119ee AW	147	#define ASSERT_ALIGNED_PROCEDURE() \
28b119ee AW	148	do { if ((scm_t_bits)bp % 8) abort (); } while (0)
a1a482e0	149	#define ASSERT_BOUND(x) \
d223c3fc	150	do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
a1a482e0	151	} while (0)
7e4760e4 AW	152	#else
7e4760e4 AW	153	#define CHECK_IP()
28b119ee	154	#define ASSERT_ALIGNED_PROCEDURE()
a1a482e0	155	#define ASSERT_BOUND(x)
7e4760e4 AW	156	#endif
7e4760e4 AW	157
eae2438d AW	158	#if VM_CHECK_OBJECT
	159	#define SET_OBJECT_COUNT(n) object_count = n
	160	#else
	161	#define SET_OBJECT_COUNT(n) /* nop */
	162	#endif
	163
20d47c39	164	/* Cache the object table and free variables. */
a52b2d3d LC	165	#define CACHE_PROGRAM() \
a52b2d3d LC	166	{ \
e677365c AW	167	if (bp != SCM_PROGRAM_DATA (program)) { \
e677365c AW	168	bp = SCM_PROGRAM_DATA (program); \
28b119ee	169	ASSERT_ALIGNED_PROCEDURE (); \
53e28ed9 AW	170	if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
53e28ed9 AW	171	objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
eae2438d	172	SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
2fda0242 AW	173	} else { \
2fda0242 AW	174	objects = NULL; \
eae2438d	175	SET_OBJECT_COUNT (0); \
2fda0242	176	} \
e677365c	177	} \
41f248a8 KN	178	}
41f248a8 KN	179
3d5ee0cd KN	180	#define SYNC_BEFORE_GC() \
	181	{ \
	182	SYNC_REGISTER (); \
17e90c5e	183	}
a98cef7e	184
17e90c5e	185	#define SYNC_ALL() \
a98cef7e	186	{ \
3d5ee0cd	187	SYNC_REGISTER (); \
a98cef7e KN	188	}
a98cef7e KN	189
a98cef7e	190	\f
ac02b386 KN	191	/*
	192	* Error check
	193	*/
	194
0b5f0e49 LC	195	/* Accesses to a program's object table. */
0b5f0e49 LC	196	#if VM_CHECK_OBJECT
53bdfcf0 AW	197	#define CHECK_OBJECT(_num) \
53bdfcf0 AW	198	VM_ASSERT ((_num) < object_count, vm_error_object ())
0b5f0e49 LC	199	#else
	200	#define CHECK_OBJECT(_num)
	201	#endif
	202
57ab0671	203	#if VM_CHECK_FREE_VARIABLES
53bdfcf0 AW	204	#define CHECK_FREE_VARIABLE(_num) \
	205	VM_ASSERT ((_num) < SCM_PROGRAM_NUM_FREE_VARIABLES (program), \
	206	vm_error_free_variable ())
8d90b356	207	#else
57ab0671	208	#define CHECK_FREE_VARIABLE(_num)
8d90b356 AW	209	#endif
8d90b356 AW	210
ac02b386	211	\f
3d5ee0cd KN	212	/*
	213	* Hooks
	214	*/
	215
	216	#undef RUN_HOOK
45cc4867	217	#undef RUN_HOOK1
3d5ee0cd	218	#if VM_USE_HOOKS
7656f194 AW	219	#define RUN_HOOK(h) \
	220	{ \
	221	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	222	{ \
	223	SYNC_REGISTER (); \
	224	vm_dispatch_hook (vm, h); \
	225	} \
	226	}
45cc4867 AW	227	#define RUN_HOOK1(h, x) \
	228	{ \
	229	if (SCM_UNLIKELY (vp->trace_level > 0)) \
	230	{ \
	231	PUSH (x); \
	232	SYNC_REGISTER (); \
	233	vm_dispatch_hook (vm, h); \
	234	DROP(); \
	235	} \
	236	}
3d5ee0cd KN	237	#else
3d5ee0cd KN	238	#define RUN_HOOK(h)
45cc4867	239	#define RUN_HOOK1(h, x)
3d5ee0cd KN	240	#endif
3d5ee0cd KN	241
c45d4d77 AW	242	#define APPLY_HOOK() \
	243	RUN_HOOK (SCM_VM_APPLY_HOOK)
	244	#define PUSH_CONTINUATION_HOOK() \
	245	RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
	246	#define POP_CONTINUATION_HOOK(n) \
	247	RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
	248	#define NEXT_HOOK() \
	249	RUN_HOOK (SCM_VM_NEXT_HOOK)
f3120251 AW	250	#define ABORT_CONTINUATION_HOOK() \
	251	RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
	252	#define RESTORE_CONTINUATION_HOOK() \
	253	RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
3d5ee0cd	254
e8c37772	255	#define VM_HANDLE_INTERRUPTS \
a2a6c0e3	256	SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
e8c37772	257
3d5ee0cd	258	\f
a98cef7e KN	259	/*
	260	* Stack operation
	261	*/
	262
11ea1aba AW	263	#ifdef VM_ENABLE_STACK_NULLING
	264	# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
	265	# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
	266	# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
66db076a AW	267	/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
	268	inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
	269	that continuation doesn't have a chance to run. It's not important on a
	270	semantic level, but it does mess up our stack nulling -- so this macro is to
	271	fix that. */
	272	# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
11ea1aba AW	273	#else
	274	# define CHECK_STACK_LEAKN(_n)
	275	# define CHECK_STACK_LEAK()
	276	# define NULLSTACK(_n)
66db076a	277	# define NULLSTACK_FOR_NONLOCAL_EXIT()
11ea1aba AW	278	#endif
11ea1aba AW	279
53bdfcf0 AW	280	/* For this check, we don't use VM_ASSERT, because that leads to a
	281	per-site SYNC_ALL, which is too much code growth. The real problem
	282	of course is having to check for overflow all the time... */
	283	#define CHECK_OVERFLOW() \
	284	do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
17e90c5e	285
eae2438d AW	286
eae2438d AW	287	#ifdef VM_CHECK_UNDERFLOW
ba2d9603	288	#define PRE_CHECK_UNDERFLOW(N) \
53bdfcf0 AW	289	VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
53bdfcf0 AW	290	#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
eae2438d	291	#else
eae2438d	292	#define PRE_CHECK_UNDERFLOW(N) /* nop */
53bdfcf0	293	#define CHECK_UNDERFLOW() /* nop */
eae2438d AW	294	#endif
eae2438d AW	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)); \
53bdfcf0	336	VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
1f40459f AW	337	} while (0)
1f40459f AW	338
135b32ee	339	\f
cb4cca12 KN	340	#define POP_LIST_MARK() \
	341	do { \
	342	SCM o; \
	343	SCM l = SCM_EOL; \
	344	POP (o); \
	345	while (!SCM_UNBNDP (o)) \
	346	{ \
	347	CONS (l, o, l); \
	348	POP (o); \
	349	} \
	350	PUSH (l); \
	351	} while (0)
	352
2bd859c8 AW	353	#define POP_CONS_MARK() \
	354	do { \
	355	SCM o, l; \
	356	POP (l); \
	357	POP (o); \
	358	while (!SCM_UNBNDP (o)) \
	359	{ \
	360	CONS (l, o, l); \
	361	POP (o); \
	362	} \
	363	PUSH (l); \
	364	} while (0)
	365
a98cef7e KN	366	\f
a98cef7e KN	367	/*
17e90c5e	368	* Instruction operation
a98cef7e KN	369	*/
a98cef7e KN	370
17e90c5e	371	#define FETCH() (*ip++)
53e28ed9	372	#define FETCH_LENGTH(len) do { len=ip++; len<<=8; len+=ip++; len<<=8; len+=*ip++; } while (0)
17e90c5e	373
17e90c5e KN	374	#undef NEXT_JUMP
17e90c5e KN	375	#ifdef HAVE_LABELS_AS_VALUES
53e28ed9	376	#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
17e90c5e KN	377	#else
	378	#define NEXT_JUMP() goto vm_start
	379	#endif
	380
	381	#define NEXT \
	382	{ \
17e90c5e	383	NEXT_HOOK (); \
11ea1aba	384	CHECK_STACK_LEAK (); \
17e90c5e	385	NEXT_JUMP (); \
a98cef7e KN	386	}
	387
	388	\f
ac99cb0c	389	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	390	/* When this is called, bp points to the new program data,
2cdb8cdc AW	391	and the arguments are already on the stack */
03e6c165 AW	392	#define DROP_FRAME() \
	393	{ \
	394	sp -= 3; \
	395	NULLSTACK (3); \
	396	CHECK_UNDERFLOW (); \
	397	}
	398
	399
17e90c5e KN	400	/*
	401	Local Variables:
	402	c-file-style: "gnu"
	403	End:
	404	*/