-/* 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
/* Virtual Machine
- This is Guile's new virtual machine. When I say "new", I mean
- relative to the current virtual machine. At some point it will
- become "the" virtual machine, and we'll delete this paragraph. As
- such, the rest of the comments speak as if there's only one VM.
- In difference from the old VM, local 0 is the procedure, and the
- first argument is local 1. At some point in the future we should
- change the fp to point to the procedure and not to local 1.
-
- <more overview here>
- */
-
-
-/* The VM has three state bits: the instruction pointer (IP), the frame
+ The VM has three state bits: the instruction pointer (IP), the frame
pointer (FP), and the top-of-stack pointer (SP). We cache the first
two of these in machine registers, local to the VM, because they are
used extensively by the VM. As the SP is used more by code outside
} while (0)
-
-/* After advancing vp->sp, but before writing any stack slots, check
- that it is actually in bounds. If it is not in bounds, currently we
- signal an error. In the future we may expand the stack instead,
- possibly by moving it elsewhere, therefore no pointer into the stack
- besides FP is valid across a CHECK_OVERFLOW call. Be careful! */
-#define CHECK_OVERFLOW() \
- do { \
- if (SCM_UNLIKELY (vp->sp >= vp->stack_limit)) \
- { \
- SYNC_IP (); \
- vm_expand_stack (vp); \
- CACHE_FP (); \
- } \
- } while (0)
-
/* Reserve stack space for a frame. Will check that there is sufficient
stack space for N locals, including the procedure. Invoke after
- preparing the new frame and setting the fp and ip. */
+ preparing the new frame and setting the fp and ip.
+
+ If there is not enough space for this frame, we try to expand the
+ stack, possibly relocating it somewhere else in the address space.
+ Because of the possible relocation, no pointer into the stack besides
+ FP is valid across an ALLOC_FRAME call. Be careful! */
#define ALLOC_FRAME(n) \
do { \
- vp->sp = LOCAL_ADDRESS (n - 1); \
- if (vp->sp > vp->sp_max_since_gc) \
+ SCM *new_sp = LOCAL_ADDRESS (n - 1); \
+ if (new_sp > vp->sp_max_since_gc) \
{ \
- vp->sp_max_since_gc = vp->sp; \
- CHECK_OVERFLOW (); \
+ if (SCM_UNLIKELY (new_sp >= vp->stack_limit)) \
+ { \
+ SYNC_IP (); \
+ vm_expand_stack (vp, new_sp); \
+ CACHE_FP (); \
+ } \
+ else \
+ vp->sp_max_since_gc = vp->sp = new_sp; \
} \
+ else \
+ vp->sp = new_sp; \
} while (0)
/* Reset the current frame to hold N locals. Used when we know that no
{ \
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;
}
if (!scm_module_system_booted_p)
{
-#ifdef VM_ENABLE_PARANOID_ASSERTIONS
- ASSERT
- (scm_is_true
- scm_equal_p (modname,
- scm_list_2 (SCM_BOOL_T,
- scm_from_utf8_symbol ("guile"))));
-#endif
+ ASSERT (scm_is_true
+ scm_equal_p (modname,
+ scm_list_2
+ (SCM_BOOL_T,
+ scm_from_utf8_symbol ("guile"))));
var = scm_lookup (sym);
}
else if (scm_is_true (SCM_CAR (modname)))
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);
- if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
- RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
- else
- {
- SYNC_IP ();
- RETURN (scm_vector_length (vect));
- }
+ VM_ASSERT (SCM_I_IS_VECTOR (vect),
+ vm_error_not_a_vector ("vector-ref", vect));
+ RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
}
/* vector-ref dst:8 src:8 idx:8
* 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);
- if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
- && SCM_I_INUMP (idx)
- && ((i = SCM_I_INUM (idx)) >= 0)
- && i < SCM_I_VECTOR_LENGTH (vect)))
- RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
- else
- {
- SYNC_IP ();
- RETURN (scm_vector_ref (vect, idx));
- }
+ VM_ASSERT (SCM_I_IS_VECTOR (vect),
+ vm_error_not_a_vector ("vector-ref", vect));
+ VM_ASSERT ((SCM_I_INUMP (idx)
+ && ((i = SCM_I_INUM (idx)) >= 0)
+ && i < SCM_I_VECTOR_LENGTH (vect)),
+ vm_error_out_of_range ("vector-ref", idx));
+ RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
}
/* vector-ref/immediate dst:8 src:8 idx:8
* 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;
UNPACK_8_8_8 (op, dst, src, idx);
v = LOCAL_REF (src);
- if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v)
- && idx < SCM_I_VECTOR_LENGTH (v)))
- LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
- else
- LOCAL_SET (dst, scm_c_vector_ref (v, idx));
+ VM_ASSERT (SCM_I_IS_VECTOR (v),
+ vm_error_not_a_vector ("vector-ref", v));
+ VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
+ vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+ LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
NEXT (1);
}
*
* 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;
idx = LOCAL_REF (idx_var);
val = LOCAL_REF (src);
- if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
- && SCM_I_INUMP (idx)
- && ((i = SCM_I_INUM (idx)) >= 0)
- && i < SCM_I_VECTOR_LENGTH (vect)))
- SCM_I_VECTOR_WELTS (vect)[i] = val;
- else
- {
- SYNC_IP ();
- scm_vector_set_x (vect, idx, val);
- }
+ VM_ASSERT (SCM_I_IS_VECTOR (vect),
+ vm_error_not_a_vector ("vector-ref", vect));
+ VM_ASSERT ((SCM_I_INUMP (idx)
+ && ((i = SCM_I_INUM (idx)) >= 0)
+ && i < SCM_I_VECTOR_LENGTH (vect)),
+ vm_error_out_of_range ("vector-ref", idx));
+ SCM_I_VECTOR_WELTS (vect)[i] = val;
NEXT (1);
}
* 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;
vect = LOCAL_REF (dst);
val = LOCAL_REF (src);
- if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect)
- && idx < SCM_I_VECTOR_LENGTH (vect)))
- SCM_I_VECTOR_WELTS (vect)[idx] = val;
- else
- {
- SYNC_IP ();
- scm_vector_set_x (vect, scm_from_uint8 (idx), val);
- }
+ VM_ASSERT (SCM_I_IS_VECTOR (vect),
+ vm_error_not_a_vector ("vector-ref", vect));
+ VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
+ vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
+ SCM_I_VECTOR_WELTS (vect)[idx] = val;
NEXT (1);
}
*
* 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)
#undef BV_INT_REF
#undef BV_INT_SET
#undef CACHE_REGISTER
-#undef CHECK_OVERFLOW
#undef END_DISPATCH_SWITCH
#undef FREE_VARIABLE_REF
#undef INIT
HCoop / bpt / guile.git / blobdiff