This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [gfortran] Fix PR 17568: Shortcomings in ISHFT constant folder
- From: Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>
- To: GCC Fortran mailing list <fortran at gcc dot gnu dot org>
- Cc: patch <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 02 Oct 2004 21:40:53 +0200
- Subject: Re: [gfortran] Fix PR 17568: Shortcomings in ISHFT constant folder
- References: <415F024E.9040602@physik.uni-muenchen.de>
Tobias Schlüter wrote:
> Patch attached, ChangeLog below.
This statement is correct for this mail. Not the previous one.
- Tobi
> 2004-10-02 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
>
> PR fortran/17568
> * simplify.c (twos_complement): New function.
> (gfc_simplify_ishft, gfc_simplify_ishftc): Revise.
>
Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.11
diff -c -3 -p -r1.11 simplify.c
*** simplify.c 20 Sep 2004 17:22:50 -0000 1.11
--- simplify.c 2 Oct 2004 19:25:42 -0000
*************** gfc_simplify_ior (gfc_expr * x, gfc_expr
*** 1586,1597 ****
}
gfc_expr *
gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
{
gfc_expr *result;
! int shift, ashift, isize, k;
! long e_int;
if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
return NULL;
--- 1586,1623 ----
}
+ /* Checks if X, which is assumed to represent a two's complement
+ integer of binary width BITSIZE, has the signbit set. If so, makes
+ X the corresponding negative number. */
+
+ static void
+ twos_complement (mpz_t x, int bitsize)
+ {
+ mpz_t mask;
+ unsigned long mask_i;
+
+ if (mpz_tstbit (x, bitsize - 1) == 1)
+ {
+ mask_i = (bitsize == sizeof(long) * 8) ? ~0 : (1 << bitsize) - 1;
+ mpz_init_set_ui (mask, mask_i);
+
+ /* We negate the number by hand, zeroing the high bits, and then
+ have it negated by GMP. */
+ mpz_com (x, x);
+ mpz_add_ui (x, x, 1);
+ mpz_and (x, x, mask);
+
+ mpz_neg (x, x);
+
+ mpz_clear (mask);
+ }
+ }
+
gfc_expr *
gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
{
gfc_expr *result;
! int shift, ashift, isize, k, *bits, i;
if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
return NULL;
*************** gfc_simplify_ishft (gfc_expr * e, gfc_ex
*** 1619,1628 ****
return &gfc_bad_expr;
}
- e_int = mpz_get_si (e->value.integer);
- if (e_int > INT_MAX || e_int < INT_MIN)
- gfc_internal_error ("ISHFT: unable to extract integer");
-
result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
if (shift == 0)
--- 1645,1650 ----
*************** gfc_simplify_ishft (gfc_expr * e, gfc_ex
*** 1630,1642 ****
mpz_set (result->value.integer, e->value.integer);
return range_check (result, "ISHFT");
}
if (shift > 0)
! mpz_set_si (result->value.integer, e_int << shift);
else
! mpz_set_si (result->value.integer, e_int >> ashift);
! return range_check (result, "ISHFT");
}
--- 1652,1694 ----
mpz_set (result->value.integer, e->value.integer);
return range_check (result, "ISHFT");
}
+
+ bits = gfc_getmem (isize * sizeof (int));
+
+ for (i = 0; i < isize; i++)
+ bits[i] = mpz_tstbit (e->value.integer, i);
if (shift > 0)
! {
! for (i = 0; i < shift; i++)
! mpz_clrbit (result->value.integer, i);
!
! for (i = 0; i < isize - shift; i++)
! {
! if (bits[i] == 0)
! mpz_clrbit (result->value.integer, i + shift);
! else
! mpz_setbit (result->value.integer, i + shift);
! }
! }
else
! {
! for (i = isize - 1; i >= isize - ashift; i--)
! mpz_clrbit (result->value.integer, i);
!
! for (i = isize - 1; i >= ashift; i--)
! {
! if (bits[i] == 0)
! mpz_clrbit (result->value.integer, i - ashift);
! else
! mpz_setbit (result->value.integer, i - ashift);
! }
! }
!
! twos_complement (result->value.integer, isize);
! gfc_free (bits);
! return result;
}
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1684,1689 ****
--- 1736,1747 ----
result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
+ if (shift == 0)
+ {
+ mpz_set (result->value.integer, e->value.integer);
+ return result;
+ }
+
bits = gfc_getmem (isize * sizeof (int));
for (i = 0; i < isize; i++)
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1691,1710 ****
delta = isize - ashift;
! if (shift == 0)
! {
! mpz_set (result->value.integer, e->value.integer);
! gfc_free (bits);
! return range_check (result, "ISHFTC");
! }
!
! else if (shift > 0)
{
for (i = 0; i < delta; i++)
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + shift);
! if (bits[i] == 1)
mpz_setbit (result->value.integer, i + shift);
}
--- 1749,1761 ----
delta = isize - ashift;
! if (shift > 0)
{
for (i = 0; i < delta; i++)
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + shift);
! else
mpz_setbit (result->value.integer, i + shift);
}
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1712,1723 ****
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i - delta);
! if (bits[i] == 1)
mpz_setbit (result->value.integer, i - delta);
}
-
- gfc_free (bits);
- return range_check (result, "ISHFTC");
}
else
{
--- 1763,1771 ----
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i - delta);
! else
mpz_setbit (result->value.integer, i - delta);
}
}
else
{
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1725,1731 ****
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + delta);
! if (bits[i] == 1)
mpz_setbit (result->value.integer, i + delta);
}
--- 1773,1779 ----
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + delta);
! else
mpz_setbit (result->value.integer, i + delta);
}
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1733,1745 ****
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + shift);
! if (bits[i] == 1)
mpz_setbit (result->value.integer, i + shift);
}
-
- gfc_free (bits);
- return range_check (result, "ISHFTC");
}
}
--- 1781,1795 ----
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + shift);
! else
mpz_setbit (result->value.integer, i + shift);
}
}
+
+ twos_complement (result->value.integer, isize);
+
+ gfc_free (bits);
+ return result;
}