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 type checking refactor

Browse source 
* libguile/vm-engine.c (VM_VALIDATE): Refactor some type-related
  assertions to use a common macro.
  (vector-length, vector-set!/immediate): Fix the proc mentioned in the
  error message.
This commit is contained in:
Andy Wingo 2016-06-11 13:01:56 +02:00
parent ddce05e819
commit 100b048097
1 changed files with 36 additions and 41 deletions
Download patch file Download diff file Expand all files Collapse all files

77
libguile/vm-engine.c
View file

@ -423,7 +423,7 @@
((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \ ((scm_t_signed_bits) SCM_UNPACK (SCM_INUM1) \
- (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0)) - (scm_t_signed_bits) SCM_UNPACK (SCM_INUM0))
#define BINARY_INTEGER_OP(CFUNC,SFUNC) \ #define BINARY_INTEGER_OP(CFUNC,SFUNC) \
{ \ { \
ARGS2 (x, y); \ ARGS2 (x, y); \
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
@ -435,14 +435,26 @@
RETURN_EXP (SFUNC (x, y)); \ RETURN_EXP (SFUNC (x, y)); \
} }
#define VM_VALIDATE_PAIR(x, proc) \ #define VM_VALIDATE(x, pred, proc, what) \
VM_ASSERT (scm_is_pair (x), vm_error_not_a_pair (proc, x)) VM_ASSERT (pred (x), vm_error_not_a_ ## what (proc, x))
#define VM_VALIDATE_STRUCT(obj, proc) \
VM_ASSERT (SCM_STRUCTP (obj), vm_error_not_a_pair (proc, obj))
#define VM_VALIDATE_BYTEVECTOR(x, proc) \ #define VM_VALIDATE_BYTEVECTOR(x, proc) \
VM_ASSERT (SCM_BYTEVECTOR_P (x), vm_error_not_a_bytevector (proc, x)) VM_VALIDATE (x, SCM_BYTEVECTOR_P, proc, bytevector)
#define VM_VALIDATE_CHAR(x, proc) \
VM_VALIDATE (x, SCM_CHARP, proc, char);
#define VM_VALIDATE_PAIR(x, proc) \
VM_VALIDATE (x, scm_is_pair, proc, pair)
#define VM_VALIDATE_STRING(obj, proc) \
VM_VALIDATE (obj, scm_is_string, proc, string)
#define VM_VALIDATE_STRUCT(obj, proc) \
VM_VALIDATE (obj, SCM_STRUCTP, proc, struct)
#define VM_VALIDATE_VARIABLE(obj, proc) \
VM_VALIDATE (obj, SCM_VARIABLEP, proc, variable)
#define VM_VALIDATE_VECTOR(obj, proc) \
VM_VALIDATE (obj, SCM_I_IS_VECTOR, proc, vector)
#define VM_VALIDATE_INDEX(u64, size, proc) \
VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64))
/* Return true (non-zero) if PTR has suitable alignment for TYPE. */ /* Return true (non-zero) if PTR has suitable alignment for TYPE. */
#define ALIGNED_P(ptr, type) \ #define ALIGNED_P(ptr, type) \
@ -1599,8 +1611,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
SCM var; SCM var;
UNPACK_12_12 (op, dst, src); UNPACK_12_12 (op, dst, src);
var = SP_REF (src); var = SP_REF (src);
VM_ASSERT (SCM_VARIABLEP (var), VM_VALIDATE_VARIABLE (var, "variable-ref");
vm_error_not_a_variable ("variable-ref", var));
VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var)); VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var));
SP_SET (dst, VARIABLE_REF (var)); SP_SET (dst, VARIABLE_REF (var));
NEXT (1); NEXT (1);
@ -1616,8 +1627,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
SCM var; SCM var;
UNPACK_12_12 (op, dst, src); UNPACK_12_12 (op, dst, src);
var = SP_REF (dst); var = SP_REF (dst);
VM_ASSERT (SCM_VARIABLEP (var), VM_VALIDATE_VARIABLE (var, "variable-set!");
vm_error_not_a_variable ("variable-set!", var));
VARIABLE_SET (var, SP_REF (src)); VARIABLE_SET (var, SP_REF (src));
NEXT (1); NEXT (1);
} }
@ -2235,8 +2245,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (76, string_length, "string-length", OP1 (X8_S12_S12) | OP_DST) VM_DEFINE_OP (76, string_length, "string-length", OP1 (X8_S12_S12) | OP_DST)
{ {
ARGS1 (str); ARGS1 (str);
VM_ASSERT (scm_is_string (str), VM_VALIDATE_STRING (str, "string-length");
vm_error_not_a_string ("string-length", str));
SP_SET_U64 (dst, scm_i_string_length (str)); SP_SET_U64 (dst, scm_i_string_length (str));
NEXT (1); NEXT (1);
} }
@ -2256,10 +2265,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
str = SP_REF (src); str = SP_REF (src);
c_idx = SP_REF_U64 (idx); c_idx = SP_REF_U64 (idx);
VM_ASSERT (scm_is_string (str), VM_VALIDATE_STRING (str, "string-ref");
vm_error_not_a_string ("string-ref", str)); VM_VALIDATE_INDEX (c_idx, scm_i_string_length (str), "string-ref");
VM_ASSERT (c_idx < scm_i_string_length (str),
vm_error_out_of_range_uint64 ("string-ref", c_idx));
RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, c_idx))); RETURN (SCM_MAKE_CHAR (scm_i_string_ref (str, c_idx)));
} }
@ -2590,8 +2597,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_8_8_8 (op, dst, length, init); UNPACK_8_8_8 (op, dst, length, init);
length_val = SP_REF_U64 (length); length_val = SP_REF_U64 (length);
VM_ASSERT (length_val < (size_t) -1, VM_VALIDATE_INDEX (length_val, (size_t) -1, "make-vector");
vm_error_out_of_range_uint64 ("make-vector", length_val));
/* TODO: Inline this allocation. */ /* TODO: Inline this allocation. */
SYNC_IP (); SYNC_IP ();
@ -2631,9 +2637,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (101, vector_length, "vector-length", OP1 (X8_S12_S12) | OP_DST) VM_DEFINE_OP (101, vector_length, "vector-length", OP1 (X8_S12_S12) | OP_DST)
{ {
ARGS1 (vect); ARGS1 (vect);
VM_ASSERT (SCM_I_IS_VECTOR (vect), VM_VALIDATE_VECTOR (vect, "vector-length");
vm_error_not_a_vector ("vector-ref", vect));
SP_SET_U64 (dst, SCM_I_VECTOR_LENGTH (vect)); SP_SET_U64 (dst, SCM_I_VECTOR_LENGTH (vect));
NEXT (1); NEXT (1);
} }
@ -2653,10 +2657,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
vect = SP_REF (src); vect = SP_REF (src);
c_idx = SP_REF_U64 (idx); c_idx = SP_REF_U64 (idx);
VM_ASSERT (SCM_I_IS_VECTOR (vect), VM_VALIDATE_VECTOR (vect, "vector-ref");
vm_error_not_a_vector ("vector-ref", vect)); VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref");
VM_ASSERT (c_idx < SCM_I_VECTOR_LENGTH (vect),
vm_error_out_of_range_uint64 ("vector-ref", c_idx));
RETURN (SCM_I_VECTOR_ELTS (vect)[c_idx]); RETURN (SCM_I_VECTOR_ELTS (vect)[c_idx]);
} }
@ -2672,10 +2674,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_8_8_8 (op, dst, src, idx); UNPACK_8_8_8 (op, dst, src, idx);
vect = SP_REF (src); vect = SP_REF (src);
VM_ASSERT (SCM_I_IS_VECTOR (vect), VM_VALIDATE_VECTOR (vect, "vector-ref");
vm_error_not_a_vector ("vector-ref", vect)); VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-ref");
VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
vm_error_out_of_range_uint64 ("vector-ref", idx));
SP_SET (dst, SCM_I_VECTOR_ELTS (vect)[idx]); SP_SET (dst, SCM_I_VECTOR_ELTS (vect)[idx]);
NEXT (1); NEXT (1);
} }
@ -2695,10 +2695,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
c_idx = SP_REF_U64 (idx); c_idx = SP_REF_U64 (idx);
val = SP_REF (src); val = SP_REF (src);
VM_ASSERT (SCM_I_IS_VECTOR (vect), VM_VALIDATE_VECTOR (vect, "vector-set!");
vm_error_not_a_vector ("vector-set!", vect)); VM_VALIDATE_INDEX (c_idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
VM_ASSERT (c_idx < SCM_I_VECTOR_LENGTH (vect),
vm_error_out_of_range_uint64 ("vector-set!", c_idx));
SCM_I_VECTOR_WELTS (vect)[c_idx] = val; SCM_I_VECTOR_WELTS (vect)[c_idx] = val;
NEXT (1); NEXT (1);
} }
@ -2717,10 +2715,8 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
vect = SP_REF (dst); vect = SP_REF (dst);
val = SP_REF (src); val = SP_REF (src);
VM_ASSERT (SCM_I_IS_VECTOR (vect), VM_VALIDATE_VECTOR (vect, "vector-set!");
vm_error_not_a_vector ("vector-ref", vect)); VM_VALIDATE_INDEX (idx, SCM_I_VECTOR_LENGTH (vect), "vector-set!");
VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
vm_error_out_of_range_uint64 ("vector-ref", idx));
SCM_I_VECTOR_WELTS (vect)[idx] = val; SCM_I_VECTOR_WELTS (vect)[idx] = val;
NEXT (1); NEXT (1);
} }
@ -3778,8 +3774,7 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_12_12 (op, dst, src); UNPACK_12_12 (op, dst, src);
x = SP_REF (src); x = SP_REF (src);
VM_ASSERT (SCM_CHARP (x), vm_error_not_a_char ("char->integer", x)); VM_VALIDATE_CHAR (x, "char->integer");
SP_SET_U64 (dst, SCM_CHAR (x)); SP_SET_U64 (dst, SCM_CHAR (x));
NEXT (1); NEXT (1);