re PR fortran/85544 (ICE in gfc_conv_scalarized_array_ref, at fortran/trans-array...

2018-12-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/85544
	* frontend-passes.c (optimize_power): Remove.
	(optimize_op): Remove call to optimize_power.
	* trans-expr.c (gfc_conv_power_op): Handle cases of 1**integer,
	(2|4|8|16) ** integer and (-1) ** integer.

2018-12-22  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/85544
	* gfortran.dg/power_7.f90: New test.

From-SVN: r267347

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0ea79f3215e2a3385dfc8d4aa6325568e1ab4048..e960cc749762b51d901caf468859b92a5c4cceca 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-12-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/85544
+       * frontend-passes.c (optimize_power): Remove.
+       (optimize_op): Remove call to optimize_power.
+       * trans-expr.c (gfc_conv_power_op): Handle cases of 1**integer,
+       (2|4|8|16) ** integer and (-1) ** integer.
+
 2018-12-21  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/87881

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 9fa50ee68fa2e12079d373cc1360029623b2ef2d..91d216b778f84211068bf62ceb145d073fb7f28f 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1863,84 +1863,6 @@ combine_array_constructor (gfc_expr *e)
   return true;
 }
 
-/* Change (-1)**k into 1-ishift(iand(k,1),1) and
- 2**k into ishift(1,k) */
-
-static bool
-optimize_power (gfc_expr *e)
-{
-  gfc_expr *op1, *op2;
-  gfc_expr *iand, *ishft;
-
-  if (e->ts.type != BT_INTEGER)
-    return false;
-
-  op1 = e->value.op.op1;
-
-  if (op1 == NULL || op1->expr_type != EXPR_CONSTANT)
-    return false;
-
-  if (mpz_cmp_si (op1->value.integer, -1L) == 0)
-    {
-      gfc_free_expr (op1);
-
-      op2 = e->value.op.op2;
-
-      if (op2 == NULL)
-       return false;
-
-      iand = gfc_build_intrinsic_call (current_ns, GFC_ISYM_IAND,
-                                      "_internal_iand", e->where, 2, op2,
-                                      gfc_get_int_expr (e->ts.kind,
-                                                        &e->where, 1));
-
-      ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
-                                       "_internal_ishft", e->where, 2, iand,
-                                       gfc_get_int_expr (e->ts.kind,
-                                                         &e->where, 1));
-
-      e->value.op.op = INTRINSIC_MINUS;
-      e->value.op.op1 = gfc_get_int_expr (e->ts.kind, &e->where, 1);
-      e->value.op.op2 = ishft;
-      return true;
-    }
-  else if (mpz_cmp_si (op1->value.integer, 2L) == 0)
-    {
-      gfc_free_expr (op1);
-
-      op2 = e->value.op.op2;
-      if (op2 == NULL)
-       return false;
-
-      ishft = gfc_build_intrinsic_call (current_ns, GFC_ISYM_ISHFT,
-                                       "_internal_ishft", e->where, 2,
-                                       gfc_get_int_expr (e->ts.kind,
-                                                         &e->where, 1),
-                                       op2);
-      *e = *ishft;
-      return true;
-    }
-
-  else if (mpz_cmp_si (op1->value.integer, 1L) == 0)
-    {
-      op2 = e->value.op.op2;
-      if (op2 == NULL)
-       return false;
-
-      gfc_free_expr (op1);
-      gfc_free_expr (op2);
-
-      e->expr_type = EXPR_CONSTANT;
-      e->value.op.op1 = NULL;
-      e->value.op.op2 = NULL;
-      mpz_init_set_si (e->value.integer, 1);
-      /* Typespec and location are still OK.  */
-      return true;
-    }
-
-  return false;
-}
-
 /* Recursive optimization of operators.  */
 
 static bool
@@ -2001,9 +1923,6 @@ optimize_op (gfc_expr *e)
     case INTRINSIC_DIVIDE:
       return combine_array_constructor (e) || changed;
 
-    case INTRINSIC_POWER:
-      return optimize_power (e);
-
     default:
       break;
     }

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 16a713551f0a2e57a70f15dc23dea660ec0f030a..a2fd53cc1f3dfe8632f960199add3a4a7c887351 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3056,6 +3056,83 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
     if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
       return;
 
+  if (INTEGER_CST_P (lse.expr)
+      && TREE_CODE (TREE_TYPE (rse.expr)) == INTEGER_TYPE)
+    {
+      wi::tree_to_wide_ref wlhs = wi::to_wide (lse.expr);
+      HOST_WIDE_INT v;
+      v = wlhs.to_shwi ();
+      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)
+       {
+         /* 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. */
+         tree lshift;
+         tree type;
+         tree shift;
+         tree ge;
+         tree cond;
+         tree num_bits;
+         tree cond2;
+
+         type = TREE_TYPE (lse.expr);
+
+         if (v == 2)
+           shift = rse.expr;
+         else if (v == 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 ();
+
+         lshift = fold_build2_loc (input_location, LSHIFT_EXPR, type,
+                                   build_int_cst (type, 1), shift);
+         ge = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+                               rse.expr, build_int_cst (type, 0));
+         cond = fold_build3_loc (input_location, COND_EXPR, type, ge, lshift,
+                                build_int_cst (type, 0));
+         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;
+         return;
+       }
+    }
+
   gfc_int4_type_node = gfc_get_int_type (4);
 
   /* In case of integer operands with kinds 1 or 2, we call the integer kind 4