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

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


#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;					\
}

/* 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_BOUND(x) \
  do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
  } while (0)
#else
#define CHECK_IP()
#define ASSERT_BOUND(x)
#endif

/* Cache the object table and free variables.  */
#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;                                                 \
    }                                                                   \
  }                                                                     \
  {                                                                     \
    SCM c = SCM_PROGRAM_FREE_VARS (program);                            \
    if (SCM_I_IS_VECTOR (c))                                            \
      {                                                                 \
        closure = SCM_I_VECTOR_WELTS (c);                               \
        closure_count = SCM_I_VECTOR_LENGTH (c);                        \
      }                                                                 \
    else                                                                \
      {                                                                 \
        closure = NULL;                                                 \
        closure_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_CLOSURE
#define CHECK_CLOSURE(_num) \
  do { if (SCM_UNLIKELY ((_num) >= closure_count)) goto vm_error_closure; } while (0)
#else
#define CHECK_CLOSURE(_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 + 2;                                \
  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[2] = (SCM)ra;                            \
  data[1] = 0x0;                                \
  data[0] = (SCM)dl;                            \
}

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/
Commit	Line	Data
e6eb2467	1	/* Copyright (C) 2001, 2009 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
3d5ee0cd	105	#define CACHE_REGISTER() \
17e90c5e	106	{ \
3d5ee0cd KN	107	ip = vp->ip; \
	108	sp = vp->sp; \
	109	fp = vp->fp; \
f13c269b	110	stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
17e90c5e	111	}
a98cef7e	112
3d5ee0cd	113	#define SYNC_REGISTER() \
a98cef7e	114	{ \
3d5ee0cd KN	115	vp->ip = ip; \
	116	vp->sp = sp; \
	117	vp->fp = fp; \
a98cef7e KN	118	}
a98cef7e KN	119
8d90b356 AW	120	/* FIXME */
	121	#define ASSERT_VARIABLE(x) \
	122	do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
	123	} while (0)
	124	#define ASSERT_BOUND_VARIABLE(x) \
	125	do { ASSERT_VARIABLE (x); \
	126	if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED) \
	127	{ SYNC_REGISTER (); abort(); } \
	128	} while (0)
	129
11ea1aba	130	#ifdef VM_ENABLE_PARANOID_ASSERTIONS
7e4760e4	131	#define CHECK_IP() \
53e28ed9	132	do { if (ip < bp->base \|\| ip - bp->base > bp->len) abort (); } while (0)
a1a482e0 AW	133	#define ASSERT_BOUND(x) \
	134	do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
	135	} while (0)
