diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:04:23 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:04:23 +0200 |
commit | eae2438d2bd1d9a0e0aaa052abb8b36b2d073850 (patch) | |
tree | 3c5e2fbe178620de4d87ccba03c53f308b66e6f4 | |
parent | 9e775af3bf0db457eceb5a9a1f4a87968d011492 (diff) | |
download | guile-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.c | 13 | ||||
-rw-r--r-- | libguile/vm-engine.h | 26 | ||||
-rw-r--r-- | libguile/vm-i-loader.c | 3 | ||||
-rw-r--r-- | libguile/vm-i-scheme.c | 22 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 52 |
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))) |