static void
pack_ts_omp_clause_value_fields (struct output_block *ob,
struct bitpack_d *bp, tree expr)
{
stream_output_location (ob, bp, OMP_CLAUSE_LOCATION (expr));
switch (OMP_CLAUSE_CODE (expr))
{
case OMP_CLAUSE_DEFAULT:
bp_pack_enum (bp, omp_clause_default_kind, OMP_CLAUSE_DEFAULT_LAST,
OMP_CLAUSE_DEFAULT_KIND (expr));
break;
case OMP_CLAUSE_SCHEDULE:
bp_pack_enum (bp, omp_clause_schedule_kind, OMP_CLAUSE_SCHEDULE_LAST,
OMP_CLAUSE_SCHEDULE_KIND (expr));
break;
case OMP_CLAUSE_DEPEND:
bp_pack_enum (bp, omp_clause_depend_kind, OMP_CLAUSE_DEPEND_LAST,
OMP_CLAUSE_DEPEND_KIND (expr));
break;
case OMP_CLAUSE_MAP:
bp_pack_enum (bp, gomp_map_kind, GOMP_MAP_LAST,
OMP_CLAUSE_MAP_KIND (expr));
break;
case OMP_CLAUSE_PROC_BIND:
bp_pack_enum (bp, omp_clause_proc_bind_kind, OMP_CLAUSE_PROC_BIND_LAST,
OMP_CLAUSE_PROC_BIND_KIND (expr));
break;
case OMP_CLAUSE_REDUCTION:
bp_pack_enum (bp, tree_code, MAX_TREE_CODES,
OMP_CLAUSE_REDUCTION_CODE (expr));
break;
default:
break;
}
}
static void
unpack_ts_omp_clause_value_fields (struct data_in *data_in,
struct bitpack_d *bp, tree expr)
{
stream_input_location (&OMP_CLAUSE_LOCATION (expr), bp, data_in);
switch (OMP_CLAUSE_CODE (expr))
{
case OMP_CLAUSE_DEFAULT:
OMP_CLAUSE_DEFAULT_KIND (expr)
= bp_unpack_enum (bp, omp_clause_default_kind,
OMP_CLAUSE_DEFAULT_LAST);
break;
case OMP_CLAUSE_SCHEDULE:
OMP_CLAUSE_SCHEDULE_KIND (expr)
= bp_unpack_enum (bp, omp_clause_schedule_kind,
OMP_CLAUSE_SCHEDULE_LAST);
break;
case OMP_CLAUSE_DEPEND:
OMP_CLAUSE_DEPEND_KIND (expr)
= bp_unpack_enum (bp, omp_clause_depend_kind, OMP_CLAUSE_DEPEND_LAST);
break;
case OMP_CLAUSE_MAP:
OMP_CLAUSE_SET_MAP_KIND (expr, bp_unpack_enum (bp, gomp_map_kind,
GOMP_MAP_LAST));
break;
case OMP_CLAUSE_PROC_BIND:
OMP_CLAUSE_PROC_BIND_KIND (expr)
= bp_unpack_enum (bp, omp_clause_proc_bind_kind,
OMP_CLAUSE_PROC_BIND_LAST);
break;
case OMP_CLAUSE_REDUCTION:
OMP_CLAUSE_REDUCTION_CODE (expr)
= bp_unpack_enum (bp, tree_code, MAX_TREE_CODES);
break;
default:
break;
}
}
static void
gfc_trans_omp_array_reduction (tree c, gfc_symbol *sym, locus where)
{
gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
gfc_expr *e1, *e2, *e3, *e4;
gfc_ref *ref;
tree decl, backend_decl, stmt;
locus old_loc = gfc_current_locus;
const char *iname;
try t;
decl = OMP_CLAUSE_DECL (c);
gfc_current_locus = where;
/* Create a fake symbol for init value. */
memset (&init_val_sym, 0, sizeof (init_val_sym));
init_val_sym.ns = sym->ns;
init_val_sym.name = sym->name;
init_val_sym.ts = sym->ts;
init_val_sym.attr.referenced = 1;
init_val_sym.declared_at = where;
init_val_sym.attr.flavor = FL_VARIABLE;
backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
init_val_sym.backend_decl = backend_decl;
/* Create a fake symbol for the outer array reference. */
outer_sym = *sym;
outer_sym.as = gfc_copy_array_spec (sym->as);
outer_sym.attr.dummy = 0;
outer_sym.attr.result = 0;
outer_sym.attr.flavor = FL_VARIABLE;
outer_sym.backend_decl = create_tmp_var_raw (TREE_TYPE (decl), NULL);
/* Create fake symtrees for it. */
symtree1 = gfc_new_symtree (&root1, sym->name);
symtree1->n.sym = sym;
gcc_assert (symtree1 == root1);
symtree2 = gfc_new_symtree (&root2, sym->name);
symtree2->n.sym = &init_val_sym;
gcc_assert (symtree2 == root2);
symtree3 = gfc_new_symtree (&root3, sym->name);
symtree3->n.sym = &outer_sym;
gcc_assert (symtree3 == root3);
/* Create expressions. */
e1 = gfc_get_expr ();
e1->expr_type = EXPR_VARIABLE;
e1->where = where;
e1->symtree = symtree1;
e1->ts = sym->ts;
e1->ref = ref = gfc_get_ref ();
ref->u.ar.where = where;
ref->u.ar.as = sym->as;
ref->u.ar.type = AR_FULL;
ref->u.ar.dimen = 0;
t = gfc_resolve_expr (e1);
gcc_assert (t == SUCCESS);
e2 = gfc_get_expr ();
e2->expr_type = EXPR_VARIABLE;
e2->where = where;
e2->symtree = symtree2;
e2->ts = sym->ts;
t = gfc_resolve_expr (e2);
gcc_assert (t == SUCCESS);
e3 = gfc_copy_expr (e1);
e3->symtree = symtree3;
t = gfc_resolve_expr (e3);
gcc_assert (t == SUCCESS);
iname = NULL;
switch (OMP_CLAUSE_REDUCTION_CODE (c))
{
case PLUS_EXPR:
case MINUS_EXPR:
e4 = gfc_add (e3, e1);
break;
case MULT_EXPR:
e4 = gfc_multiply (e3, e1);
break;
case TRUTH_ANDIF_EXPR:
e4 = gfc_and (e3, e1);
break;
case TRUTH_ORIF_EXPR:
e4 = gfc_or (e3, e1);
break;
case EQ_EXPR:
e4 = gfc_eqv (e3, e1);
break;
case NE_EXPR:
e4 = gfc_neqv (e3, e1);
break;
case MIN_EXPR:
iname = "min";
break;
case MAX_EXPR:
iname = "max";
break;
case BIT_AND_EXPR:
iname = "iand";
break;
case BIT_IOR_EXPR:
iname = "ior";
break;
case BIT_XOR_EXPR:
iname = "ieor";
break;
default:
gcc_unreachable ();
}
if (iname != NULL)
{
memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
intrinsic_sym.ns = sym->ns;
intrinsic_sym.name = iname;
intrinsic_sym.ts = sym->ts;
intrinsic_sym.attr.referenced = 1;
intrinsic_sym.attr.intrinsic = 1;
intrinsic_sym.attr.function = 1;
intrinsic_sym.result = &intrinsic_sym;
intrinsic_sym.declared_at = where;
symtree4 = gfc_new_symtree (&root4, iname);
symtree4->n.sym = &intrinsic_sym;
gcc_assert (symtree4 == root4);
e4 = gfc_get_expr ();
e4->expr_type = EXPR_FUNCTION;
e4->where = where;
e4->symtree = symtree4;
e4->value.function.isym = gfc_find_function (iname);
e4->value.function.actual = gfc_get_actual_arglist ();
e4->value.function.actual->expr = e3;
e4->value.function.actual->next = gfc_get_actual_arglist ();
e4->value.function.actual->next->expr = e1;
}
/* e1 and e3 have been stored as arguments of e4, avoid sharing. */
e1 = gfc_copy_expr (e1);
e3 = gfc_copy_expr (e3);
t = gfc_resolve_expr (e4);
gcc_assert (t == SUCCESS);
/* Create the init statement list. */
pushlevel (0);
stmt = gfc_trans_assignment (e1, e2, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
poplevel (0, 0, 0);
OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
/* Create the merge statement list. */
pushlevel (0);
stmt = gfc_trans_assignment (e3, e4, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0, 0));
else
poplevel (0, 0, 0);
OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
/* And stick the placeholder VAR_DECL into the clause as well. */
OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_sym.backend_decl;
gfc_current_locus = old_loc;
gfc_free_expr (e1);
gfc_free_expr (e2);
gfc_free_expr (e3);
gfc_free_expr (e4);
gfc_free (symtree1);
gfc_free (symtree2);
gfc_free (symtree3);
if (symtree4)
gfc_free (symtree4);
gfc_free_array_spec (outer_sym.as);
}
static tree
gfc_trans_omp_reduction_list (gfc_namelist *namelist, tree list,
enum tree_code reduction_code, locus where)
{
for (; namelist != NULL; namelist = namelist->next)
if (namelist->sym->attr.referenced)
{
tree t = gfc_trans_omp_variable (namelist->sym);
if (t != error_mark_node)
{
tree node = build_omp_clause (OMP_CLAUSE_REDUCTION);
OMP_CLAUSE_DECL (node) = t;
OMP_CLAUSE_REDUCTION_CODE (node) = reduction_code;
if (namelist->sym->attr.dimension)
gfc_trans_omp_array_reduction (node, namelist->sym, where);
list = gfc_trans_add_clause (node, list);
}
}
return list;
}
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
int list;
enum omp_clause_code clause_code;
gfc_se se;
if (clauses == NULL)
return NULL_TREE;
for (list = 0; list < OMP_LIST_NUM; list++)
{
gfc_namelist *n = clauses->lists[list];
if (n == NULL)
continue;
if (list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
{
enum tree_code reduction_code;
switch (list)
{
case OMP_LIST_PLUS:
reduction_code = PLUS_EXPR;
break;
case OMP_LIST_MULT:
reduction_code = MULT_EXPR;
break;
case OMP_LIST_SUB:
reduction_code = MINUS_EXPR;
break;
case OMP_LIST_AND:
reduction_code = TRUTH_ANDIF_EXPR;
break;
case OMP_LIST_OR:
reduction_code = TRUTH_ORIF_EXPR;
break;
case OMP_LIST_EQV:
reduction_code = EQ_EXPR;
break;
case OMP_LIST_NEQV:
reduction_code = NE_EXPR;
break;
case OMP_LIST_MAX:
reduction_code = MAX_EXPR;
break;
case OMP_LIST_MIN:
reduction_code = MIN_EXPR;
break;
case OMP_LIST_IAND:
reduction_code = BIT_AND_EXPR;
break;
case OMP_LIST_IOR:
reduction_code = BIT_IOR_EXPR;
break;
case OMP_LIST_IEOR:
reduction_code = BIT_XOR_EXPR;
break;
default:
gcc_unreachable ();
}
old_clauses = omp_clauses;
omp_clauses
= gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
where);
continue;
}
switch (list)
{
case OMP_LIST_PRIVATE:
clause_code = OMP_CLAUSE_PRIVATE;
goto add_clause;
case OMP_LIST_SHARED:
clause_code = OMP_CLAUSE_SHARED;
goto add_clause;
case OMP_LIST_FIRSTPRIVATE:
clause_code = OMP_CLAUSE_FIRSTPRIVATE;
goto add_clause;
case OMP_LIST_LASTPRIVATE:
clause_code = OMP_CLAUSE_LASTPRIVATE;
goto add_clause;
case OMP_LIST_COPYIN:
clause_code = OMP_CLAUSE_COPYIN;
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
/* FALLTHROUGH */
add_clause:
omp_clauses
= gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
break;
default:
break;
}
}
if (clauses->if_expr)
{
tree if_var;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->if_expr);
gfc_add_block_to_block (block, &se.pre);
if_var = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (OMP_CLAUSE_IF);
OMP_CLAUSE_IF_EXPR (c) = if_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->num_threads)
{
tree num_threads;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->num_threads);
gfc_add_block_to_block (block, &se.pre);
num_threads = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (OMP_CLAUSE_NUM_THREADS);
OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
chunk_size = NULL_TREE;
if (clauses->chunk_size)
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->chunk_size);
gfc_add_block_to_block (block, &se.pre);
chunk_size = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
if (clauses->sched_kind != OMP_SCHED_NONE)
{
c = build_omp_clause (OMP_CLAUSE_SCHEDULE);
OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
switch (clauses->sched_kind)
{
case OMP_SCHED_STATIC:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
break;
case OMP_SCHED_DYNAMIC:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
break;
case OMP_SCHED_GUIDED:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
break;
case OMP_SCHED_RUNTIME:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
break;
default:
gcc_unreachable ();
}
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
{
c = build_omp_clause (OMP_CLAUSE_DEFAULT);
switch (clauses->default_sharing)
{
case OMP_DEFAULT_NONE:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
break;
case OMP_DEFAULT_SHARED:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
break;
case OMP_DEFAULT_PRIVATE:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
break;
default:
gcc_unreachable ();
}
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->nowait)
{
c = build_omp_clause (OMP_CLAUSE_NOWAIT);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->ordered)
{
c = build_omp_clause (OMP_CLAUSE_ORDERED);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
return omp_clauses;
}
void
omp_extract_for_data (gomp_for *for_stmt, struct omp_for_data *fd,
struct omp_for_data_loop *loops)
{
tree t, var, *collapse_iter, *collapse_count;
tree count = NULL_TREE, iter_type = long_integer_type_node;
struct omp_for_data_loop *loop;
int i;
struct omp_for_data_loop dummy_loop;
location_t loc = gimple_location (for_stmt);
bool simd = gimple_omp_for_kind (for_stmt) & GF_OMP_FOR_SIMD;
bool distribute = gimple_omp_for_kind (for_stmt)
== GF_OMP_FOR_KIND_DISTRIBUTE;
bool taskloop = gimple_omp_for_kind (for_stmt)
== GF_OMP_FOR_KIND_TASKLOOP;
tree iterv, countv;
fd->for_stmt = for_stmt;
fd->pre = NULL;
if (gimple_omp_for_collapse (for_stmt) > 1)
fd->loops = loops;
else
fd->loops = &fd->loop;
fd->have_nowait = distribute || simd;
fd->have_ordered = false;
fd->collapse = 1;
fd->ordered = 0;
fd->sched_kind = OMP_CLAUSE_SCHEDULE_STATIC;
fd->sched_modifiers = 0;
fd->chunk_size = NULL_TREE;
fd->simd_schedule = false;
if (gimple_omp_for_kind (fd->for_stmt) == GF_OMP_FOR_KIND_CILKFOR)
fd->sched_kind = OMP_CLAUSE_SCHEDULE_CILKFOR;
collapse_iter = NULL;
collapse_count = NULL;
for (t = gimple_omp_for_clauses (for_stmt); t ; t = OMP_CLAUSE_CHAIN (t))
switch (OMP_CLAUSE_CODE (t))
{
case OMP_CLAUSE_NOWAIT:
fd->have_nowait = true;
break;
case OMP_CLAUSE_ORDERED:
fd->have_ordered = true;
if (OMP_CLAUSE_ORDERED_EXPR (t))
fd->ordered = tree_to_shwi (OMP_CLAUSE_ORDERED_EXPR (t));
break;
case OMP_CLAUSE_SCHEDULE:
gcc_assert (!distribute && !taskloop);
fd->sched_kind
= (enum omp_clause_schedule_kind)
(OMP_CLAUSE_SCHEDULE_KIND (t) & OMP_CLAUSE_SCHEDULE_MASK);
fd->sched_modifiers = (OMP_CLAUSE_SCHEDULE_KIND (t)
& ~OMP_CLAUSE_SCHEDULE_MASK);
fd->chunk_size = OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (t);
fd->simd_schedule = OMP_CLAUSE_SCHEDULE_SIMD (t);
break;
case OMP_CLAUSE_DIST_SCHEDULE:
gcc_assert (distribute);
fd->chunk_size = OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (t);
break;
case OMP_CLAUSE_COLLAPSE:
fd->collapse = tree_to_shwi (OMP_CLAUSE_COLLAPSE_EXPR (t));
if (fd->collapse > 1)
{
collapse_iter = &OMP_CLAUSE_COLLAPSE_ITERVAR (t);
collapse_count = &OMP_CLAUSE_COLLAPSE_COUNT (t);
}
break;
default:
break;
}
if (fd->ordered && fd->collapse == 1 && loops != NULL)
{
fd->loops = loops;
iterv = NULL_TREE;
countv = NULL_TREE;
collapse_iter = &iterv;
collapse_count = &countv;
}
/* FIXME: for now map schedule(auto) to schedule(static).
There should be analysis to determine whether all iterations
are approximately the same amount of work (then schedule(static)
is best) or if it varies (then schedule(dynamic,N) is better). */
if (fd->sched_kind == OMP_CLAUSE_SCHEDULE_AUTO)
{
fd->sched_kind = OMP_CLAUSE_SCHEDULE_STATIC;
gcc_assert (fd->chunk_size == NULL);
}
gcc_assert (fd->collapse == 1 || collapse_iter != NULL);
if (taskloop)
fd->sched_kind = OMP_CLAUSE_SCHEDULE_RUNTIME;
if (fd->sched_kind == OMP_CLAUSE_SCHEDULE_RUNTIME)
gcc_assert (fd->chunk_size == NULL);
else if (fd->chunk_size == NULL)
{
/* We only need to compute a default chunk size for ordered
static loops and dynamic loops. */
if (fd->sched_kind != OMP_CLAUSE_SCHEDULE_STATIC
|| fd->have_ordered)
fd->chunk_size = (fd->sched_kind == OMP_CLAUSE_SCHEDULE_STATIC)
? integer_zero_node : integer_one_node;
}
int cnt = fd->ordered ? fd->ordered : fd->collapse;
for (i = 0; i < cnt; i++)
{
if (i == 0 && fd->collapse == 1 && (fd->ordered == 0 || loops == NULL))
loop = &fd->loop;
else if (loops != NULL)
loop = loops + i;
else
loop = &dummy_loop;
loop->v = gimple_omp_for_index (for_stmt, i);
gcc_assert (SSA_VAR_P (loop->v));
gcc_assert (TREE_CODE (TREE_TYPE (loop->v)) == INTEGER_TYPE
|| TREE_CODE (TREE_TYPE (loop->v)) == POINTER_TYPE);
var = TREE_CODE (loop->v) == SSA_NAME ? SSA_NAME_VAR (loop->v) : loop->v;
loop->n1 = gimple_omp_for_initial (for_stmt, i);
loop->cond_code = gimple_omp_for_cond (for_stmt, i);
loop->n2 = gimple_omp_for_final (for_stmt, i);
gcc_assert (loop->cond_code != NE_EXPR
|| gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_CILKSIMD
|| gimple_omp_for_kind (for_stmt) == GF_OMP_FOR_KIND_CILKFOR);
omp_adjust_for_condition (loc, &loop->cond_code, &loop->n2);
t = gimple_omp_for_incr (for_stmt, i);
gcc_assert (TREE_OPERAND (t, 0) == var);
loop->step = omp_get_for_step_from_incr (loc, t);
if (simd
|| (fd->sched_kind == OMP_CLAUSE_SCHEDULE_STATIC
&& !fd->have_ordered))
{
if (fd->collapse == 1)
iter_type = TREE_TYPE (loop->v);
else if (i == 0
|| TYPE_PRECISION (iter_type)
< TYPE_PRECISION (TREE_TYPE (loop->v)))
iter_type
= build_nonstandard_integer_type
(TYPE_PRECISION (TREE_TYPE (loop->v)), 1);
}
else if (iter_type != long_long_unsigned_type_node)
{
if (POINTER_TYPE_P (TREE_TYPE (loop->v)))
iter_type = long_long_unsigned_type_node;
else if (TYPE_UNSIGNED (TREE_TYPE (loop->v))
&& TYPE_PRECISION (TREE_TYPE (loop->v))
>= TYPE_PRECISION (iter_type))
{
tree n;
if (loop->cond_code == LT_EXPR)
n = fold_build2_loc (loc,
PLUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
else
n = loop->n1;
if (TREE_CODE (n) != INTEGER_CST
|| tree_int_cst_lt (TYPE_MAX_VALUE (iter_type), n))
iter_type = long_long_unsigned_type_node;
}
else if (TYPE_PRECISION (TREE_TYPE (loop->v))
> TYPE_PRECISION (iter_type))
{
tree n1, n2;
if (loop->cond_code == LT_EXPR)
{
n1 = loop->n1;
n2 = fold_build2_loc (loc,
PLUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
}
else
{
n1 = fold_build2_loc (loc,
MINUS_EXPR, TREE_TYPE (loop->v),
loop->n2, loop->step);
n2 = loop->n1;
}
if (TREE_CODE (n1) != INTEGER_CST
|| TREE_CODE (n2) != INTEGER_CST
|| !tree_int_cst_lt (TYPE_MIN_VALUE (iter_type), n1)
|| !tree_int_cst_lt (n2, TYPE_MAX_VALUE (iter_type)))
iter_type = long_long_unsigned_type_node;
}
}
if (i >= fd->collapse)
continue;
if (collapse_count && *collapse_count == NULL)
{
t = fold_binary (loop->cond_code, boolean_type_node,
fold_convert (TREE_TYPE (loop->v), loop->n1),
fold_convert (TREE_TYPE (loop->v), loop->n2));
if (t && integer_zerop (t))
count = build_zero_cst (long_long_unsigned_type_node);
else if ((i == 0 || count != NULL_TREE)
&& TREE_CODE (TREE_TYPE (loop->v)) == INTEGER_TYPE
&& TREE_CONSTANT (loop->n1)
&& TREE_CONSTANT (loop->n2)
&& TREE_CODE (loop->step) == INTEGER_CST)
{
tree itype = TREE_TYPE (loop->v);
if (POINTER_TYPE_P (itype))
itype = signed_type_for (itype);
t = build_int_cst (itype, (loop->cond_code == LT_EXPR ? -1 : 1));
t = fold_build2_loc (loc,
PLUS_EXPR, itype,
fold_convert_loc (loc, itype, loop->step), t);
t = fold_build2_loc (loc, PLUS_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->n2));
t = fold_build2_loc (loc, MINUS_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->n1));
if (TYPE_UNSIGNED (itype) && loop->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,
loop->step)));
else
t = fold_build2_loc (loc, TRUNC_DIV_EXPR, itype, t,
fold_convert_loc (loc, itype, loop->step));
t = fold_convert_loc (loc, long_long_unsigned_type_node, t);
if (count != NULL_TREE)
count = fold_build2_loc (loc,
MULT_EXPR, long_long_unsigned_type_node,
count, t);
else
count = t;
if (TREE_CODE (count) != INTEGER_CST)
count = NULL_TREE;
}
else if (count && !integer_zerop (count))
count = NULL_TREE;
}
}
if (count
&& !simd
&& (fd->sched_kind != OMP_CLAUSE_SCHEDULE_STATIC
|| fd->have_ordered))
{
if (!tree_int_cst_lt (count, TYPE_MAX_VALUE (long_integer_type_node)))
iter_type = long_long_unsigned_type_node;
else
iter_type = long_integer_type_node;
}
else if (collapse_iter && *collapse_iter != NULL)
iter_type = TREE_TYPE (*collapse_iter);
fd->iter_type = iter_type;
if (collapse_iter && *collapse_iter == NULL)
*collapse_iter = create_tmp_var (iter_type, ".iter");
if (collapse_count && *collapse_count == NULL)
{
if (count)
*collapse_count = fold_convert_loc (loc, iter_type, count);
else
*collapse_count = create_tmp_var (iter_type, ".count");
}
if (fd->collapse > 1 || (fd->ordered && loops))
{
fd->loop.v = *collapse_iter;
fd->loop.n1 = build_int_cst (TREE_TYPE (fd->loop.v), 0);
fd->loop.n2 = *collapse_count;
fd->loop.step = build_int_cst (TREE_TYPE (fd->loop.v), 1);
fd->loop.cond_code = LT_EXPR;
}
else if (loops)
loops[0] = fd->loop;
}
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
tree omp_clauses = NULL_TREE, chunk_size, c;
int list;
enum omp_clause_code clause_code;
gfc_se se;
if (clauses == NULL)
return NULL_TREE;
for (list = 0; list < OMP_LIST_NUM; list++)
{
gfc_namelist *n = clauses->lists[list];
if (n == NULL)
continue;
if (list >= OMP_LIST_REDUCTION_FIRST
&& list <= OMP_LIST_REDUCTION_LAST)
{
enum tree_code reduction_code;
switch (list)
{
case OMP_LIST_PLUS:
reduction_code = PLUS_EXPR;
break;
case OMP_LIST_MULT:
reduction_code = MULT_EXPR;
break;
case OMP_LIST_SUB:
reduction_code = MINUS_EXPR;
break;
case OMP_LIST_AND:
reduction_code = TRUTH_ANDIF_EXPR;
break;
case OMP_LIST_OR:
reduction_code = TRUTH_ORIF_EXPR;
break;
case OMP_LIST_EQV:
reduction_code = EQ_EXPR;
break;
case OMP_LIST_NEQV:
reduction_code = NE_EXPR;
break;
case OMP_LIST_MAX:
reduction_code = MAX_EXPR;
break;
case OMP_LIST_MIN:
reduction_code = MIN_EXPR;
break;
case OMP_LIST_IAND:
reduction_code = BIT_AND_EXPR;
break;
case OMP_LIST_IOR:
reduction_code = BIT_IOR_EXPR;
break;
case OMP_LIST_IEOR:
reduction_code = BIT_XOR_EXPR;
break;
default:
gcc_unreachable ();
}
omp_clauses
= gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
where);
continue;
}
switch (list)
{
case OMP_LIST_PRIVATE:
clause_code = OMP_CLAUSE_PRIVATE;
goto add_clause;
case OMP_LIST_SHARED:
clause_code = OMP_CLAUSE_SHARED;
goto add_clause;
case OMP_LIST_FIRSTPRIVATE:
clause_code = OMP_CLAUSE_FIRSTPRIVATE;
goto add_clause;
case OMP_LIST_LASTPRIVATE:
clause_code = OMP_CLAUSE_LASTPRIVATE;
goto add_clause;
case OMP_LIST_COPYIN:
clause_code = OMP_CLAUSE_COPYIN;
goto add_clause;
case OMP_LIST_COPYPRIVATE:
clause_code = OMP_CLAUSE_COPYPRIVATE;
/* FALLTHROUGH */
add_clause:
omp_clauses
= gfc_trans_omp_variable_list (clause_code, n, omp_clauses);
break;
default:
break;
}
}
if (clauses->if_expr)
{
tree if_var;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->if_expr);
gfc_add_block_to_block (block, &se.pre);
if_var = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_IF);
OMP_CLAUSE_IF_EXPR (c) = if_var;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->num_threads)
{
tree num_threads;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->num_threads);
gfc_add_block_to_block (block, &se.pre);
num_threads = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NUM_THREADS);
OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
chunk_size = NULL_TREE;
if (clauses->chunk_size)
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, clauses->chunk_size);
gfc_add_block_to_block (block, &se.pre);
chunk_size = gfc_evaluate_now (se.expr, block);
gfc_add_block_to_block (block, &se.post);
}
if (clauses->sched_kind != OMP_SCHED_NONE)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_SCHEDULE);
OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
switch (clauses->sched_kind)
{
case OMP_SCHED_STATIC:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
break;
case OMP_SCHED_DYNAMIC:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
break;
case OMP_SCHED_GUIDED:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
break;
case OMP_SCHED_RUNTIME:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
break;
case OMP_SCHED_AUTO:
OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
break;
default:
gcc_unreachable ();
}
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULT);
switch (clauses->default_sharing)
{
case OMP_DEFAULT_NONE:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
break;
case OMP_DEFAULT_SHARED:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
break;
case OMP_DEFAULT_PRIVATE:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
break;
case OMP_DEFAULT_FIRSTPRIVATE:
OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
break;
default:
gcc_unreachable ();
}
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->nowait)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->ordered)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->untied)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_UNTIED);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
if (clauses->collapse)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_COLLAPSE);
OMP_CLAUSE_COLLAPSE_EXPR (c) = build_int_cst (NULL, clauses->collapse);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
return omp_clauses;
}
