bool
c_omp_check_loop_iv (tree stmt, tree declv, walk_tree_lh lh)
{
hash_set<tree> pset;
struct c_omp_check_loop_iv_data data;
int i;
data.declv = declv;
data.fail = false;
data.stmt_loc = EXPR_LOCATION (stmt);
data.lh = lh;
data.ppset = &pset;
for (i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (stmt)); i++)
{
tree init = TREE_VEC_ELT (OMP_FOR_INIT (stmt), i);
gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
tree decl = TREE_OPERAND (init, 0);
tree cond = TREE_VEC_ELT (OMP_FOR_COND (stmt), i);
gcc_assert (COMPARISON_CLASS_P (cond));
gcc_assert (TREE_OPERAND (cond, 0) == decl);
tree incr = TREE_VEC_ELT (OMP_FOR_INCR (stmt), i);
data.expr_loc = EXPR_LOCATION (TREE_OPERAND (init, 1));
data.kind = 0;
walk_tree_1 (&TREE_OPERAND (init, 1),
c_omp_check_loop_iv_r, &data, &pset, lh);
/* Don't warn for C++ random access iterators here, the
expression then involves the subtraction and always refers
to the original value. The C++ FE needs to warn on those
earlier. */
if (decl == TREE_VEC_ELT (declv, i))
{
data.expr_loc = EXPR_LOCATION (cond);
data.kind = 1;
walk_tree_1 (&TREE_OPERAND (cond, 1),
c_omp_check_loop_iv_r, &data, &pset, lh);
}
if (TREE_CODE (incr) == MODIFY_EXPR)
{
gcc_assert (TREE_OPERAND (incr, 0) == decl);
incr = TREE_OPERAND (incr, 1);
data.kind = 2;
if (TREE_CODE (incr) == PLUS_EXPR
&& TREE_OPERAND (incr, 1) == decl)
{
data.expr_loc = EXPR_LOCATION (TREE_OPERAND (incr, 0));
walk_tree_1 (&TREE_OPERAND (incr, 0),
c_omp_check_loop_iv_r, &data, &pset, lh);
}
else
{
data.expr_loc = EXPR_LOCATION (TREE_OPERAND (incr, 1));
walk_tree_1 (&TREE_OPERAND (incr, 1),
c_omp_check_loop_iv_r, &data, &pset, lh);
}
}
}
return !data.fail;
}
static void
genericize_omp_for_stmt (tree *stmt_p, int *walk_subtrees, void *data)
{
tree stmt = *stmt_p;
location_t locus = EXPR_LOCATION (stmt);
tree clab = begin_bc_block (bc_continue, locus);
cp_walk_tree (&OMP_FOR_BODY (stmt), cp_genericize_r, data, NULL);
cp_walk_tree (&OMP_FOR_CLAUSES (stmt), cp_genericize_r, data, NULL);
cp_walk_tree (&OMP_FOR_INIT (stmt), cp_genericize_r, data, NULL);
cp_walk_tree (&OMP_FOR_COND (stmt), cp_genericize_r, data, NULL);
cp_walk_tree (&OMP_FOR_INCR (stmt), cp_genericize_r, data, NULL);
cp_walk_tree (&OMP_FOR_PRE_BODY (stmt), cp_genericize_r, data, NULL);
*walk_subtrees = 0;
finish_bc_block (&OMP_FOR_BODY (stmt), bc_continue, clab);
}
tree
c_finish_omp_for (location_t locus, tree decl, tree init, tree cond,
tree incr, tree body, tree pre_body)
{
location_t elocus = locus;
bool fail = false;
if (EXPR_HAS_LOCATION (init))
elocus = EXPR_LOCATION (init);
/* Validate the iteration variable. */
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl)))
{
error ("%Hinvalid type for iteration variable %qE", &elocus, decl);
fail = true;
}
if (TYPE_UNSIGNED (TREE_TYPE (decl)))
warning (0, "%Hiteration variable %qE is unsigned", &elocus, decl);
/* In the case of "for (int i = 0...)", init will be a decl. It should
have a DECL_INITIAL that we can turn into an assignment. */
if (init == decl)
{
elocus = DECL_SOURCE_LOCATION (decl);
init = DECL_INITIAL (decl);
if (init == NULL)
{
error ("%H%qE is not initialized", &elocus, decl);
init = integer_zero_node;
fail = true;
}
init = build_modify_expr (decl, NOP_EXPR, init);
SET_EXPR_LOCATION (init, elocus);
}
gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
gcc_assert (TREE_OPERAND (init, 0) == decl);
if (cond == NULL_TREE)
{
error ("%Hmissing controlling predicate", &elocus);
fail = true;
}
else
{
bool cond_ok = false;
if (EXPR_HAS_LOCATION (cond))
elocus = EXPR_LOCATION (cond);
if (TREE_CODE (cond) == LT_EXPR
|| TREE_CODE (cond) == LE_EXPR
|| TREE_CODE (cond) == GT_EXPR
|| TREE_CODE (cond) == GE_EXPR)
{
tree op0 = TREE_OPERAND (cond, 0);
tree op1 = TREE_OPERAND (cond, 1);
/* 2.5.1. The comparison in the condition is computed in the type
of DECL, otherwise the behavior is undefined.
For example:
long n; int i;
i < n;
according to ISO will be evaluated as:
(long)i < n;
We want to force:
i < (int)n; */
if (TREE_CODE (op0) == NOP_EXPR
&& decl == TREE_OPERAND (op0, 0))
{
TREE_OPERAND (cond, 0) = TREE_OPERAND (op0, 0);
TREE_OPERAND (cond, 1) = fold_build1 (NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 1));
}
else if (TREE_CODE (op1) == NOP_EXPR
&& decl == TREE_OPERAND (op1, 0))
{
TREE_OPERAND (cond, 1) = TREE_OPERAND (op1, 0);
TREE_OPERAND (cond, 0) = fold_build1 (NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 0));
}
if (decl == TREE_OPERAND (cond, 0))
cond_ok = true;
else if (decl == TREE_OPERAND (cond, 1))
{
TREE_SET_CODE (cond, swap_tree_comparison (TREE_CODE (cond)));
TREE_OPERAND (cond, 1) = TREE_OPERAND (cond, 0);
TREE_OPERAND (cond, 0) = decl;
cond_ok = true;
}
}
if (!cond_ok)
{
error ("%Hinvalid controlling predicate", &elocus);
fail = true;
}
}
if (incr == NULL_TREE)
{
error ("%Hmissing increment expression", &elocus);
fail = true;
}
else
{
bool incr_ok = false;
if (EXPR_HAS_LOCATION (incr))
elocus = EXPR_LOCATION (incr);
/* Check all the valid increment expressions: v++, v--, ++v, --v,
v = v + incr, v = incr + v and v = v - incr. */
switch (TREE_CODE (incr))
{
case POSTINCREMENT_EXPR:
case PREINCREMENT_EXPR:
case POSTDECREMENT_EXPR:
case PREDECREMENT_EXPR:
incr_ok = (TREE_OPERAND (incr, 0) == decl);
break;
case MODIFY_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
if (TREE_OPERAND (incr, 1) == decl)
break;
if (TREE_CODE (TREE_OPERAND (incr, 1)) == PLUS_EXPR
&& (TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl
|| TREE_OPERAND (TREE_OPERAND (incr, 1), 1) == decl))
incr_ok = true;
else if (TREE_CODE (TREE_OPERAND (incr, 1)) == MINUS_EXPR
&& TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl)
incr_ok = true;
else
{
tree t = check_omp_for_incr_expr (TREE_OPERAND (incr, 1), decl);
if (t != error_mark_node)
{
incr_ok = true;
t = build2 (PLUS_EXPR, TREE_TYPE (decl), decl, t);
incr = build2 (MODIFY_EXPR, void_type_node, decl, t);
}
}
break;
default:
break;
}
if (!incr_ok)
{
error ("%Hinvalid increment expression", &elocus);
fail = true;
}
}
if (fail)
return NULL;
else
{
tree t = make_node (OMP_FOR);
TREE_TYPE (t) = void_type_node;
OMP_FOR_INIT (t) = init;
OMP_FOR_COND (t) = cond;
OMP_FOR_INCR (t) = incr;
OMP_FOR_BODY (t) = body;
OMP_FOR_PRE_BODY (t) = pre_body;
SET_EXPR_LOCATION (t, locus);
return add_stmt (t);
}
}
tree
c_finish_omp_for (location_t locus, enum tree_code code, tree declv,
tree orig_declv, tree initv, tree condv, tree incrv,
tree body, tree pre_body)
{
location_t elocus;
bool fail = false;
int i;
if ((code == CILK_SIMD || code == CILK_FOR)
&& !c_check_cilk_loop (locus, TREE_VEC_ELT (declv, 0)))
fail = true;
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (initv));
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (condv));
gcc_assert (TREE_VEC_LENGTH (declv) == TREE_VEC_LENGTH (incrv));
for (i = 0; i < TREE_VEC_LENGTH (declv); i++)
{
tree decl = TREE_VEC_ELT (declv, i);
tree init = TREE_VEC_ELT (initv, i);
tree cond = TREE_VEC_ELT (condv, i);
tree incr = TREE_VEC_ELT (incrv, i);
elocus = locus;
if (EXPR_HAS_LOCATION (init))
elocus = EXPR_LOCATION (init);
/* Validate the iteration variable. */
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl))
&& TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
{
error_at (elocus, "invalid type for iteration variable %qE", decl);
fail = true;
}
/* In the case of "for (int i = 0...)", init will be a decl. It should
have a DECL_INITIAL that we can turn into an assignment. */
if (init == decl)
{
elocus = DECL_SOURCE_LOCATION (decl);
init = DECL_INITIAL (decl);
if (init == NULL)
{
error_at (elocus, "%qE is not initialized", decl);
init = integer_zero_node;
fail = true;
}
DECL_INITIAL (decl) = NULL_TREE;
init = build_modify_expr (elocus, decl, NULL_TREE, NOP_EXPR,
/* FIXME diagnostics: This should
be the location of the INIT. */
elocus,
init,
NULL_TREE);
}
if (init != error_mark_node)
{
gcc_assert (TREE_CODE (init) == MODIFY_EXPR);
gcc_assert (TREE_OPERAND (init, 0) == decl);
}
if (cond == NULL_TREE)
{
error_at (elocus, "missing controlling predicate");
fail = true;
}
else
{
bool cond_ok = false;
if (EXPR_HAS_LOCATION (cond))
elocus = EXPR_LOCATION (cond);
if (TREE_CODE (cond) == LT_EXPR
|| TREE_CODE (cond) == LE_EXPR
|| TREE_CODE (cond) == GT_EXPR
|| TREE_CODE (cond) == GE_EXPR
|| TREE_CODE (cond) == NE_EXPR
|| TREE_CODE (cond) == EQ_EXPR)
{
tree op0 = TREE_OPERAND (cond, 0);
tree op1 = TREE_OPERAND (cond, 1);
/* 2.5.1. The comparison in the condition is computed in
the type of DECL, otherwise the behavior is undefined.
For example:
long n; int i;
i < n;
according to ISO will be evaluated as:
(long)i < n;
We want to force:
i < (int)n; */
if (TREE_CODE (op0) == NOP_EXPR
&& decl == TREE_OPERAND (op0, 0))
{
TREE_OPERAND (cond, 0) = TREE_OPERAND (op0, 0);
TREE_OPERAND (cond, 1)
= fold_build1_loc (elocus, NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 1));
}
else if (TREE_CODE (op1) == NOP_EXPR
&& decl == TREE_OPERAND (op1, 0))
{
TREE_OPERAND (cond, 1) = TREE_OPERAND (op1, 0);
TREE_OPERAND (cond, 0)
= fold_build1_loc (elocus, NOP_EXPR, TREE_TYPE (decl),
TREE_OPERAND (cond, 0));
}
if (decl == TREE_OPERAND (cond, 0))
cond_ok = true;
else if (decl == TREE_OPERAND (cond, 1))
{
TREE_SET_CODE (cond,
swap_tree_comparison (TREE_CODE (cond)));
TREE_OPERAND (cond, 1) = TREE_OPERAND (cond, 0);
TREE_OPERAND (cond, 0) = decl;
cond_ok = true;
}
if (TREE_CODE (cond) == NE_EXPR
|| TREE_CODE (cond) == EQ_EXPR)
{
if (!INTEGRAL_TYPE_P (TREE_TYPE (decl)))
{
if (code != CILK_SIMD && code != CILK_FOR)
cond_ok = false;
}
else if (operand_equal_p (TREE_OPERAND (cond, 1),
TYPE_MIN_VALUE (TREE_TYPE (decl)),
0))
TREE_SET_CODE (cond, TREE_CODE (cond) == NE_EXPR
? GT_EXPR : LE_EXPR);
else if (operand_equal_p (TREE_OPERAND (cond, 1),
TYPE_MAX_VALUE (TREE_TYPE (decl)),
0))
TREE_SET_CODE (cond, TREE_CODE (cond) == NE_EXPR
? LT_EXPR : GE_EXPR);
else if (code != CILK_SIMD && code != CILK_FOR)
cond_ok = false;
}
}
if (!cond_ok)
{
error_at (elocus, "invalid controlling predicate");
fail = true;
}
}
if (incr == NULL_TREE)
{
error_at (elocus, "missing increment expression");
fail = true;
}
else
{
bool incr_ok = false;
if (EXPR_HAS_LOCATION (incr))
elocus = EXPR_LOCATION (incr);
/* Check all the valid increment expressions: v++, v--, ++v, --v,
v = v + incr, v = incr + v and v = v - incr. */
switch (TREE_CODE (incr))
{
case POSTINCREMENT_EXPR:
case PREINCREMENT_EXPR:
case POSTDECREMENT_EXPR:
case PREDECREMENT_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
incr_ok = true;
incr = c_omp_for_incr_canonicalize_ptr (elocus, decl, incr);
break;
case COMPOUND_EXPR:
if (TREE_CODE (TREE_OPERAND (incr, 0)) != SAVE_EXPR
|| TREE_CODE (TREE_OPERAND (incr, 1)) != MODIFY_EXPR)
break;
incr = TREE_OPERAND (incr, 1);
/* FALLTHRU */
case MODIFY_EXPR:
if (TREE_OPERAND (incr, 0) != decl)
break;
if (TREE_OPERAND (incr, 1) == decl)
break;
if (TREE_CODE (TREE_OPERAND (incr, 1)) == PLUS_EXPR
&& (TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl
|| TREE_OPERAND (TREE_OPERAND (incr, 1), 1) == decl))
incr_ok = true;
else if ((TREE_CODE (TREE_OPERAND (incr, 1)) == MINUS_EXPR
|| (TREE_CODE (TREE_OPERAND (incr, 1))
== POINTER_PLUS_EXPR))
&& TREE_OPERAND (TREE_OPERAND (incr, 1), 0) == decl)
incr_ok = true;
else
{
tree t = check_omp_for_incr_expr (elocus,
TREE_OPERAND (incr, 1),
decl);
if (t != error_mark_node)
{
incr_ok = true;
t = build2 (PLUS_EXPR, TREE_TYPE (decl), decl, t);
incr = build2 (MODIFY_EXPR, void_type_node, decl, t);
}
}
break;
default:
break;
}
if (!incr_ok)
{
error_at (elocus, "invalid increment expression");
fail = true;
}
}
TREE_VEC_ELT (initv, i) = init;
TREE_VEC_ELT (incrv, i) = incr;
}
if (fail)
return NULL;
else
{
tree t = make_node (code);
TREE_TYPE (t) = void_type_node;
OMP_FOR_INIT (t) = initv;
OMP_FOR_COND (t) = condv;
OMP_FOR_INCR (t) = incrv;
OMP_FOR_BODY (t) = body;
OMP_FOR_PRE_BODY (t) = pre_body;
if (code == OMP_FOR)
OMP_FOR_ORIG_DECLS (t) = orig_declv;
SET_EXPR_LOCATION (t, locus);
return add_stmt (t);
}
}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
gfc_omp_clauses *do_clauses)
{
gfc_se se;
tree dovar, stmt, from, to, step, type, init, cond, incr;
tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
stmtblock_t block;
stmtblock_t body;
int simple = 0;
bool dovar_found = false;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
code = code->block->next;
gcc_assert (code->op == EXEC_DO);
if (pblock == NULL)
{
gfc_start_block (&block);
pblock = █
}
omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
if (clauses)
{
gfc_namelist *n;
for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
if (n == NULL)
for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
if (n != NULL)
dovar_found = true;
}
/* Evaluate all the expressions in the iterator. */
gfc_init_se (&se, NULL);
gfc_conv_expr_lhs (&se, code->ext.iterator->var);
gfc_add_block_to_block (pblock, &se.pre);
dovar = se.expr;
type = TREE_TYPE (dovar);
gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->start);
gfc_add_block_to_block (pblock, &se.pre);
from = gfc_evaluate_now (se.expr, pblock);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->end);
gfc_add_block_to_block (pblock, &se.pre);
to = gfc_evaluate_now (se.expr, pblock);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->step);
gfc_add_block_to_block (pblock, &se.pre);
step = gfc_evaluate_now (se.expr, pblock);
/* Special case simple loops. */
if (integer_onep (step))
simple = 1;
else if (tree_int_cst_equal (step, integer_minus_one_node))
simple = -1;
/* Loop body. */
if (simple)
{
init = build2_v (MODIFY_EXPR, dovar, from);
cond = build2 (simple > 0 ? LE_EXPR : GE_EXPR, boolean_type_node,
dovar, to);
incr = fold_build2 (PLUS_EXPR, type, dovar, step);
incr = fold_build2 (MODIFY_EXPR, type, dovar, incr);
if (pblock != &block)
{
pushlevel (0);
gfc_start_block (&block);
}
gfc_start_block (&body);
}
else
{
/* STEP is not 1 or -1. Use:
for (count = 0; count < (to + step - from) / step; count++)
{
dovar = from + count * step;
body;
cycle_label:;
} */
tmp = fold_build2 (MINUS_EXPR, type, step, from);
tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count");
init = build2_v (MODIFY_EXPR, count, build_int_cst (type, 0));
cond = build2 (LT_EXPR, boolean_type_node, count, tmp);
incr = fold_build2 (PLUS_EXPR, type, count, build_int_cst (type, 1));
incr = fold_build2 (MODIFY_EXPR, type, count, incr);
if (pblock != &block)
{
pushlevel (0);
gfc_start_block (&block);
}
gfc_start_block (&body);
/* Initialize DOVAR. */
tmp = fold_build2 (MULT_EXPR, type, count, step);
tmp = build2 (PLUS_EXPR, type, from, tmp);
gfc_add_modify_expr (&body, dovar, tmp);
}
if (!dovar_found)
{
tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = dovar;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
if (!simple)
{
tmp = build_omp_clause (OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = count;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
/* Cycle statement is implemented with a goto. Exit statement must not be
present for this loop. */
cycle_label = gfc_build_label_decl (NULL_TREE);
/* Put these labels where they can be found later. We put the
labels in a TREE_LIST node (because TREE_CHAIN is already
used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
label in TREE_VALUE (backend_decl). */
code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
/* Main loop body. */
tmp = gfc_trans_omp_code (code->block->next, true);
gfc_add_expr_to_block (&body, tmp);
/* Label for cycle statements (if needed). */
if (TREE_USED (cycle_label))
{
tmp = build1_v (LABEL_EXPR, cycle_label);
gfc_add_expr_to_block (&body, tmp);
}
/* End of loop body. */
stmt = make_node (OMP_FOR);
TREE_TYPE (stmt) = void_type_node;
OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
OMP_FOR_CLAUSES (stmt) = omp_clauses;
OMP_FOR_INIT (stmt) = init;
OMP_FOR_COND (stmt) = cond;
OMP_FOR_INCR (stmt) = incr;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
tree
cilk_for_number_of_iterations (tree cilk_for)
{
tree t, v, n1, n2, step, type, init, cond, incr, itype;
enum tree_code cond_code;
location_t loc = EXPR_LOCATION (cilk_for);
init = TREE_VEC_ELT (OMP_FOR_INIT (cilk_for), 0);
v = TREE_OPERAND (init, 0);
cond = TREE_VEC_ELT (OMP_FOR_COND (cilk_for), 0);
incr = TREE_VEC_ELT (OMP_FOR_INCR (cilk_for), 0);
type = TREE_TYPE (v);
gcc_assert (TREE_CODE (TREE_TYPE (v)) == INTEGER_TYPE
|| TREE_CODE (TREE_TYPE (v)) == POINTER_TYPE);
n1 = TREE_OPERAND (init, 1);
cond_code = TREE_CODE (cond);
n2 = TREE_OPERAND (cond, 1);
switch (cond_code)
{
case LT_EXPR:
case GT_EXPR:
case NE_EXPR:
break;
case LE_EXPR:
if (POINTER_TYPE_P (TREE_TYPE (n2)))
n2 = fold_build_pointer_plus_hwi_loc (loc, n2, 1);
else
n2 = fold_build2_loc (loc, PLUS_EXPR, TREE_TYPE (n2), n2,
build_int_cst (TREE_TYPE (n2), 1));
cond_code = LT_EXPR;
break;
case GE_EXPR:
if (POINTER_TYPE_P (TREE_TYPE (n2)))
n2 = fold_build_pointer_plus_hwi_loc (loc, n2, -1);
else
n2 = fold_build2_loc (loc, MINUS_EXPR, TREE_TYPE (n2), n2,
build_int_cst (TREE_TYPE (n2), 1));
cond_code = GT_EXPR;
break;
default:
gcc_unreachable ();
}
step = NULL_TREE;
switch (TREE_CODE (incr))
{
case PREINCREMENT_EXPR:
case POSTINCREMENT_EXPR:
step = build_int_cst (TREE_TYPE (v), 1);
break;
case PREDECREMENT_EXPR:
case POSTDECREMENT_EXPR:
step = build_int_cst (TREE_TYPE (v), -1);
break;
case MODIFY_EXPR:
t = TREE_OPERAND (incr, 1);
gcc_assert (TREE_OPERAND (t, 0) == v);
switch (TREE_CODE (t))
{
case PLUS_EXPR:
step = TREE_OPERAND (t, 1);
break;
case POINTER_PLUS_EXPR:
step = fold_convert (ssizetype, TREE_OPERAND (t, 1));
break;
case MINUS_EXPR:
step = TREE_OPERAND (t, 1);
step = fold_build1_loc (loc, NEGATE_EXPR, TREE_TYPE (step), step);
break;
default:
gcc_unreachable ();
}
break;
default:
gcc_unreachable ();
}
itype = type;
if (POINTER_TYPE_P (itype))
itype = signed_type_for (itype);
if (cond_code == NE_EXPR)
{
/* For NE_EXPR, we need to find out if the iterator increases
or decreases from whether step is positive or negative. */
tree stype = itype;
if (TYPE_UNSIGNED (stype))
stype = signed_type_for (stype);
cond = fold_build2_loc (loc, GE_EXPR, boolean_type_node,
fold_convert_loc (loc, stype, step),
build_int_cst (stype, 0));
t = fold_build3_loc (loc, COND_EXPR, itype, cond,
build_int_cst (itype, -1),
build_int_cst (itype, 1));
}
else
t = build_int_cst (itype, (cond_code == LT_EXPR ? -1 : 1));
t = fold_build2_loc (loc, PLUS_EXPR, itype,
fold_convert_loc (loc, itype, step), t);
t = fold_build2_loc (loc, PLUS_EXPR, itype, t,
fold_convert_loc (loc, itype, n2));
t = fold_build2_loc (loc, MINUS_EXPR, itype, t,
fold_convert_loc (loc, itype, n1));
if (TYPE_UNSIGNED (itype) && cond_code == GT_EXPR)
t = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype,
fold_build1_loc (loc, NEGATE_EXPR, itype, t),
fold_build1_loc (loc, NEGATE_EXPR, itype,
fold_convert_loc (loc, itype,
step)));
else if (TYPE_UNSIGNED (itype) && cond_code == NE_EXPR)
{
tree t1
= fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, t,
fold_convert_loc (loc, itype, step));
tree t2
= fold_build2_loc (loc, TRUNC_DIV_EXPR, itype,
fold_build1_loc (loc, NEGATE_EXPR, itype, t),
fold_build1_loc (loc, NEGATE_EXPR, itype,
fold_convert_loc (loc, itype,
step)));
t = fold_build3_loc (loc, COND_EXPR, itype, cond, t1, t2);
}
else
t = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, t,
fold_convert_loc (loc, itype, step));
cond = fold_build2_loc (loc, cond_code, boolean_type_node, n1, n2);
t = fold_build3_loc (loc, COND_EXPR, itype, cond, t,
build_int_cst (itype, 0));
return t;
}
static tree
gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
gfc_omp_clauses *do_clauses, tree par_clauses)
{
gfc_se se;
tree dovar, stmt, from, to, step, type, init, cond, incr;
tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
stmtblock_t block;
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
int i, collapse = clauses->collapse;
tree dovar_init = NULL_TREE;
if (collapse <= 0)
collapse = 1;
code = code->block->next;
gcc_assert (code->op == EXEC_DO);
init = make_tree_vec (collapse);
cond = make_tree_vec (collapse);
incr = make_tree_vec (collapse);
if (pblock == NULL)
{
gfc_start_block (&block);
pblock = █
}
omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
for (i = 0; i < collapse; i++)
{
int simple = 0;
int dovar_found = 0;
tree dovar_decl;
if (clauses)
{
gfc_namelist *n;
for (n = clauses->lists[OMP_LIST_LASTPRIVATE]; n != NULL;
n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
if (n != NULL)
dovar_found = 1;
else if (n == NULL)
for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
if (code->ext.iterator->var->symtree->n.sym == n->sym)
break;
if (n != NULL)
dovar_found++;
}
/* Evaluate all the expressions in the iterator. */
gfc_init_se (&se, NULL);
gfc_conv_expr_lhs (&se, code->ext.iterator->var);
gfc_add_block_to_block (pblock, &se.pre);
dovar = se.expr;
type = TREE_TYPE (dovar);
gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->start);
gfc_add_block_to_block (pblock, &se.pre);
from = gfc_evaluate_now (se.expr, pblock);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->end);
gfc_add_block_to_block (pblock, &se.pre);
to = gfc_evaluate_now (se.expr, pblock);
gfc_init_se (&se, NULL);
gfc_conv_expr_val (&se, code->ext.iterator->step);
gfc_add_block_to_block (pblock, &se.pre);
step = gfc_evaluate_now (se.expr, pblock);
dovar_decl = dovar;
/* Special case simple loops. */
if (TREE_CODE (dovar) == VAR_DECL)
{
if (integer_onep (step))
simple = 1;
else if (tree_int_cst_equal (step, integer_minus_one_node))
simple = -1;
}
else
dovar_decl
= gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
/* Loop body. */
if (simple)
{
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
TREE_VEC_ELT (cond, i) = fold_build2 (simple > 0 ? LE_EXPR : GE_EXPR,
boolean_type_node, dovar, to);
TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, dovar, step);
TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type, dovar,
TREE_VEC_ELT (incr, i));
}
else
{
/* STEP is not 1 or -1. Use:
for (count = 0; count < (to + step - from) / step; count++)
{
dovar = from + count * step;
body;
cycle_label:;
} */
tmp = fold_build2 (MINUS_EXPR, type, step, from);
tmp = fold_build2 (PLUS_EXPR, type, to, tmp);
tmp = fold_build2 (TRUNC_DIV_EXPR, type, tmp, step);
tmp = gfc_evaluate_now (tmp, pblock);
count = gfc_create_var (type, "count");
TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
build_int_cst (type, 0));
TREE_VEC_ELT (cond, i) = fold_build2 (LT_EXPR, boolean_type_node,
count, tmp);
TREE_VEC_ELT (incr, i) = fold_build2 (PLUS_EXPR, type, count,
build_int_cst (type, 1));
TREE_VEC_ELT (incr, i) = fold_build2 (MODIFY_EXPR, type,
count, TREE_VEC_ELT (incr, i));
/* Initialize DOVAR. */
tmp = fold_build2 (MULT_EXPR, type, count, step);
tmp = fold_build2 (PLUS_EXPR, type, from, tmp);
dovar_init = tree_cons (dovar, tmp, dovar_init);
}
if (!dovar_found)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
else if (dovar_found == 2)
{
tree c = NULL;
tmp = NULL;
if (!simple)
{
/* If dovar is lastprivate, but different counter is used,
dovar += step needs to be added to
OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
will have the value on entry of the last loop, rather
than value after iterator increment. */
tmp = gfc_evaluate_now (step, pblock);
tmp = fold_build2 (PLUS_EXPR, type, dovar, tmp);
tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp);
for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
&& OMP_CLAUSE_DECL (c) == dovar_decl)
{
OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
break;
}
}
if (c == NULL && par_clauses != NULL)
{
for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
&& OMP_CLAUSE_DECL (c) == dovar_decl)
{
tree l = build_omp_clause (input_location,
OMP_CLAUSE_LASTPRIVATE);
OMP_CLAUSE_DECL (l) = dovar_decl;
OMP_CLAUSE_CHAIN (l) = omp_clauses;
OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
omp_clauses = l;
OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
break;
}
}
gcc_assert (simple || c != NULL);
}
if (!simple)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
OMP_CLAUSE_DECL (tmp) = count;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
if (i + 1 < collapse)
code = code->block->next;
}
if (pblock != &block)
{
pushlevel (0);
gfc_start_block (&block);
}
gfc_start_block (&body);
dovar_init = nreverse (dovar_init);
while (dovar_init)
{
gfc_add_modify (&body, TREE_PURPOSE (dovar_init),
TREE_VALUE (dovar_init));
dovar_init = TREE_CHAIN (dovar_init);
}
/* Cycle statement is implemented with a goto. Exit statement must not be
present for this loop. */
cycle_label = gfc_build_label_decl (NULL_TREE);
/* Put these labels where they can be found later. We put the
labels in a TREE_LIST node (because TREE_CHAIN is already
used). cycle_label goes in TREE_PURPOSE (backend_decl), exit
label in TREE_VALUE (backend_decl). */
code->block->backend_decl = tree_cons (cycle_label, NULL, NULL);
/* Main loop body. */
tmp = gfc_trans_omp_code (code->block->next, true);
gfc_add_expr_to_block (&body, tmp);
/* Label for cycle statements (if needed). */
if (TREE_USED (cycle_label))
{
tmp = build1_v (LABEL_EXPR, cycle_label);
gfc_add_expr_to_block (&body, tmp);
}
/* End of loop body. */
stmt = make_node (OMP_FOR);
TREE_TYPE (stmt) = void_type_node;
OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
OMP_FOR_CLAUSES (stmt) = omp_clauses;
OMP_FOR_INIT (stmt) = init;
OMP_FOR_COND (stmt) = cond;
OMP_FOR_INCR (stmt) = incr;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
}
