[bpt/guile.git] / src / vm_engine.h

/* Copyright (C) 2000 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 */

/*
 * VM Options
 */

#undef VM_USE_BOOT_HOOK
#undef VM_USE_HALT_HOOK
#undef VM_USE_NEXT_HOOK
#undef VM_USE_CALL_HOOK
#undef VM_USE_APPLY_HOOK
#undef VM_USE_RETURN_HOOK
#undef VM_INIT_LOCAL_VARIABLES
#undef VM_CHECK_LINK
#undef VM_CHECK_BINDING
#undef VM_CHECK_PROGRAM_COUNTER

#if VM_ENGINE == SCM_VM_REGULAR_ENGINE
#define VM_USE_BOOT_HOOK		0
#define	VM_USE_HALT_HOOK		0
#define	VM_USE_NEXT_HOOK		0
#define	VM_USE_CALL_HOOK		0
#define	VM_USE_APPLY_HOOK		0
#define	VM_USE_RETURN_HOOK		0
#define VM_INIT_LOCAL_VARIABLES		0
#define VM_CHECK_LINK			0
#define VM_CHECK_BINDING		1
#define VM_CHECK_PROGRAM_COUNTER	0
#else
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
#define VM_USE_BOOT_HOOK		1
#define	VM_USE_HALT_HOOK		1
#define	VM_USE_NEXT_HOOK		1
#define	VM_USE_CALL_HOOK		1
#define	VM_USE_APPLY_HOOK		1
#define	VM_USE_RETURN_HOOK		1
#define VM_INIT_LOCAL_VARIABLES		1
#define VM_CHECK_LINK			1
#define VM_CHECK_BINDING		1
#define	VM_CHECK_PROGRAM_COUNTER	1
#endif
#endif

#undef VM_USE_HOOK
#if VM_USE_BOOT_HOOK || VM_USE_HALT_HOOK || VM_USE_NEXT_HOOK \
    || VM_USE_CALL_HOOK || VM_USE_APPLY_HOOK || VM_USE_RETURN_HOOK
#define VM_USE_HOOK 1
#else
#define VM_USE_HOOK 0
#endif

\f
/*
 * Type checking
 */

#define VM_ASSERT_PROGRAM(OBJ)	SCM_VALIDATE_PROGRAM (1, OBJ)

#undef VM_ASSERT_BOUND
#if VM_CHECK_BINDING
#define VM_ASSERT_BOUND(CELL)					\
  if (SCM_UNBNDP (SCM_CDR (CELL)))				\
    SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL)))
#else
#define VM_ASSERT_BOUND(CELL)
#endif

#undef VM_ASSERT_LINK
#if VM_CHECK_LINK
#define VM_ASSERT_LINK(OBJ)				\
  if (SCM_FALSEP (OBJ))					\
    SCM_MISC_ERROR ("VM broken link", SCM_EOL)
#else
#define VM_ASSERT_LINK(OBJ)
#endif

\f
/*
 * Hooks
 */

#undef VM_BOOT_HOOK
#if VM_USE_BOOT_HOOK
#define VM_BOOT_HOOK()	SYNC (); scm_c_run_hook (vmp->boot_hook, hook_args)
#else
#define VM_BOOT_HOOK()
#endif

#undef VM_HALT_HOOK
#if VM_USE_HALT_HOOK
#define VM_HALT_HOOK()	SYNC (); scm_c_run_hook (vmp->halt_hook, hook_args)
#else
#define VM_HALT_HOOK()
#endif

#undef VM_NEXT_HOOK
#if VM_USE_NEXT_HOOK
#define VM_NEXT_HOOK()	SYNC (); scm_c_run_hook (vmp->next_hook, hook_args)
#else
#define VM_NEXT_HOOK()
#endif

#undef VM_CALL_HOOK
#if VM_USE_CALL_HOOK
#define VM_CALL_HOOK()	SYNC (); scm_c_run_hook (vmp->call_hook, hook_args)
#else
#define VM_CALL_HOOK()
#endif

#undef VM_APPLY_HOOK
#if VM_USE_APPLY_HOOK
#define VM_APPLY_HOOK()	SYNC (); scm_c_run_hook (vmp->apply_hook, hook_args)
#else
#define VM_APPLY_HOOK()
#endif

