diff options
| author | Mark H Weaver <mhw@netris.org> | 2018-10-14 03:18:35 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2018-10-14 03:27:52 -0400 |
| commit | 011aec7e240ef987931548d90c53e6692c85d01c (patch) | |
| tree | cb22f160cb70de98d7398d479a26e58b5464cba9 /libguile | |
| parent | fe73fedab40cf716cc39139a61c078e2c9a2f37f (diff) | |
Gracefully handle huge shift counts in 'ash' and 'round-ash'.
Fixes <https://bugs.gnu.org/32644>.
Reported by Stefan Israelsson Tampe <stefan.itampe@gmail.com>.
The need for this arose because the type inferrer for 'ursh' sometimes
passes (- 1 (expt 2 64)) as the second argument to 'ash'.
* libguile/numbers.c (scm_ash, scm_round_ash): Gracefully handle several
cases where the shift count does not fit in a C 'long'.
* test-suite/tests/numbers.test: Add tests.
Diffstat (limited to 'libguile')
| -rw-r--r-- | libguile/numbers.c | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 3e035d226..afe5e558a 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995-2016 Free Software Foundation, Inc. +/* Copyright (C) 1995-2016, 2018 Free Software Foundation, Inc. * * Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories * and Bellcore. See scm_divide. @@ -5067,7 +5067,21 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, { if (SCM_I_INUMP (n) || SCM_BIGP (n)) { - long bits_to_shift = scm_to_long (count); + long bits_to_shift; + + if (SCM_I_INUMP (count)) /* fast path, not strictly needed */ + bits_to_shift = SCM_I_INUM (count); + else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX)) + bits_to_shift = scm_to_long (count); + else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n), + count)))) + /* Huge right shift that eliminates all but the sign bit */ + return scm_is_false (scm_negative_p (n)) + ? SCM_INUM0 : SCM_I_MAKINUM (-1); + else if (scm_is_true (scm_zero_p (n))) + return SCM_INUM0; + else + scm_num_overflow ("ash"); if (bits_to_shift > 0) return left_shift_exact_integer (n, bits_to_shift); @@ -5105,7 +5119,21 @@ SCM_DEFINE (scm_round_ash, "round-ash", 2, 0, 0, { if (SCM_I_INUMP (n) || SCM_BIGP (n)) { - long bits_to_shift = scm_to_long (count); + long bits_to_shift; + + if (SCM_I_INUMP (count)) /* fast path, not strictly needed */ + bits_to_shift = SCM_I_INUM (count); + else if (scm_is_signed_integer (count, LONG_MIN, LONG_MAX)) + bits_to_shift = scm_to_long (count); + else if (scm_is_false (scm_positive_p (scm_sum (scm_integer_length (n), + count)))) + /* Huge right shift that eliminates all but the sign bit */ + return scm_is_false (scm_negative_p (n)) + ? SCM_INUM0 : SCM_I_MAKINUM (-1); + else if (scm_is_true (scm_zero_p (n))) + return SCM_INUM0; + else + scm_num_overflow ("round-ash"); if (bits_to_shift > 0) return left_shift_exact_integer (n, bits_to_shift); |