mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-09 15:10:29 +02:00
Code Activity

Add lsh, rsh instructions

Browse source 
* libguile/vm-engine.c (lsh, rsh, lsh/immediate, rsh/immediate): New
  instructions taking unboxed bit counts.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/effects-analysis.scm:
* module/language/cps/specialize-numbers.scm (specialize-f64-unop):
  (specialize-u64-unop): Add ability to specialize add/immediate, etc,
  and add lsh/immediate as well.
  (specialize-u64-binop, specialize-u64-shift): Move rsh/lsh
  specialization to its own procedure, given that the bit count is
  already unboxed.
  (specialize-operations): Adapt to support more /immediate
  instructions.
* module/language/cps/type-fold.scm (mul): Reify an lsh/immediate
  instead of an ash.
* module/language/cps/types.scm (compute-ash-range): Add type inferrers
  for lsh, rsh, and their immediate variants.
* module/system/vm/assembler.scm: Export emit-lsh and so on.
* module/language/tree-il/compile-cps.scm (convert): Convert "ash" on
  immediates to rsh/immediate or lsh/immediate.
This commit is contained in:
Andy Wingo 2017-11-05 10:46:13 +01:00
parent dea84a46b4
commit 17bd5a8938
8 changed files with 304 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

142
libguile/vm-engine.c
View file

@ -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;
}