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

\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'.  */
#define CACHE_PROGRAM()					\
{							\
  size_t _vsize;					\
  ssize_t _vincr;					\
  scm_t_array_handle _vhandle;				\
							\
  bp = SCM_PROGRAM_DATA (program);			\
  /* Was: objects = SCM_VELTS (bp->objs); */		\
  objects = scm_vector_elements (bp->objs, &_vhandle,	\
				 &_vsize, &_vincr);	\
  scm_array_handle_release (&_vhandle);			\
}

#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

\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 */
a98cef7e KN	51
	52	\f
	53	/*
17e90c5e	54	* Registers
a98cef7e KN	55	*/
a98cef7e KN	56
17e90c5e	57	/* Register optimization. [ stolen from librep/src/lispmach.h,v 1.3 ]
9df03fd0	58
17e90c5e KN	59	Some compilers underestimate the use of the local variables representing
	60	the abstract machine registers, and don't put them in hardware registers,
	61	which slows down the interpreter considerably.
	62	For GCC, I have hand-assigned hardware registers for several architectures.
	63	*/
9df03fd0	64
17e90c5e KN	65	#ifdef __GNUC__
	66	#ifdef __mips__
	67	#define IP_REG asm("$16")
	68	#define SP_REG asm("$17")
	69	#define FP_REG asm("$18")
	70	#endif
	71	#ifdef __sparc__
	72	#define IP_REG asm("%l0")
	73	#define SP_REG asm("%l1")
	74	#define FP_REG asm("%l2")
	75	#endif
	76	#ifdef __alpha__
	77	#ifdef __CRAY__
	78	#define IP_REG asm("r9")
	79	#define SP_REG asm("r10")
	80	#define FP_REG asm("r11")
9df03fd0	81	#else
17e90c5e KN	82	#define IP_REG asm("$9")
	83	#define SP_REG asm("$10")
	84	#define FP_REG asm("$11")
	85	#endif
	86	#endif
	87	#ifdef __i386__
	88	#define IP_REG asm("%esi")
	89	#define SP_REG asm("%edi")
	90	#define FP_REG
	91	#endif
	92	#if defined(PPC) \|\| defined(_POWER) \|\| defined(_IBMR2)
	93	#define IP_REG asm("26")
	94	#define SP_REG asm("27")
	95	#define FP_REG asm("28")
	96	#endif
	97	#ifdef __hppa__
	98	#define IP_REG asm("%r18")
	99	#define SP_REG asm("%r17")
	100	#define FP_REG asm("%r16")
	101	#endif
	102	#ifdef __mc68000__
	103	#define IP_REG asm("a5")
	104	#define SP_REG asm("a4")
	105	#define FP_REG
	106	#endif
	107	#ifdef __arm__
	108	#define IP_REG asm("r9")
	109	#define SP_REG asm("r8")
	110	#define FP_REG asm("r7")
	111	#endif
9df03fd0 KN	112	#endif
	113
	114	\f