7e4760e4 AW	136	#else
7e4760e4 AW	137	#define CHECK_IP()
a1a482e0	138	#define ASSERT_BOUND(x)
7e4760e4 AW	139	#endif
7e4760e4 AW	140
20d47c39	141	/* Cache the object table and free variables. */
a52b2d3d LC	142	#define CACHE_PROGRAM() \
a52b2d3d LC	143	{ \
e677365c AW	144	if (bp != SCM_PROGRAM_DATA (program)) { \
e677365c AW	145	bp = SCM_PROGRAM_DATA (program); \
53e28ed9 AW	146	if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
	147	objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
	148	object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
2fda0242 AW	149	} else { \
	150	objects = NULL; \
	151	object_count = 0; \
	152	} \
e677365c	153	} \
8d90b356	154	{ \
20d47c39	155	SCM c = SCM_PROGRAM_FREE_VARS (program); \
8d90b356 AW	156	if (SCM_I_IS_VECTOR (c)) \
	157	{ \
	158	closure = SCM_I_VECTOR_WELTS (c); \
	159	closure_count = SCM_I_VECTOR_LENGTH (c); \
	160	} \
	161	else \
	162	{ \
	163	closure = NULL; \
	164	closure_count = 0; \
	165	} \
	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
8d90b356 AW	192	#if VM_CHECK_CLOSURE
	193	#define CHECK_CLOSURE(_num) \
	194	do { if (SCM_UNLIKELY ((_num) >= closure_count)) goto vm_error_closure; } while (0)
	195	#else
	196	#define CHECK_CLOSURE(_num)
	197	#endif
	198
ac02b386	199	\f
3d5ee0cd KN	200	/*
	201	* Hooks
	202	*/
	203
	204	#undef RUN_HOOK
	205	#if VM_USE_HOOKS
	206	#define RUN_HOOK(h) \
	207	{ \
b1b942b7	208	if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
3d5ee0cd	209	{ \
af988bbf	210	SYNC_REGISTER (); \
6d14383e	211	vm_dispatch_hook (vp, vp->hooks[h], hook_args); \
af988bbf	212	CACHE_REGISTER (); \
3d5ee0cd KN	213	} \
	214	}
	215	#else
	216	#define RUN_HOOK(h)
	217	#endif
	218
ac02b386 KN	219	#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
	220	#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
	221	#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
7a0d0cee	222	#define BREAK_HOOK() RUN_HOOK (SCM_VM_BREAK_HOOK)
ac02b386 KN	223	#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
	224	#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
	225	#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
	226	#define RETURN_HOOK() RUN_HOOK (SCM_VM_RETURN_HOOK)
3d5ee0cd KN	227
3d5ee0cd KN	228	\f
a98cef7e KN	229	/*
	230	* Stack operation
	231	*/
	232
11ea1aba AW	233	#ifdef VM_ENABLE_STACK_NULLING
	234	# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
	235	# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
	236	# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
66db076a AW	237	/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
	238	inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
	239	that continuation doesn't have a chance to run. It's not important on a
	240	semantic level, but it does mess up our stack nulling -- so this macro is to
	241	fix that. */
	242	# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
11ea1aba AW	243	#else
	244	# define CHECK_STACK_LEAKN(_n)
	245	# define CHECK_STACK_LEAK()
	246	# define NULLSTACK(_n)
66db076a	247	# define NULLSTACK_FOR_NONLOCAL_EXIT()
11ea1aba AW	248	#endif
11ea1aba AW	249
17e90c5e	250	#define CHECK_OVERFLOW() \
3616e9e9	251	if (sp > stack_limit) \
17e90c5e KN	252	goto vm_error_stack_overflow
17e90c5e KN	253
7e4760e4 AW	254	#define CHECK_UNDERFLOW() \
	255	if (sp < stack_base) \
	256	goto vm_error_stack_underflow;
a98cef7e	257
3616e9e9	258	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
11ea1aba AW	259	#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
11ea1aba AW	260	#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
17e90c5e KN	261	#define POP(x) do { x = *sp; DROP (); } while (0)
17e90c5e KN	262
2d80426a LC	263	/* A fast CONS. This has to be fast since its used, for instance, by
	264	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	265	inlined function in Guile 1.7. Unfortunately, it calls
	266	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	267	heap. XXX */
	268	#define CONS(x,y,z) \
	269	{ \
	270	SYNC_BEFORE_GC (); \
	271	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	272	}
a98cef7e KN	273
f41cb00c LC	274	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	275	them. */
17e90c5e	276	#define POP_LIST(n) \
f41cb00c LC	277	do \
f41cb00c LC	278	{ \
17e90c5e	279	int i; \
11ea1aba AW	280	SCM l = SCM_EOL, x; \
	281	for (i = n; i; i--) \
	282	{ \
	283	POP (x); \
	284	CONS (l, x, l); \
	285	} \
3616e9e9	286	PUSH (l); \
17e90c5e KN	287	} while (0)
17e90c5e KN	288
1f40459f	289	/* The opposite: push all of the elements in L onto the list. */
fb10a008	290	#define PUSH_LIST(l, NILP) \
1f40459f AW	291	do \
	292	{ \
	293	for (; scm_is_pair (l); l = SCM_CDR (l)) \
	294	PUSH (SCM_CAR (l)); \
fb10a008	295	if (SCM_UNLIKELY (!NILP (l))) { \
e06e857c	296	finish_args = scm_list_1 (l); \
1f40459f AW	297	goto vm_error_improper_list; \
	298	} \
	299	} while (0)
	300
135b32ee	301	\f
cb4cca12 KN	302	#define POP_LIST_MARK() \
	303	do { \
	304	SCM o; \
	305	SCM l = SCM_EOL; \
	306	POP (o); \
	307	while (!SCM_UNBNDP (o)) \
	308	{ \
	309	CONS (l, o, l); \
	310	POP (o); \
	311	} \
	312	PUSH (l); \
	313	} while (0)
	314
2bd859c8 AW	315	#define POP_CONS_MARK() \
	316	do { \
	317	SCM o, l; \
	318	POP (l); \
	319	POP (o); \
	320	while (!SCM_UNBNDP (o)) \
	321	{ \
	322	CONS (l, o, l); \
	323	POP (o); \
	324	} \
	325	PUSH (l); \
	326	} while (0)
	327
a98cef7e KN	328	\f
a98cef7e KN	329	/*
17e90c5e	330	* Instruction operation
a98cef7e KN	331	*/
a98cef7e KN	332
17e90c5e	333	#define FETCH() (*ip++)
53e28ed9	334	#define FETCH_LENGTH(len) do { len=ip++; len<<=8; len+=ip++; len<<=8; len+=*ip++; } while (0)
17e90c5e KN	335
	336	#undef CLOCK
	337	#if VM_USE_CLOCK
3d5ee0cd	338	#define CLOCK(n) vp->clock += n
a98cef7e	339	#else
17e90c5e	340	#define CLOCK(n)
a98cef7e KN	341	#endif
a98cef7e KN	342
17e90c5e KN	343	#undef NEXT_JUMP
17e90c5e KN	344	#ifdef HAVE_LABELS_AS_VALUES
53e28ed9	345	#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
17e90c5e KN	346	#else
	347	#define NEXT_JUMP() goto vm_start
	348	#endif
	349
	350	#define NEXT \
	351	{ \
	352	CLOCK (1); \
17e90c5e	353	NEXT_HOOK (); \
11ea1aba	354	CHECK_STACK_LEAK (); \
17e90c5e	355	NEXT_JUMP (); \
a98cef7e KN	356	}
	357
	358	\f
	359	/*
ac02b386	360	* Stack frame
17e90c5e KN	361	*/
17e90c5e KN	362
17e90c5e KN	363	#define INIT_ARGS() \
17e90c5e KN	364	{ \
7edf2001	365	if (SCM_UNLIKELY (bp->nrest)) \
17e90c5e	366	{ \
5315b862	367	int n = nargs - (bp->nargs - 1); \
17e90c5e KN	368	if (n < 0) \
17e90c5e KN	369	goto vm_error_wrong_num_args; \
11ea1aba AW	370	/* NB, can cause GC while setting up the \
11ea1aba AW	371	stack frame */ \
17e90c5e KN	372	POP_LIST (n); \
	373	} \
	374	else \
	375	{ \
7edf2001	376	if (SCM_UNLIKELY (nargs != bp->nargs)) \
17e90c5e KN	377	goto vm_error_wrong_num_args; \
	378	} \
	379	}
	380
ac99cb0c	381	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	382	/* When this is called, bp points to the new program data,
2cdb8cdc AW	383	and the arguments are already on the stack */
3616e9e9 KN	384	#define NEW_FRAME() \
3616e9e9 KN	385	{ \
24aa2715	386	int i; \
2cdb8cdc AW	387	SCM dl, data; \
2cdb8cdc AW	388	scm_byte_t *ra = ip; \
24aa2715	389	\
2cdb8cdc AW	390	/* Save old registers */ \
	391	ra = ip; \
	392	dl = fp; \
	393	\
	394	/* New registers */ \
	395	fp = sp - bp->nargs + 1; \
	396	data = SCM_FRAME_DATA_ADDRESS (fp); \
20d47c39	397	sp = data + 2; \
3616e9e9	398	CHECK_OVERFLOW (); \
2cdb8cdc AW	399	stack_base = sp; \
2cdb8cdc AW	400	ip = bp->base; \
24aa2715 KN	401	\
24aa2715 KN	402	/* Init local variables */ \
2cdb8cdc AW	403	for (i=bp->nlocs; i; i--) \
2cdb8cdc AW	404	data[-i] = SCM_UNDEFINED; \
24aa2715	405	\
ac02b386	406	/* Set frame data */ \
20d47c39 AW	407	data[2] = (SCM)ra; \
	408	data[1] = 0x0; \
	409	data[0] = (SCM)dl; \
3616e9e9 KN	410	}
3616e9e9 KN	411
17e90c5e KN	412	/*
	413	Local Variables:
	414	c-file-style: "gnu"
	415	End:
	416	*/