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

/* Copyright (C) 2001 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 2.1 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__
/* gcc on lenny actually crashes if we allocate these variables in registers.
   hopefully this is the only one of these. */
#if !(__GNUC__==4 && __GNUC_MINOR__==1 && __GNUC_PATCHLEVEL__==2)
#define IP_REG asm("%esi")
#define SP_REG asm("%edi")
#define FP_REG
#endif
#endif
#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
#define IP_REG asm("26")
#define SP_REG asm("27")
#define FP_REG asm("28")
#endif
#ifdef __hppa__
#define IP_REG asm("%r18")
#define SP_REG asm("%r17")
#define FP_REG asm("%r16")
#endif
#ifdef __mc68000__
#define IP_REG asm("a5")
#define SP_REG asm("a4")
#define FP_REG
#endif
#ifdef __arm__
#define IP_REG asm("r9")
#define SP_REG asm("r8")
#define FP_REG asm("r7")
#endif
#endif

#ifndef IP_REG
#define IP_REG
#endif
#ifndef SP_REG
#define SP_REG
#endif
#ifndef FP_REG
#define FP_REG
#endif

\f
/*
 * Cache/Sync
 */

#ifdef VM_ENABLE_ASSERTIONS
# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
#else
# define ASSERT(condition)
#endif


#define CACHE_REGISTER()			\
{						\
  ip = vp->ip;					\
  sp = vp->sp;					\
  fp = vp->fp;					\
  stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
}

#define SYNC_REGISTER()				\
{						\
  vp->ip = ip;					\
  vp->sp = sp;					\
  vp->fp = fp;					\
}

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

/* Get a local copy of the program's "object table" (i.e. the vector of
   external bindings that are referenced by the program), initialized by
   `load-program'.  */
/* XXX:  We could instead use the "simple vector macros", thus not having to
   call `scm_vector_writable_elements ()' and the likes.  */
#define CACHE_PROGRAM()							\
{									\
  if (bp != SCM_PROGRAM_DATA (program)) {                               \
    bp = SCM_PROGRAM_DATA (program);					\
    if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) {             \
      objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program));    \
      object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
    } else {                                                            \
      objects = NULL;                                                   \
      object_count = 0;                                                 \
    }                                                                   \
  }                                                                     \
}

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

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

\f
/*
 * Error check
 */

#undef CHECK_EXTERNAL
#if VM_CHECK_EXTERNAL
#define CHECK_EXTERNAL(e) \
  do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0)
#else
#define CHECK_EXTERNAL(e)
#endif

/* Accesses to a program's object table.  */
#if VM_CHECK_OBJECT
#define CHECK_OBJECT(_num) \
  do { if (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
#else
#define CHECK_OBJECT(_num)
#endif

\f
/*
 * Hooks
 */

#undef RUN_HOOK
#if VM_USE_HOOKS
#define RUN_HOOK(h)				\
{						\
  if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
    {						\
      SYNC_REGISTER ();				\
      vm_dispatch_hook (vp, vp->hooks[h], hook_args);      \
      CACHE_REGISTER ();			\
    }						\
}
#else
#define RUN_HOOK(h)
#endif

#define BOOT_HOOK()	RUN_HOOK (SCM_VM_BOOT_HOOK)
#define HALT_HOOK()	RUN_HOOK (SCM_VM_HALT_HOOK)
#define NEXT_HOOK()	RUN_HOOK (SCM_VM_NEXT_HOOK)
#define BREAK_HOOK()	RUN_HOOK (SCM_VM_BREAK_HOOK)
#define ENTER_HOOK()	RUN_HOOK (SCM_VM_ENTER_HOOK)
#define APPLY_HOOK()	RUN_HOOK (SCM_VM_APPLY_HOOK)
#define EXIT_HOOK()	RUN_HOOK (SCM_VM_EXIT_HOOK)
#define RETURN_HOOK()	RUN_HOOK (SCM_VM_RETURN_HOOK)

\f
/*
 * Stack operation
 */

#ifdef VM_ENABLE_STACK_NULLING
# define CHECK_STACK_LEAKN(_n) ASSERT (!sp[_n]);
# define CHECK_STACK_LEAK() CHECK_STACK_LEAKN(1)
# define NULLSTACK(_n) { int __x = _n; CHECK_STACK_LEAKN (_n+1); while (__x > 0) sp[__x--] = NULL; }
/* If you have a nonlocal exit in a pre-wind proc while invoking a continuation
   inside a dynwind (phew!), the stack is fully rewound but vm_reset_stack for
   that continuation doesn't have a chance to run. It's not important on a
   semantic level, but it does mess up our stack nulling -- so this macro is to
   fix that. */
# define NULLSTACK_FOR_NONLOCAL_EXIT() if (vp->sp > sp) NULLSTACK (vp->sp - sp);
#else
# define CHECK_STACK_LEAKN(_n)
# define CHECK_STACK_LEAK()
# define NULLSTACK(_n)
# define NULLSTACK_FOR_NONLOCAL_EXIT()
#endif

#define CHECK_OVERFLOW()			\
  if (sp > stack_limit)				\
    goto vm_error_stack_overflow

#define CHECK_UNDERFLOW()                       \
  if (sp < stack_base)                          \
    goto vm_error_stack_underflow;

#define PUSH(x)	do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP()	do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
#define DROPN(_n)	do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
#define POP(x)	do { x = *sp; DROP (); } while (0)

/* A fast CONS.  This has to be fast since its used, for instance, by
   POP_LIST when fetching a function's argument list.  Note: `scm_cell' is an
   inlined function in Guile 1.7.  Unfortunately, it calls
   `scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
   heap.  XXX  */
#define CONS(x,y,z)					\
{							\
  SYNC_BEFORE_GC ();					\
  x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z));	\
}

