This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, fortran] PR 30381, PR 30420: Fix constant-folding in bitwise intrinsics
- From: Brooks Moses <brooks dot moses at codesourcery dot com>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Tue, 09 Jan 2007 20:18:03 -0800
- Subject: [patch, fortran] PR 30381, PR 30420: Fix constant-folding in bitwise intrinsics
In bitwise intrinsics such as IBCLR(), an integer variable is treated as
a finite bit array. In the constant-folding, where the variable is
represented as an mpz_t infinite-precision integer, this requires
conversion to handle the sign bit in particular. This is currently
being done somewhat haphazardly, resulting in things like PR 30420.
This patch cleans this up, with explicit functions for converting to and
from unsigned finite-width representations as needed. It also adds some
gcc_asserts to what of this code already existed, to make sure that the
conversion is only being applied to valid values.
Interestingly, in gfc_simplify_not (just like in _iand, _ior, and
_ieor), there is no need to do the conversion -- the above-range high
bits will always be the same as the sign bit -- and so the masking there
is irrelevant. This patch removes it.
The constant-folding in ISHFTC() is somewhat of a mess; PR30381
describes about half the stuff I found with that.
The first problem with ISHFTC() is that there wasn't a check to bail out
of the constant-folding if the third argument isn't constant, so I added
that.
The second problem is that, if SIZE is present and less than the size of
the first argument, then only the low bits should be shifted, and the
high bits should be carried over. This was fixed by setting the result
value to the first argument value (and then converting to an unsigned
representation) before doing the bit shuffling.
The third problem is that the process of converting back to a signed
representation at the end of the function was using the SIZEth bit as
the sign bit, which is wrong -- it should use the leftmost bit,
regardless of the value of SIZE.
The fourth thing is that no checking was performed to make sure that
SHIFT and SIZE did not exceed the size of the first argument. So I
added checks for that.
In looking at the chkbits.f90 test, I noticed that although it appears
to be checking four different integer kinds, it's merely repeating the
same INTEGER(4) tests and assigning them to different integer variables.
So I fixed that, and added the relevant IBCLR() tests to it.
-----------------------------------------------------------
2007-01-09 Brooks Moses <brooks.moses@codesourcery.com>
PR 30381
PR 30420
* simplify.c (convert_mpz_to_unsigned): New function.
(convert_mpz_to_signed): New function, largely based on
twos_complement().
(twos_complement): Removed.
(gfc_simplify_ibclr): Add conversions to and from an
unsigned representation before bit-twiddling.
(gfc_simplify_ibset): Same.
(gfc_simplify_ishftc): Add checks for overly large
constant arguments, only check the third argument if
it's present, carry over high bits into the result as
appropriate, and perform the final conversion back to
a signed representation using the correct sign bit.
(gfc_simplify_not): Removed unnecessary masking.
-----------------------------------------------------------
2007-01-09 Brooks Moses <brooks.moses@codesourcery.com>
* chkbits.f90: Added IBCLR tests; test calls for
different integer kinds.
* ishft.f90: Renamed to ishft_1.f90...
* ishft_1.f90: ...Renamed from ishft.f90.
* ishft_2.f90: New test.
* ishft_3.f90: New test.
-----------------------------------------------------------
Tested on i686-pc-linux-gnu for trunk. Ok to commit?
Ok to backport to 4.2 a week later, after testing there?
- Brooks
Index: simplify.c
===================================================================
--- simplify.c (revision 120594)
+++ simplify.c (working copy)
@@ -154,20 +154,56 @@
}
-/* 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. */
+/* Converts an mpz_t signed variable into an unsigned one, assuming
+ two's complement representations and a binary width of bitsize.
+ The conversion is a no-op unless x is negative; otherwise, it can
+ be accomplished by masking out the high bits. */
static void
-twos_complement (mpz_t x, int bitsize)
+convert_mpz_to_unsigned (mpz_t x, int bitsize)
{
mpz_t mask;
+ if (mpz_sgn (x) < 0)
+ {
+ /* Confirm that no bits above the signed range are unset. */
+ gcc_assert (mpz_scan0 (x, bitsize-1) == ULONG_MAX);
+
+ mpz_init_set_ui (mask, 1);
+ mpz_mul_2exp (mask, mask, bitsize);
+ mpz_sub_ui (mask, mask, 1);
+
+ mpz_and (x, x, mask);
+
+ mpz_clear (mask);
+ }
+ else
+ {
+ /* Confirm that no bits above the signed range are set. */
+ gcc_assert (mpz_scan1 (x, bitsize-1) == ULONG_MAX);
+ }
+}
+
+
+/* Converts an mpz_t unsigned variable into a signed one, assuming
+ two's complement representations and a binary width of bitsize.
+ If the bitsize-1 bit is set, this is taken as a sign bit and
+ the number is converted to the corresponding negative number. */
+
+
+static void
+convert_mpz_to_signed (mpz_t x, int bitsize)
+{
+ mpz_t mask;
+
+ /* Confirm that no bits above the unsigned range are set. */
+ gcc_assert (mpz_scan1 (x, bitsize) == ULONG_MAX);
+
if (mpz_tstbit (x, bitsize - 1) == 1)
{
- mpz_init_set_ui(mask, 1);
- mpz_mul_2exp(mask, mask, bitsize);
- mpz_sub_ui(mask, mask, 1);
+ mpz_init_set_ui (mask, 1);
+ mpz_mul_2exp (mask, mask, bitsize);
+ mpz_sub_ui (mask, mask, 1);
/* We negate the number by hand, zeroing the high bits, that is
make it the corresponding positive number, and then have it
@@ -1253,7 +1289,14 @@
result = gfc_copy_expr (x);
+ convert_mpz_to_unsigned (result->value.integer,
+ gfc_integer_kinds[k].bit_size);
+
mpz_clrbit (result->value.integer, pos);
+
+ convert_mpz_to_signed (result->value.integer,
+ gfc_integer_kinds[k].bit_size);
+
return range_check (result, "IBCLR");
}
@@ -1353,9 +1396,13 @@
result = gfc_copy_expr (x);
+ convert_mpz_to_unsigned (result->value.integer,
+ gfc_integer_kinds[k].bit_size);
+
mpz_setbit (result->value.integer, pos);
- twos_complement (result->value.integer, gfc_integer_kinds[k].bit_size);
+ convert_mpz_to_signed (result->value.integer,
+ gfc_integer_kinds[k].bit_size);
return range_check (result, "IBSET");
}
@@ -1786,7 +1833,7 @@
}
}
- twos_complement (result->value.integer, isize);
+ convert_mpz_to_signed (result->value.integer, isize);
gfc_free (bits);
return result;
@@ -1797,7 +1844,7 @@
gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
{
gfc_expr *result;
- int shift, ashift, isize, delta, k;
+ int shift, ashift, isize, ssize, delta, k;
int i, *bits;
if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
@@ -1810,45 +1857,63 @@
}
k = gfc_validate_kind (e->ts.type, e->ts.kind, false);
+ isize = gfc_integer_kinds[k].bit_size;
if (sz != NULL)
{
- if (gfc_extract_int (sz, &isize) != NULL || isize < 0)
+ if (sz->expr_type != EXPR_CONSTANT)
+ return NULL;
+
+ if (gfc_extract_int (sz, &ssize) != NULL || ssize <= 0)
{
gfc_error ("Invalid third argument of ISHFTC at %L", &sz->where);
return &gfc_bad_expr;
}
+
+ if (ssize > isize)
+ {
+ gfc_error
+ ("Magnitude of third argument of ISHFTC exceeds BIT_SIZE of "
+ "first argument at %L", &s->where);
+ return &gfc_bad_expr;
+ }
}
else
- isize = gfc_integer_kinds[k].bit_size;
+ ssize = isize;
if (shift >= 0)
ashift = shift;
else
ashift = -shift;
- if (ashift > isize)
+ if (ashift > ssize)
{
- gfc_error
- ("Magnitude of second argument of ISHFTC exceeds third argument "
- "at %L", &s->where);
+ if (sz != NULL)
+ gfc_error
+ ("Magnitude of second argument of ISHFTC exceeds third argument "
+ "at %L", &s->where);
+ else
+ gfc_error
+ ("Magnitude of second argument of ISHFTC exceeds BIT_SIZE of "
+ "first argument at %L", &s->where);
return &gfc_bad_expr;
}
result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
+ mpz_set (result->value.integer, e->value.integer);
+
if (shift == 0)
- {
- mpz_set (result->value.integer, e->value.integer);
- return result;
- }
+ return result;
- bits = gfc_getmem (isize * sizeof (int));
+ convert_mpz_to_unsigned (result->value.integer, isize);
- for (i = 0; i < isize; i++)
+ bits = gfc_getmem (ssize * sizeof (int));
+
+ for (i = 0; i < ssize; i++)
bits[i] = mpz_tstbit (e->value.integer, i);
- delta = isize - ashift;
+ delta = ssize - ashift;
if (shift > 0)
{
@@ -1860,7 +1925,7 @@
mpz_setbit (result->value.integer, i + shift);
}
- for (i = delta; i < isize; i++)
+ for (i = delta; i < ssize; i++)
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i - delta);
@@ -1878,7 +1943,7 @@
mpz_setbit (result->value.integer, i + delta);
}
- for (i = ashift; i < isize; i++)
+ for (i = ashift; i < ssize; i++)
{
if (bits[i] == 0)
mpz_clrbit (result->value.integer, i + shift);
@@ -1887,7 +1952,7 @@
}
}
- twos_complement (result->value.integer, isize);
+ convert_mpz_to_signed (result->value.integer, isize);
gfc_free (bits);
return result;
@@ -2580,8 +2645,6 @@
gfc_simplify_not (gfc_expr * e)
{
gfc_expr *result;
- int i;
- mpz_t mask;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
@@ -2590,21 +2653,6 @@
mpz_com (result->value.integer, e->value.integer);
- /* Because of how GMP handles numbers, the result must be ANDed with
- a mask. For radices <> 2, this will require change. */
-
- i = gfc_validate_kind (BT_INTEGER, e->ts.kind, false);
-
- mpz_init (mask);
- mpz_add (mask, gfc_integer_kinds[i].huge, gfc_integer_kinds[i].huge);
- mpz_add_ui (mask, mask, 1);
-
- mpz_and (result->value.integer, result->value.integer, mask);
-
- twos_complement (result->value.integer, gfc_integer_kinds[i].bit_size);
-
- mpz_clear (mask);
-
return range_check (result, "NOT");
}
! { dg-do run }
program ishft_2
if ( ishftc(3, 2, 3) /= 5 ) call abort()
if ( ishftc(256+3, 2, 3) /= 256+5 ) call abort()
if ( ishftc(1_4, 31) /= (-huge(1_4) - 1) ) call abort()
end program
! { dg-do compile }
program ishft_3
integer i, j
write(*,*) ishftc( 3, 2, 3 )
write(*,*) ishftc( 3, 2, i )
write(*,*) ishftc( 3, i, j )
write(*,*) ishftc( 3, 128 ) ! { dg-error "exceeds BIT_SIZE of first" }
write(*,*) ishftc( 3, 0, 128 ) ! { dg-error "exceeds BIT_SIZE of first" }
write(*,*) ishftc( 3, 0, 0 ) ! { dg-error "Invalid third argument" }
write(*,*) ishftc( 3, 3, 2 ) ! { dg-error "exceeds third argument" }
end program
Index: chkbits.f90
===================================================================
--- chkbits.f90 (revision 120594)
+++ chkbits.f90 (working copy)
@@ -11,16 +11,23 @@
integer(kind=4) i4
integer(kind=8) i8
- i1 = ibset(2147483647,bit_size(i4)-1)
- i2 = ibset(2147483647,bit_size(i4)-1)
- i4 = ibset(2147483647,bit_size(i4)-1)
- i8 = ibset(2147483647,bit_size(i4)-1)
+ i1 = ibset(huge(0_1), bit_size(i1)-1)
+ i2 = ibset(huge(0_2), bit_size(i2)-1)
+ i4 = ibset(huge(0_4), bit_size(i4)-1)
+ i8 = ibset(huge(0_8), bit_size(i8)-1)
if (i1 /= -1 .or. i2 /= -1 .or. i4 /= -1 .or. i8 /= -1) call abort
- i1 = not(0)
- i2 = not(0)
- i4 = not(0)
- i8 = not(0)
+ i1 = ibclr(-1_1, bit_size(i1)-1)
+ i2 = ibclr(-1_2, bit_size(i2)-1)
+ i4 = ibclr(-1_4, bit_size(i4)-1)
+ i8 = ibclr(-1_8, bit_size(i8)-1)
+ if (i1 /= huge(0_1) .or. i2 /= huge(0_2)) call abort
+ if (i4 /= huge(0_4) .or. i8 /= huge(0_8)) call abort
+
+ i1 = not(0_1)
+ i2 = not(0_2)
+ i4 = not(0_4)
+ i8 = not(0_8)
if (i1 /= -1 .or. i2 /= -1 .or. i4 /= -1 .or. i8 /= -1) call abort
end program chkbits