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