re PR fortran/55806 (Missed optimization with ANY or ALL)
2013-01-14 Thomas Koenig <tkoenig@gcc.gnu.org> 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 <tkoenig@gcc.gnu.org> PR fortran/55806 * gfortran.dg/array_constructor_40.f90: New test. From-SVN: r195179
This commit is contained in:
Thomas Koenig
parent
5a0727d990
commit
e81e4b43e9
|
|
@ -1,3 +1,13 @@
|
|||
2013-01-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
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 <jakub@redhat.com>
|
||||
|
||||
PR fortran/55935
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2013-01-14 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/55806
|
||||
* gfortran.dg/array_constructor_40.f90: New test.
|
||||
|
||||
2013-01-14 Richard Sandiford <rdsandiford@googlemail.com>
|
||||
|
||||
* gcc.dg/tree-ssa/slsr-8.c: Allow widening multiplications.
|
||||
|
|
|
|||
|
|
@ -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" } }
|
||||
Loading…
Reference in New Issue