Hello world,
the attached patch replaces (-1.0)**i with (in C language)
(i & 1) == 0 ? 1.0 : 1.0, see PR 57073.
I tried doing it in the middle end, see the PR of where these
approaches failed. So, rather than not doing the optimization
at all, I would rather do it in the Fortran front end.
If somebody jumps in with a middle-end solution that works, I
would withdraw this patch.
Regression-tested on trunk. OK?
Thomas
2013-05-19 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/57073
* trans-expr.c: Simplify (-1.0)**i to (i & 1) == 0 ? 1.0 : -1.0.
2013-05-19 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/57073
* gfortran.dg/power_6.f90: New test.
Index: trans-expr.c
===================================================================
--- trans-expr.c (Revision 199050)
+++ trans-expr.c (Arbeitskopie)
@@ -2110,18 +2110,41 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
gfc_se lse;
gfc_se rse;
tree fndecl = NULL;
+ gfc_expr *op1, *op2;
+ op1 = expr->value.op.op1;
+ op2 = expr->value.op.op2;
+
gfc_init_se (&lse, se);
- gfc_conv_expr_val (&lse, expr->value.op.op1);
+ gfc_conv_expr_val (&lse, op1);
lse.expr = gfc_evaluate_now (lse.expr, &lse.pre);
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_init_se (&rse, se);
- gfc_conv_expr_val (&rse, expr->value.op.op2);
+ gfc_conv_expr_val (&rse, op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
- if (expr->value.op.op2->ts.type == BT_INTEGER
- && expr->value.op.op2->expr_type == EXPR_CONSTANT)
+ if (op1->ts.type == BT_REAL && op1->expr_type == EXPR_CONSTANT
+ && op2->expr_type != EXPR_CONSTANT
+ && mpfr_cmp_si (op1->value.real, -1L) == 0)
+ {
+ tree tmp, type_op1, type_op2;
+
+ type_op1 = TREE_TYPE (lse.expr);
+ type_op2 = TREE_TYPE (rse.expr);
+
+ tmp = fold_build2_loc (input_location, BIT_AND_EXPR, type_op2,
+ rse.expr, build_int_cst (type_op2, 1));
+ tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
+ tmp, build_int_cst (type_op2, 0));
+ se->expr = fold_build3_loc (input_location, COND_EXPR, type_op1, tmp,
+ build_real (type_op1, dconst1),
+ build_real (type_op1, dconstm1));
+ return;
+ }
+
+ if (op2->ts.type == BT_INTEGER
+ && op2->expr_type == EXPR_CONSTANT)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return;
@@ -2134,11 +2157,11 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
res_ikind_1 = -1;
res_ikind_2 = -1;
- kind = expr->value.op.op1->ts.kind;
- switch (expr->value.op.op2->ts.type)
+ kind = op1->ts.kind;
+ switch (op2->ts.type)
{
case BT_INTEGER:
- ikind = expr->value.op.op2->ts.kind;
+ ikind = op2->ts.kind;
switch (ikind)
{
case 1:
@@ -2166,7 +2189,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
{
case 1:
case 2:
- if (expr->value.op.op1->ts.type == BT_INTEGER)
+ if (op1->ts.type == BT_INTEGER)
{
lse.expr = convert (gfc_int4_type_node, lse.expr);
res_ikind_1 = kind;
@@ -2195,7 +2218,7 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
gcc_unreachable ();
}
- switch (expr->value.op.op1->ts.type)
+ switch (op1->ts.type)
{
case BT_INTEGER:
if (kind == 3) /* Case 16 was not handled properly above. */
! { dg-do run }
! { dg-options "-fdump-tree-original" }
! PR 57073 - test that (-1.0)**n is transormed into n & 1 == 0 ? 1.0 : -1.0
program main
integer :: i
character(len=10) :: c
real(8) :: a
c = '-1.0'
read (unit=c,fmt=*) a
do i=-3,3
if ((-1.0_8)**i /= a**i) call abort
end do
end program main
! { dg-final { scan-tree-dump-times "__builtin_powi" 1 "original" } }
! { dg-final { scan-tree-dump-times "i & 1" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