a98cef7e	115	/*
3d5ee0cd	116	* Cache/Sync
a98cef7e KN	117	*/
a98cef7e KN	118
3d5ee0cd	119	#define CACHE_REGISTER() \
17e90c5e	120	{ \
3d5ee0cd KN	121	ip = vp->ip; \
	122	sp = vp->sp; \
	123	fp = vp->fp; \
17e90c5e	124	}
a98cef7e	125
3d5ee0cd	126	#define SYNC_REGISTER() \
a98cef7e	127	{ \
3d5ee0cd KN	128	vp->ip = ip; \
	129	vp->sp = sp; \
	130	vp->fp = fp; \
a98cef7e KN	131	}
a98cef7e KN	132
238e7a11 LC	133	/* Get a local copy of the program's "object table" (i.e. the vector of
	134	external bindings that are referenced by the program), initialized by
	135	`load-program'. */
	136	#define CACHE_PROGRAM() \
	137	{ \
	138	size_t _vsize; \
	139	ssize_t _vincr; \
	140	scm_t_array_handle _vhandle; \
	141	\
	142	bp = SCM_PROGRAM_DATA (program); \
	143	/* Was: objects = SCM_VELTS (bp->objs); */ \
	144	objects = scm_vector_elements (bp->objs, &_vhandle, \
	145	&_vsize, &_vincr); \
	146	scm_array_handle_release (&_vhandle); \
41f248a8 KN	147	}
41f248a8 KN	148
3d5ee0cd KN	149	#define SYNC_BEFORE_GC() \
	150	{ \
	151	SYNC_REGISTER (); \
17e90c5e	152	}
a98cef7e	153
17e90c5e	154	#define SYNC_ALL() \
a98cef7e	155	{ \
3d5ee0cd	156	SYNC_REGISTER (); \
a98cef7e KN	157	}
a98cef7e KN	158
a98cef7e	159	\f
ac02b386 KN	160	/*
	161	* Error check
	162	*/
	163
	164	#undef CHECK_EXTERNAL
	165	#if VM_CHECK_EXTERNAL
	166	#define CHECK_EXTERNAL(e) \
	167	do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
	168	#else
	169	#define CHECK_EXTERNAL(e)
	170	#endif
	171
	172	\f
3d5ee0cd KN	173	/*
	174	* Hooks
	175	*/
	176
	177	#undef RUN_HOOK
	178	#if VM_USE_HOOKS
	179	#define RUN_HOOK(h) \
	180	{ \
ac02b386	181	if (!SCM_FALSEP (vp->hooks[h])) \
3d5ee0cd	182	{ \
af988bbf KN	183	SYNC_REGISTER (); \
af988bbf KN	184	vm_heapify_frames (vm); \
ac02b386	185	scm_c_run_hook (vp->hooks[h], hook_args); \
af988bbf	186	CACHE_REGISTER (); \
3d5ee0cd KN	187	} \
	188	}
	189	#else
	190	#define RUN_HOOK(h)
	191	#endif
	192
ac02b386 KN	193	#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
	194	#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
	195	#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
7a0d0cee	196	#define BREAK_HOOK() RUN_HOOK (SCM_VM_BREAK_HOOK)
ac02b386 KN	197	#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
	198	#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
	199	#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
	200	#define RETURN_HOOK() RUN_HOOK (SCM_VM_RETURN_HOOK)
3d5ee0cd KN	201
3d5ee0cd KN	202	\f
a98cef7e KN	203	/*
	204	* Stack operation
	205	*/
	206
17e90c5e	207	#define CHECK_OVERFLOW() \
3616e9e9	208	if (sp > stack_limit) \
17e90c5e KN	209	goto vm_error_stack_overflow
	210
	211	#define CHECK_UNDERFLOW() \
