mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

Gracefully handle huge shift counts in 'ash' and 'round-ash'.

Browse source 
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.
This commit is contained in:
Mark H Weaver 2018-10-14 03:18:35 -04:00
parent fe73fedab4
commit 011aec7e24
2 changed files with 53 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

34
libguile/numbers.c
View file

@ -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);