[bpt/guile.git] / src / 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

\f
/*
 * Cache/Sync
 */

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

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

/* 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;							\
									\
  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 { CHECK_UNDERFLOW (); sp--; } while (0)
#define DROPN(_n)	do { CHECK_UNDERFLOW (); sp -= (_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;				\
  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)

\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 */

#define NEW_FRAME()				\
{						\
  int i;					\
  SCM ra = SCM_PACK (ip);			\
  SCM dl = SCM_PACK (fp);			\
  SCM *p = sp + 1;				\
  SCM *q = p + bp->nlocs;			\
						\
  /* New pointers */				\
  ip = bp->base;				\
  fp = p - bp->nargs;				\
  sp = q + 3;					\
  CHECK_OVERFLOW ();				\
						\
  /* Init local variables */			\
  for (; p < q; p++)				\
    *p = SCM_UNDEFINED;				\
						\
  /* Create external variables */		\
  external = bp->external;			\
  for (i = 0; i < bp->nexts; i++)		\
    CONS (external, SCM_UNDEFINED, external);	\
						\
  /* Set frame data */				\
  p[3] = ra;					\
  p[2] = dl;					\
  p[1] = SCM_BOOL_F;				\
  p[0] = external;				\
}

#define FREE_FRAME()				\
{						\
  SCM *last_sp = sp;				\
  SCM *last_fp = fp;				\
  SCM *p = fp + bp->nargs + bp->nlocs;		\
						\
  /* Restore pointers */			\
  ip = SCM_FRAME_BYTE_CAST (p[3]);		\
  fp = SCM_FRAME_STACK_CAST (p[2]);		\
						\
  if (!SCM_FALSEP (p[1]))			\
    {						\
      /* Unlink the heap stack */		\
      vp->this_frame = p[1];			\
    }						\
  else						\
    {						\
      /* Move stack items */			\
      p += 4;					\
      sp = SCM_FRAME_LOWER_ADDRESS (last_fp);	\
      while (p <= last_sp)			\
	*sp++ = *p++;				\
      sp--;					\
    }						\
}

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

\f
/*
 * Function support
 */

#define ARGS1(a1)	SCM a1 = sp[0];
#define ARGS2(a1,a2)	SCM a1 = sp[-1], a2 = sp[0]; sp--;
#define ARGS3(a1,a2,a3)	SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;

#define RETURN(x)	do { *sp = x; NEXT; } while (0)