#undef VM_RETURN_HOOK
#if VM_USE_RETURN_HOOK
#define VM_RETURN_HOOK() SYNC (); scm_c_run_hook (vmp->return_hook, hook_args)
#else
#define VM_RETURN_HOOK()
#endif

\f
/*
 * Basic operations
 */

#define LOAD()					\
{						\
  ac = vmp->ac;					\
  pc = vmp->pc;					\
  sp = vmp->sp;					\
  fp = vmp->fp;					\
  stack_base  = vmp->stack_base;		\
  stack_limit = vmp->stack_limit;		\
}

#define SYNC()					\
{						\
  vmp->ac = ac;					\
  vmp->pc = pc;					\
  vmp->sp = sp;					\
  vmp->fp = fp;					\
}

#define FETCH()		*pc++

#define CONS(X,Y,Z)				\
{						\
  SCM cell;					\
  SYNC ();					\
  SCM_NEWCELL (cell);				\
  SCM_SET_CELL_OBJECT_0 (cell, Y);		\
  SCM_SET_CELL_OBJECT_1 (cell, Z);		\
  X = cell;					\
}

#define VM_SETUP_ARGS2() an = 2; a2 = ac; POP (ac);
#define VM_SETUP_ARGS3() an = 3; a3 = ac; POP (a2); POP (ac);
#define VM_SETUP_ARGS4() an = 4; a4 = ac; POP (a3); POP (a2); POP (ac);
#define VM_SETUP_ARGSN() an = SCM_INUM (FETCH ());

\f
/*
 * Stack operation
 */

#define PUSH(X)					\
{						\
  if (sp < stack_base)				\
    SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL);	\
  *sp-- = (X);					\
}

#define POP(X)					\
{						\
  if (sp == stack_limit)			\
    SCM_MISC_ERROR ("FIXME: Stack underflow", SCM_EOL);	\
  (X) = *++sp;					\
}

#define POP_LIST(N,L)				\
{						\
  while (N-- > 0)				\
    {						\
      SCM obj;					\
      POP (obj);				\
      CONS (L, obj, L);				\
    }						\
}

\f
/*
 * Frame allocation
 */

/* an = the number of arguments */
#define VM_FRAME_INIT_ARGS(PROG,NREQS,RESTP)			\
{								\
  if (RESTP)							\
    /* have a rest argument */					\
    {								\
      SCM list;							\
      if (an < NREQS)						\
	scm_wrong_num_args (PROG);				\
								\
      /* Construct the rest argument list */			\
      an -= NREQS;	/* the number of rest arguments */	\
      list = SCM_EOL;	/* list of the rest arguments */	\
      POP_LIST (an, list);					\
      PUSH (list);						\
    }								\
  else								\
    /* not have a rest argument */				\
    {								\
      if (an != NREQS)						\
	scm_wrong_num_args (PROG);				\
    }								\
}

#undef VM_FRAME_INIT_LOCAL_VARIABLES
#if VM_INIT_LOCAL_VARIABLES
/* This is necessary when creating frame objects for debugging */
#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)		\
{							\
  int i;						\
  for (i = 0; i < NVARS; i++)				\
    SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED;	\
}
#else
#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)
#endif

#define VM_FRAME_INIT_EXTERNAL_VARIABLES(FP,PROG)	\
{							\
  int *exts = SCM_PROGRAM_EXTS (PROG);			\
  if (exts)						\
    {							\
      /* Export variables */				\
      int n = exts[0];					\
      while (n-- > 0)					\
	SCM_VM_EXTERNAL_VARIABLE (ext, n)		\
	  = SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]);	\
    }							\
}

