mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

VM tweaks

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2011-05-05 14:04:23 +02:00
parent 9e775af3bf
commit eae2438d2b
5 changed files with 68 additions and 48 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/vm-engine.c
View file

@ -20,12 +20,14 @@
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE) #if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
#define VM_USE_HOOKS 0 /* Various hooks */ #define VM_USE_HOOKS 0 /* Various hooks */
#define VM_CHECK_OBJECT 1 /* Check object table */ #define VM_CHECK_OBJECT 0 /* Check object table */
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */ #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) #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1 #define VM_USE_HOOKS 1
#define VM_CHECK_OBJECT 1 #define VM_CHECK_OBJECT 0
#define VM_CHECK_FREE_VARIABLES 1 #define VM_CHECK_FREE_VARIABLES 0
#define VM_CHECK_UNDERFLOW 0 /* Check underflow when popping values */
#else #else
#error unknown debug engine VM_ENGINE #error unknown debug engine VM_ENGINE
#endif #endif
@ -45,7 +47,9 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
/* Cache variables */ /* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */ struct scm_objcode *bp = NULL; /* program base pointer */
SCM *objects = NULL; /* constant objects */ SCM *objects = NULL; /* constant objects */
#if VM_CHECK_OBJECT
size_t object_count = 0; /* length of OBJECTS */ size_t object_count = 0; /* length of OBJECTS */
#endif
SCM *stack_limit = vp->stack_limit; /* stack limit address */ SCM *stack_limit = vp->stack_limit; /* stack limit address */
SCM dynstate = SCM_I_CURRENT_THREAD->dynamic_state; 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_USE_HOOKS
#undef VM_CHECK_OBJECT #undef VM_CHECK_OBJECT
#undef VM_CHECK_FREE_VARIABLE #undef VM_CHECK_FREE_VARIABLE
#undef VM_CHECK_UNDERFLOW
/* /*
Local Variables: Local Variables:

26
libguile/vm-engine.h
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -144,6 +144,12 @@
#define ASSERT_BOUND(x) #define ASSERT_BOUND(x)
#endif #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. */ /* Cache the object table and free variables. */
#define CACHE_PROGRAM() \ #define CACHE_PROGRAM() \
{ \ { \
@ -152,10 +158,10 @@
ASSERT_ALIGNED_PROCEDURE (); \ ASSERT_ALIGNED_PROCEDURE (); \
if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \ if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \
objects = SCM_I_VECTOR_WELTS (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 { \ } else { \
objects = NULL; \ objects = NULL; \
object_count = 0; \ SET_OBJECT_COUNT (0); \
} \ } \
} \ } \
} }
@ -266,18 +272,26 @@
if (SCM_UNLIKELY (sp >= stack_limit)) \ if (SCM_UNLIKELY (sp >= stack_limit)) \
goto vm_error_stack_overflow goto vm_error_stack_overflow
#ifdef VM_CHECK_UNDERFLOW
#define CHECK_UNDERFLOW() \ #define CHECK_UNDERFLOW() \
if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp))) \ if (SCM_UNLIKELY (sp <= SCM_FRAME_UPPER_ADDRESS (fp))) \
goto vm_error_stack_underflow; goto vm_error_stack_underflow
#define PRE_CHECK_UNDERFLOW(N) \ #define PRE_CHECK_UNDERFLOW(N) \
if (SCM_UNLIKELY (sp - N <= SCM_FRAME_UPPER_ADDRESS (fp))) \ 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 PUSH(x) do { sp++; CHECK_OVERFLOW (); *sp = x; } while (0)
#define DROP() do { sp--; CHECK_UNDERFLOW (); NULLSTACK (1); } 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 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 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 /* 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 POP_LIST when fetching a function's argument list. Note: `scm_cell' is an

3
libguile/vm-i-loader.c
View file

