[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_ALIGNED_PROCEDURE() \
  do { if ((scm_t_bits)bp % 8) abort (); } while (0)
#define ASSERT_BOUND(x) \
  do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \
  } while (0)
#else
#define CHECK_IP()
#define ASSERT_ALIGNED_PROCEDURE()
#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);					\
    ASSERT_ALIGNED_PROCEDURE ();                                        \
    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_VARIABLES (program);                       \
    if (SCM_I_IS_VECTOR (c))                                            \
      {                                                                 \
        free_vars = SCM_I_VECTOR_WELTS (c);                             \
        free_vars_count = SCM_I_VECTOR_LENGTH (c);                      \
      }                                                                 \
    else                                                                \
      {                                                                 \
        free_vars = NULL;                                               \
        free_vars_count = 0;                                            \
      }                                                                 \
  }                                                                     \
}

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

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

\f
/*
 * Error check
 */

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

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