#define VM_NEW_FRAME(FP,PROG,DL,SP,RA)					  \
{									  \
  int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */	  \
  int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
  int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
  int nexts = SCM_PROGRAM_NEXTS (PROG);	/* the number of external vars */ \
									  \
  VM_FRAME_INIT_ARGS (PROG, nreqs, restp);				  \
									  \
  /* Allocate the new frame */						  \
  if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1)		  \
    SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL);			  \
  sp -= nvars + SCM_VM_FRAME_DATA_SIZE;					  \
  FP = sp + SCM_VM_FRAME_DATA_SIZE + 1;					  \
									  \
  /* Setup the new external frame */					  \
  if (!SCM_FALSEP (SCM_PROGRAM_ENV (PROG)))				  \
    ext = SCM_PROGRAM_ENV (PROG);	/* Use program's environment */	  \
  if (nexts)								  \
    {									  \
      SCM new = SCM_VM_MAKE_EXTERNAL (nexts); /* new external */	  \
      SCM_VM_EXTERNAL_LINK (new) = ext;					  \
      ext = new;							  \
    }									  \
									  \
  /* Setup the new frame */						  \
  SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars);				  \
  SCM_VM_FRAME_PROGRAM (FP) = PROG;					  \
  SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL;					  \
  SCM_VM_FRAME_EXTERNAL_LINK (FP) = ext;				  \
  SCM_VM_FRAME_STACK_POINTER (FP) = SP;					  \
  SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA;				  \
  VM_FRAME_INIT_LOCAL_VARIABLES (FP, nvars);				  \
  VM_FRAME_INIT_EXTERNAL_VARIABLES (FP, PROG);				  \
}

\f
/*
 * Goto next
 */

#undef VM_PROGRAM_COUNTER_CHECK
#if VM_CHECK_PROGRAM_COUNTER
#define VM_PROGRAM_COUNTER_CHECK()					\
{									\
  SCM prog = SCM_VM_FRAME_PROGRAM (fp);					\
  if (pc < SCM_PROGRAM_BASE (prog)					\
      || pc >= (SCM_PROGRAM_BASE (prog) + SCM_PROGRAM_SIZE (prog)))	\
    SCM_MISC_ERROR ("VM accessed invalid program address", SCM_EOL);	\
} 
#else
#define VM_PROGRAM_COUNTER_CHECK()
#endif

#undef VM_GOTO_NEXT
#if HAVE_LABELS_AS_VALUES
#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
#define VM_GOTO_NEXT()		goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ())
#else /* not SCM_VM_DEBUG_ENGINE */
#define VM_GOTO_NEXT()		goto *SCM_CODE_TO_ADDR (FETCH ())
#endif
#else /* not HAVE_LABELS_AS_VALUES */
#define VM_GOTO_NEXT()		goto vm_start
#endif

#define NEXT					\
{						\
  VM_PROGRAM_COUNTER_CHECK ();			\
  VM_NEXT_HOOK ();				\
  VM_GOTO_NEXT ();				\
}

/* Just an abbreviation */
#define RETURN(X)	{ ac = (X); NEXT; }
Commit	Line	Data
a98cef7e KN	1	/* Copyright (C) 2000 Free Software Foundation, Inc.
	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	/*
	45	* VM Options
	46	*/
	47
	48	#undef VM_USE_BOOT_HOOK
	49	#undef VM_USE_HALT_HOOK
	50	#undef VM_USE_NEXT_HOOK
	51	#undef VM_USE_CALL_HOOK
	52	#undef VM_USE_APPLY_HOOK
	53	#undef VM_USE_RETURN_HOOK
	54	#undef VM_INIT_LOCAL_VARIABLES
	55	#undef VM_CHECK_LINK
	56	#undef VM_CHECK_BINDING
	57	#undef VM_CHECK_PROGRAM_COUNTER
	58
	59	#if VM_ENGINE == SCM_VM_REGULAR_ENGINE
	60	#define VM_USE_BOOT_HOOK 0
	61	#define VM_USE_HALT_HOOK 0
	62	#define VM_USE_NEXT_HOOK 0
	63	#define VM_USE_CALL_HOOK 0
	64	#define VM_USE_APPLY_HOOK 0
