summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-05-05 14:04:23 +0200
committerAndy Wingo <wingo@pobox.com>2011-05-05 14:04:23 +0200
commiteae2438d2bd1d9a0e0aaa052abb8b36b2d073850 (patch)
tree3c5e2fbe178620de4d87ccba03c53f308b66e6f4
parent9e775af3bf0db457eceb5a9a1f4a87968d011492 (diff)
downloadguile-eae2438d2bd1d9a0e0aaa052abb8b36b2d073850.tar.gz
VM tweaks
* libguile/vm-engine.c (VM_CHECK_OBJECT, VM_CHECK_FREE_VARIABLES): Set to 0 for both engines. These are really internal debugging variables, which don't affect user-visible features, provided that the compiler is correct of course. (VM_CHECK_UNDERFLOW): New var, also off by default: whether to check for stack underflow when popping values. (vm_engine): Don't declare object_count if we are not checking object table accesses. * libguile/vm-engine.h (CACHE_PROGRAM): Don't muck with object_count if we are not checking object table accesses. (CHECK_UNDERFLOW, PRE_CHECK_UNDERFLOW): Nop out if we are not checking underflow. (POP2, POP3): New macros which check for underflow before popping more than one value. * libguile/vm-i-loader.c (load_array): * libguile/vm-i-scheme.c (set_car, set_cdr, vector_set, slot_set) (BV_SET_WITH_ENDIANNESS, BV_FIXABLE_INT_SET, BV_INT_SET) (BV_FLOAT_SET): * libguile/vm-i-system.c (partial_cont_call, fix_closure, prompt) (fluid_set): Use POP2 / POP3. (local_set, long_local_set): Pop to locals instead of using values on the stack then dropping; allows for underflow to be checked before the value is accessed. (BR): Don't NULLSTACK or DROP after the operation. (br_if, br_if_not, br_if_eq, br_if_not_eq, br_if_null) (br_if_not_null): Pop to locals before doing the compare and jump.
-rw-r--r--libguile/vm-engine.c13
-rw-r--r--libguile/vm-engine.h26
-rw-r--r--libguile/vm-i-loader.c3
-rw-r--r--libguile/vm-i-scheme.c22
-rw-r--r--libguile/vm-i-system.c52
5 files changed, 68 insertions, 48 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index ab9ffc98c..bfa848967 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -20,12 +20,14 @@
#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
@@ -45,7 +47,9 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
/* 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;
@@ -298,6 +302,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
#undef VM_USE_HOOKS
#undef VM_CHECK_OBJECT
#undef VM_CHECK_FREE_VARIABLE
+#undef VM_CHECK_UNDERFLOW
/*
Local Variables:
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index ad226dc03..abbc11077 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -1,4 +1,4 @@
-/* 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
@@ -144,6 +144,12 @@
#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() \
{ \
@@ -152,10 +158,10 @@
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); \
} \
} \
}
@@ -266,18 +272,26 @@
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
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 0d8678485..6fa8eb2ea 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -92,8 +92,7 @@ VM_DEFINE_LOADER (106, load_array, "load-array")
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;
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 9e249bc85..60e44521e 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -1,4 +1,4 @@
-/* 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
@@ -147,8 +147,7 @@ VM_DEFINE_FUNCTION (142, cdr, "cdr", 1)
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;
@@ -157,8 +156,7 @@ VM_DEFINE_INSTRUCTION (143, set_car, "set-car!", 0, 2, 0)
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;
@@ -469,7 +467,7 @@ VM_DEFINE_INSTRUCTION (164, vector_set, "vector-set", 0, 3, 0)
{
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)
@@ -645,9 +643,7 @@ VM_DEFINE_INSTRUCTION (173, slot_set, "slot-set", 0, 3, 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;
@@ -820,7 +816,7 @@ BV_FLOAT_REF (f64, ieee_double, double, 8)
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; \
@@ -852,7 +848,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
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); \
@@ -879,7 +875,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
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); \
@@ -903,7 +899,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
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); \
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 71c5281c8..ea00fc920 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -397,18 +397,20 @@ VM_DEFINE_INSTRUCTION (28, long_toplevel_ref, "long-toplevel-ref", 2, 0, 1)
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;
}
@@ -479,7 +481,7 @@ VM_DEFINE_INSTRUCTION (33, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
offset -= (offset & (1<<23)) << 1; \
}
-#define BR(p) \
+#define BR(p) \
{ \
scm_t_int32 offset; \
FETCH_OFFSET (offset); \
@@ -487,8 +489,6 @@ VM_DEFINE_INSTRUCTION (33, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
ip += offset; \
if (offset < 0) \
VM_HANDLE_INTERRUPTS; \
- NULLSTACK (1); \
- DROP (); \
NEXT; \
}
@@ -504,34 +504,44 @@ VM_DEFINE_INSTRUCTION (34, br, "br", 3, 0, 0)
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));
}
@@ -1029,8 +1039,7 @@ VM_DEFINE_INSTRUCTION (58, continuation_call, "continuation-call", 0, -1, 0)
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;
@@ -1512,8 +1521,7 @@ VM_DEFINE_INSTRUCTION (81, fix_closure, "fix-closure", 2, -1, 0)
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),
@@ -1578,8 +1586,7 @@ VM_DEFINE_INSTRUCTION (85, prompt, "prompt", 4, 2, 0)
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
@@ -1675,8 +1682,7 @@ VM_DEFINE_INSTRUCTION (92, fluid_set, "fluid-set", 0, 2, 0)
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)))