3616e9e9	212	if (sp < stack_base) \
17e90c5e	213	goto vm_error_stack_underflow
a98cef7e	214
3616e9e9 KN	215	#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
3616e9e9 KN	216	#define DROP() do { CHECK_UNDERFLOW (); sp--; } while (0)
f41cb00c	217	#define DROPN(_n) do { CHECK_UNDERFLOW (); sp -= (_n); } while (0)
17e90c5e KN	218	#define POP(x) do { x = *sp; DROP (); } while (0)
17e90c5e KN	219
2d80426a LC	220	/* A fast CONS. This has to be fast since its used, for instance, by
	221	POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
	222	inlined function in Guile 1.7. Unfortunately, it calls
	223	`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
	224	heap. XXX */
	225	#define CONS(x,y,z) \
	226	{ \
	227	SYNC_BEFORE_GC (); \
	228	x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
a98cef7e KN	229	}
a98cef7e KN	230
f41cb00c LC	231	/* Pop the N objects on top of the stack and push a list that contains
f41cb00c LC	232	them. */
17e90c5e	233	#define POP_LIST(n) \
f41cb00c LC	234	do \
f41cb00c LC	235	{ \
17e90c5e KN	236	int i; \
17e90c5e KN	237	SCM l = SCM_EOL; \
3616e9e9 KN	238	sp -= n; \
3616e9e9 KN	239	for (i = n; i; i--) \
17e90c5e	240	CONS (l, sp[i], l); \
3616e9e9	241	PUSH (l); \
17e90c5e KN	242	} while (0)
17e90c5e KN	243
135b32ee LC	244	\f
	245	/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
	246	allocate cells on the stack. This is a significant improvement for
	247	programs which call a lot of procedures, since the procedure call
	248	mechanism uses POP_LIST which normally uses `scm_cons'.
	249
	250	What it does is that it creates a list whose cells are allocated on the
	251	VM's stack instead of being allocated on the heap via `scm_cell'. This is
	252	much faster. However, if the callee does something like:
	253
	254	(lambda (. args)
	255	(set! the-args args))
	256
	257	then terrible things may happen since the list of arguments may be
	258	overwritten later on. */
	259
	260
	261	/* Awful hack that aligns PTR so that it can be considered as a non-immediate
	262	value by Guile. */
	263	#define ALIGN_AS_NON_IMMEDIATE(_ptr) \
	264	{ \
	265	if ((scm_t_bits)(_ptr) & 6) \
	266	{ \
	267	size_t _incr; \
	268	\
	269	_incr = (scm_t_bits)(_ptr) & 6; \
	270	_incr = (~_incr) & 7; \
	271	(_ptr) += _incr; \
	272	} \
	273	}
	274
	275	#define POP_LIST_ON_STACK(n) \
	276	do \
	277	{ \
	278	int i; \
	279	if (n == 0) \
	280	{ \
	281	sp -= n; \
	282	PUSH (SCM_EOL); \
	283	} \
	284	else \
	285	{ \
	286	SCM list_head, list; \
	287	\
	288	list_head = sp + 1; \
	289	ALIGN_AS_NON_IMMEDIATE (list_head); \
	290	list = list_head; \
	291	\
	292	sp -= n; \
	293	for (i = 1; i <= n; i++) \
	294	{ \
	295	/* The cell's car and cdr. */ \
	296	*(list) = sp[i]; \
	297	*(list + 1) = PTR2SCM (list + 2); \
	298	list += 2; \
	299	} \
	300	\
	301	/* The last pair's cdr is '(). */ \
	302	list--; \
	303	*list = SCM_EOL; \
	304	/* Push the SCM object that points */ \
	305	/* to the first cell. */ \
	306	PUSH (PTR2SCM (list_head)); \
	307	} \
308	} \
309	while (0)
310
311	/* end of the experiment */
312
313	\f
cb4cca12 KN	314	#define POP_LIST_MARK() \
	315	do { \
	316	SCM o; \
	317	SCM l = SCM_EOL; \
	318	POP (o); \
	319	while (!SCM_UNBNDP (o)) \
	320	{ \
	321	CONS (l, o, l); \
	322	POP (o); \
	323	} \
	324	PUSH (l); \
	325	} while (0)
	326
a98cef7e KN	327	\f
a98cef7e KN	328	/*
17e90c5e	329	* Instruction operation
a98cef7e KN	330	*/
a98cef7e KN	331
17e90c5e	332	#define FETCH() (*ip++)
17e90c5e KN	333	#define FETCH_LENGTH(len) do { ip = vm_fetch_length (ip, &len); } while (0)
	334
	335	#undef CLOCK
	336	#if VM_USE_CLOCK
