-/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013,
+ * 2014, 2015 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
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset < 0) \
+ if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (0);
apply:
- while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
+ while (!SCM_PROGRAM_P (LOCAL_REF (0)))
{
- SCM proc = SCM_FRAME_PROGRAM (fp);
+ SCM proc = LOCAL_REF (0);
if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
{
}
/* Let's go! */
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
BEGIN_DISPATCH_SWITCH;
VM_HANDLE_INTERRUPTS;
+ PUSH_CONTINUATION_HOOK ();
+
old_fp = fp;
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
RESET_FRAME (nlocals);
- PUSH_CONTINUATION_HOOK ();
- APPLY_HOOK ();
-
- if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
goto apply;
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
VM_HANDLE_INTERRUPTS;
+ PUSH_CONTINUATION_HOOK ();
+
old_fp = fp;
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
RESET_FRAME (nlocals);
- PUSH_CONTINUATION_HOOK ();
+ ip += label;
+
APPLY_HOOK ();
- NEXT (label);
+ NEXT (0);
}
/* tail-call nlocals:24
RESET_FRAME (nlocals);
- APPLY_HOOK ();
-
- if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
goto apply;
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
RESET_FRAME (nlocals);
+ ip += label;
+
APPLY_HOOK ();
- NEXT (label);
+ NEXT (0);
}
/* tail-call/shuffle from:24
RESET_FRAME (n + 1);
- APPLY_HOOK ();
-
- if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
goto apply;
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
for (i = 0; i < list_len; i++, list = SCM_CDR (list))
LOCAL_SET (list_idx - 1 + i, SCM_CAR (list));
- APPLY_HOOK ();
-
- if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
goto apply;
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
LOCAL_SET (1, cont);
RESET_FRAME (2);
- APPLY_HOOK ();
-
- if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (LOCAL_REF (0))))
goto apply;
- ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
else
scm_t_uint32 expected;
UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
- vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
+ vm_error_wrong_num_args (LOCAL_REF (0)));
NEXT (1);
}
VM_DEFINE_OP (22, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
scm_t_uint32 expected;
UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () >= expected,
- vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
+ vm_error_wrong_num_args (LOCAL_REF (0)));
NEXT (1);
}
VM_DEFINE_OP (23, assert_nargs_le, "assert-nargs-le", OP1 (U8_U24))
scm_t_uint32 expected;
UNPACK_24 (op, expected);
VM_ASSERT (FRAME_LOCALS_COUNT () <= expected,
- vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
+ vm_error_wrong_num_args (LOCAL_REF (0)));
NEXT (1);
}
scm_t_uint16 expected, nlocals;
UNPACK_12_12 (op, expected, nlocals);
VM_ASSERT (FRAME_LOCALS_COUNT () == expected,
- vm_error_wrong_num_args (SCM_FRAME_PROGRAM (fp)));
+ vm_error_wrong_num_args (LOCAL_REF (0)));
ALLOC_FRAME (expected + nlocals);
while (nlocals--)
LOCAL_SET (expected + nlocals, SCM_UNDEFINED);
LOCAL_SET (n++, SCM_UNDEFINED);
VM_ASSERT (has_rest || (nkw % 2) == 0,
- vm_error_kwargs_length_not_even (SCM_FRAME_PROGRAM (fp)));
+ vm_error_kwargs_length_not_even (LOCAL_REF (0)));
/* Now bind keywords, in the order given. */
for (n = 0; n < nkw; n++)
break;
}
VM_ASSERT (scm_is_pair (walk) || allow_other_keys,
- vm_error_kwargs_unrecognized_keyword (SCM_FRAME_PROGRAM (fp),
+ vm_error_kwargs_unrecognized_keyword (LOCAL_REF (0),
LOCAL_REF (ntotal + n)));
n++;
}
else
- VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (SCM_FRAME_PROGRAM (fp),
+ VM_ASSERT (has_rest, vm_error_kwargs_invalid_keyword (LOCAL_REF (0),
LOCAL_REF (ntotal + n)));
if (has_rest)
{
scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */
+ if (offset <= 0)
+ VM_HANDLE_INTERRUPTS;
NEXT (offset);
}
var = LOCAL_REF (src);
VM_ASSERT (SCM_VARIABLEP (var),
vm_error_not_a_variable ("variable-ref", var));
- VM_ASSERT (VARIABLE_BOUNDP (var),
- vm_error_unbound (SCM_FRAME_PROGRAM (fp), var));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (var));
LOCAL_SET (dst, VARIABLE_REF (var));
NEXT (1);
}
* Make an immediate whose low bits are LOW-BITS, and whose top bits are
* 0.
*/
- VM_DEFINE_OP (53, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32))
+ VM_DEFINE_OP (53, make_long_immediate, "make-long-immediate", OP2 (U8_U24, I32) | OP_DST)
{
scm_t_uint32 dst;
scm_t_bits val;
* that the compiler is unable to statically allocate, like symbols.
* These values would be initialized when the object file loads.
*/
- VM_DEFINE_OP (56, static_ref, "static-ref", OP2 (U8_U24, S32))
+ VM_DEFINE_OP (56, static_ref, "static-ref", OP2 (U8_U24, S32) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 offset;
var = scm_lookup (LOCAL_REF (sym));
CACHE_FP ();
if (ip[1] & 0x1)
- VM_ASSERT (VARIABLE_BOUNDP (var),
- vm_error_unbound (fp[0], LOCAL_REF (sym)));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (LOCAL_REF (sym)));
LOCAL_SET (dst, var);
NEXT (2);
var = scm_module_lookup (mod, sym);
CACHE_FP ();
if (ip[4] & 0x1)
- VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
*var_loc = var;
}
CACHE_FP ();
if (ip[4] & 0x1)
- VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (fp[0], sym));
+ VM_ASSERT (VARIABLE_BOUNDP (var), vm_error_unbound (sym));
*var_loc = var;
}
if (scm_is_eq (val, SCM_UNDEFINED))
val = SCM_I_FLUID_DEFAULT (fluid);
VM_ASSERT (!scm_is_eq (val, SCM_UNDEFINED),
- vm_error_unbound_fluid (SCM_FRAME_PROGRAM (fp), fluid));
+ vm_error_unbound_fluid (fluid));
LOCAL_SET (dst, val);
}
&& ((scm_t_bits)
(SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
<= 1))
- RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
+ RETURN (SCM_I_MAKINUM (nn < 0
+ ? -(-nn << bits_to_shift)
+ : (nn << bits_to_shift)));
/* fall through */
}
/* fall through */
RETURN_EXP (scm_logxor (x, y));
}
+ /* make-vector dst:8 length:8 init:8
+ *
+ * Make a vector and write it to DST. The vector will have space for
+ * LENGTH slots. They will be filled with the value in slot INIT.
+ */
+ VM_DEFINE_OP (94, make_vector, "make-vector", OP1 (U8_U8_U8_U8) | OP_DST)
+ {
+ scm_t_uint8 dst, init, length;
+
+ UNPACK_8_8_8 (op, dst, length, init);
+
+ LOCAL_SET (dst, scm_make_vector (LOCAL_REF (length), LOCAL_REF (init)));
+
+ NEXT (1);
+ }
+
/* make-vector/immediate dst:8 length:8 init:8
*
* Make a short vector of known size and write it to DST. The vector
* will have space for LENGTH slots, an immediate value. They will be
* filled with the value in slot INIT.
*/
- VM_DEFINE_OP (94, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (95, make_vector_immediate, "make-vector/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, init;
scm_t_int32 length, n;
*
* Store the length of the vector in SRC in DST.
*/
- VM_DEFINE_OP (95, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (96, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (vect);
VM_ASSERT (SCM_I_IS_VECTOR (vect),
* Fetch the item at position IDX in the vector in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (96, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (97, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (vect, idx);
* Fill DST with the item IDX elements into the vector at SRC. Useful
* for building data types using vectors.
*/
- VM_DEFINE_OP (97, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (98, vector_ref_immediate, "vector-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM v;
*
* Store SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (98, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (99, vector_set, "vector-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx_var, src;
SCM vect, idx, val;
* Store SRC into the vector DST at index IDX. Here IDX is an
* immediate value.
*/
- VM_DEFINE_OP (99, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (100, vector_set_immediate, "vector-set!/immediate", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM vect, val;
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (100, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (101, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
VM_VALIDATE_STRUCT (obj, "struct_vtable");
* will be constructed with space for NFIELDS fields, which should
* correspond to the field count of the VTABLE.
*/
- VM_DEFINE_OP (101, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (102, allocate_struct_immediate, "allocate-struct/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, vtable, nfields;
SCM ret;
* 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 (102, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (103, struct_ref_immediate, "struct-ref/immediate", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM obj;
* Store SRC into the struct DST at slot IDX. IDX is an immediate
* unsigned 8-bit value.
*/
- VM_DEFINE_OP (103, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (104, struct_set_immediate, "struct-set!/immediate", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM obj, val;
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (104, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (105, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
if (SCM_INSTANCEP (obj))
* from the instruction pointer, and store into DST. LEN is a byte
* length. OFFSET is signed.
*/
- VM_DEFINE_OP (105, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
+ VM_DEFINE_OP (106, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8, N32, U32) | OP_DST)
{
scm_t_uint8 dst, type, shape;
scm_t_int32 offset;
NEXT (3);
}
- /* make-array dst:12 type:12 _:8 fill:12 bounds:12
+ /* make-array dst:8 type:8 fill:8 _:8 bounds:24
*
* Make a new array with TYPE, FILL, and BOUNDS, storing it in DST.
*/
- VM_DEFINE_OP (106, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (107, make_array, "make-array", OP2 (U8_U8_U8_U8, X8_U24) | OP_DST)
{
- scm_t_uint16 dst, type, fill, bounds;
- UNPACK_12_12 (op, dst, type);
- UNPACK_12_12 (ip[1], fill, bounds);
+ scm_t_uint8 dst, type, fill, bounds;
+ UNPACK_8_8_8 (op, dst, type, fill);
+ UNPACK_24 (ip[1], bounds);
SYNC_IP ();
LOCAL_SET (dst, scm_make_typed_array (LOCAL_REF (type), LOCAL_REF (fill),
LOCAL_REF (bounds)));
RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
} while (0)
- VM_DEFINE_OP (107, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (108, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
- VM_DEFINE_OP (108, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (109, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s8, s8, int8, 1);
- VM_DEFINE_OP (109, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (110, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
- VM_DEFINE_OP (110, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (111, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
- VM_DEFINE_OP (111, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (112, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
#else
BV_INT_REF (u32, uint32, 4);
#endif
- VM_DEFINE_OP (112, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (113, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
#else
BV_INT_REF (s32, int32, 4);
#endif
- VM_DEFINE_OP (113, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (114, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (u64, uint64, 8);
- VM_DEFINE_OP (114, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (115, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (s64, int64, 8);
- VM_DEFINE_OP (115, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (116, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f32, ieee_single, float, 4);
- VM_DEFINE_OP (116, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (117, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f64, ieee_double, double, 8);
/* bv-u8-set! dst:8 idx:8 src:8
NEXT (1); \
} while (0)
- VM_DEFINE_OP (117, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (118, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
- VM_DEFINE_OP (118, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (119, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
- VM_DEFINE_OP (119, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (120, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
- VM_DEFINE_OP (120, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (121, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN, SCM_T_INT16_MAX, 2);
- VM_DEFINE_OP (121, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (122, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
#else
BV_INT_SET (u32, uint32, 4);
#endif
- VM_DEFINE_OP (122, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (123, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN, SCM_T_INT32_MAX, 4);
#else
BV_INT_SET (s32, int32, 4);
#endif
- VM_DEFINE_OP (123, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (124, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (u64, uint64, 8);
- VM_DEFINE_OP (124, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (125, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (s64, int64, 8);
- VM_DEFINE_OP (125, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (126, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f32, ieee_single, float, 4);
- VM_DEFINE_OP (126, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (127, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f64, ieee_double, double, 8);
- VM_DEFINE_OP (127, unused_127, NULL, NOP)
- VM_DEFINE_OP (128, unused_128, NULL, NOP)
- VM_DEFINE_OP (129, unused_129, NULL, NOP)
- VM_DEFINE_OP (130, unused_130, NULL, NOP)
- VM_DEFINE_OP (131, unused_131, NULL, NOP)
+ /* br-if-logtest a:12 b:12 invert:1 _:7 offset:24
+ *
+ * If the exact integer in A has any bits in common with the exact
+ * integer in B, add OFFSET, a signed 24-bit number, to the current
+ * instruction pointer.
+ */
+ VM_DEFINE_OP (128, br_if_logtest, "br-if-logtest", OP2 (U8_U12_U12, B1_X7_L24))
+ {
+ BR_BINARY (x, y,
+ ((SCM_I_INUMP (x) && SCM_I_INUMP (y))
+ ? (SCM_UNPACK (x) & SCM_UNPACK (y) & ~scm_tc2_int)
+ : scm_is_true (scm_logtest (x, y))));
+ }
+
+ /* FIXME: Move above */
+
+ /* 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 (129, allocate_struct, "allocate-struct", OP1 (U8_U8_U8_U8) | OP_DST)
+ {
+ scm_t_uint8 dst, vtable, nfields;
+ SCM ret;
+
+ UNPACK_8_8_8 (op, dst, vtable, nfields);
+
+ SYNC_IP ();
+ ret = scm_allocate_struct (LOCAL_REF (vtable), LOCAL_REF (nfields));
+ LOCAL_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 (130, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ {
+ scm_t_uint8 dst, src, idx;
+ SCM obj;
+ SCM index;
+
+ UNPACK_8_8_8 (op, dst, src, idx);
+
+ obj = LOCAL_REF (src);
+ index = LOCAL_REF (idx);
+
+ if (SCM_LIKELY (SCM_STRUCTP (obj)
+ && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
+ SCM_VTABLE_FLAG_SIMPLE)
+ && SCM_I_INUMP (index)
+ && SCM_I_INUM (index) >= 0
+ && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF
+ (SCM_STRUCT_VTABLE (obj),
+ scm_vtable_index_size))))
+ RETURN (SCM_STRUCT_SLOT_REF (obj, SCM_I_INUM (index)));
+
+ SYNC_IP ();
+ RETURN (scm_struct_ref (obj, index));
+ }
+
+ /* struct-set! dst:8 idx:8 src:8
+ *
+ * Store SRC into the struct DST at slot IDX.
+ */
+ VM_DEFINE_OP (131, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
+ {
+ scm_t_uint8 dst, idx, src;
+ SCM obj, val, index;
+
+ UNPACK_8_8_8 (op, dst, idx, src);
+
+ obj = LOCAL_REF (dst);
+ val = LOCAL_REF (src);
+ index = LOCAL_REF (idx);
+
+ if (SCM_LIKELY (SCM_STRUCTP (obj)
+ && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
+ SCM_VTABLE_FLAG_SIMPLE)
+ && SCM_STRUCT_VTABLE_FLAG_IS_SET (obj,
+ SCM_VTABLE_FLAG_SIMPLE_RW)
+ && SCM_I_INUMP (index)
+ && SCM_I_INUM (index) >= 0
+ && SCM_I_INUM (index) < (SCM_STRUCT_DATA_REF
+ (SCM_STRUCT_VTABLE (obj),
+ scm_vtable_index_size))))
+ {
+ SCM_STRUCT_SLOT_SET (obj, SCM_I_INUM (index), val);
+ NEXT (1);
+ }
+
+ SYNC_IP ();
+ scm_struct_set_x (obj, index, val);
+ NEXT (1);
+ }
+
VM_DEFINE_OP (132, unused_132, NULL, NOP)
VM_DEFINE_OP (133, unused_133, NULL, NOP)
VM_DEFINE_OP (134, unused_134, NULL, NOP)
HCoop / bpt / guile.git / blobdiff