From: Thomas Koenig Date: Sat, 22 Dec 2018 14:14:44 +0000 (+0000) Subject: re PR fortran/85544 (ICE in gfc_conv_scalarized_array_ref, at fortran/trans-array... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=06b26538521a21477ce4587b98f1adaa3d2ade5b;p=gcc.git re PR fortran/85544 (ICE in gfc_conv_scalarized_array_ref, at fortran/trans-array.c:3385) 2018-12-22 Thomas Koenig 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 PR fortran/85544 * gfortran.dg/power_7.f90: New test. From-SVN: r267347 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0ea79f3215e..e960cc74976 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2018-12-22 Thomas Koenig + + 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 PR fortran/87881 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 9fa50ee68fa..91d216b778f 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 16a713551f0..a2fd53cc1f3 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<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