mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-18 01:30:27 +02:00
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.
This commit is contained in:
parent
9e775af3bf
commit
eae2438d2b
5 changed files with 68 additions and 48 deletions
|
@ -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); \
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue