mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-19 18:20:22 +02:00
Code Activity

fix bug in ash opcode

Browse source 
* libguile/vm-i-scheme.c (ash): Fix embarrassing bug in (ash 1 32).
* test-suite/tests/bit-operations.test ("bitshifts on word boundaries"):
  Add tests.
This commit is contained in:
Andy Wingo 2010-03-31 22:29:29 +02:00
parent e275b8a220
commit 8ecd1943ef
2 changed files with 21 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/vm-i-scheme.c
View file

@ -287,10 +287,23 @@ VM_DEFINE_FUNCTION (157, ash, "ash", 2)
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
{
if (SCM_I_INUM (y) < 0)
/* Right shift, will be a fixnum. */
RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y)));
else if ((SCM_I_INUM (x) << SCM_I_INUM (y)) >> SCM_I_INUM (y)
== SCM_I_INUM (x))
RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) << SCM_I_INUM (y)));
else
/* Left shift. See comments in scm_ash. */
{
long nn, bits_to_shift;
nn = SCM_I_INUM (x);
bits_to_shift = SCM_I_INUM (y);
if (bits_to_shift < SCM_I_FIXNUM_BIT-1
&& ((unsigned long)
(SCM_SRS (nn, (SCM_I_FIXNUM_BIT-1 - bits_to_shift)) + 1)
<= 1))
RETURN (SCM_I_MAKINUM (nn << bits_to_shift));
/* fall through */
}
/* fall through */
}
SYNC_REGISTER ();