diff options
-rw-r--r-- | libguile/vm-i-scheme.c | 19 | ||||
-rw-r--r-- | test-suite/tests/bit-operations.test | 6 |
2 files changed, 21 insertions, 4 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 (); diff --git a/test-suite/tests/bit-operations.test b/test-suite/tests/bit-operations.test index 0e9df7d09..e7da5712a 100644 --- a/test-suite/tests/bit-operations.test +++ b/test-suite/tests/bit-operations.test @@ -1,5 +1,5 @@ ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*- -;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -362,3 +362,7 @@ (+ fixnum-bit fixnum-bit 1) (- (ash 1 (+ fixnum-bit 1)) 1)) (list (- fixnum-min 1) (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 2) (- (ash 1 (+ fixnum-bit 1)) 1)))))) + +(with-test-prefix "bitshifts on word boundaries" + (pass-if (= (ash 1 32) 4294967296)) + (pass-if (= (ash 1 64) 18446744073709551616))) |