aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog18
-rw-r--r--gcc/fortran/simplify.c136
-rw-r--r--gcc/testsuite/ChangeLog9
-rw-r--r--gcc/testsuite/gfortran.dg/chkbits.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/ishft_1.f90 (renamed from gcc/testsuite/gfortran.dg/ishft.f90)0
-rw-r--r--gcc/testsuite/gfortran.dg/ishft_2.f906
-rw-r--r--gcc/testsuite/gfortran.dg/ishft_3.f9011
7 files changed, 149 insertions, 54 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5ea277e..8cf0bc3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+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 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30408
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 8ecabf0..82005f1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -154,20 +154,56 @@ get_kind (bt type, gfc_expr * k, const char *name, int default_kind)
}
-/* 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 @@ gfc_simplify_ibclr (gfc_expr * x, gfc_expr * y)
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");
}
@@ -1289,9 +1332,8 @@ gfc_simplify_ibits (gfc_expr * x, gfc_expr * y, gfc_expr * z)
if (pos + len > bitsize)
{
- gfc_error
- ("Sum of second and third arguments of IBITS exceeds bit size "
- "at %L", &y->where);
+ gfc_error ("Sum of second and third arguments of IBITS exceeds "
+ "bit size at %L", &y->where);
return &gfc_bad_expr;
}
@@ -1353,9 +1395,13 @@ gfc_simplify_ibset (gfc_expr * x, gfc_expr * y)
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 +1832,7 @@ gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
}
}
- twos_complement (result->value.integer, isize);
+ convert_mpz_to_signed (result->value.integer, isize);
gfc_free (bits);
return result;
@@ -1797,7 +1843,7 @@ gfc_expr *
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 +1856,60 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
}
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 +1921,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
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 +1939,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
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 +1948,7 @@ gfc_simplify_ishftc (gfc_expr * e, gfc_expr * s, gfc_expr * sz)
}
}
- twos_complement (result->value.integer, isize);
+ convert_mpz_to_signed (result->value.integer, isize);
gfc_free (bits);
return result;
@@ -2580,8 +2641,6 @@ gfc_expr *
gfc_simplify_not (gfc_expr * e)
{
gfc_expr *result;
- int i;
- mpz_t mask;
if (e->expr_type != EXPR_CONSTANT)
return NULL;
@@ -2590,21 +2649,6 @@ gfc_simplify_not (gfc_expr * e)
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");
}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0a6ffa2..71488e5 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,14 @@
2007-01-09 Brooks Moses <brooks.moses@codesourcery.com>
+ * gfortran.dg/chkbits.f90: Added IBCLR tests; test calls
+ for different integer kinds.
+ * gfortran.dg/ishft.f90: Renamed to ishft_1.f90...
+ * gfortran.dg/ishft_1.f90: ...Renamed from ishft.f90.
+ * gfortran.dg/ishft_2.f90: New test.
+ * gfortran.dg/ishft_3.f90: New test.
+
+2007-01-09 Brooks Moses <brooks.moses@codesourcery.com>
+
* gfortran.dg/altreturn_2.f90: Removed executable bit.
2007-01-09 Zdenek Dvorak <dvorakz@suse.cz>
diff --git a/gcc/testsuite/gfortran.dg/chkbits.f90 b/gcc/testsuite/gfortran.dg/chkbits.f90
index 19ab5c7..4652439 100644
--- a/gcc/testsuite/gfortran.dg/chkbits.f90
+++ b/gcc/testsuite/gfortran.dg/chkbits.f90
@@ -11,16 +11,23 @@ program chkbits
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
diff --git a/gcc/testsuite/gfortran.dg/ishft.f90 b/gcc/testsuite/gfortran.dg/ishft_1.f90
index 88edd30..88edd30 100644
--- a/gcc/testsuite/gfortran.dg/ishft.f90
+++ b/gcc/testsuite/gfortran.dg/ishft_1.f90
diff --git a/gcc/testsuite/gfortran.dg/ishft_2.f90 b/gcc/testsuite/gfortran.dg/ishft_2.f90
new file mode 100644
index 0000000..96acf0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_2.f90
@@ -0,0 +1,6 @@
+! { 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)+1 /= -huge(1_4) ) call abort()
+end program
diff --git a/gcc/testsuite/gfortran.dg/ishft_3.f90 b/gcc/testsuite/gfortran.dg/ishft_3.f90
new file mode 100644
index 0000000..fa3938e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ishft_3.f90
@@ -0,0 +1,11 @@
+! { 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
generated by cgit v1.1 at 2025-12-28 21:07:22 +0000