65	#define VM_USE_RETURN_HOOK 0
66	#define VM_INIT_LOCAL_VARIABLES 0
67	#define VM_CHECK_LINK 0
68	#define VM_CHECK_BINDING 1
69	#define VM_CHECK_PROGRAM_COUNTER 0
70	#else
71	#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
72	#define VM_USE_BOOT_HOOK 1
73	#define VM_USE_HALT_HOOK 1
74	#define VM_USE_NEXT_HOOK 1
75	#define VM_USE_CALL_HOOK 1
76	#define VM_USE_APPLY_HOOK 1
77	#define VM_USE_RETURN_HOOK 1
78	#define VM_INIT_LOCAL_VARIABLES 1
79	#define VM_CHECK_LINK 1
80	#define VM_CHECK_BINDING 1
81	#define VM_CHECK_PROGRAM_COUNTER 1
82	#endif
83	#endif
84
85	#undef VM_USE_HOOK
86	#if VM_USE_BOOT_HOOK \|\| VM_USE_HALT_HOOK \|\| VM_USE_NEXT_HOOK \
87	\|\| VM_USE_CALL_HOOK \|\| VM_USE_APPLY_HOOK \|\| VM_USE_RETURN_HOOK
88	#define VM_USE_HOOK 1
89	#else
90	#define VM_USE_HOOK 0
91	#endif
92
93	\f
94	/*
95	* Type checking
96	*/
97
98	#define VM_ASSERT_PROGRAM(OBJ) SCM_VALIDATE_PROGRAM (1, OBJ)
99
100	#undef VM_ASSERT_BOUND
101	#if VM_CHECK_BINDING
102	#define VM_ASSERT_BOUND(CELL) \
103	if (SCM_UNBNDP (SCM_CDR (CELL))) \
104	SCM_MISC_ERROR ("Unbound variable: ~S", SCM_LIST1 (SCM_CAR (CELL)))
105	#else
106	#define VM_ASSERT_BOUND(CELL)
107	#endif
108
109	#undef VM_ASSERT_LINK
110	#if VM_CHECK_LINK
111	#define VM_ASSERT_LINK(OBJ) \
112	if (SCM_FALSEP (OBJ)) \
113	SCM_MISC_ERROR ("VM broken link", SCM_EOL)
114	#else
115	#define VM_ASSERT_LINK(OBJ)
116	#endif
117
118	\f
119	/*
120	* Hooks
121	*/
122
123	#undef VM_BOOT_HOOK
124	#if VM_USE_BOOT_HOOK
125	#define VM_BOOT_HOOK() SYNC (); scm_c_run_hook (vmp->boot_hook, hook_args)
126	#else
127	#define VM_BOOT_HOOK()
128	#endif
129
130	#undef VM_HALT_HOOK
131	#if VM_USE_HALT_HOOK
132	#define VM_HALT_HOOK() SYNC (); scm_c_run_hook (vmp->halt_hook, hook_args)
133	#else
134	#define VM_HALT_HOOK()
135	#endif
136
137	#undef VM_NEXT_HOOK
138	#if VM_USE_NEXT_HOOK
139	#define VM_NEXT_HOOK() SYNC (); scm_c_run_hook (vmp->next_hook, hook_args)
140	#else
141	#define VM_NEXT_HOOK()
142	#endif
143
144	#undef VM_CALL_HOOK
145	#if VM_USE_CALL_HOOK
146	#define VM_CALL_HOOK() SYNC (); scm_c_run_hook (vmp->call_hook, hook_args)
147	#else
148	#define VM_CALL_HOOK()
149	#endif
150
151	#undef VM_APPLY_HOOK
152	#if VM_USE_APPLY_HOOK
153	#define VM_APPLY_HOOK() SYNC (); scm_c_run_hook (vmp->apply_hook, hook_args)
154	#else
155	#define VM_APPLY_HOOK()
156	#endif
157
158	#undef VM_RETURN_HOOK
159	#if VM_USE_RETURN_HOOK
160	#define VM_RETURN_HOOK() SYNC (); scm_c_run_hook (vmp->return_hook, hook_args)
161	#else
162	#define VM_RETURN_HOOK()
163	#endif
164
165	\f
166	/*
167	* Basic operations
168	*/
169
170	#define LOAD() \
171	{ \
172	ac = vmp->ac; \
173	pc = vmp->pc; \
174	sp = vmp->sp; \
175	fp = vmp->fp; \
176	stack_base = vmp->stack_base; \
177	stack_limit = vmp->stack_limit; \
178	}
179
180	#define SYNC() \
181	{ \
182	vmp->ac = ac; \
183	vmp->pc = pc; \
184	vmp->sp = sp; \
185	vmp->fp = fp; \
186	}
187
188	#define FETCH() *pc++
189
190	#define CONS(X,Y,Z) \
191	{ \
192	SCM cell; \
193	SYNC (); \
194	SCM_NEWCELL (cell); \
195	SCM_SET_CELL_OBJECT_0 (cell, Y); \
196	SCM_SET_CELL_OBJECT_1 (cell, Z); \
197	X = cell; \
198	}
199
200	#define VM_SETUP_ARGS2() an = 2; a2 = ac; POP (ac);
201	#define VM_SETUP_ARGS3() an = 3; a3 = ac; POP (a2); POP (ac);
202	#define VM_SETUP_ARGS4() an = 4; a4 = ac; POP (a3); POP (a2); POP (ac);
203	#define VM_SETUP_ARGSN() an = SCM_INUM (FETCH ());
204
205	\f
206	/*
207	* Stack operation
208	*/
209
210	#define PUSH(X) \
211	{ \
212	if (sp < stack_base) \
213	SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \
214	*sp-- = (X); \
215	}
216
217	#define POP(X) \
218	{ \
219	if (sp == stack_limit) \
220	SCM_MISC_ERROR ("FIXME: Stack underflow", SCM_EOL); \
221	(X) = *++sp; \
222	}
223
224	#define POP_LIST(N,L) \
225	{ \
226	while (N-- > 0) \
227	{ \
228	SCM obj; \
229	POP (obj); \
230	CONS (L, obj, L); \
231	} \
232	}
233
234	\f
235	/*
236	* Frame allocation
237	*/
238
239	/* an = the number of arguments */
d608d68d	240	#define VM_FRAME_INIT_ARGS(PROG,NREQS,RESTP) \
a98cef7e KN	241	{ \
	242	if (RESTP) \
	243	/* have a rest argument */ \
	244	{ \
	245	SCM list; \
	246	if (an < NREQS) \
	247	scm_wrong_num_args (PROG); \
	248	\
	249	/* Construct the rest argument list */ \
	250	an -= NREQS; /* the number of rest arguments */ \
	251	list = SCM_EOL; /* list of the rest arguments */ \
	252	POP_LIST (an, list); \
	253	PUSH (list); \
	254	} \
	255	else \
	256	/* not have a rest argument */ \
	257	{ \
	258	if (an != NREQS) \
	259	scm_wrong_num_args (PROG); \
	260	} \
	261	}
	262
