-/* 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.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
*
- * 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.
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * as published by the Free Software Foundation; either version 3 of
+ * the License, or (at your option) any later version.
*
- * 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 library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
*
- * 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. */
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+ * 02110-1301 USA
+ */
/* This file is included in vm_engine.c */
#endif
#endif
#ifdef __i386__
-/* gcc on lenny actually crashes if we allocate these variables in registers.
- hopefully this is the only one of these. */
-#if !(__GNUC__==4 && __GNUC_MINOR__==1 && __GNUC_PATCHLEVEL__==2)
-#define IP_REG asm("%esi")
-#define SP_REG asm("%edi")
-#define FP_REG
-#endif
+/* too few registers! because of register allocation errors with various gcs,
+ just punt on explicit assignments on i386, hoping that the "register"
+ declaration will be sufficient. */
+#elif defined __x86_64__
+/* GCC 4.6 chooses %rbp for IP_REG and %rbx for SP_REG, which works
+ well. Tell it to keep the jump table in a r12, which is
+ callee-saved. */
+#define JT_REG asm ("r12")
#endif
#if defined(PPC) || defined(_POWER) || defined(_IBMR2)
#define IP_REG asm("26")
#ifndef FP_REG
#define FP_REG
#endif
+#ifndef JT_REG
+#define JT_REG
+#endif
\f
/*
* Cache/Sync
*/
+#define VM_ASSERT(condition, handler) \
+ do { if (SCM_UNLIKELY (!(condition))) { SYNC_ALL(); handler; } } while (0)
+
#ifdef VM_ENABLE_ASSERTIONS
-# define ASSERT(condition) if (SCM_UNLIKELY (!(condition))) abort()
+# define ASSERT(condition) VM_ASSERT (condition, abort())
#else
# define ASSERT(condition)
#endif
+/* Cache the VM's instruction, stack, and frame pointer in local variables. */
#define CACHE_REGISTER() \
{ \
ip = vp->ip; \
sp = vp->sp; \
fp = vp->fp; \
- stack_base = fp ? SCM_FRAME_UPPER_ADDRESS (fp) - 1 : vp->stack_base; \
}
+/* Update the registers in VP, a pointer to the current VM. This must be done
+ at least before any GC invocation so that `vp->sp' is up-to-date and the
+ whole stack gets marked. */
#define SYNC_REGISTER() \
{ \
vp->ip = ip; \
vp->fp = fp; \
}
+/* FIXME */
+#define ASSERT_VARIABLE(x) \
+ do { if (!SCM_VARIABLEP (x)) { SYNC_REGISTER (); abort(); } \
+ } while (0)
+#define ASSERT_BOUND_VARIABLE(x) \
+ do { ASSERT_VARIABLE (x); \
+ if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED)) \
+ { SYNC_REGISTER (); abort(); } \
+ } while (0)
+
#ifdef VM_ENABLE_PARANOID_ASSERTIONS
#define CHECK_IP() \
do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0)
+#define ASSERT_ALIGNED_PROCEDURE() \
+ do { if ((scm_t_bits)bp % 8) abort (); } while (0)
+#define ASSERT_BOUND(x) \
+ do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
+ } while (0)
#else
#define CHECK_IP()
+#define ASSERT_ALIGNED_PROCEDURE()
+#define ASSERT_BOUND(x)
#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. */
+#if VM_CHECK_OBJECT
+#define SET_OBJECT_COUNT(n) object_count = n
+#else
+#define SET_OBJECT_COUNT(n) /* nop */
+#endif
+
+/* Cache the object table and free variables. */
#define CACHE_PROGRAM() \
{ \
if (bp != SCM_PROGRAM_DATA (program)) { \
bp = SCM_PROGRAM_DATA (program); \
+ ASSERT_ALIGNED_PROCEDURE (); \
if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \
- object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \
+ SET_OBJECT_COUNT (SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program))); \
} else { \
objects = NULL; \
- object_count = 0; \
+ SET_OBJECT_COUNT (0); \
} \
} \
}
* Error check
*/
-#undef CHECK_EXTERNAL
-#if VM_CHECK_EXTERNAL
-#define CHECK_EXTERNAL(e) \
- do { if (SCM_UNLIKELY (!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 (SCM_UNLIKELY ((_num) >= object_count)) goto vm_error_object; } while (0)
+#define CHECK_OBJECT(_num) \
+ VM_ASSERT ((_num) < object_count, vm_error_object ())
#else
#define CHECK_OBJECT(_num)
#endif
+#if VM_CHECK_FREE_VARIABLES
+#define CHECK_FREE_VARIABLE(_num) \
+ VM_ASSERT ((_num) < SCM_PROGRAM_NUM_FREE_VARIABLES (program), \
+ vm_error_free_variable ())
+#else
+#define CHECK_FREE_VARIABLE(_num)
+#endif
+
\f
/*
* Hooks
*/
#undef RUN_HOOK
+#undef RUN_HOOK1
#if VM_USE_HOOKS
-#define RUN_HOOK(h) \
-{ \
- if (SCM_UNLIKELY (!SCM_FALSEP (vp->hooks[h])))\
- { \
- SYNC_REGISTER (); \
- vm_dispatch_hook (vp, vp->hooks[h], hook_args); \
- CACHE_REGISTER (); \
- } \
-}
+#define RUN_HOOK(h) \
+ { \
+ if (SCM_UNLIKELY (vp->trace_level > 0)) \
+ { \
+ SYNC_REGISTER (); \
+ vm_dispatch_hook (vm, h); \
+ } \
+ }
+#define RUN_HOOK1(h, x) \
+ { \
+ if (SCM_UNLIKELY (vp->trace_level > 0)) \
+ { \
+ PUSH (x); \
+ SYNC_REGISTER (); \
+ vm_dispatch_hook (vm, h); \
+ DROP(); \
+ } \
+ }
#else
#define RUN_HOOK(h)
+#define RUN_HOOK1(h, x)
#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)
+#define APPLY_HOOK() \
+ RUN_HOOK (SCM_VM_APPLY_HOOK)
+#define PUSH_CONTINUATION_HOOK() \
+ RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK)
+#define POP_CONTINUATION_HOOK(n) \
+ RUN_HOOK1 (SCM_VM_POP_CONTINUATION_HOOK, SCM_I_MAKINUM (n))
+#define NEXT_HOOK() \
+ RUN_HOOK (SCM_VM_NEXT_HOOK)
+#define ABORT_CONTINUATION_HOOK() \
+ RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK)
+#define RESTORE_CONTINUATION_HOOK() \
+ RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK)
+
+#define VM_HANDLE_INTERRUPTS \
+ SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
\f
/*
# define NULLSTACK_FOR_NONLOCAL_EXIT()
#endif
-#define CHECK_OVERFLOW() \
- if (sp > stack_limit) \
- goto vm_error_stack_overflow
+/* For this check, we don't use VM_ASSERT, because that leads to a
+ per-site SYNC_ALL, which is too much code growth. The real problem
+ of course is having to check for overflow all the time... */
+#define CHECK_OVERFLOW() \
+ do { if (SCM_UNLIKELY (sp >= stack_limit)) goto handle_overflow; } while (0)
+
+#ifdef VM_CHECK_UNDERFLOW
+#define PRE_CHECK_UNDERFLOW(N) \
+ VM_ASSERT (sp - (N) > SCM_FRAME_UPPER_ADDRESS (fp), vm_error_stack_underflow ())
+#define CHECK_UNDERFLOW() PRE_CHECK_UNDERFLOW (0)
+#else
+#define PRE_CHECK_UNDERFLOW(N) /* nop */
+#define CHECK_UNDERFLOW() /* nop */
+#endif
-#define CHECK_UNDERFLOW() \
- if (sp < stack_base) \
- goto vm_error_stack_underflow;
#define PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } while (0)
-#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
-#define POP(x) do { x = *sp; DROP (); } while (0)
+#define DROPN(_n) do { sp -= (_n); CHECK_UNDERFLOW (); NULLSTACK (_n); } while (0)
+#define POP(x) do { PRE_CHECK_UNDERFLOW (1); x = *sp--; NULLSTACK (1); } while (0)
+#define POP2(x,y) do { PRE_CHECK_UNDERFLOW (2); x = *sp--; y = *sp--; NULLSTACK (2); } while (0)
+#define POP3(x,y,z) do { PRE_CHECK_UNDERFLOW (3); x = *sp--; y = *sp--; z = *sp--; NULLSTACK (3); } 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
{ \
for (; scm_is_pair (l); l = SCM_CDR (l)) \
PUSH (SCM_CAR (l)); \
- if (SCM_UNLIKELY (!NILP (l))) { \
- finish_args = scm_list_1 (l); \
- goto vm_error_improper_list; \
- } \
+ VM_ASSERT (NILP (l), vm_error_improper_list (l)); \
} while (0)
\f
#define FETCH() (*ip++)
#define FETCH_LENGTH(len) do { len=*ip++; len<<=8; len+=*ip++; len<<=8; len+=*ip++; } while (0)
-#undef CLOCK
-#if VM_USE_CLOCK
-#define CLOCK(n) vp->clock += n
-#else
-#define CLOCK(n)
-#endif
-
#undef NEXT_JUMP
#ifdef HAVE_LABELS_AS_VALUES
#define NEXT_JUMP() goto *jump_table[FETCH () & SCM_VM_INSTRUCTION_MASK]
#define NEXT \
{ \
- CLOCK (1); \
NEXT_HOOK (); \
CHECK_STACK_LEAK (); \
NEXT_JUMP (); \
}
\f
-/*
- * Stack frame
- */
-
-#define INIT_ARGS() \
-{ \
- if (SCM_UNLIKELY (bp->nrest)) \
- { \
- int n = nargs - (bp->nargs - 1); \
- if (n < 0) \
- goto vm_error_wrong_num_args; \
- /* NB, can cause GC while setting up the \
- stack frame */ \
- POP_LIST (n); \
- } \
- else \
- { \
- if (SCM_UNLIKELY (nargs != bp->nargs)) \
- goto vm_error_wrong_num_args; \
- } \
-}
-
/* See frames.h for the layout of stack frames */
/* When this is called, bp points to the new program data,
and the arguments are already on the stack */
-#define NEW_FRAME() \
-{ \
- int i; \
- SCM *dl, *data; \
- scm_byte_t *ra = ip; \
- \
- /* Save old registers */ \
- ra = ip; \
- dl = fp; \
- \
- /* New registers */ \
- fp = sp - bp->nargs + 1; \
- data = SCM_FRAME_DATA_ADDRESS (fp); \
- sp = data + 3; \
- CHECK_OVERFLOW (); \
- stack_base = sp; \
- ip = bp->base; \
- \
- /* Init local variables */ \
- for (i=bp->nlocs; i; i--) \
- data[-i] = SCM_UNDEFINED; \
- \
- /* Set frame data */ \
- data[3] = (SCM)ra; \
- data[2] = 0x0; \
- data[1] = (SCM)dl; \
- \
- /* Postpone initializing external vars, \
- because if the CONS causes a GC, we \
- want the stack marker to see the data \
- array formatted as expected. */ \
- data[0] = SCM_UNDEFINED; \
- external = SCM_PROGRAM_EXTERNALS (fp[-1]); \
- for (i = 0; i < bp->nexts; i++) \
- CONS (external, SCM_UNDEFINED, external); \
- data[0] = external; \
-}
-
-#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
+#define DROP_FRAME() \
+ { \
+ sp -= 3; \
+ NULLSTACK (3); \
+ CHECK_UNDERFLOW (); \
+ }
+
/*
Local Variables:
HCoop / bpt / guile.git / blobdiff