aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2018-12-22 14:14:44 +0000
committerThomas Koenig <tkoenig@gcc.gnu.org>2018-12-22 14:14:44 +0000
commit06b26538521a21477ce4587b98f1adaa3d2ade5b (patch)
tree4b6ba2a548b8eba7e69ff750a4a2d1fb4b501dd3 /gcc
parent91c02f863e86aa81d003c6382ede715cffdfffc8 (diff)
downloadgcc-06b26538521a21477ce4587b98f1adaa3d2ade5b.zip
gcc-06b26538521a21477ce4587b98f1adaa3d2ade5b.tar.gz
gcc-06b26538521a21477ce4587b98f1adaa3d2ade5b.tar.bz2
re PR fortran/85544 (ICE in gfc_conv_scalarized_array_ref, at fortran/trans-array.c:3385)
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
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog8
-rw-r--r--gcc/fortran/frontend-passes.c81
-rw-r--r--gcc/fortran/trans-expr.c77
3 files changed, 85 insertions, 81 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0ea79f3..e960cc7 100644
--- 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 9fa50ee..91d216b 100644
--- 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 16a7135..a2fd53c 100644
--- 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