diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 2b58da484..61fb38967 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -322,19 +322,11 @@ VM_VALIDATE (x, SCM_CHARP, proc, char) #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_INDEX(u64, size, proc) \ VM_ASSERT (u64 < size, vm_error_out_of_range_uint64 (proc, u64)) -#define VM_VALIDATE_BOXED_STRUCT_FIELD(obj, i, proc) \ - VM_ASSERT (!SCM_STRUCT_FIELD_IS_UNBOXED (obj, i), \ - vm_error_boxed_struct_field (proc, i)) -#define VM_VALIDATE_UNBOXED_STRUCT_FIELD(obj, i, proc) \ - VM_ASSERT (SCM_STRUCT_FIELD_IS_UNBOXED (obj, i), \ - vm_error_boxed_struct_field (proc, i)) /* Return true (non-zero) if PTR has suitable alignment for TYPE. */ #define ALIGNED_P(ptr, type) \ @@ -2388,6 +2380,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, VM_DEFINE_OP (103, unused_103, NULL, NOP) VM_DEFINE_OP (104, unused_104, NULL, NOP) VM_DEFINE_OP (105, unused_105, NULL, NOP) + VM_DEFINE_OP (106, unused_106, NULL, NOP) + VM_DEFINE_OP (107, unused_107, NULL, NOP) + VM_DEFINE_OP (108, unused_108, NULL, NOP) + VM_DEFINE_OP (109, unused_109, NULL, NOP) + VM_DEFINE_OP (110, unused_110, NULL, NOP) + VM_DEFINE_OP (111, unused_111, NULL, NOP) + VM_DEFINE_OP (112, unused_112, NULL, NOP) { vm_error_bad_instruction (op); abort (); /* never reached */ @@ -2396,158 +2395,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, - /* - * Structs and GOOPS - */ - - /* struct-vtable dst:12 src:12 - * - * Store the vtable of SRC into DST. - */ - VM_DEFINE_OP (106, struct_vtable, "struct-vtable", OP1 (X8_S12_S12) | OP_DST) - { - ARGS1 (obj); - VM_VALIDATE_STRUCT (obj, "struct_vtable"); - RETURN (SCM_STRUCT_VTABLE (obj)); - } - - /* allocate-struct dst:8 vtable:8 nfields:8 - * - * Allocate a new struct with VTABLE, and place it in DST. The struct - * will be constructed with space for NFIELDS fields, which should - * correspond to the field count of the VTABLE. - */ - VM_DEFINE_OP (107, allocate_struct, "allocate-struct", OP1 (X8_S8_S8_S8) | OP_DST) - { - scm_t_uint8 dst, vtable, nfields; - SCM ret; - - UNPACK_8_8_8 (op, dst, vtable, nfields); - - /* TODO: Specify nfields as untagged value when calling - allocate-struct. */ - SYNC_IP (); - ret = scm_allocate_struct (SP_REF (vtable), - scm_from_uint64 (SP_REF_U64 (nfields))); - SP_SET (dst, ret); - - NEXT (1); - } - - /* struct-ref dst:8 src:8 idx:8 - * - * Fetch the item at slot IDX in the struct in SRC, and store it - * in DST. - */ - VM_DEFINE_OP (108, struct_ref, "struct-ref", OP1 (X8_S8_S8_S8) | OP_DST) - { - scm_t_uint8 dst, src, idx; - SCM obj; - scm_t_uint64 index; - - UNPACK_8_8_8 (op, dst, src, idx); - - obj = SP_REF (src); - index = SP_REF_U64 (idx); - - VM_VALIDATE_STRUCT (obj, "struct-ref"); - VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-ref"); - VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-ref"); - - RETURN (SCM_STRUCT_SLOT_REF (obj, index)); - } - - /* struct-set! dst:8 idx:8 src:8 - * - * Store SRC into the struct DST at slot IDX. - */ - VM_DEFINE_OP (109, struct_set, "struct-set!", OP1 (X8_S8_S8_S8)) - { - scm_t_uint8 dst, idx, src; - SCM obj, val; - scm_t_uint64 index; - - UNPACK_8_8_8 (op, dst, idx, src); - - obj = SP_REF (dst); - val = SP_REF (src); - index = SP_REF_U64 (idx); - - VM_VALIDATE_STRUCT (obj, "struct-set!"); - VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-set!"); - VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-set!"); - - SCM_STRUCT_SLOT_SET (obj, index, val); - NEXT (1); - } - - /* allocate-struct/immediate dst:8 vtable:8 nfields:8 - * - * Allocate a new struct with VTABLE, and place it in DST. The struct - * will be constructed with space for NFIELDS fields, which should - * correspond to the field count of the VTABLE. - */ - VM_DEFINE_OP (110, allocate_struct_immediate, "allocate-struct/immediate", OP1 (X8_S8_S8_C8) | OP_DST) - { - scm_t_uint8 dst, vtable, nfields; - SCM ret; - - UNPACK_8_8_8 (op, dst, vtable, nfields); - - SYNC_IP (); - ret = scm_allocate_struct (SP_REF (vtable), SCM_I_MAKINUM (nfields)); - SP_SET (dst, ret); - - NEXT (1); - } - - /* struct-ref/immediate dst:8 src:8 idx:8 - * - * Fetch the item at slot IDX in the struct in SRC, and store it - * in DST. IDX is an immediate unsigned 8-bit value. - */ - VM_DEFINE_OP (111, struct_ref_immediate, "struct-ref/immediate", OP1 (X8_S8_S8_C8) | OP_DST) - { - scm_t_uint8 dst, src, idx; - SCM obj; - scm_t_uint64 index; - - UNPACK_8_8_8 (op, dst, src, idx); - - obj = SP_REF (src); - index = idx; - - VM_VALIDATE_STRUCT (obj, "struct-ref"); - VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-ref"); - VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-ref"); - - RETURN (SCM_STRUCT_SLOT_REF (obj, index)); - } - - /* struct-set!/immediate dst:8 idx:8 src:8 - * - * Store SRC into the struct DST at slot IDX. IDX is an immediate - * unsigned 8-bit value. - */ - VM_DEFINE_OP (112, struct_set_immediate, "struct-set!/immediate", OP1 (X8_S8_C8_S8)) - { - scm_t_uint8 dst, idx, src; - SCM obj, val; - scm_t_uint64 index; - - UNPACK_8_8_8 (op, dst, idx, src); - - obj = SP_REF (dst); - val = SP_REF (src); - index = idx; - - VM_VALIDATE_STRUCT (obj, "struct-set!"); - VM_VALIDATE_INDEX (index, SCM_STRUCT_SIZE (obj), "struct-set!"); - VM_VALIDATE_BOXED_STRUCT_FIELD (obj, index, "struct-set!"); - - SCM_STRUCT_SLOT_SET (obj, index, val); - NEXT (1); - } /* class-of dst:12 type:12 * @@ -4184,7 +4031,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp, #undef VM_INSTRUCTION_TO_LABEL #undef VM_USE_HOOKS #undef VM_VALIDATE_ATOMIC_BOX -#undef VM_VALIDATE_STRUCT /* (defun renumber-ops () diff --git a/libguile/vm.c b/libguile/vm.c index 472076d8a..0a20f11cf 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -438,10 +438,7 @@ static void vm_error_wrong_type_apply (SCM proc) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_char (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_string (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_atomic_box (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; -static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx) SCM_NORETURN SCM_NOINLINE; -static void vm_error_boxed_struct_field (const char *subr, scm_t_uint64 idx) SCM_NORETURN SCM_NOINLINE; -static void vm_error_unboxed_struct_field (const char *subr, scm_t_uint64 idx) SCM_NORETURN SCM_NOINLINE; static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE; static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE; @@ -566,30 +563,12 @@ vm_error_not_a_atomic_box (const char *subr, SCM x) scm_wrong_type_arg_msg (subr, 1, x, "atomic box"); } -static void -vm_error_not_a_struct (const char *subr, SCM x) -{ - scm_wrong_type_arg_msg (subr, 1, x, "struct"); -} - static void vm_error_out_of_range_uint64 (const char *subr, scm_t_uint64 idx) { scm_out_of_range (subr, scm_from_uint64 (idx)); } -static void -vm_error_boxed_struct_field (const char *subr, scm_t_uint64 idx) -{ - scm_wrong_type_arg_msg (subr, 2, scm_from_uint64 (idx), "boxed field"); -} - -static void -vm_error_unboxed_struct_field (const char *subr, scm_t_uint64 idx) -{ - scm_wrong_type_arg_msg (subr, 2, scm_from_uint64 (idx), "unboxed field"); -} - static void vm_error_no_values (void) {