d608d68d	263	#undef VM_FRAME_INIT_LOCAL_VARIABLES
a98cef7e KN	264	#if VM_INIT_LOCAL_VARIABLES
a98cef7e KN	265	/* This is necessary when creating frame objects for debugging */
d608d68d	266	#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS) \
a98cef7e KN	267	{ \
	268	int i; \
	269	for (i = 0; i < NVARS; i++) \
	270	SCM_VM_FRAME_VARIABLE (FP, i) = SCM_UNDEFINED; \
	271	}
	272	#else
d608d68d	273	#define VM_FRAME_INIT_LOCAL_VARIABLES(FP,NVARS)
a98cef7e KN	274	#endif
a98cef7e KN	275
d608d68d KN	276	#define VM_FRAME_INIT_EXTERNAL_VARIABLES(FP,PROG) \
	277	{ \
	278	int *exts = SCM_PROGRAM_EXTS (PROG); \
	279	if (exts) \
	280	{ \
	281	/* Export variables */ \
	282	int n = exts[0]; \
	283	while (n-- > 0) \
	284	SCM_VM_EXTERNAL_VARIABLE (ext, n) \
	285	= SCM_VM_FRAME_VARIABLE (FP, exts[n + 1]); \
	286	} \
	287	}
	288
a98cef7e KN	289	#define VM_NEW_FRAME(FP,PROG,DL,SP,RA) \
	290	{ \
	291	int nvars = SCM_PROGRAM_NVARS (PROG); /* the number of local vars */ \
	292	int nreqs = SCM_PROGRAM_NREQS (PROG); /* the number of required args */ \
	293	int restp = SCM_PROGRAM_RESTP (PROG); /* have a rest argument or not */ \
d608d68d	294	int nexts = SCM_PROGRAM_NEXTS (PROG); /* the number of external vars */ \
a98cef7e	295	\
d608d68d KN	296	VM_FRAME_INIT_ARGS (PROG, nreqs, restp); \
	297	\
	298	/* Allocate the new frame */ \
a98cef7e KN	299	if (sp - nvars - SCM_VM_FRAME_DATA_SIZE < stack_base - 1) \
	300	SCM_MISC_ERROR ("FIXME: Stack overflow", SCM_EOL); \
	301	sp -= nvars + SCM_VM_FRAME_DATA_SIZE; \
	302	FP = sp + SCM_VM_FRAME_DATA_SIZE + 1; \
d608d68d KN	303	\
	304	/* Setup the new external frame */ \
	305	if (!SCM_FALSEP (SCM_PROGRAM_ENV (PROG))) \
	306	ext = SCM_PROGRAM_ENV (PROG); /* Use program's environment */ \
	307	if (nexts) \
	308	{ \
	309	SCM new = SCM_VM_MAKE_EXTERNAL (nexts); /* new external */ \
	310	SCM_VM_EXTERNAL_LINK (new) = ext; \
	311	ext = new; \
	312	} \
	313	\
	314	/* Setup the new frame */ \
a98cef7e KN	315	SCM_VM_FRAME_SIZE (FP) = SCM_MAKINUM (nvars); \
	316	SCM_VM_FRAME_PROGRAM (FP) = PROG; \
	317	SCM_VM_FRAME_DYNAMIC_LINK (FP) = DL; \
d608d68d	318	SCM_VM_FRAME_EXTERNAL_LINK (FP) = ext; \
a98cef7e KN	319	SCM_VM_FRAME_STACK_POINTER (FP) = SP; \
a98cef7e KN	320	SCM_VM_FRAME_RETURN_ADDRESS (FP) = RA; \
d608d68d KN	321	VM_FRAME_INIT_LOCAL_VARIABLES (FP, nvars); \
d608d68d KN	322	VM_FRAME_INIT_EXTERNAL_VARIABLES (FP, PROG); \
a98cef7e KN	323	}
	324
	325	\f
	326	/*
	327	* Goto next
	328	*/
	329
	330	#undef VM_PROGRAM_COUNTER_CHECK
	331	#if VM_CHECK_PROGRAM_COUNTER
	332	#define VM_PROGRAM_COUNTER_CHECK() \
	333	{ \
	334	SCM prog = SCM_VM_FRAME_PROGRAM (fp); \
	335	if (pc < SCM_PROGRAM_BASE (prog) \
	336	\|\| pc >= (SCM_PROGRAM_BASE (prog) + SCM_PROGRAM_SIZE (prog))) \
	337	SCM_MISC_ERROR ("VM accessed invalid program address", SCM_EOL); \
	338	}
	339	#else
	340	#define VM_PROGRAM_COUNTER_CHECK()
	341	#endif
	342
	343	#undef VM_GOTO_NEXT
	344	#if HAVE_LABELS_AS_VALUES
	345	#if VM_ENGINE == SCM_VM_DEBUG_ENGINE
	346	#define VM_GOTO_NEXT() goto *SCM_CODE_TO_DEBUG_ADDR (FETCH ())
	347	#else /* not SCM_VM_DEBUG_ENGINE */
	348	#define VM_GOTO_NEXT() goto *SCM_CODE_TO_ADDR (FETCH ())
	349	#endif
	350	#else /* not HAVE_LABELS_AS_VALUES */
	351	#define VM_GOTO_NEXT() goto vm_start
	352	#endif
	353
	354	#define NEXT \
	355	{ \
	356	VM_PROGRAM_COUNTER_CHECK (); \
	357	VM_NEXT_HOOK (); \
	358	VM_GOTO_NEXT (); \
	359	}
	360
	361	/* Just an abbreviation */
	362	#define RETURN(X) { ac = (X); NEXT; }