/*
  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
	114
	115	\f
a98cef7e	116	/*
3d5ee0cd	117	* Cache/Sync
a98cef7e KN	118	*/
a98cef7e KN	119
3d5ee0cd	120	#define CACHE_REGISTER() \
17e90c5e	121	{ \
3d5ee0cd KN	122	ip = vp->ip; \
	123	sp = vp->sp; \
	124	fp = vp->fp; \
17e90c5e	125	}
a98cef7e	126
3d5ee0cd	127	#define SYNC_REGISTER() \
a98cef7e	128	{ \
3d5ee0cd KN	129	vp->ip = ip; \
	130	vp->sp = sp; \
	131	vp->fp = fp; \
a98cef7e KN	132	}
a98cef7e KN	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	{ \
	141	ssize_t _vincr; \
	142	\
	143	bp = SCM_PROGRAM_DATA (program); \
	144	/* Was: objects = SCM_VELTS (bp->objs); */ \
	145	\
	146	if (objects) \
	147	scm_array_handle_release (&objects_handle); \
	148	\
	149	objects = scm_vector_writable_elements (bp->objs, &objects_handle, \
	150	&object_count, &_vincr); \
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) \
	171	do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
	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) \
	179	do { if ((_num) >= object_count) goto vm_error_object; } while (0)
	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	{ \
ac02b386	193	if (!SCM_FALSEP (vp->hooks[h])) \
3d5ee0cd	194	{ \
af988bbf KN	195	SYNC_REGISTER (); \
af988bbf KN	196	vm_heapify_frames (vm); \
ac02b386	197	scm_c_run_hook (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
17e90c5e	219	#define CHECK_OVERFLOW() \
3616e9e9	220	if (sp > stack_limit) \
17e90c5e KN	221	goto vm_error_stack_overflow
	222
	223	#define CHECK_UNDERFLOW() \
3616e9e9	224	if (sp < stack_base) \
17e90c5e	225	goto vm_error_stack_underflow
a98cef7e	226
3616e9e9 KN	227	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
3616e9e9 KN	228	#define DROP() do { CHECK_UNDERFLOW (); sp--; } while (0)
f41cb00c	229	#define DROPN(_n) do { CHECK_UNDERFLOW (); sp -= (_n); } while (0)
17e90c5e KN	230	#define POP(x) do { x = *sp; DROP (); } while (0)
17e90c5e KN	231
2d80426a LC	232	/* A fast CONS. This has to be fast since its used, for instance, by
	233	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	234	inlined function in Guile 1.7. Unfortunately, it calls
	235	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	236	heap. XXX */
	237	#define CONS(x,y,z) \
	238	{ \
	239	SYNC_BEFORE_GC (); \
	240	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	241	}
a98cef7e KN	242
f41cb00c LC	243	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	244	them. */
17e90c5e	245	#define POP_LIST(n) \
f41cb00c LC	246	do \
f41cb00c LC	247	{ \
17e90c5e KN	248	int i; \
17e90c5e KN	249	SCM l = SCM_EOL; \
3616e9e9 KN	250	sp -= n; \
3616e9e9 KN	251	for (i = n; i; i--) \
17e90c5e	252	CONS (l, sp[i], l); \
3616e9e9	253	PUSH (l); \
17e90c5e KN	254	} while (0)
17e90c5e KN	255
135b32ee LC	256	\f
	257	/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
	258	allocate cells on the stack. This is a significant improvement for
	259	programs which call a lot of procedures, since the procedure call
	260	mechanism uses POP_LIST which normally uses `scm_cons'.
	261
	262	What it does is that it creates a list whose cells are allocated on the
	263	VM's stack instead of being allocated on the heap via `scm_cell'. This is
	264	much faster. However, if the callee does something like:
	265
	266	(lambda (. args)
	267	(set! the-args args))
	268
	269	then terrible things may happen since the list of arguments may be
	270	overwritten later on. */
	271
	272
	273	/* Awful hack that aligns PTR so that it can be considered as a non-immediate
	274	value by Guile. */
	275	#define ALIGN_AS_NON_IMMEDIATE(_ptr) \
	276	{ \
	277	if ((scm_t_bits)(_ptr) & 6) \
	278	{ \
	279	size_t _incr; \
	280	\
	281	_incr = (scm_t_bits)(_ptr) & 6; \
	282	_incr = (~_incr) & 7; \
	283	(_ptr) += _incr; \
	284	} \
	285	}
	286
	287	#define POP_LIST_ON_STACK(n) \
	288	do \
	289	{ \
	290	int i; \
	291	if (n == 0) \
	292	{ \
	293	sp -= n; \
	294	PUSH (SCM_EOL); \
	295	} \
	296	else \
	297	{ \
	298	SCM list_head, list; \
	299	\
	300	list_head = sp + 1; \
	301	ALIGN_AS_NON_IMMEDIATE (list_head); \
	302	list = list_head; \
	303	\
	304	sp -= n; \
	305	for (i = 1; i <= n; i++) \
	306	{ \
	307	/* The cell's car and cdr. */ \
	308	*(list) = sp[i]; \
	309	*(list + 1) = PTR2SCM (list + 2); \
	310	list += 2; \
	311	} \
	312	\
	313	/* The last pair's cdr is '(). */ \
	314	list--; \
	315	*list = SCM_EOL; \
	316	/* Push the SCM object that points */ \
	317	/* to the first cell. */ \
	318	PUSH (PTR2SCM (list_head)); \
	319	} \
320	} \
321	while (0)
322
323	/* end of the experiment */
324
325	\f
cb4cca12 KN	326	#define POP_LIST_MARK() \
	327	do { \
	328	SCM o; \
	329	SCM l = SCM_EOL; \
	330	POP (o); \
	331	while (!SCM_UNBNDP (o)) \
	332	{ \
	333	CONS (l, o, l); \
	334	POP (o); \
	335	} \
	336	PUSH (l); \
	337	} while (0)
	338
a98cef7e KN	339	\f
a98cef7e KN	340	/*
17e90c5e	341	* Instruction operation
a98cef7e KN	342	*/
a98cef7e KN	343
17e90c5e	344	#define FETCH() (*ip++)
17e90c5e KN	345	#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
	346
	347	#undef CLOCK
	348	#if VM_USE_CLOCK
3d5ee0cd	349	#define CLOCK(n) vp->clock += n
a98cef7e	350	#else
17e90c5e	351	#define CLOCK(n)
a98cef7e KN	352	#endif
a98cef7e KN	353
17e90c5e KN	354	#undef NEXT_JUMP
	355	#ifdef HAVE_LABELS_AS_VALUES
	356	#define NEXT_JUMP() goto *jump_table[FETCH ()]
	357	#else
	358	#define NEXT_JUMP() goto vm_start
	359	#endif
	360
	361	#define NEXT \
	362	{ \
	363	CLOCK (1); \
17e90c5e KN	364	NEXT_HOOK (); \
17e90c5e KN	365	NEXT_JUMP (); \
a98cef7e KN	366	}
	367
	368	\f
	369	/*
ac02b386	370	* Stack frame
17e90c5e KN	371	*/
17e90c5e KN	372
17e90c5e KN	373	#define INIT_ARGS() \
	374	{ \
	375	if (bp->nrest) \
	376	{ \
5315b862	377	int n = nargs - (bp->nargs - 1); \
17e90c5e KN	378	if (n < 0) \
	379	goto vm_error_wrong_num_args; \
	380	POP_LIST (n); \
	381	} \
	382	else \
	383	{ \
	384	if (nargs != bp->nargs) \
	385	goto vm_error_wrong_num_args; \
	386	} \
	387	}
	388
ac99cb0c	389	/* See frames.h for the layout of stack frames */
3616e9e9 KN	390
	391	#define NEW_FRAME() \
	392	{ \
24aa2715	393	int i; \
af988bbf KN	394	SCM ra = SCM_PACK (ip); \
af988bbf KN	395	SCM dl = SCM_PACK (fp); \
24aa2715 KN	396	SCM *p = sp + 1; \
	397	SCM *q = p + bp->nlocs; \
	398	\
	399	/* New pointers */ \
3616e9e9	400	ip = bp->base; \
24aa2715	401	fp = p - bp->nargs; \
af988bbf	402	sp = q + 3; \
3616e9e9	403	CHECK_OVERFLOW (); \
24aa2715 KN	404	\
	405	/* Init local variables */ \
	406	for (; p < q; p++) \
	407	*p = SCM_UNDEFINED; \
	408	\
	409	/* Create external variables */ \
	410	external = bp->external; \
	411	for (i = 0; i < bp->nexts; i++) \
	412	CONS (external, SCM_UNDEFINED, external); \
ac02b386 KN	413	\
ac02b386 KN	414	/* Set frame data */ \
af988bbf KN	415	p[3] = ra; \
	416	p[2] = dl; \
	417	p[1] = SCM_BOOL_F; \
24aa2715	418	p[0] = external; \
3616e9e9 KN	419	}
	420
	421	#define FREE_FRAME() \
	422	{ \
46f215f8 KN	423	SCM *last_sp = sp; \
46f215f8 KN	424	SCM *last_fp = fp; \
f21dfea6	425	SCM *p = fp + bp->nargs + bp->nlocs; \
46f215f8 KN	426	\
	427	/* Restore pointers */ \
	428	ip = SCM_FRAME_BYTE_CAST (p[3]); \
	429	fp = SCM_FRAME_STACK_CAST (p[2]); \
	430	\
af988bbf	431	if (!SCM_FALSEP (p[1])) \
46f215f8 KN	432	{ \
	433	/* Unlink the heap stack */ \
	434	vp->this_frame = p[1]; \
	435	} \
af988bbf	436	else \
46f215f8 KN	437	{ \
	438	/* Move stack items */ \
	439	p += 4; \
	440	sp = SCM_FRAME_LOWER_ADDRESS (last_fp); \
	441	while (p <= last_sp) \
	442	sp++ = p++; \
	443	sp--; \
	444	} \
3616e9e9 KN	445	}
3616e9e9 KN	446
af988bbf KN	447	#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
af988bbf KN	448
ac02b386 KN	449	\f
	450	/*
	451	* Function support
	452	*/
	453
	454	#define ARGS1(a1) SCM a1 = sp[0];
	455	#define ARGS2(a1,a2) SCM a1 = sp[-1], a2 = sp[0]; sp--;
	456	#define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
	457
	458	#define RETURN(x) do { *sp = x; NEXT; } while (0)
	459
17e90c5e KN	460	/*
	461	Local Variables:
	462	c-file-style: "gnu"
	463	End:
	464	*/