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

/* Copyright (C) 2001 Free Software Foundation, Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program 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 General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */

/* This file is included in vm_engine.c */

/*
 * Options
 */

#define VM_USE_HOOKS		1	/* Various hooks */
#define VM_USE_CLOCK		1	/* Bogoclock */
#define VM_CHECK_EXTERNAL	1	/* Check external link */
#define VM_CHECK_OBJECT         1       /* Check object table */

\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__
#define IP_REG asm("%esi")
#define SP_REG asm("%edi")
#define FP_REG
#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
 */

#define ENABLE_ASSERTIONS

#ifdef 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 IP_PARANOIA
#define CHECK_IP() \
  do { if (ip < bp->base || ip - bp->base > bp->size) abort (); } while (0)
#else
#define CHECK_IP()
#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()							\
{									\
  ssize_t _vincr;							\
									\
  if (bp != SCM_PROGRAM_DATA (program)) {                               \
    bp = SCM_PROGRAM_DATA (program);					\
    /* Was: objects = SCM_VELTS (bp->objs); */				\
									\
    if (objects)                                                        \
      scm_array_handle_release (&objects_handle);                       \
									\
    objects = scm_vector_writable_elements (bp->objs, &objects_handle,	\
                                            &object_count, &_vincr);	\
  }                                                                     \
}

#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_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 ((_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_FALSEP (vp->hooks[h]))		\
    {						\
      SYNC_REGISTER ();				\
      vm_heapify_frames (vm);			\
      scm_c_run_hook (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
 */

#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 (); } while (0)
#define DROPN(_n)	do { sp -= (_n); CHECK_UNDERFLOW (); } 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;				\
  sp -= n;					\
  for (i = n; i; i--)				\
    CONS (l, sp[i], l);				\
  PUSH (l);					\
} while (0)

\f
/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
   allocate cells on the stack.  This is a significant improvement for
   programs which call a lot of procedures, since the procedure call
   mechanism uses POP_LIST which normally uses `scm_cons'.

   What it does is that it creates a list whose cells are allocated on the
   VM's stack instead of being allocated on the heap via `scm_cell'.  This is
   much faster.  However, if the callee does something like:

     (lambda (. args)
       (set! the-args args))

   then terrible things may happen since the list of arguments may be
   overwritten later on.  */


/* Awful hack that aligns PTR so that it can be considered as a non-immediate
   value by Guile.  */
#define ALIGN_AS_NON_IMMEDIATE(_ptr)		\
{						\
  if ((scm_t_bits)(_ptr) & 6)			\
    {						\
      size_t _incr;				\
						\
      _incr = (scm_t_bits)(_ptr) & 6;		\
      _incr = (~_incr) & 7;			\
      (_ptr) += _incr;				\
    }						\
}

#define POP_LIST_ON_STACK(n)			\
do						\
{						\
  int i;					\
  if (n == 0)					\
    {						\
      sp -= n;					\
      PUSH (SCM_EOL);				\
    }						\
  else						\
    {						\
      SCM *list_head, *list;			\
						\
      list_head = sp + 1;			\
      ALIGN_AS_NON_IMMEDIATE (list_head);	\
      list = list_head;				\
						\
      sp -= n;					\
      for (i = 1; i <= n; i++)			\
	{					\
	  /* The cell's car and cdr.  */	\
	  *(list) = sp[i];			\
	  *(list + 1) = PTR2SCM (list + 2);	\
	  list += 2;				\
	}					\
						\
      /* The last pair's cdr is '().  */	\
      list--;					\
      *list = SCM_EOL;				\
      /* Push the SCM object that points */	\
      /* to the first cell.  */			\
      PUSH (PTR2SCM (list_head));		\
    }						\
}						\
while (0)

/* end of the experiment */

\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 { ip = vm_fetch_length (ip, &len); } 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 ()]
#else
#define NEXT_JUMP()		goto vm_start
#endif

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

\f
/*
 * Stack frame
 */

