This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[FORTRAN] Improved expansion of simple WHERE statements
- From: Roger Sayle <roger at eyesopen dot com>
- To: fortran at gcc dot gnu dot org, <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 4 Feb 2006 09:27:47 -0700 (MST)
- Subject: [FORTRAN] Improved expansion of simple WHERE statements
The following patch improves the code generated by gfortran for the
common case of simple (Fortran-90) WHERE statements and constructs.
Consider the following test case:
program where_1
integer :: a(5)
integer :: b(5)
a = (/1, 2, 3, 4, 5/)
b = (/1, 0, 1, 0, 1/)
where (b .ne. 0)
a = a + 10
endwhere
print *,a
end program
Currently, the code generated for the WHERE portion of this program
looks like the following C code:
int *mask = malloc(5*sizeof(int));
for (i=0; i<5; i++)
mask[i] = (b[i] != 0);
for (i=0; i<5; i++)
if (mask[i])
a[i] += 10;
free(mask);
Likewise the slightly more complicated example:
program where_2
integer :: a(5)
integer :: b(5)
a = (/1, 2, 3, 4, 5/)
b = (/1, 0, 1, 0, 1/)
where (b .ne. 0)
a = a + 10
elsewhere
a = 0
endwhere
print *,a
end program
generates the even more curious:
int *mask1 = malloc(5*sizeof(int));
int *mask2 = malloc(5*sizeof(int));
for (i=0; i<5; i++)
{
int flag = (b[i] != 0);
mask1[i] = flag;
mask2[i] = !flag;
}
for (i=0; i<5; i++)
if (mask1[i])
a[i] += 10;
for (i=0; i<5; i++)
if (mask2[i])
a[i] = 0;
free(mask1);
free(mask2);
The patch below is the main part of a series of patches to improve
things. This installment identifies the common cases of a where
containing a single assignment without internal dependencies, possibly
with a single unconditional elsewhere also containing a single assignment
without internal dependencies.
With this patch we now generate, the following code for the first
case:
for (i=0; i<5; i++)
if (b[i] != 0)
a[i] += 10;
and the following code for the second case:
for (i=0; i<5; i++)
if (b[i] != 0)
a[i] += 10;
else
a[i] = 0;
Unfortunately, this transformation revealed some minor limitations
in gfortran's dependency infrastructure, so the patch below address
four separate but related issues. The first and most trivial is
that the prototype for gfc_check_dependency is duplicated in both
dependency.h and trans-array.h. When the implementation was broken
out of trans-array.c into dependency.c the prototype was duplicated
rather than moved. This patch removes the trans-array.h definition,
and tweaks trans-stmt.c to include "dependency.h" to get this
declaration (updating the build dependenices in Make-lang.in
appropriately).
The second subtle issue concerns the semantics of gfc_check_dependency.
This routine was originally intended to analyse WHERE and FORALL
statements to determine whether array references contained a
dependency, i.e. in something like "x = y" whether the write to
x would affect the "future" values of y. In such cases, we need
a temporary array to preserve the original y during the assignment.
The complication involves this "TODO" comment from the current code:
/* Identical ranges return 0, overlapping ranges return 1. */
This is the semantics required by this patch, that identical ranges
have no dependency. i.e. in the assignment "a = a" we don't need a
temporary, or in "WHERE (a /= 0) a = LOG(a)", we don't need a
temporary. Unfortunately, implementing this TODO revealed that
gfc_check_dependency has other callers that required indentical
array references/ranges to have a dependency. The callers where
for the non-copying intrinsics TRANSPOSE, CSHIFT and EOSHIFT.
Consider the difference between "A = SQRT(A)" and "A = TRANSPOSE(A)",
clearly the first doesn't require a temporary as each element can be
processed order-independenly, whilst in the second we do require a
temporary, as the source "A" and destination "A" have been silently
permuted. To allow both behaviours, I introduce an "identical"
argument to gfc_check_dependency to indicate where identical
references should be consider dependent or not.
The third issue is a minor clean-up, the "vars" and "nvars" arguments
to gfc_check_dependency are unused, only passed in recursive invocations,
and indeed were unlikely to be useful before the "identical" conflict
was resolved above. This patch removes these currently unneeded args,
and even cures a memory leak in trans-stmt.c where we allocate a vars
array, but never free it.
The fourth and final aspect of this patch is the new gfc_trans_where_3
to handle simple-enough WHERE statements. Currently the dependency
checks are extremely strict, and the restriction to single assignments,
no nested WHEREs, no WHEREs in FORALL, no more than one ELSEWHERE and
only ELSEWHEREs without conditions may seem draconian but probably
catches a significant fraction of WHEREs in practice. Many of the
problematics features were added by Fortran-95, so most? Fortran-90
usage should be ammenable to this optimization.
The following patch has been tested on x86_64-unknown-linux-gnu with
a "make bootstrap" including gfortran, and tested with a "make -k
check-gfortran" in the gcc/ directory with no new failures.
I'm happy to split this patch into smaller pieces, fixing the
gfc_check_dependency duplication, removing the unused arguments
from gfc_check_dependency, adding the identical parameter to
gfc_check_dependency and adding the actual transformation, but
the motivation and testing of these changes only makes sense
when all the pieces are put together and infrastructure changes
are excerised by their intended use.
I've follow up patches to only use LOGICAL*1 for masks in the
WHERE statements that still need them, and optimizations to
avoid the need for complementary true/false masks, and to reduce
the number of mask allocations in nested WHEREs/ELSEWHEREs.
Ok for mainline? Could someone double check with NIST/LAPACK
that there are no complications with this change (though the
gfortran reviewers are usually excellent about this)? The
gfc_walk_expr API is scary, so I'd appreciate someone looking
over my usage of it. Some of the restrictions on which WHEREs
can be optimized could be lifted by improved scalarization.
Thanks in advance,
2006-02-04 Roger Sayle <roger@eyesopen.com>
* dependency.c (gfc_check_dependency): Remove unused vars and nvars
arguments. Replace with an "identical" argument. A full array
reference to the same symbol is a dependency if identical is true.
* dependency.h (gfc_check_dependency): Update prototype.
* trans-array.h (gfc_check_dependency): Delete duplicate prototype.
* trans-stmt.c: #include dependency.h for gfc_check_dependency.
(gfc_trans_forall_1): Update calls to gfc_check_dependency.
(gfc_trans_where_2): Likewise. Remove unneeded variables.
(gfc_trans_where_3): New function for simple non-dependent WHEREs.
(gfc_trans_where): Call gfc_trans_where_3 to translate simple
F90-style WHERE statements without internal dependencies.
* Make-lang.in (trans-stmt.o): Depend upon dependency.h.
Index: dependency.c
===================================================================
*** dependency.c (revision 110537)
--- dependency.c (working copy)
*************** gfc_check_argument_var_dependency (gfc_e
*** 259,268 ****
{
case EXPR_VARIABLE:
return (gfc_ref_needs_temporary_p (expr->ref)
! || gfc_check_dependency (var, expr, NULL, 0));
case EXPR_ARRAY:
! return gfc_check_dependency (var, expr, NULL, 0);
case EXPR_FUNCTION:
if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
--- 259,268 ----
{
case EXPR_VARIABLE:
return (gfc_ref_needs_temporary_p (expr->ref)
! || gfc_check_dependency (var, expr, 1));
case EXPR_ARRAY:
! return gfc_check_dependency (var, expr, 1);
case EXPR_FUNCTION:
if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
*************** gfc_check_fncall_dependency (gfc_expr *
*** 339,353 ****
/* Return true if the statement body redefines the condition. Returns
true if expr2 depends on expr1. expr1 should be a single term
! suitable for the lhs of an assignment. The symbols listed in VARS
! must be considered to have all possible values. All other scalar
! variables may be considered constant. Used for forall and where
statements. Also used with functions returning arrays without a
temporary. */
int
! gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
! int nvars)
{
gfc_ref *ref;
int n;
--- 339,352 ----
/* Return true if the statement body redefines the condition. Returns
true if expr2 depends on expr1. expr1 should be a single term
! suitable for the lhs of an assignment. The IDENTICAL flag indicates
! whether array references to the same symbol with identical range
! references count as a dependency or not. Used for forall and where
statements. Also used with functions returning arrays without a
temporary. */
int
! gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
{
gfc_ref *ref;
int n;
*************** gfc_check_dependency (gfc_expr * expr1,
*** 367,377 ****
switch (expr2->expr_type)
{
case EXPR_OP:
! n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
if (n)
return n;
if (expr2->value.op.op2)
! return gfc_check_dependency (expr1, expr2->value.op.op2, vars, nvars);
return 0;
case EXPR_VARIABLE:
--- 366,376 ----
switch (expr2->expr_type)
{
case EXPR_OP:
! n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
if (n)
return n;
if (expr2->value.op.op2)
! return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
return 0;
case EXPR_VARIABLE:
*************** gfc_check_dependency (gfc_expr * expr1,
*** 387,401 ****
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
return 0;
! for (ref = expr2->ref; ref; ref = ref->next)
! {
! /* Identical ranges return 0, overlapping ranges return 1. */
! if (ref->type == REF_ARRAY)
! return 1;
! }
return 1;
case EXPR_FUNCTION:
/* Remember possible differences between elemental and
transformational functions. All functions inside a FORALL
will be pure. */
--- 386,410 ----
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
return 0;
! if (identical)
! return 1;
!
! /* Identical ranges return 0, overlapping ranges return 1. */
!
! /* Return zero if we refer to the same full arrays. */
! if (expr1->ref->type == REF_ARRAY
! && expr2->ref->type == REF_ARRAY
! && expr1->ref->u.ar.type == AR_FULL
! && expr2->ref->u.ar.type == AR_FULL
! && !expr1->ref->next
! && !expr2->ref->next)
! return 0;
!
return 1;
case EXPR_FUNCTION:
+ if (expr2->inline_noncopying_intrinsic)
+ identical = 1;
/* Remember possible differences between elemental and
transformational functions. All functions inside a FORALL
will be pure. */
*************** gfc_check_dependency (gfc_expr * expr1,
*** 404,410 ****
{
if (!actual->expr)
continue;
! n = gfc_check_dependency (expr1, actual->expr, vars, nvars);
if (n)
return n;
}
--- 413,419 ----
{
if (!actual->expr)
continue;
! n = gfc_check_dependency (expr1, actual->expr, identical);
if (n)
return n;
}
Index: dependency.h
===================================================================
*** dependency.h (revision 110537)
--- dependency.h (working copy)
*************** bool gfc_ref_needs_temporary_p (gfc_ref
*** 25,31 ****
gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *);
int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
gfc_actual_arglist *);
! int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int);
int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
int gfc_expr_is_one (gfc_expr *, int);
--- 25,31 ----
gfc_expr *gfc_get_noncopying_intrinsic_argument (gfc_expr *);
int gfc_check_fncall_dependency (gfc_expr *, sym_intent, gfc_symbol *,
gfc_actual_arglist *);
! int gfc_check_dependency (gfc_expr *, gfc_expr *, bool);
int gfc_is_same_range (gfc_array_ref *, gfc_array_ref *, int, int);
int gfc_expr_is_one (gfc_expr *, int);
Index: trans-array.h
===================================================================
*** trans-array.h (revision 110537)
--- trans-array.h (working copy)
*************** tree gfc_conv_descriptor_stride (tree, t
*** 115,123 ****
tree gfc_conv_descriptor_lbound (tree, tree);
tree gfc_conv_descriptor_ubound (tree, tree);
- /* Dependency checking for WHERE and FORALL. */
- int gfc_check_dependency (gfc_expr *, gfc_expr *, gfc_expr **, int);
-
/* Add pre-loop scalarization code for intrinsic functions which require
special handling. */
void gfc_add_intrinsic_ss_code (gfc_loopinfo *, gfc_ss *);
--- 115,120 ----
Index: trans-stmt.c
===================================================================
*** trans-stmt.c (revision 110537)
--- trans-stmt.c (working copy)
*************** Software Foundation, 51 Franklin Street,
*** 37,42 ****
--- 37,43 ----
#include "trans-array.h"
#include "trans-const.h"
#include "arith.h"
+ #include "dependency.h"
typedef struct iter_info
{
*************** gfc_trans_forall_1 (gfc_code * code, for
*** 2503,2509 ****
{
case EXEC_ASSIGN:
/* A scalar or array assignment. */
! need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
/* Temporaries due to array assignment data dependencies introduce
no end of problems. */
if (need_temp)
--- 2504,2510 ----
{
case EXEC_ASSIGN:
/* A scalar or array assignment. */
! need_temp = gfc_check_dependency (c->expr, c->expr2, 0);
/* Temporaries due to array assignment data dependencies introduce
no end of problems. */
if (need_temp)
*************** gfc_trans_forall_1 (gfc_code * code, for
*** 2546,2552 ****
/* Pointer assignment inside FORALL. */
case EXEC_POINTER_ASSIGN:
! need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
if (need_temp)
gfc_trans_pointer_assign_need_temp (c->expr, c->expr2,
nested_forall_info, &block);
--- 2547,2553 ----
/* Pointer assignment inside FORALL. */
case EXEC_POINTER_ASSIGN:
! need_temp = gfc_check_dependency (c->expr, c->expr2, 0);
if (need_temp)
gfc_trans_pointer_assign_need_temp (c->expr, c->expr2,
nested_forall_info, &block);
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3058,3071 ****
expr2 = cnext->expr2;
if (nested_forall_info != NULL)
{
! int nvar;
! gfc_expr **varexpr;
!
! nvar = nested_forall_info->nvar;
! varexpr = (gfc_expr **)
! gfc_getmem (nvar * sizeof (gfc_expr *));
! need_temp = gfc_check_dependency (expr1, expr2, varexpr,
! nvar);
if (need_temp)
gfc_trans_assign_need_temp (expr1, expr2, mask,
nested_forall_info, block);
--- 3059,3065 ----
expr2 = cnext->expr2;
if (nested_forall_info != NULL)
{
! need_temp = gfc_check_dependency (expr1, expr2, 0);
if (need_temp)
gfc_trans_assign_need_temp (expr1, expr2, mask,
nested_forall_info, block);
*************** gfc_trans_where_2 (gfc_code * code, tree
*** 3120,3125 ****
--- 3114,3250 ----
}
}
+ /* Translate a simple WHERE construct or statement without dependencies.
+ CBLOCK is the "then" clause of the WHERE statement, where CBLOCK->EXPR
+ is the mask condition, and EBLOCK if non-NULL is the "else" clause.
+ Currently both CBLOCK and EBLOCK are restricted to single assignments. */
+
+ static tree
+ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
+ {
+ stmtblock_t block, body;
+ gfc_expr *cond, *tdst, *tsrc, *edst, *esrc;
+ tree tmp, cexpr, tstmt, estmt;
+ gfc_ss *css, *tdss, *tsss;
+ gfc_se cse, tdse, tsse, edse, esse;
+ gfc_loopinfo loop;
+ gfc_ss *edss = 0;
+ gfc_ss *esss = 0;
+
+ cond = cblock->expr;
+ tdst = cblock->next->expr;
+ tsrc = cblock->next->expr2;
+ edst = eblock ? eblock->next->expr : NULL;
+ esrc = eblock ? eblock->next->expr2 : NULL;
+
+ gfc_start_block (&block);
+ gfc_init_loopinfo (&loop);
+
+ /* Handle the condition. */
+ gfc_init_se (&cse, NULL);
+ css = gfc_walk_expr (cond);
+ gfc_add_ss_to_loop (&loop, css);
+
+ /* Handle the then-clause. */
+ gfc_init_se (&tdse, NULL);
+ gfc_init_se (&tsse, NULL);
+ tdss = gfc_walk_expr (tdst);
+ tsss = gfc_walk_expr (tsrc);
+ if (tsss == gfc_ss_terminator)
+ {
+ tsss = gfc_get_ss ();
+ tsss->next = gfc_ss_terminator;
+ tsss->type = GFC_SS_SCALAR;
+ tsss->expr = tsrc;
+ }
+ gfc_add_ss_to_loop (&loop, tdss);
+ gfc_add_ss_to_loop (&loop, tsss);
+
+ if (eblock)
+ {
+ /* Handle the else clause. */
+ gfc_init_se (&edse, NULL);
+ gfc_init_se (&esse, NULL);
+ edss = gfc_walk_expr (edst);
+ esss = gfc_walk_expr (esrc);
+ if (esss == gfc_ss_terminator)
+ {
+ esss = gfc_get_ss ();
+ esss->next = gfc_ss_terminator;
+ esss->type = GFC_SS_SCALAR;
+ esss->expr = esrc;
+ }
+ gfc_add_ss_to_loop (&loop, edss);
+ gfc_add_ss_to_loop (&loop, esss);
+ }
+
+ gfc_conv_ss_startstride (&loop);
+ gfc_conv_loop_setup (&loop);
+
+ gfc_mark_ss_chain_used (css, 1);
+ gfc_mark_ss_chain_used (tdss, 1);
+ gfc_mark_ss_chain_used (tsss, 1);
+ if (eblock)
+ {
+ gfc_mark_ss_chain_used (edss, 1);
+ gfc_mark_ss_chain_used (esss, 1);
+ }
+
+ gfc_start_scalarized_body (&loop, &body);
+
+ gfc_copy_loopinfo_to_se (&cse, &loop);
+ gfc_copy_loopinfo_to_se (&tdse, &loop);
+ gfc_copy_loopinfo_to_se (&tsse, &loop);
+ cse.ss = css;
+ tdse.ss = tdss;
+ tsse.ss = tsss;
+ if (eblock)
+ {
+ gfc_copy_loopinfo_to_se (&edse, &loop);
+ gfc_copy_loopinfo_to_se (&esse, &loop);
+ edse.ss = edss;
+ esse.ss = esss;
+ }
+
+ gfc_conv_expr (&cse, cond);
+ gfc_add_block_to_block (&body, &cse.pre);
+ cexpr = cse.expr;
+
+ gfc_conv_expr (&tsse, tsrc);
+ if (tdss != gfc_ss_terminator && loop.temp_ss != NULL)
+ {
+ gfc_conv_tmp_array_ref (&tdse);
+ gfc_advance_se_ss_chain (&tdse);
+ }
+ else
+ gfc_conv_expr (&tdse, tdst);
+
+ if (eblock)
+ {
+ gfc_conv_expr (&esse, esrc);
+ if (edss != gfc_ss_terminator && loop.temp_ss != NULL)
+ {
+ gfc_conv_tmp_array_ref (&edse);
+ gfc_advance_se_ss_chain (&edse);
+ }
+ else
+ gfc_conv_expr (&edse, edst);
+ }
+
+ tstmt = gfc_trans_scalar_assign (&tdse, &tsse, tdst->ts.type);
+ estmt = eblock ? gfc_trans_scalar_assign (&edse, &esse, edst->ts.type)
+ : build_empty_stmt ();
+ tmp = build3_v (COND_EXPR, cexpr, tstmt, estmt);
+ gfc_add_expr_to_block (&body, tmp);
+ gfc_add_block_to_block (&body, &cse.post);
+
+ gfc_trans_scalarizing_loops (&loop, &body);
+ gfc_add_block_to_block (&block, &loop.pre);
+ gfc_add_block_to_block (&block, &loop.post);
+ gfc_cleanup_loop (&loop);
+
+ return gfc_finish_block (&block);
+ }
/* As the WHERE or WHERE construct statement can be nested, we call
gfc_trans_where_2 to do the translation, and pass the initial
*************** gfc_trans_where (gfc_code * code)
*** 3130,3138 ****
--- 3255,3309 ----
{
stmtblock_t block;
temporary_list *temp, *p;
+ gfc_code *cblock;
+ gfc_code *eblock;
tree args;
tree tmp;
+ cblock = code->block;
+ if (cblock->next
+ && cblock->next->op == EXEC_ASSIGN
+ && !cblock->next->next)
+ {
+ eblock = cblock->block;
+ if (!eblock)
+ {
+ /* A simple "WHERE (cond) x = y" statement or block is
+ dependence free if cond is not dependent upon writing x,
+ and the source y is unaffected by the destination x. */
+ if (!gfc_check_dependency (cblock->next->expr,
+ cblock->expr, 0)
+ && !gfc_check_dependency (cblock->next->expr,
+ cblock->next->expr2, 0))
+ return gfc_trans_where_3 (cblock, NULL);
+ }
+ else if (!eblock->expr
+ && !eblock->block
+ && eblock->next
+ && eblock->next->op == EXEC_ASSIGN
+ && !eblock->next->next)
+ {
+ /* A simple "WHERE (cond) x1 = y1 ELSEWHERE x2 = y2 ENDWHERE"
+ block is dependence free if cond is not dependent on writes
+ to x1 and x2, y1 is not dependent on writes to x2, and y2
+ is not dependent on writes to x1, and both y's are not
+ dependent upon their own x's. */
+ if (!gfc_check_dependency(cblock->next->expr,
+ cblock->expr, 0)
+ && !gfc_check_dependency(eblock->next->expr,
+ cblock->expr, 0)
+ && !gfc_check_dependency(cblock->next->expr,
+ eblock->next->expr2, 0)
+ && !gfc_check_dependency(eblock->next->expr,
+ cblock->next->expr2, 0)
+ && !gfc_check_dependency(cblock->next->expr,
+ cblock->next->expr2, 0)
+ && !gfc_check_dependency(eblock->next->expr,
+ eblock->next->expr2, 0))
+ return gfc_trans_where_3 (cblock, eblock);
+ }
+ }
+
gfc_start_block (&block);
temp = NULL;
Index: Make-lang.in
===================================================================
*** Make-lang.in (revision 110537)
--- Make-lang.in (working copy)
*************** fortran/trans-types.o: $(GFORTRAN_TRANS_
*** 279,285 ****
real.h toplev.h $(TARGET_H)
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
! fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
fortran/ioparm.def
fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
--- 279,285 ----
real.h toplev.h $(TARGET_H)
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
! fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/dependency.h
fortran/trans-io.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-io.h \
fortran/ioparm.def
fortran/trans-array.o: $(GFORTRAN_TRANS_DEPS)
Roger
--