diff options
author | Mark H Weaver <mhw@netris.org> | 2013-10-03 14:25:51 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-10-03 19:08:24 -0400 |
commit | d360671c1cca335600079f1c5714572d1c2e676d (patch) | |
tree | a9785d2d021691933c15018a48f9ea655ef5135a /libguile/numbers.c | |
parent | 1ea0803e9ea1d5afede0eff8175d0cba12bab49e (diff) |
Fix edge case in 'ash'.
* libguile/numbers.c (left_shift_exact_integer): Fix edge case where
N is -1 and count is SCM_I_FIXNUM_BIT-1 to return the most negative
fixnum. Previously this result was returned as a bignum.
* test-suite/tests/numbers.test (ash): Add tests.
Diffstat (limited to 'libguile/numbers.c')
-rw-r--r-- | libguile/numbers.c | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 6f3a6ec46..22b53a502 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -4978,11 +4978,14 @@ left_shift_exact_integer (SCM n, long count) { scm_t_inum nn = SCM_I_INUM (n); - /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will always + /* Left shift of count >= SCM_I_FIXNUM_BIT-1 will almost[*] always overflow a non-zero fixnum. For smaller shifts we check the bits going into positions above SCM_I_FIXNUM_BIT-1. If they're all 0s for nn>=0, or all 1s for nn<0 then there's no overflow. - Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)". */ + Those bits are "nn >> (SCM_I_FIXNUM_BIT-1 - count)". + + [*] There's one exception: + (-1) << SCM_I_FIXNUM_BIT-1 == SCM_MOST_NEGATIVE_FIXNUM */ if (nn == 0) return n; @@ -4995,7 +4998,7 @@ left_shift_exact_integer (SCM n, long count) SCM result = scm_i_inum2big (nn); mpz_mul_2exp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result), count); - return result; + return scm_i_normbig (result); } } else if (SCM_BIGP (n)) |