#define INIT_ARGS()				\
{						\
  if (bp->nrest)				\
    {						\
      int n = nargs - (bp->nargs - 1);		\
      if (n < 0)				\
	goto vm_error_wrong_num_args;		\
      POP_LIST (n);				\
    }						\
  else						\
    {						\
      if (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 + 4;                                \
  CHECK_OVERFLOW ();				\
  stack_base = sp;				\
  ip = bp->base;				\
						\
  /* Init local variables */			\
  for (i=bp->nlocs; i; i--)                     \
    data[-i] = SCM_UNDEFINED;                   \
						\
  /* Create external variables */		\
  external = bp->external;			\
  for (i = 0; i < bp->nexts; i++)		\
    CONS (external, SCM_UNDEFINED, external);	\
						\
  /* Set frame data */				\
  data[4] = (SCM)ra;                            \
  data[3] = 0x0;                                \
  data[2] = (SCM)dl;                            \
  data[1] = SCM_BOOL_F;				\
  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 KN	2	*
	3	* This program is free software; you can redistribute it and/or modify
	4	* it under the terms of the GNU General Public License as published by
	5	* the Free Software Foundation; either version 2, or (at your option)
	6	* any later version.
	7	*
	8	* This program 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
	11	* GNU General Public License for more details.
	12	*
	13	* You should have received a copy of the GNU General Public License
	14	* along with this software; see the file COPYING. If not, write to
	15	* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
	16	* Boston, MA 02111-1307 USA
	17	*
	18	* As a special exception, the Free Software Foundation gives permission
	19	* for additional uses of the text contained in its release of GUILE.
	20	*
	21	* The exception is that, if you link the GUILE library with other files
	22	* to produce an executable, this does not by itself cause the
	23	* resulting executable to be covered by the GNU General Public License.
	24	* Your use of that executable is in no way restricted on account of
	25	* linking the GUILE library code into it.
	26	*
	27	* This exception does not however invalidate any other reasons why
	28	* the executable file might be covered by the GNU General Public License.
	29	*
	30	* This exception applies only to the code released by the
	31	* Free Software Foundation under the name GUILE. If you copy
	32	* code from other Free Software Foundation releases into a copy of
	33	* GUILE, as the General Public License permits, the exception does
	34	* not apply to the code that you add in this way. To avoid misleading
	35	* anyone as to the status of such modified files, you must delete
	36	* this exception notice from them.
	37	*
	38	* If you write modifications of your own for GUILE, it is your choice
	39	* whether to permit this exception to apply to your modifications.
	40	* If you do not wish that, delete this exception notice. */
	41
	42	/* This file is included in vm_engine.c */
	43
	44	/*
3d5ee0cd	45	* Options
a98cef7e KN	46	*/
a98cef7e KN	47
ac02b386 KN	48	#define VM_USE_HOOKS 1 /* Various hooks */
	49	#define VM_USE_CLOCK 1 /* Bogoclock */
	50	#define VM_CHECK_EXTERNAL 1 /* Check external link */
0b5f0e49	51	#define VM_CHECK_OBJECT 1 /* Check object table */
a98cef7e KN	52
	53	\f
	54	/*
17e90c5e	55	* Registers
a98cef7e KN	56	*/
a98cef7e KN	57
17e90c5e	58	/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
9df03fd0	59
17e90c5e KN	60	Some compilers underestimate the use of the local variables representing
	61	the abstract machine registers, and don't put them in hardware registers,
	62	which slows down the interpreter considerably.
	63	For GCC, I have hand-assigned hardware registers for several architectures.
	64	*/
9df03fd0	65
17e90c5e KN	66	#ifdef __GNUC__
	67	#ifdef __mips__
	68	#define IP_REG asm("$16")
	69	#define SP_REG asm("$17")
	70	#define FP_REG asm("$18")
	71	#endif
	72	#ifdef __sparc__
	73	#define IP_REG asm("%l0")
	74	#define SP_REG asm("%l1")
	75	#define FP_REG asm("%l2")
	76	#endif
	77	#ifdef __alpha__
	78	#ifdef __CRAY__
	79	#define IP_REG asm("r9")
	80	#define SP_REG asm("r10")
	81	#define FP_REG asm("r11")
9df03fd0	82	#else
17e90c5e KN	83	#define IP_REG asm("$9")
	84	#define SP_REG asm("$10")
	85	#define FP_REG asm("$11")
	86	#endif
	87	#endif
	88	#ifdef __i386__
	89	#define IP_REG asm("%esi")
	90	#define SP_REG asm("%edi")
	91	#define FP_REG
	92	#endif
	93	#if defined(PPC) \|\| defined(_POWER) \|\| defined(_IBMR2)
	94	#define IP_REG asm("26")
	95	#define SP_REG asm("27")
	96	#define FP_REG asm("28")
	97	#endif
	98	#ifdef __hppa__
	99	#define IP_REG asm("%r18")
	100	#define SP_REG asm("%r17")
	101	#define FP_REG asm("%r16")
	102	#endif
	103	#ifdef __mc68000__
	104	#define IP_REG asm("a5")
	105	#define SP_REG asm("a4")
	106	#define FP_REG
	107	#endif
	108	#ifdef __arm__
	109	#define IP_REG asm("r9")
	110	#define SP_REG asm("r8")
	111	#define FP_REG asm("r7")
	112	#endif
9df03fd0 KN	113	#endif
9df03fd0 KN	114
17d1b4bf AW	115	#ifndef IP_REG
	116	#define IP_REG
	117	#endif
	118	#ifndef SP_REG
	119	#define SP_REG
	120	#endif
	121	#ifndef FP_REG
	122	#define FP_REG
	123	#endif
	124
9df03fd0	125	\f
a98cef7e	126	/*
3d5ee0cd	127	* Cache/Sync
a98cef7e KN	128	*/
a98cef7e KN	129
9a8cc8e7 AW	130	#define ENABLE_ASSERTIONS
	131
	132	#ifdef ENABLE_ASSERTIONS
	133	# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
	134	#else
	135	# define ASSERT(condition)
	136	#endif
	137
	138
3d5ee0cd	139	#define CACHE_REGISTER() \
17e90c5e	140	{ \
3d5ee0cd KN	141	ip = vp->ip; \
	142	sp = vp->sp; \
	143	fp = vp->fp; \
f13c269b	144	stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
17e90c5e	145	}
a98cef7e	146
3d5ee0cd	147	#define SYNC_REGISTER() \
a98cef7e	148	{ \
3d5ee0cd KN	149	vp->ip = ip; \
	150	vp->sp = sp; \
	151	vp->fp = fp; \
a98cef7e KN	152	}
a98cef7e KN	153
7e4760e4 AW	154	#ifdef IP_PARANOIA
	155	#define CHECK_IP() \
	156	do { if (ip < bp->base \|\| ip - bp->base > bp->size) abort (); } while (0)
	157	#else
	158	#define CHECK_IP()
	159	#endif
	160
238e7a11 LC	161	/* Get a local copy of the program's "object table" (i.e. the vector of
	162	external bindings that are referenced by the program), initialized by
	163	`load-program'. */
a52b2d3d LC	164	/* XXX: We could instead use the "simple vector macros", thus not having to
	165	call `scm_vector_writable_elements ()' and the likes. */
	166	#define CACHE_PROGRAM() \
	167	{ \
	168	ssize_t _vincr; \
	169	\
e677365c AW	170	if (bp != SCM_PROGRAM_DATA (program)) { \
	171	bp = SCM_PROGRAM_DATA (program); \
	172	/* Was: objects = SCM_VELTS (bp->objs); */ \
a52b2d3d	173	\
e677365c AW	174	if (objects) \
e677365c AW	175	scm_array_handle_release (&objects_handle); \
a52b2d3d	176	\
e677365c AW	177	objects = scm_vector_writable_elements (bp->objs, &objects_handle, \
	178	&object_count, &_vincr); \
	179	} \
41f248a8 KN	180	}
41f248a8 KN	181
3d5ee0cd KN	182	#define SYNC_BEFORE_GC() \
	183	{ \
	184	SYNC_REGISTER (); \
17e90c5e	185	}
a98cef7e	186
17e90c5e	187	#define SYNC_ALL() \
a98cef7e	188	{ \
3d5ee0cd	189	SYNC_REGISTER (); \
a98cef7e KN	190	}
a98cef7e KN	191
a98cef7e	192	\f
ac02b386 KN	193	/*
	194	* Error check
	195	*/
	196
	197	#undef CHECK_EXTERNAL
	198	#if VM_CHECK_EXTERNAL
	199	#define CHECK_EXTERNAL(e) \
	200	do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
	201	#else
	202	#define CHECK_EXTERNAL(e)
	203	#endif
	204
0b5f0e49 LC	205	/* Accesses to a program's object table. */
	206	#if VM_CHECK_OBJECT
	207	#define CHECK_OBJECT(_num) \
	208	do { if ((_num) >= object_count) goto vm_error_object; } while (0)
	209	#else
	210	#define CHECK_OBJECT(_num)
	211	#endif
	212
ac02b386	213	\f
3d5ee0cd KN	214	/*
	215	* Hooks
	216	*/
	217
	218	#undef RUN_HOOK
	219	#if VM_USE_HOOKS
	220	#define RUN_HOOK(h) \
	221	{ \
ac02b386	222	if (!SCM_FALSEP (vp->hooks[h])) \
3d5ee0cd	223	{ \
af988bbf KN	224	SYNC_REGISTER (); \
af988bbf KN	225	vm_heapify_frames (vm); \
ac02b386	226	scm_c_run_hook (vp->hooks[h], hook_args); \
af988bbf	227	CACHE_REGISTER (); \
3d5ee0cd KN	228	} \
	229	}
	230	#else
	231	#define RUN_HOOK(h)
	232	#endif
	233
ac02b386 KN	234	#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
	235	#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
	236	#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
7a0d0cee	237	#define BREAK_HOOK() RUN_HOOK (SCM_VM_BREAK_HOOK)
ac02b386 KN	238	#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
	239	#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
	240	#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
	241	#define RETURN_HOOK() RUN_HOOK (SCM_VM_RETURN_HOOK)
3d5ee0cd KN	242
3d5ee0cd KN	243	\f
a98cef7e KN	244	/*
	245	* Stack operation
	246	*/
	247
17e90c5e	248	#define CHECK_OVERFLOW() \
3616e9e9	249	if (sp > stack_limit) \
17e90c5e KN	250	goto vm_error_stack_overflow
17e90c5e KN	251
7e4760e4 AW	252	#define CHECK_UNDERFLOW() \
	253	if (sp < stack_base) \
	254	goto vm_error_stack_underflow;
a98cef7e	255
3616e9e9	256	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
659b4611 AW	257	#define DROP() do { sp--; CHECK_UNDERFLOW (); } while (0)
659b4611 AW	258	#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); } while (0)
17e90c5e KN	259	#define POP(x) do { x = *sp; DROP (); } while (0)
17e90c5e KN	260
2d80426a LC	261	/* A fast CONS. This has to be fast since its used, for instance, by
	262	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	263	inlined function in Guile 1.7. Unfortunately, it calls
	264	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	265	heap. XXX */
	266	#define CONS(x,y,z) \
	267	{ \
	268	SYNC_BEFORE_GC (); \
	269	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	270	}
a98cef7e KN	271
f41cb00c LC	272	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	273	them. */
17e90c5e	274	#define POP_LIST(n) \
f41cb00c LC	275	do \
f41cb00c LC	276	{ \
17e90c5e KN	277	int i; \
17e90c5e KN	278	SCM l = SCM_EOL; \
3616e9e9 KN	279	sp -= n; \
3616e9e9 KN	280	for (i = n; i; i--) \
17e90c5e	281	CONS (l, sp[i], l); \
3616e9e9	282	PUSH (l); \
17e90c5e KN	283	} while (0)
17e90c5e KN	284
135b32ee LC	285	\f
	286	/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
	287	allocate cells on the stack. This is a significant improvement for
	288	programs which call a lot of procedures, since the procedure call
	289	mechanism uses POP_LIST which normally uses `scm_cons'.
	290
	291	What it does is that it creates a list whose cells are allocated on the
	292	VM's stack instead of being allocated on the heap via `scm_cell'. This is
	293	much faster. However, if the callee does something like:
	294
	295	(lambda (. args)
	296	(set! the-args args))
	297
	298	then terrible things may happen since the list of arguments may be
	299	overwritten later on. */
	300
	301
	302	/* Awful hack that aligns PTR so that it can be considered as a non-immediate
	303	value by Guile. */
	304	#define ALIGN_AS_NON_IMMEDIATE(_ptr) \
	305	{ \
	306	if ((scm_t_bits)(_ptr) & 6) \
	307	{ \
	308	size_t _incr; \
	309	\
	310	_incr = (scm_t_bits)(_ptr) & 6; \
	311	_incr = (~_incr) & 7; \
	312	(_ptr) += _incr; \
	313	} \
	314	}
	315
	316	#define POP_LIST_ON_STACK(n) \
	317	do \
	318	{ \
	319	int i; \
	320	if (n == 0) \
	321	{ \
	322	sp -= n; \
	323	PUSH (SCM_EOL); \
	324	} \
	325	else \
	326	{ \
	327	SCM list_head, list; \
	328	\
	329	list_head = sp + 1; \
	330	ALIGN_AS_NON_IMMEDIATE (list_head); \
	331	list = list_head; \
	332	\
	333	sp -= n; \
	334	for (i = 1; i <= n; i++) \
	335	{ \
	336	/* The cell's car and cdr. */ \
	337	*(list) = sp[i]; \
	338	*(list + 1) = PTR2SCM (list + 2); \
	339	list += 2; \
	340	} \
	341	\
	342	/* The last pair's cdr is '(). */ \
	343	list--; \
	344	*list = SCM_EOL; \
	345	/* Push the SCM object that points */ \
	346	/* to the first cell. */ \
	347	PUSH (PTR2SCM (list_head)); \
	348	} \
349	} \
350	while (0)
351
352	/* end of the experiment */
353
354	\f
cb4cca12 KN	355	#define POP_LIST_MARK() \
	356	do { \
	357	SCM o; \
	358	SCM l = SCM_EOL; \
	359	POP (o); \
	360	while (!SCM_UNBNDP (o)) \
	361	{ \
	362	CONS (l, o, l); \
	363	POP (o); \
	364	} \
	365	PUSH (l); \
	366	} while (0)
	367
2bd859c8 AW	368	#define POP_CONS_MARK() \
	369	do { \
	370	SCM o, l; \
	371	POP (l); \
	372	POP (o); \
	373	while (!SCM_UNBNDP (o)) \
	374	{ \
	375	CONS (l, o, l); \
	376	POP (o); \
	377	} \
	378	PUSH (l); \
	379	} while (0)
	380
a98cef7e KN	381	\f
a98cef7e KN	382	/*
17e90c5e	383	* Instruction operation
a98cef7e KN	384	*/
a98cef7e KN	385
17e90c5e	386	#define FETCH() (*ip++)
17e90c5e KN	387	#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
	388
	389	#undef CLOCK
	390	#if VM_USE_CLOCK
3d5ee0cd	391	#define CLOCK(n) vp->clock += n
a98cef7e	392	#else
17e90c5e	393	#define CLOCK(n)
a98cef7e KN	394	#endif
a98cef7e KN	395
17e90c5e KN	396	#undef NEXT_JUMP
	397	#ifdef HAVE_LABELS_AS_VALUES
	398	#define NEXT_JUMP() goto *jump_table[FETCH ()]
	399	#else
	400	#define NEXT_JUMP() goto vm_start
	401	#endif
	402
	403	#define NEXT \
	404	{ \
	405	CLOCK (1); \
17e90c5e KN	406	NEXT_HOOK (); \
17e90c5e KN	407	NEXT_JUMP (); \
a98cef7e KN	408	}
	409
	410	\f
	411	/*
ac02b386	412	* Stack frame
17e90c5e KN	413	*/
17e90c5e KN	414
17e90c5e KN	415	#define INIT_ARGS() \
	416	{ \
	417	if (bp->nrest) \
	418	{ \
5315b862	419	int n = nargs - (bp->nargs - 1); \
17e90c5e KN	420	if (n < 0) \
	421	goto vm_error_wrong_num_args; \
	422	POP_LIST (n); \
	423	} \
	424	else \
	425	{ \
	426	if (nargs != bp->nargs) \
	427	goto vm_error_wrong_num_args; \
	428	} \
	429	}
	430
ac99cb0c	431	/* See frames.h for the layout of stack frames */
2cdb8cdc AW	432	/* When this is called, bp points to the new program data,
2cdb8cdc AW	433	and the arguments are already on the stack */
3616e9e9 KN	434	#define NEW_FRAME() \
3616e9e9 KN	435	{ \
24aa2715	436	int i; \
2cdb8cdc AW	437	SCM dl, data; \
2cdb8cdc AW	438	scm_byte_t *ra = ip; \
24aa2715	439	\
2cdb8cdc AW	440	/* Save old registers */ \
	441	ra = ip; \
	442	dl = fp; \
	443	\
	444	/* New registers */ \
	445	fp = sp - bp->nargs + 1; \
	446	data = SCM_FRAME_DATA_ADDRESS (fp); \
da320011	447	sp = data + 4; \
3616e9e9	448	CHECK_OVERFLOW (); \
2cdb8cdc AW	449	stack_base = sp; \
2cdb8cdc AW	450	ip = bp->base; \
24aa2715 KN	451	\
24aa2715 KN	452	/* Init local variables */ \
2cdb8cdc AW	453	for (i=bp->nlocs; i; i--) \
2cdb8cdc AW	454	data[-i] = SCM_UNDEFINED; \
24aa2715 KN	455	\
	456	/* Create external variables */ \
	457	external = bp->external; \
	458	for (i = 0; i < bp->nexts; i++) \
	459	CONS (external, SCM_UNDEFINED, external); \
ac02b386 KN	460	\
ac02b386 KN	461	/* Set frame data */ \
da320011 AW	462	data[4] = (SCM)ra; \
da320011 AW	463	data[3] = 0x0; \
2cdb8cdc AW	464	data[2] = (SCM)dl; \
	465	data[1] = SCM_BOOL_F; \
	466	data[0] = external; \
3616e9e9 KN	467	}
3616e9e9 KN	468
af988bbf KN	469	#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
af988bbf KN	470
17e90c5e KN	471	/*
	472	Local Variables:
	473	c-file-style: "gnu"
	474	End:
	475	*/