3d5ee0cd	337	#define CLOCK(n) vp->clock += n
a98cef7e	338	#else
17e90c5e	339	#define CLOCK(n)
a98cef7e KN	340	#endif
a98cef7e KN	341
17e90c5e KN	342	#undef NEXT_JUMP
	343	#ifdef HAVE_LABELS_AS_VALUES
	344	#define NEXT_JUMP() goto *jump_table[FETCH ()]
	345	#else
	346	#define NEXT_JUMP() goto vm_start
	347	#endif
	348
	349	#define NEXT \
	350	{ \
	351	CLOCK (1); \
17e90c5e KN	352	NEXT_HOOK (); \
17e90c5e KN	353	NEXT_JUMP (); \
a98cef7e KN	354	}
	355
	356	\f
	357	/*
ac02b386	358	* Stack frame
17e90c5e KN	359	*/
17e90c5e KN	360
17e90c5e KN	361	#define INIT_ARGS() \
	362	{ \
	363	if (bp->nrest) \
	364	{ \
5315b862	365	int n = nargs - (bp->nargs - 1); \
17e90c5e KN	366	if (n < 0) \
	367	goto vm_error_wrong_num_args; \
	368	POP_LIST (n); \
	369	} \
	370	else \
	371	{ \
	372	if (nargs != bp->nargs) \
	373	goto vm_error_wrong_num_args; \
	374	} \
	375	}
	376
ac99cb0c	377	/* See frames.h for the layout of stack frames */
3616e9e9 KN	378
	379	#define NEW_FRAME() \
	380	{ \
24aa2715	381	int i; \
af988bbf KN	382	SCM ra = SCM_PACK (ip); \
af988bbf KN	383	SCM dl = SCM_PACK (fp); \
24aa2715 KN	384	SCM *p = sp + 1; \
	385	SCM *q = p + bp->nlocs; \
	386	\
	387	/* New pointers */ \
3616e9e9	388	ip = bp->base; \
24aa2715	389	fp = p - bp->nargs; \
af988bbf	390	sp = q + 3; \
3616e9e9	391	CHECK_OVERFLOW (); \
24aa2715 KN	392	\
	393	/* Init local variables */ \
	394	for (; p < q; p++) \
	395	*p = SCM_UNDEFINED; \
	396	\
	397	/* Create external variables */ \
	398	external = bp->external; \
	399	for (i = 0; i < bp->nexts; i++) \
	400	CONS (external, SCM_UNDEFINED, external); \
ac02b386 KN	401	\
ac02b386 KN	402	/* Set frame data */ \
af988bbf KN	403	p[3] = ra; \
	404	p[2] = dl; \
	405	p[1] = SCM_BOOL_F; \
24aa2715	406	p[0] = external; \
3616e9e9 KN	407	}
	408
	409	#define FREE_FRAME() \
	410	{ \
46f215f8 KN	411	SCM *last_sp = sp; \
46f215f8 KN	412	SCM *last_fp = fp; \
f21dfea6	413	SCM *p = fp + bp->nargs + bp->nlocs; \
46f215f8 KN	414	\
	415	/* Restore pointers */ \
	416	ip = SCM_FRAME_BYTE_CAST (p[3]); \
	417	fp = SCM_FRAME_STACK_CAST (p[2]); \
	418	\
af988bbf	419	if (!SCM_FALSEP (p[1])) \
46f215f8 KN	420	{ \
	421	/* Unlink the heap stack */ \
	422	vp->this_frame = p[1]; \
	423	} \
af988bbf	424	else \
46f215f8 KN	425	{ \
	426	/* Move stack items */ \
	427	p += 4; \
	428	sp = SCM_FRAME_LOWER_ADDRESS (last_fp); \
	429	while (p <= last_sp) \
	430	sp++ = p++; \
	431	sp--; \
	432	} \
3616e9e9 KN	433	}
3616e9e9 KN	434
af988bbf KN	435	#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
af988bbf KN	436
ac02b386 KN	437	\f
	438	/*
	439	* Function support
	440	*/
	441
	442	#define ARGS1(a1) SCM a1 = sp[0];
	443	#define ARGS2(a1,a2) SCM a1 = sp[-1], a2 = sp[0]; sp--;
	444	#define ARGS3(a1,a2,a3) SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
	445
	446	#define RETURN(x) do { *sp = x; NEXT; } while (0)
	447
17e90c5e KN	448	/*
	449	Local Variables:
	450	c-file-style: "gnu"
	451	End:
	452	*/