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

4 files changed, 136 insertions, 37 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a6d793c..31a8b2c 100644
--- 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 3238e7c..328ffc9 100644
--- 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 afa010e..66b692e 100644
--- 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
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" } }