OSDN Git Service

PR 30381
authorbrooks <brooks@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 10 Jan 2007 05:46:13 +0000 (05:46 +0000)
committerbrooks <brooks@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 10 Jan 2007 05:46:13 +0000 (05:46 +0000)
PR 30420
* fortran/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.
* testsuite/gfortran.dg/
* 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120634 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/simplify.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/chkbits.f90
gcc/testsuite/gfortran.dg/ishft_1.f90 [moved from gcc/testsuite/gfortran.dg/ishft.f90 with 100% similarity]
gcc/testsuite/gfortran.dg/ishft_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/ishft_3.f90 [new file with mode: 0644]

index 5ea277e..8cf0bc3 100644 (file)
@@ -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
index 8ecabf0..82005f1 100644 (file)
@@ -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");
 }
 
index 0a6ffa2..71488e5 100644 (file)
@@ -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>
index 19ab5c7..4652439 100644 (file)
@@ -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_2.f90 b/gcc/testsuite/gfortran.dg/ishft_2.f90
new file mode 100644 (file)
index 0000000..96acf0e
--- /dev/null
@@ -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 (file)
index 0000000..fa3938e
--- /dev/null
@@ -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