dependency.c (gfc_check_dependency): Remove unused vars and nvars arguments.
* 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. From-SVN: r110625
This commit is contained in:
Roger Sayle
Roger Sayle
parent
71ab8de85a
commit
3ded621059
6 changed files with 223 additions and 31 deletions
|
|
@ -1,3 +1,18 @@
|
|||
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.
|
||||
|
||||
2006-02-05 H.J. Lu <hongjiu.lu@intel.com>
|
||||
|
||||
PR fortran/26041
|
||||
|
|
|
|||
|
|
@ -279,7 +279,7 @@ fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
|
|||
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-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)
|
||||
|
|
|
|||
|
|
@ -259,10 +259,10 @@ gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
|
|||
{
|
||||
case EXPR_VARIABLE:
|
||||
return (gfc_ref_needs_temporary_p (expr->ref)
|
||||
|| gfc_check_dependency (var, expr, NULL, 0));
|
||||
|| gfc_check_dependency (var, expr, 1));
|
||||
|
||||
case EXPR_ARRAY:
|
||||
return gfc_check_dependency (var, expr, NULL, 0);
|
||||
return gfc_check_dependency (var, expr, 1);
|
||||
|
||||
case EXPR_FUNCTION:
|
||||
if (intent != INTENT_IN && expr->inline_noncopying_intrinsic)
|
||||
|
|
@ -339,15 +339,14 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
|
|||
|
||||
/* 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
|
||||
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, gfc_expr ** vars,
|
||||
int nvars)
|
||||
gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
|
||||
{
|
||||
gfc_ref *ref;
|
||||
int n;
|
||||
|
|
@ -367,11 +366,11 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
|
|||
switch (expr2->expr_type)
|
||||
{
|
||||
case EXPR_OP:
|
||||
n = gfc_check_dependency (expr1, expr2->value.op.op1, vars, nvars);
|
||||
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, vars, nvars);
|
||||
return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
|
||||
return 0;
|
||||
|
||||
case EXPR_VARIABLE:
|
||||
|
|
@ -387,15 +386,25 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
|
|||
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;
|
||||
}
|
||||
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. */
|
||||
|
|
@ -404,7 +413,7 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, gfc_expr ** vars,
|
|||
{
|
||||
if (!actual->expr)
|
||||
continue;
|
||||
n = gfc_check_dependency (expr1, actual->expr, vars, nvars);
|
||||
n = gfc_check_dependency (expr1, actual->expr, identical);
|
||||
if (n)
|
||||
return n;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -25,7 +25,7 @@ bool gfc_ref_needs_temporary_p (gfc_ref *);
|
|||
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_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);
|
||||
|
||||
|
|
|
|||
|
|
@ -115,9 +115,6 @@ tree gfc_conv_descriptor_stride (tree, tree);
|
|||
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 *);
|
||||
|
|
|
|||
|
|
@ -37,6 +37,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
|
|||
#include "trans-array.h"
|
||||
#include "trans-const.h"
|
||||
#include "arith.h"
|
||||
#include "dependency.h"
|
||||
|
||||
typedef struct iter_info
|
||||
{
|
||||
|
|
@ -2503,7 +2504,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
|
|||
{
|
||||
case EXEC_ASSIGN:
|
||||
/* A scalar or array assignment. */
|
||||
need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
|
||||
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)
|
||||
|
|
@ -2546,7 +2547,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
|
|||
|
||||
/* Pointer assignment inside FORALL. */
|
||||
case EXEC_POINTER_ASSIGN:
|
||||
need_temp = gfc_check_dependency (c->expr, c->expr2, varexpr, nvar);
|
||||
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);
|
||||
|
|
@ -3062,14 +3063,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
|
|||
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);
|
||||
need_temp = gfc_check_dependency (expr1, expr2, 0);
|
||||
if (need_temp)
|
||||
gfc_trans_assign_need_temp (expr1, expr2, mask,
|
||||
nested_forall_info, block);
|
||||
|
|
@ -3124,6 +3118,137 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
|
|||
}
|
||||
}
|
||||
|
||||
/* 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
|
||||
|
|
@ -3134,9 +3259,55 @@ gfc_trans_where (gfc_code * code)
|
|||
{
|
||||
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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue