re PR fortran/88579 (Calculating power of powers of two)

2019-01-22  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/88579
	* trans-expr.c (gfc_conv_power_op): Handle cases of (2**e) ** integer
	and (- 2**e) ** integer.

2019-01-22  Harald Anlauf  <anlauf@gmx.de>

	PR fortran/88579
	* gfortran.dg/power_8.f90: New test.

From-SVN: r268163

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6d793c8b66d4c568e60f5c4abfea150d965c0e8..31a8b2c9aa2c767f06f6662f5a5242a2a3d99c4b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2019-01-22  Harald Anlauf  <anlauf@gmx.de>
+
+       PR fortran/88579
+       * trans-expr.c (gfc_conv_power_op): Handle cases of (2**e) ** integer
+       and (- 2**e) ** integer.
+
 2019-01-19  Dominique d'Humieres  <dominiq@gcc.gnu.org>
 
        PR fortran/37835
@@ -8,7 +14,7 @@
 
        PR fortran/77960
        * io.c (match_io_element): input-item cannot be an external function.
- 
+
 2018-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
        Paul Thomas  <pault@gcc.gnu.org>
 

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3238e7cb582fa55d5749b887c3bd1a13fb6e78ab..328ffc97110bc582fb0b5402716b89359f5597e9 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3060,19 +3060,44 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
       && TREE_CODE (TREE_TYPE (rse.expr)) == INTEGER_TYPE)
     {
       wi::tree_to_wide_ref wlhs = wi::to_wide (lse.expr);
-      HOST_WIDE_INT v;
+      HOST_WIDE_INT v, w;
+      int kind, ikind, bit_size;
+
       v = wlhs.to_shwi ();
+      w = abs (v);
+
+      kind = expr->value.op.op1->ts.kind;
+      ikind = gfc_validate_kind (BT_INTEGER, kind, false);
+      bit_size = gfc_integer_kinds[ikind].bit_size;
+
       if (v == 1)
        {
          /* 1**something is always 1.  */
          se->expr = build_int_cst (TREE_TYPE (lse.expr), 1);
          return;
        }
-      else if (v == 2 || v == 4 || v == 8 || v == 16)
+      else if (v == -1)
        {
-         /* 2**n = 1<<n, 4**n = 1<<(n+n), 8**n = 1 <<(3*n), 16**n =
-          1<<(4*n), but we have to make sure to return zero if the
-          number of bits is too large. */
+         /* (-1)**n is 1 - ((n & 1) << 1) */
+         tree type;
+         tree tmp;
+
+         type = TREE_TYPE (lse.expr);
+         tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type,
+                                rse.expr, build_int_cst (type, 1));
+         tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+                                tmp, build_int_cst (type, 1));
+         tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
+                                build_int_cst (type, 1), tmp);
+         se->expr = tmp;
+         return;
+       }
+      else if (w > 0 && ((w & (w-1)) == 0) && ((w >> (bit_size-1)) == 0))
+       {
+         /* Here v is +/- 2**e.  The further simplification uses
+            2**n = 1<<n, 4**n = 1<<(n+n), 8**n = 1 <<(3*n), 16**n =
+            1<<(4*n), etc., but we have to make sure to return zero
+            if the number of bits is too large. */
          tree lshift;
          tree type;
          tree shift;
@@ -3080,27 +3105,25 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
          tree cond;
          tree num_bits;
          tree cond2;
+         tree tmp1;
 
          type = TREE_TYPE (lse.expr);
 
-         if (v == 2)
+         if (w == 2)
            shift = rse.expr;
-         else if (v == 4)
+         else if (w == 4)
            shift = fold_build2_loc (input_location, PLUS_EXPR,
                                     TREE_TYPE (rse.expr),
                                       rse.expr, rse.expr);
-         else if (v == 8)
-           shift = fold_build2_loc (input_location, MULT_EXPR,
-                                    TREE_TYPE (rse.expr),
-                                    build_int_cst (TREE_TYPE (rse.expr), 3),
-                                    rse.expr);
-         else if (v == 16)
-           shift = fold_build2_loc (input_location, MULT_EXPR,
-                                    TREE_TYPE (rse.expr),
-                                    build_int_cst (TREE_TYPE (rse.expr), 4),
-                                    rse.expr);
          else
-           gcc_unreachable ();
+           {
+             /* use popcount for fast log2(w) */
+             int e = wi::popcount (w-1);
+             shift = fold_build2_loc (input_location, MULT_EXPR,
+                                      TREE_TYPE (rse.expr),
+                                      build_int_cst (TREE_TYPE (rse.expr), e),
+                                      rse.expr);
+           }
 
          lshift = fold_build2_loc (input_location, LSHIFT_EXPR, type,
                                    build_int_cst (type, 1), shift);
@@ -3111,24 +3134,25 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
          num_bits = build_int_cst (TREE_TYPE (rse.expr), TYPE_PRECISION (type));
          cond2 = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
                                   rse.expr, num_bits);
-         se->expr = fold_build3_loc (input_location, COND_EXPR, type, cond2,
-                                     build_int_cst (type, 0), cond);
-         return;
-       }
-      else if (v == -1)
-       {
-         /* (-1)**n is 1 - ((n & 1) << 1) */
-         tree type;
-         tree tmp;
-
-         type = TREE_TYPE (lse.expr);
-         tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type,
-                                rse.expr, build_int_cst (type, 1));
-         tmp = fold_build2_loc (input_location, LSHIFT_EXPR, type,
-                                tmp, build_int_cst (type, 1));
-         tmp = fold_build2_loc (input_location, MINUS_EXPR, type,
-                                build_int_cst (type, 1), tmp);
-         se->expr = tmp;
+         tmp1 = fold_build3_loc (input_location, COND_EXPR, type, cond2,
+                                 build_int_cst (type, 0), cond);
+         if (v > 0)
+           {
+             se->expr = tmp1;
+           }
+         else
+           {
+             /* for v < 0, calculate v**n = |v|**n * (-1)**n */
+             tree tmp2;
+             tmp2 = fold_build2_loc (input_location, BIT_AND_EXPR, type,
+                                     rse.expr, build_int_cst (type, 1));
+             tmp2 = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+                                     tmp2, build_int_cst (type, 1));
+             tmp2 = fold_build2_loc (input_location, MINUS_EXPR, type,
+                                     build_int_cst (type, 1), tmp2);
+             se->expr = fold_build2_loc (input_location, MULT_EXPR, type,
+                                         tmp1, tmp2);
+           }
          return;
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index afa010e80d6f39784994834bf06639397e6e2550..66b692e7109453409eb9728c515ba2428e116f91 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-01-22  Harald Anlauf  <anlauf@gmx.de>
+
+       PR fortran/88579
+       * gfortran.dg/power_8.f90: New test.
+
 2019-01-22  Sandra Loosemore  <sandra@codesourcery.com>
 
        * g++.dg/lto/pr87906_0.C: Add dg-require-effective-target fpic.

diff --git a/gcc/testsuite/gfortran.dg/power_8.f90 b/gcc/testsuite/gfortran.dg/power_8.f90
new file mode 100644 (file)
index 0000000..143063b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/power_8.f90
@@ -0,0 +1,64 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR88579 - Test optimizations for bases that are powers of 2 or -2.
+program p
+  implicit none
+  integer(4) :: i, u
+  integer(1) :: j, v
+  integer(2) :: k, w
+  integer(8) :: z
+  ! Test selected positive bases
+  u = 1
+  do i=1,5
+     u = u * 64_4
+     if (u /= 64_4 ** i) stop 1
+  end do
+  z = 1
+  do i=1,7
+     z = z * 256_8
+     if (z /= 256_8 ** i) stop 2
+  end do
+  z = 1
+  do i=1,3
+     z = z * 65536_8
+     if (z /= 65536_8 ** i) stop 3
+  end do
+  ! Test selected negative bases and integer kind combinations
+  u = 1
+  do i=1,7
+     u = u * (-2_1)
+     if (u /= (-2_1) ** i) stop 4
+  end do
+  v = 1
+  do j=1,7
+     v = v * (-2_1)
+     if (v /= (-2_1) ** j) stop 5
+  end do
+  v = 1
+  do k=1,7
+     v = v * (-2_1)
+     if (v /= (-2_1) ** k) stop 6
+  end do
+  w = 1
+  do k=1,7
+     w = w * (-4_2)
+     if (w /= (-4_2) ** k) stop 7
+  end do
+  w = 1
+  do i=1,5
+     w = w * (-8_2)
+     if (w /= (-8_2) ** i) stop 8
+  end do
+  u = 1
+  do i=1,1
+     u = u * (-HUGE(1_4)/2-1)
+     if (u /= (-HUGE(1_4)/2-1) ** i) stop 9
+  end do
+  z = 1
+  do i=1,7
+     z = z * (-512_8)
+     if (z /= (-512_8) ** i) stop 10
+  end do
+end program p
+! { dg-final { scan-tree-dump-not "_gfortran_pow" "original" } }