summaryrefslogtreecommitdiff
path: root/libguile/vm-engine.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r--libguile/vm-engine.c142
1 files changed, 138 insertions, 4 deletions
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index ffbe5c1ae..7c0a226b3 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -4024,15 +4024,149 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (249, unused_249, NULL, NOP)
VM_DEFINE_OP (250, unused_250, NULL, NOP)
VM_DEFINE_OP (251, unused_251, NULL, NOP)
- VM_DEFINE_OP (252, unused_252, NULL, NOP)
- VM_DEFINE_OP (253, unused_253, NULL, NOP)
- VM_DEFINE_OP (254, unused_254, NULL, NOP)
- VM_DEFINE_OP (255, unused_255, NULL, NOP)
{
vm_error_bad_instruction (op);
abort (); /* never reached */
}
+ /* Temporary instructions down here, while we incrementally proceed
+ with instruction explosion. */
+
+ /* lsh dst:8 a:8 b:8
+ *
+ * Shift A left by B bits, and place the result in DST. B is a U64
+ * value.
+ */
+ VM_DEFINE_OP (252, lsh, "lsh", OP1 (X8_S8_S8_S8) | OP_DST)
+ {
+ scm_t_uint8 dst, x, y;
+ SCM a, result;
+ scm_t_uint64 b;
+
+ UNPACK_8_8_8 (op, dst, x, y);
+ a = SP_REF (x);
+ b = SP_REF_U64 (y);
+
+ if (SCM_LIKELY (SCM_I_INUMP (a))
+ && b < (scm_t_uint64) (SCM_I_FIXNUM_BIT - 1)
+ && ((scm_t_bits)
+ (SCM_SRS (SCM_I_INUM (a), (SCM_I_FIXNUM_BIT-1 - b)) + 1)
+ <= 1))
+ {
+ scm_t_signed_bits nn = SCM_I_INUM (a);
+ result = SCM_I_MAKINUM (nn < 0 ? -(-nn << b) : (nn << b));
+ }
+ else
+ {
+ SYNC_IP ();
+ /* B has to be a bignum. FIXME: use instruction explosion to
+ ensure that. */
+ result = scm_ash (a, scm_from_uint64 (b));
+ CACHE_SP ();
+ }
+ SP_SET (dst, result);
+ NEXT (1);
+ }
+ /* rsh dst:8 a:8 b:8
+ *
+ * Shift A right by B bits, and place the result in DST. B is a U64
+ * value.
+ */
+ VM_DEFINE_OP (253, rsh, "rsh", OP1 (X8_S8_S8_S8) | OP_DST)
+ {
+ scm_t_uint8 dst, x, y;
+ SCM a, result;
+ scm_t_uint64 b;
+
+ UNPACK_8_8_8 (op, dst, x, y);
+ a = SP_REF (x);
+ b = SP_REF_U64 (y);
+
+ if (SCM_LIKELY (SCM_I_INUMP (a)))
+ {
+ if (b > (scm_t_uint64) (SCM_I_FIXNUM_BIT - 1))
+ b = SCM_I_FIXNUM_BIT - 1;
+ result = SCM_I_MAKINUM (SCM_SRS (SCM_I_INUM (a), b));
+ }
+ else
+ {
+ SYNC_IP ();
+ /* B has to be a bignum. FIXME: use instruction explosion to
+ ensure that. */
+ result = scm_ash (a, scm_difference (SCM_INUM0, scm_from_uint64 (b)));
+ CACHE_SP ();
+ }
+ SP_SET (dst, result);
+ NEXT (1);
+ }
+ /* lsh/immediate dst:8 a:8 b:8
+ *
+ * Shift A left by B bits, and place the result in DST. B is an
+ * immediate unsigned integer.
+ */
+ VM_DEFINE_OP (254, lsh_immediate, "lsh/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+ {
+ scm_t_uint8 dst, x, y;
+ SCM a, result;
+ unsigned int b;
+
+ UNPACK_8_8_8 (op, dst, x, y);
+ a = SP_REF (x);
+ b = y;
+
+ if (SCM_LIKELY (SCM_I_INUMP (a))
+ && b < (unsigned int) (SCM_I_FIXNUM_BIT - 1)
+ && ((scm_t_bits)
+ (SCM_SRS (SCM_I_INUM (a), (SCM_I_FIXNUM_BIT-1 - b)) + 1)
+ <= 1))
+ {
+ scm_t_signed_bits nn = SCM_I_INUM (a);
+ result = SCM_I_MAKINUM (nn < 0 ? -(-nn << b) : (nn << b));
+ }
+ else
+ {
+ SYNC_IP ();
+ /* B has to be a bignum. FIXME: use instruction explosion to
+ ensure that. */
+ result = scm_ash (a, SCM_I_MAKINUM (b));
+ CACHE_SP ();
+ }
+ SP_SET (dst, result);
+ NEXT (1);
+ }
+ /* rsh dst:8 a:8 b:8
+ *
+ * Shift A right by B bits, and place the result in DST. B is an
+ * immediate unsigned integer.
+ */
+ VM_DEFINE_OP (255, rsh_immediate, "rsh/immediate", OP1 (X8_S8_S8_C8) | OP_DST)
+ {
+ scm_t_uint8 dst, x, y;
+ SCM a, result;
+ int b;
+
+ UNPACK_8_8_8 (op, dst, x, y);
+ a = SP_REF (x);
+ b = y;
+
+ if (SCM_LIKELY (SCM_I_INUMP (a)))
+ {
+ if (b > (int) (SCM_I_FIXNUM_BIT - 1))
+ b = SCM_I_FIXNUM_BIT - 1;
+ result = SCM_I_MAKINUM (SCM_SRS (SCM_I_INUM (a), b));
+ }
+ else
+ {
+ SYNC_IP ();
+ /* B has to be a bignum. FIXME: use instruction explosion to
+ ensure that. */
+ result = scm_ash (a, SCM_I_MAKINUM (-b));
+ CACHE_SP ();
+ }
+ SP_SET (dst, result);
+ NEXT (1);
+ }
+
END_DISPATCH_SWITCH;
}