===================================================================
@@ -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;
}
===================================================================
@@ -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
Hello world, the PR pointed out an old regression because the front-end optimization pass was substituting 2**n with ishift(1,n), where n was an array. Simply removing the optimization for that case would have been easy, but also introduced a performance regression. So, for this, I moved the optimization to trans-*, where it makes more sense. Regression-tested. This turned up that one of our tests, mvbits_1.f90, depends on the behavior that 2**32 is zero. This is certainly not guaranteed by the standard, but I chose to keep the behavior as not to introduce any changes in behavior. This fixes a regression, so I would like to backport to all active branches if this if possible. Oh yes, if anybody feels strongly that we should also optimize 32**n and powers of other powers to two, now is the time to speak up :-) OK for affected branches? Regards Thomas 2018-12-16 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-16 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/85544 * gfortran.dg/power_7.f90: New test.