diff options
Diffstat (limited to 'libguile/vm-engine.c')
-rw-r--r-- | libguile/vm-engine.c | 142 |
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; } |