From e81e4b43e9e07cb115a9cb14d1bc2fdf8fab4c15 Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 14 Jan 2013 21:50:28 +0000 Subject: [PATCH] re PR fortran/55806 (Missed optimization with ANY or ALL) 2013-01-14 Thomas Koenig PR fortran/55806 * frontend-passes.c (optimize_reduction): New function, including prototype. (callback_reduction): Likewise. (gfc_run_passes): Also run optimize_reduction. (copy_walk_reduction_arg): New function. (dummy_code_callback): New function. 2013-01-14 Thomas Koenig PR fortran/55806 * gfortran.dg/array_constructor_40.f90: New test. From-SVN: r195179 --- gcc/fortran/ChangeLog | 10 ++ gcc/fortran/frontend-passes.c | 166 ++++++++++++++++++ gcc/testsuite/ChangeLog | 5 + .../gfortran.dg/array_constructor_40.f90 | 52 ++++++ 4 files changed, 233 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_40.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0f62c2aa54d..b412d0a97b9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2013-01-14 Thomas Koenig + + PR fortran/55806 + * frontend-passes.c (optimize_reduction): New function, + including prototype. + (callback_reduction): Likewise. + (gfc_run_passes): Also run optimize_reduction. + (copy_walk_reduction_arg): New function. + (dummy_code_callback): New function. + 2013-01-13 Jakub Jelinek PR fortran/55935 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index a5a46d505c0..5b092ca906f 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -40,6 +40,8 @@ static bool optimize_lexical_comparison (gfc_expr *); static void optimize_minmaxloc (gfc_expr **); static bool is_empty_string (gfc_expr *e); static void doloop_warn (gfc_namespace *); +static void optimize_reduction (gfc_namespace *); +static int callback_reduction (gfc_expr **, int *, void *); /* How deep we are inside an argument list. */ @@ -107,6 +109,7 @@ gfc_run_passes (gfc_namespace *ns) expr_array = XNEWVEC(gfc_expr **, expr_size); optimize_namespace (ns); + optimize_reduction (ns); if (gfc_option.dump_fortran_optimized) gfc_dump_parse_tree (ns, stdout); @@ -180,6 +183,145 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, return 0; } +/* Auxiliary function to handle the arguments to reduction intrnisics. If the + function is a scalar, just copy it; otherwise returns the new element, the + old one can be freed. */ + +static gfc_expr * +copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn) +{ + gfc_expr *fcn; + gfc_isym_id id; + + if (e->rank == 0 || e->expr_type == EXPR_FUNCTION) + fcn = gfc_copy_expr (e); + else + { + id = fn->value.function.isym->id; + + if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT) + fcn = gfc_build_intrinsic_call (current_ns, + fn->value.function.isym->id, + fn->value.function.isym->name, + fn->where, 3, gfc_copy_expr (e), + NULL, NULL); + else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL) + fcn = gfc_build_intrinsic_call (current_ns, + fn->value.function.isym->id, + fn->value.function.isym->name, + fn->where, 2, gfc_copy_expr (e), + NULL); + else + gfc_internal_error ("Illegal id in copy_walk_reduction_arg"); + + fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE; + } + + (void) gfc_expr_walker (&fcn, callback_reduction, NULL); + + return fcn; +} + +/* Callback function for optimzation of reductions to scalars. Transform ANY + ([f1,f2,f3, ...]) to f1 .or. f2 .or. f3 .or. ..., with ANY, SUM and PRODUCT + correspondingly. Handly only the simple cases without MASK and DIM. */ + +static int +callback_reduction (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + gfc_expr *fn, *arg; + gfc_intrinsic_op op; + gfc_isym_id id; + gfc_actual_arglist *a; + gfc_actual_arglist *dim; + gfc_constructor *c; + gfc_expr *res, *new_expr; + gfc_actual_arglist *mask; + + fn = *e; + + if (fn->rank != 0 || fn->expr_type != EXPR_FUNCTION + || fn->value.function.isym == NULL) + return 0; + + id = fn->value.function.isym->id; + + if (id != GFC_ISYM_SUM && id != GFC_ISYM_PRODUCT + && id != GFC_ISYM_ANY && id != GFC_ISYM_ALL) + return 0; + + a = fn->value.function.actual; + + /* Don't handle MASK or DIM. */ + + dim = a->next; + + if (dim->expr != NULL) + return 0; + + if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT) + { + mask = dim->next; + if ( mask->expr != NULL) + return 0; + } + + arg = a->expr; + + if (arg->expr_type != EXPR_ARRAY) + return 0; + + switch (id) + { + case GFC_ISYM_SUM: + op = INTRINSIC_PLUS; + break; + + case GFC_ISYM_PRODUCT: + op = INTRINSIC_TIMES; + break; + + case GFC_ISYM_ANY: + op = INTRINSIC_OR; + break; + + case GFC_ISYM_ALL: + op = INTRINSIC_AND; + break; + + default: + return 0; + } + + c = gfc_constructor_first (arg->value.constructor); + + if (c == NULL) + return 0; + + res = copy_walk_reduction_arg (c->expr, fn); + + c = gfc_constructor_next (c); + while (c) + { + new_expr = gfc_get_expr (); + new_expr->ts = fn->ts; + new_expr->expr_type = EXPR_OP; + new_expr->rank = fn->rank; + new_expr->where = fn->where; + new_expr->value.op.op = op; + new_expr->value.op.op1 = res; + new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn); + res = new_expr; + c = gfc_constructor_next (c); + } + + gfc_simplify_expr (res, 0); + *e = res; + gfc_free_expr (fn); + + return 0; +} /* Callback function for common function elimination, called from cfe_expr_0. Put all eligible function expressions into expr_array. */ @@ -484,6 +626,16 @@ dummy_expr_callback (gfc_expr **e ATTRIBUTE_UNUSED, int *walk_subtrees, return 0; } +/* Dummy function for code callback, for use when we really + don't want to do anything. */ +static int +dummy_code_callback (gfc_code **e ATTRIBUTE_UNUSED, + int *walk_subtrees ATTRIBUTE_UNUSED, + void *data ATTRIBUTE_UNUSED) +{ + return 0; +} + /* Code callback function for converting do while(a) end do @@ -639,6 +791,20 @@ optimize_namespace (gfc_namespace *ns) } } +static void +optimize_reduction (gfc_namespace *ns) +{ + current_ns = ns; + gfc_code_walker (&ns->code, dummy_code_callback, callback_reduction, NULL); + +/* BLOCKs are handled in the expression walker below. */ + for (ns = ns->contained; ns; ns = ns->sibling) + { + if (ns->code == NULL || ns->code->op != EXEC_BLOCK) + optimize_reduction (ns); + } +} + /* Replace code like a = matmul(b,c) + d with diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d561e3cb062..e25cfc8bf0f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-01-14 Thomas Koenig + + PR fortran/55806 + * gfortran.dg/array_constructor_40.f90: New test. + 2013-01-14 Richard Sandiford * gcc.dg/tree-ssa/slsr-8.c: Allow widening multiplications. diff --git a/gcc/testsuite/gfortran.dg/array_constructor_40.f90 b/gcc/testsuite/gfortran.dg/array_constructor_40.f90 new file mode 100644 index 00000000000..ca91d5eacda --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_40.f90 @@ -0,0 +1,52 @@ +! { dg-do run } +! { dg-options "-ffrontend-optimize -fdump-tree-original" } +! PR 55806 - replace ANY intrinsic for array +! constructor with .or. + +module mymod + implicit none +contains + subroutine bar(a,b,c, lo) + real, dimension(3,3), intent(in) :: a,b + logical, dimension(3,3), intent(in) :: lo + integer, intent(out) :: c + real, parameter :: acc = 1e-4 + integer :: i,j + + c = 0 + do i=1,3 + if (any([abs(a(i,1) - b(i,1)) > acc, & + (j==i+1,j=3,8)])) cycle + if (any([abs(a(i,2) - b(i,2)) > acc, & + abs(a(i,3) - b(i,3)) > acc, lo(i,:)])) cycle + c = c + i + end do + end subroutine bar + + subroutine baz(a, b, c) + real, dimension(3,3), intent(in) :: a,b + real, intent(out) :: c + c = sum([a(1,1),a(2,2),a(3,3),b(:,1)]) + end subroutine baz +end module mymod + +program main + use mymod + implicit none + real, dimension(3,3) :: a,b + real :: res + integer :: c + logical lo(3,3) + data a/1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9/ + + b = a + b(2,2) = a(2,2) + 0.2 + lo = .false. + lo(3,3) = .true. + call bar(a,b,c,lo) + if (c /= 1) call abort + call baz(a,b,res); + if (abs(res - 8.1) > 1e-5) call abort +end program main +! { dg-final { scan-tree-dump-times "while" 3 "original" } } +! { dg-final { cleanup-tree-dump "original" } }