diff options
author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-12-22 14:14:44 +0000 |
---|---|---|
committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2018-12-22 14:14:44 +0000 |
commit | 06b26538521a21477ce4587b98f1adaa3d2ade5b (patch) | |
tree | 4b6ba2a548b8eba7e69ff750a4a2d1fb4b501dd3 /gcc | |
parent | 91c02f863e86aa81d003c6382ede715cffdfffc8 (diff) | |
download | gcc-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/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/fortran/frontend-passes.c | 81 | ||||
-rw-r--r-- | gcc/fortran/trans-expr.c | 77 |
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 |