/* Pop the N objects on top of the stack and push a list that contains
   them.  */
#define POP_LIST(n)				\
do						\
{						\
  int i;					\
  SCM l = SCM_EOL, x;				\
  for (i = n; i; i--)                           \
    {                                           \
      POP (x);                                  \
      CONS (l, x, l);                           \
    }                                           \
  PUSH (l);					\
} while (0)

/* The opposite: push all of the elements in L onto the list. */
#define PUSH_LIST(l, NILP)			\
do						\
{						\
  for (; scm_is_pair (l); l = SCM_CDR (l))      \
    PUSH (SCM_CAR (l));                         \
  if (SCM_UNLIKELY (!NILP (l))) {               \
    finish_args = scm_list_1 (l);               \
    goto vm_error_improper_list;                \
  }                                             \
} while (0)

\f
#define POP_LIST_MARK()				\
do {						\
  SCM o;					\
  SCM l = SCM_EOL;				\
  POP (o);					\
  while (!SCM_UNBNDP (o))			\
    {						\
      CONS (l, o, l);				\
      POP (o);					\
    }						\
  PUSH (l);					\
} while (0)

#define POP_CONS_MARK()				\
do {						\
  SCM o, l;					\
  POP (l);                                      \
  POP (o);					\
  while (!SCM_UNBNDP (o))			\
    {						\
      CONS (l, o, l);				\
      POP (o);					\
    }						\
  PUSH (l);					\
} while (0)

\f
/*
 * Instruction operation
 */

#define FETCH()		(*ip++)
#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)

#undef CLOCK
#if VM_USE_CLOCK
#define CLOCK(n)	vp->clock += n
#else
#define CLOCK(n)
#endif

#undef NEXT_JUMP
#ifdef HAVE_LABELS_AS_VALUES
#define NEXT_JUMP()		goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
#else
#define NEXT_JUMP()		goto vm_start
#endif

#define NEXT					\
{						\
  CLOCK (1);					\
  NEXT_HOOK ();					\
  CHECK_STACK_LEAK ();                          \
  NEXT_JUMP ();					\
}

\f
/*
 * Stack frame
 */

#define INIT_ARGS()				\
{						\
  if (SCM_UNLIKELY (bp->nrest))                 \
    {						\
      int n = nargs - (bp->nargs - 1);		\
      if (n < 0)				\
	goto vm_error_wrong_num_args;		\
      /* NB, can cause GC while setting up the  \
         stack frame */                         \
      POP_LIST (n);				\
    }						\
  else						\
    {						\
      if (SCM_UNLIKELY (nargs != bp->nargs))    \
	goto vm_error_wrong_num_args;		\
    }						\
}

/* See frames.h for the layout of stack frames */
/* When this is called, bp points to the new program data,
   and the arguments are already on the stack */
#define NEW_FRAME()				\
{						\
  int i;					\
  SCM *dl, *data;                               \
  scm_byte_t *ra = ip;                          \
						\
  /* Save old registers */                      \
  ra = ip;                                      \
  dl = fp;                                      \
						\
  /* New registers */                           \
  fp = sp - bp->nargs + 1;                      \
  data = SCM_FRAME_DATA_ADDRESS (fp);           \
  sp = data + 3;                                \
  CHECK_OVERFLOW ();				\
  stack_base = sp;				\
  ip = bp->base;				\
						\
  /* Init local variables */			\
  for (i=bp->nlocs; i; i--)                     \
    data[-i] = SCM_UNDEFINED;                   \
						\
  /* Set frame data */				\
  data[3] = (SCM)ra;                            \
  data[2] = 0x0;                                \
  data[1] = (SCM)dl;                            \
                                                \
  /* Postpone initializing external vars,       \
     because if the CONS causes a GC, we        \
     want the stack marker to see the data      \
     array formatted as expected. */            \
  data[0] = SCM_UNDEFINED;                      \
  external = SCM_PROGRAM_EXTERNALS (fp[-1]);    \
  for (i = 0; i < bp->nexts; i++)               \
    CONS (external, SCM_UNDEFINED, external);   \
  data[0] = external;                           \
}

#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]

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