summaryrefslogtreecommitdiff
path: root/libguile/vm-i-scheme.c
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-03-31 22:29:29 +0200
committerAndy Wingo <wingo@pobox.com>2010-03-31 22:29:29 +0200
commit8ecd1943ef7bbef67b83b0502da1527e3b7a7133 (patch)
treedf97cd9a8a3e12e3cf7191e04312bd0d41569f80 /libguile/vm-i-scheme.c
parente275b8a220f39b5a1ff9644ac21796a12e4d0c9a (diff)
downloadguile-8ecd1943ef7bbef67b83b0502da1527e3b7a7133.tar.gz
fix bug in ash opcode
* 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.
Diffstat (limited to 'libguile/vm-i-scheme.c')
-rw-r--r--libguile/vm-i-scheme.c19
1 files changed, 16 insertions, 3 deletions
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index ecc77bdee..df3181050 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -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 ();