#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
#define VM_USE_HOOKS 0 /* Various hooks */
-#define VM_CHECK_OBJECT 1 /* Check object table */
-#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
+#define VM_CHECK_OBJECT 0 /* Check object table */
+#define VM_CHECK_FREE_VARIABLES 0 /* Check free variable access */
+#define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1
-#define VM_CHECK_OBJECT 1
-#define VM_CHECK_FREE_VARIABLES 1
+#define VM_CHECK_OBJECT 0
+#define VM_CHECK_FREE_VARIABLES 0
+#define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
#else
#error unknown debug engine VM_ENGINE
#endif
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
SCM *objects = NULL; /* constant objects */
+#if VM_CHECK_OBJECT
size_t object_count = 0; /* length of OBJECTS */
+#endif
SCM *stack_limit = vp->stack_limit; /* stack limit address */
SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state;
#undef VM_USE_HOOKS
#undef VM_CHECK_OBJECT
#undef VM_CHECK_FREE_VARIABLE
+#undef VM_CHECK_UNDERFLOW
/*
Local Variables:
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#define ASSERT_BOUND(x)
#endif
+#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() \
{ \
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); \
} \
} \
}
if (SCM_UNLIKELY (sp >= stack_limit)) \
goto vm_error_stack_overflow
+
+#ifdef VM_CHECK_UNDERFLOW
#define CHECK_UNDERFLOW() \
if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp))) \
- goto vm_error_stack_underflow;
-
+ goto vm_error_stack_underflow
#define PRE_CHECK_UNDERFLOW(N) \
if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp))) \
- goto vm_error_stack_underflow;
+ goto vm_error_stack_underflow
+#else
+#define CHECK_UNDERFLOW() /* nop */
+#define PRE_CHECK_UNDERFLOW(N) /* nop */
+#endif
+
#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 { 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
SCM type, shape;
size_t len;
FETCH_LENGTH (len);
- POP (shape);
- POP (type);
+ POP2 (shape, type);
SYNC_REGISTER ();
PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
ip += len;
-/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
VM_DEFINE_INSTRUCTION (143, set_car, "set-car!", 0, 2, 0)
{
SCM x, y;
- POP (y);
- POP (x);
+ POP2 (y, x);
VM_VALIDATE_CONS (x, "set-car!");
SCM_SETCAR (x, y);
NEXT;
VM_DEFINE_INSTRUCTION (144, set_cdr, "set-cdr!", 0, 2, 0)
{
SCM x, y;
- POP (y);
- POP (x);
+ POP2 (y, x);
VM_VALIDATE_CONS (x, "set-cdr!");
SCM_SETCDR (x, y);
NEXT;
{
scm_t_signed_bits i = 0;
SCM vect, idx, val;
- POP (val); POP (idx); POP (vect);
+ POP3 (val, idx, vect);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
&& SCM_I_INUMP (idx)
&& ((i = SCM_I_INUM (idx)) >= 0)
{
SCM instance, idx, val;
size_t slot;
- POP (val);
- POP (idx);
- POP (instance);
+ POP3 (val, idx, instance);
slot = SCM_I_INUM (idx);
SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
NEXT;
if (scm_is_eq (endianness, scm_i_native_endianness)) \
goto VM_LABEL (bv_##stem##_native_set); \
{ \
- SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
+ SCM bv, idx, val; POP3 (val, idx, bv); \
SYNC_REGISTER (); \
scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \
NEXT; \
SCM bv, idx, val; \
scm_t_ ## type *int_ptr; \
\
- POP (val); POP (idx); POP (bv); \
+ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
SCM bv, idx, val; \
scm_t_ ## type *int_ptr; \
\
- POP (val); POP (idx); POP (bv); \
+ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
SCM bv, idx, val; \
type *float_ptr; \
\
- POP (val); POP (idx); POP (bv); \
+ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \
float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \
VM_DEFINE_INSTRUCTION (29, local_set, "local-set", 1, 1, 0)
{
- LOCAL_SET (FETCH (), *sp);
- DROP ();
+ SCM x;
+ POP (x);
+ LOCAL_SET (FETCH (), x);
NEXT;
}
VM_DEFINE_INSTRUCTION (30, long_local_set, "long-local-set", 2, 1, 0)
{
+ SCM x;
unsigned int i = FETCH ();
i <<= 8;
i += FETCH ();
- LOCAL_SET (i, *sp);
- DROP ();
+ POP (x);
+ LOCAL_SET (i, x);
NEXT;
}
offset -= (offset & (1<<23)) << 1; \
}
-#define BR(p) \
+#define BR(p) \
{ \
scm_t_int32 offset; \
FETCH_OFFSET (offset); \
ip += offset; \
if (offset < 0) \
VM_HANDLE_INTERRUPTS; \
- NULLSTACK (1); \
- DROP (); \
NEXT; \
}
VM_DEFINE_INSTRUCTION (35, br_if, "br-if", 3, 0, 0)
{
- BR (scm_is_true (*sp));
+ SCM x;
+ POP (x);
+ BR (scm_is_true (x));
}
VM_DEFINE_INSTRUCTION (36, br_if_not, "br-if-not", 3, 0, 0)
{
- BR (scm_is_false (*sp));
+ SCM x;
+ POP (x);
+ BR (scm_is_false (x));
}
VM_DEFINE_INSTRUCTION (37, br_if_eq, "br-if-eq", 3, 0, 0)
{
- sp--; /* underflow? */
- BR (scm_is_eq (sp[0], sp[1]));
+ SCM x, y;
+ POP2 (y, x);
+ BR (scm_is_eq (x, y));
}
VM_DEFINE_INSTRUCTION (38, br_if_not_eq, "br-if-not-eq", 3, 0, 0)
{
- sp--; /* underflow? */
- BR (!scm_is_eq (sp[0], sp[1]));
+ SCM x, y;
+ POP2 (y, x);
+ BR (!scm_is_eq (x, y));
}
VM_DEFINE_INSTRUCTION (39, br_if_null, "br-if-null", 3, 0, 0)
{
- BR (scm_is_null (*sp));
+ SCM x;
+ POP (x);
+ BR (scm_is_null (x));
}
VM_DEFINE_INSTRUCTION (40, br_if_not_null, "br-if-not-null", 3, 0, 0)
{
- BR (!scm_is_null (*sp));
+ SCM x;
+ POP (x);
+ BR (!scm_is_null (x));
}
\f
VM_DEFINE_INSTRUCTION (59, partial_cont_call, "partial-cont-call", 0, -1, 0)
{
SCM vmcont, intwinds, prevwinds;
- POP (intwinds);
- POP (vmcont);
+ POP2 (intwinds, vmcont);
SYNC_REGISTER ();
if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont)))
{ finish_args = vmcont;
VM_DEFINE_INSTRUCTION (82, define, "define", 0, 0, 2)
{
SCM sym, val;
- POP (sym);
- POP (val);
+ POP2 (sym, val);
SYNC_REGISTER ();
VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (),
SCM_BOOL_T),
VM_DEFINE_INSTRUCTION (86, wind, "wind", 0, 2, 0)
{
SCM wind, unwind;
- POP (unwind);
- POP (wind);
+ POP2 (unwind, wind);
SYNC_REGISTER ();
/* Push wind and unwind procedures onto the dynamic stack. Note that neither
are actually called; the compiler should emit calls to wind and unwind for
size_t num;
SCM val, fluid, fluids;
- POP (val);
- POP (fluid);
+ POP2 (val, fluid);
fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
|| ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))
HCoop / bpt / guile.git / commitdiff