-/* 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
/* Let's go! */
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 (LOCAL_REF (0))))
goto apply;
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 (LOCAL_REF (0))))
goto apply;
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 (LOCAL_REF (0))))
goto apply;
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 (LOCAL_REF (0))))
goto apply;
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 (LOCAL_REF (0))))
goto apply;
ip = SCM_PROGRAM_CODE (LOCAL_REF (0));
+
+ APPLY_HOOK ();
+
NEXT (0);
}
else
&& ((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 */
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 (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