@ -92,8 +92,7 @@ VM_DEFINE_LOADER (106, load_array, "load-array")
SCM type, shape; SCM type, shape;
size_t len; size_t len;
FETCH_LENGTH (len); FETCH_LENGTH (len);
POP (shape); POP2 (shape, type);
POP (type);
SYNC_REGISTER (); SYNC_REGISTER ();
PUSH (scm_from_contiguous_typed_array (type, shape, ip, len)); PUSH (scm_from_contiguous_typed_array (type, shape, ip, len));
ip += len; ip += len;

22
libguile/vm-i-scheme.c
View file

@ -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 * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * 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) VM_DEFINE_INSTRUCTION (143, set_car, "set-car!", 0, 2, 0)
{ {
SCM x, y; SCM x, y;
POP (y); POP2 (y, x);
POP (x);
VM_VALIDATE_CONS (x, "set-car!"); VM_VALIDATE_CONS (x, "set-car!");
SCM_SETCAR (x, y); SCM_SETCAR (x, y);
NEXT; 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) VM_DEFINE_INSTRUCTION (144, set_cdr, "set-cdr!", 0, 2, 0)
{ {
SCM x, y; SCM x, y;
POP (y); POP2 (y, x);
POP (x);
VM_VALIDATE_CONS (x, "set-cdr!"); VM_VALIDATE_CONS (x, "set-cdr!");
SCM_SETCDR (x, y); SCM_SETCDR (x, y);
NEXT; NEXT;
@ -469,7 +467,7 @@ VM_DEFINE_INSTRUCTION (164, vector_set, "vector-set", 0, 3, 0)
{ {
scm_t_signed_bits i = 0; scm_t_signed_bits i = 0;
SCM vect, idx, val; SCM vect, idx, val;
POP (val); POP (idx); POP (vect); POP3 (val, idx, vect);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
&& SCM_I_INUMP (idx) && SCM_I_INUMP (idx)
&& ((i = SCM_I_INUM (idx)) >= 0) && ((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; SCM instance, idx, val;
size_t slot; size_t slot;
POP (val); POP3 (val, idx, instance);
POP (idx);
POP (instance);
slot = SCM_I_INUM (idx); slot = SCM_I_INUM (idx);
SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val); SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (val);
NEXT; NEXT;
@ -820,7 +816,7 @@ BV_FLOAT_REF (f64, ieee_double, double, 8)
if (scm_is_eq (endianness, scm_i_native_endianness)) \ if (scm_is_eq (endianness, scm_i_native_endianness)) \
goto VM_LABEL (bv_##stem##_native_set); \ 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 (); \ SYNC_REGISTER (); \
scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \ scm_bytevector_##fn_stem##_set_x (bv, idx, val, endianness); \
NEXT; \ NEXT; \
@ -852,7 +848,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
SCM bv, idx, val; \ SCM bv, idx, val; \
scm_t_ ## type *int_ptr; \ scm_t_ ## type *int_ptr; \
\ \
POP (val); POP (idx); POP (bv); \ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \ i = SCM_I_INUM (idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \ 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 bv, idx, val; \
scm_t_ ## type *int_ptr; \ scm_t_ ## type *int_ptr; \
\ \
POP (val); POP (idx); POP (bv); \ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \ i = SCM_I_INUM (idx); \
int_ptr = (scm_t_ ## type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \ 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; \ SCM bv, idx, val; \
type *float_ptr; \ type *float_ptr; \
\ \
POP (val); POP (idx); POP (bv); \ POP3 (val, idx, bv); \
VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \ VM_VALIDATE_BYTEVECTOR (bv, "bv-" #stem "-set"); \
i = SCM_I_INUM (idx); \ i = SCM_I_INUM (idx); \
float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \ float_ptr = (type *) (SCM_BYTEVECTOR_CONTENTS (bv) + i); \

50
libguile/vm-i-system.c
View file

@ -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) VM_DEFINE_INSTRUCTION (29, local_set, "local-set", 1, 1, 0)
{ {
LOCAL_SET (FETCH (), *sp); SCM x;
DROP (); POP (x);
LOCAL_SET (FETCH (), x);
NEXT; NEXT;
} }
VM_DEFINE_INSTRUCTION (30, long_local_set, "long-local-set", 2, 1, 0) VM_DEFINE_INSTRUCTION (30, long_local_set, "long-local-set", 2, 1, 0)
{ {
SCM x;
unsigned int i = FETCH (); unsigned int i = FETCH ();
i <<= 8; i <<= 8;
i += FETCH (); i += FETCH ();
LOCAL_SET (i, *sp); POP (x);
DROP (); LOCAL_SET (i, x);
NEXT; NEXT;
} }
@ -487,8 +489,6 @@ VM_DEFINE_INSTRUCTION (33, long_toplevel_set, "long-toplevel-set", 2, 1, 0)
ip += offset; \ ip += offset; \
if (offset < 0) \ if (offset < 0) \
VM_HANDLE_INTERRUPTS; \ VM_HANDLE_INTERRUPTS; \
NULLSTACK (1); \
DROP (); \
NEXT; \ 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) 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) 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) VM_DEFINE_INSTRUCTION (37, br_if_eq, "br-if-eq", 3, 0, 0)
{ {
sp--; /* underflow? */ SCM x, y;
BR (scm_is_eq (sp[0], sp[1])); POP2 (y, x);
BR (scm_is_eq (x, y));
} }
VM_DEFINE_INSTRUCTION (38, br_if_not_eq, "br-if-not-eq", 3, 0, 0) VM_DEFINE_INSTRUCTION (38, br_if_not_eq, "br-if-not-eq", 3, 0, 0)
{ {
sp--; /* underflow? */ SCM x, y;
BR (!scm_is_eq (sp[0], sp[1])); POP2 (y, x);
BR (!scm_is_eq (x, y));
} }
VM_DEFINE_INSTRUCTION (39, br_if_null, "br-if-null", 3, 0, 0) 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) 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) VM_DEFINE_INSTRUCTION (59, partial_cont_call, "partial-cont-call", 0, -1, 0)
{ {
SCM vmcont, intwinds, prevwinds; SCM vmcont, intwinds, prevwinds;
POP (intwinds); POP2 (intwinds, vmcont);
POP (vmcont);
SYNC_REGISTER (); SYNC_REGISTER ();
if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont))) if (SCM_UNLIKELY (!SCM_VM_CONT_REWINDABLE_P (vmcont)))
{ finish_args = 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) VM_DEFINE_INSTRUCTION (82, define, "define", 0, 0, 2)
{ {
SCM sym, val; SCM sym, val;
POP (sym); POP2 (sym, val);
POP (val);
SYNC_REGISTER (); SYNC_REGISTER ();
VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (), VARIABLE_SET (scm_sym2var (sym, scm_current_module_lookup_closure (),
SCM_BOOL_T), 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) VM_DEFINE_INSTRUCTION (86, wind, "wind", 0, 2, 0)
{ {
SCM wind, unwind; SCM wind, unwind;
POP (unwind); POP2 (unwind, wind);
POP (wind);
SYNC_REGISTER (); SYNC_REGISTER ();
/* Push wind and unwind procedures onto the dynamic stack. Note that neither /* 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 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; size_t num;
SCM val, fluid, fluids; SCM val, fluid, fluids;
POP (val); POP2 (val, fluid);
POP (fluid);
fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate); fluids = SCM_I_DYNAMIC_STATE_FLUIDS (dynstate);
if (SCM_UNLIKELY (!SCM_FLUID_P (fluid)) if (SCM_UNLIKELY (!SCM_FLUID_P (fluid))
|| ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids))) || ((num = SCM_I_FLUID_NUM (fluid)) >= SCM_SIMPLE_VECTOR_LENGTH (fluids)))