@@ -246,7 +246,7 @@ enum gfc_statement
ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP,
- ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD,
+ ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
ST_EVENT_WAIT,ST_NONE
@@ -1110,7 +1110,9 @@ enum gfc_omp_depend_op
{
OMP_DEPEND_IN,
OMP_DEPEND_OUT,
- OMP_DEPEND_INOUT
+ OMP_DEPEND_INOUT,
+ OMP_DEPEND_SINK_FIRST,
+ OMP_DEPEND_SINK
};
enum gfc_omp_map_op
@@ -1255,7 +1257,7 @@ typedef struct gfc_omp_clauses
bool nowait, ordered, untied, mergeable;
bool inbranch, notinbranch, defaultmap, nogroup;
bool sched_simd, sched_monotonic, sched_nonmonotonic;
- bool simd, threads;
+ bool simd, threads, depend_source;
enum gfc_omp_cancel_kind cancel;
enum gfc_omp_proc_bind_kind proc_bind;
struct gfc_expr *safelen_expr;
@@ -831,7 +831,14 @@ decode_omp_directive (void)
matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
break;
case 'o':
- matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
+ if (flag_openmp && gfc_match ("ordered depend (") == MATCH_YES)
+ {
+ gfc_current_locus = old_locus;
+ matcho ("ordered", gfc_match_omp_ordered_depend,
+ ST_OMP_ORDERED_DEPEND);
+ }
+ else
+ matcho ("ordered", gfc_match_omp_ordered, ST_OMP_ORDERED);
break;
case 'p':
matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
@@ -1373,7 +1380,8 @@ next_statement (void)
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
- case ST_OMP_TARGET_EXIT_DATA: case ST_ERROR_STOP: case ST_SYNC_ALL: \
+ case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
+ case ST_ERROR_STOP: case ST_SYNC_ALL: \
case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
case ST_EVENT_POST: case ST_EVENT_WAIT: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
@@ -2149,6 +2157,7 @@ gfc_ascii_statement (gfc_statement st)
p = "!$OMP MASTER";
break;
case ST_OMP_ORDERED:
+ case ST_OMP_ORDERED_DEPEND:
p = "!$OMP ORDERED";
break;
case ST_OMP_PARALLEL:
@@ -215,6 +215,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
case EXEC_OMP_END_SINGLE:
+ case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
@@ -261,7 +262,6 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_MASTER:
- case EXEC_OMP_ORDERED:
case EXEC_OMP_END_NOWAIT:
case EXEC_OMP_TASKGROUP:
case EXEC_OMP_TASKWAIT:
@@ -1050,6 +1050,27 @@ show_omp_namelist (int list_type, gfc_om
case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
+ case OMP_DEPEND_SINK_FIRST:
+ fputs ("sink:", dumpfile);
+ while (1)
+ {
+ fprintf (dumpfile, "%s", n->sym->name);
+ if (n->expr)
+ {
+ fputc ('+', dumpfile);
+ show_expr (n->expr);
+ }
+ if (n->next == NULL)
+ break;
+ else if (n->next->u.depend_op != OMP_DEPEND_SINK)
+ {
+ fputs (") DEPEND(", dumpfile);
+ break;
+ }
+ fputc (',', dumpfile);
+ n = n->next;
+ }
+ continue;
default: break;
}
else if (list_type == OMP_LIST_MAP)
@@ -1423,6 +1444,8 @@ show_omp_clauses (gfc_omp_clauses *omp_c
show_expr (omp_clauses->if_exprs[i]);
fputc (')', dumpfile);
}
+ if (omp_clauses->depend_source)
+ fputs (" DEPEND(source)", dumpfile);
}
/* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -1533,6 +1556,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
case EXEC_OMP_PARALLEL_DO_SIMD:
@@ -1594,7 +1618,8 @@ show_omp_node (int level, gfc_code *c)
if (c->op == EXEC_OACC_CACHE || c->op == EXEC_OACC_UPDATE
|| c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
- || c->op == EXEC_OMP_TARGET_EXIT_DATA)
+ || c->op == EXEC_OMP_TARGET_EXIT_DATA
+ || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
{
@@ -1927,6 +1927,47 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
case OMP_LIST_DEPEND:
for (; n != NULL; n = n->next)
{
+ if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+ {
+ tree vec = NULL_TREE;
+ while (1)
+ {
+ tree addend = integer_zero_node, t;
+ bool neg = false;
+ if (n->expr)
+ {
+ addend = gfc_conv_constant_to_tree (n->expr);
+ if (TREE_CODE (addend) == INTEGER_CST
+ && tree_int_cst_sgn (addend) == -1)
+ {
+ neg = true;
+ addend = const_unop (NEGATE_EXPR,
+ TREE_TYPE (addend), addend);
+ }
+ }
+ t = gfc_trans_omp_variable (n->sym, false);
+ if (t != error_mark_node)
+ {
+ vec = tree_cons (addend, t, vec);
+ if (neg)
+ OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1;
+ }
+ if (n->next == NULL
+ || n->next->u.depend_op != OMP_DEPEND_SINK)
+ break;
+ n = n->next;
+ }
+ if (vec == NULL_TREE)
+ continue;
+
+ tree node = build_omp_clause (input_location,
+ OMP_CLAUSE_DEPEND);
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK;
+ OMP_CLAUSE_DECL (node) = nreverse (vec);
+ omp_clauses = gfc_trans_add_clause (node, omp_clauses);
+ continue;
+ }
+
if (!n->sym->attr.referenced)
continue;
@@ -2490,7 +2531,9 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
if (clauses->ordered)
{
c = build_omp_clause (where.lb->location, OMP_CLAUSE_ORDERED);
- OMP_CLAUSE_ORDERED_EXPR (c) = NULL_TREE;
+ OMP_CLAUSE_ORDERED_EXPR (c)
+ = clauses->orderedc ? build_int_cst (integer_type_node,
+ clauses->orderedc) : NULL_TREE;
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
@@ -2750,6 +2793,12 @@ gfc_trans_omp_clauses (stmtblock_t *bloc
c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEFAULTMAP);
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->depend_source)
+ {
+ c = build_omp_clause (where.lb->location, OMP_CLAUSE_DEPEND);
+ OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+ }
if (clauses->async)
{
@@ -3373,7 +3422,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
gfc_omp_clauses *do_clauses, tree par_clauses)
{
gfc_se se;
- tree dovar, stmt, from, to, step, type, init, cond, incr;
+ tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
stmtblock_t block;
stmtblock_t body;
@@ -3383,6 +3432,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
dovar_init *di;
unsigned ix;
+ if (clauses->orderedc)
+ collapse = clauses->orderedc;
if (collapse <= 0)
collapse = 1;
@@ -3392,6 +3443,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
init = make_tree_vec (collapse);
cond = make_tree_vec (collapse);
incr = make_tree_vec (collapse);
+ orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE;
if (pblock == NULL)
{
@@ -3517,6 +3569,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
dovar_init e = {dovar, tmp};
inits.safe_push (e);
}
+ if (orig_decls)
+ TREE_VEC_ELT (orig_decls, i) = dovar_decl;
if (dovar_found == 2
&& op == EXEC_OMP_SIMD
@@ -3670,6 +3724,8 @@ gfc_trans_omp_do (gfc_code *code, gfc_ex
OMP_FOR_INIT (stmt) = init;
OMP_FOR_COND (stmt) = cond;
OMP_FOR_INCR (stmt) = incr;
+ if (orig_decls)
+ OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
gfc_add_expr_to_block (&block, stmt);
return gfc_finish_block (&block);
@@ -3773,8 +3829,11 @@ gfc_trans_omp_master (gfc_code *code)
static tree
gfc_trans_omp_ordered (gfc_code *code)
{
+ tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses,
+ code->loc);
return build2_loc (input_location, OMP_ORDERED, void_type_node,
- gfc_trans_code (code->block->next), NULL_TREE);
+ code->block ? gfc_trans_code (code->block->next)
+ : NULL_TREE, omp_clauses);
}
static tree
@@ -4011,6 +4070,8 @@ gfc_split_omp_clauses (gfc_code *code,
/* First the clauses that are unique to some constructs. */
clausesa[GFC_OMP_SPLIT_DO].ordered
= code->ext.omp_clauses->ordered;
+ clausesa[GFC_OMP_SPLIT_DO].orderedc
+ = code->ext.omp_clauses->orderedc;
clausesa[GFC_OMP_SPLIT_DO].sched_kind
= code->ext.omp_clauses->sched_kind;
if (innermost == GFC_OMP_SPLIT_SIMD)
@@ -3593,6 +3593,7 @@ gfc_code_walker (gfc_code **c, walk_code
case EXEC_OMP_DISTRIBUTE_SIMD:
case EXEC_OMP_DO:
case EXEC_OMP_DO_SIMD:
+ case EXEC_OMP_ORDERED:
case EXEC_OMP_SECTIONS:
case EXEC_OMP_SINGLE:
case EXEC_OMP_END_SINGLE:
@@ -340,6 +340,80 @@ cleanup:
return MATCH_ERROR;
}
+/* Match depend(sink : ...) construct a namelist from it. */
+
+static match
+gfc_match_omp_depend_sink (gfc_omp_namelist **list)
+{
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc, cur_loc;
+ gfc_symbol *sym;
+
+ head = tail = NULL;
+
+ old_loc = gfc_current_locus;
+
+ for (;;)
+ {
+ cur_loc = gfc_current_locus;
+ switch (gfc_match_symbol (&sym, 1))
+ {
+ case MATCH_YES:
+ gfc_set_sym_referenced (sym);
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ {
+ head = tail = p;
+ head->u.depend_op = OMP_DEPEND_SINK_FIRST;
+ }
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ tail->u.depend_op = OMP_DEPEND_SINK;
+ }
+ tail->sym = sym;
+ tail->expr = NULL;
+ tail->where = cur_loc;
+ if (gfc_match_char ('+') == MATCH_YES)
+ {
+ if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+ goto syntax;
+ }
+ else if (gfc_match_char ('-') == MATCH_YES)
+ {
+ if (gfc_match_literal_constant (&tail->expr, 0) != MATCH_YES)
+ goto syntax;
+ tail->expr = gfc_uminus (tail->expr);
+ }
+ break;
+ case MATCH_NO:
+ goto syntax;
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
+
+cleanup:
+ gfc_free_omp_namelist (head);
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
static match
match_oacc_expr_list (const char *str, gfc_expr_list **list,
bool allow_asterisk)
@@ -923,6 +997,19 @@ gfc_match_omp_clauses (gfc_omp_clauses *
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
+ else if (!c->depend_source
+ && gfc_match ("source )") == MATCH_YES)
+ {
+ c->depend_source = true;
+ continue;
+ }
+ else if (gfc_match ("sink : ") == MATCH_YES)
+ {
+ if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
+ == MATCH_YES)
+ continue;
+ m = MATCH_NO;
+ }
else
m = MATCH_NO;
head = NULL;
@@ -2235,6 +2322,8 @@ cleanup:
| OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE)
#define OMP_SINGLE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
+#define OMP_ORDERED_CLAUSES \
+ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
static match
@@ -3252,14 +3341,14 @@ gfc_match_omp_master (void)
match
gfc_match_omp_ordered (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
- {
- gfc_error ("Unexpected junk after $OMP ORDERED statement at %C");
- return MATCH_ERROR;
- }
- new_st.op = EXEC_OMP_ORDERED;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES);
+}
+
+
+match
+gfc_match_omp_ordered_depend (void)
+{
+ return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
}
@@ -3691,6 +3780,10 @@ resolve_omp_clauses (gfc_code *code, gfc
if (omp_clauses == NULL)
return;
+ if (omp_clauses->orderedc && omp_clauses->orderedc < omp_clauses->collapse)
+ gfc_error ("ORDERED clause parameter is less than COLLAPSE at %L",
+ &code->loc);
+
if (omp_clauses->if_expr)
{
gfc_expr *expr = omp_clauses->if_expr;
@@ -4035,6 +4128,36 @@ resolve_omp_clauses (gfc_code *code, gfc
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
+ if (list == OMP_LIST_DEPEND)
+ {
+ if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
+ || n->u.depend_op == OMP_DEPEND_SINK)
+ {
+ if (code->op != EXEC_OMP_ORDERED)
+ gfc_error ("SINK dependence type only allowed "
+ "on ORDERED directive at %L", &n->where);
+ else if (omp_clauses->depend_source)
+ {
+ gfc_error ("DEPEND SINK used together with "
+ "DEPEND SOURCE on the same construct "
+ "at %L", &n->where);
+ omp_clauses->depend_source = false;
+ }
+ else if (n->expr)
+ {
+ if (!gfc_resolve_expr (n->expr)
+ || n->expr->ts.type != BT_INTEGER
+ || n->expr->rank != 0)
+ gfc_error ("SINK addend not a constant integer"
+ "at %L", &n->where);
+ }
+ continue;
+ }
+ else if (code->op == EXEC_OMP_ORDERED)
+ gfc_error ("Only SOURCE or SINK dependence types "
+ "are allowed on ORDERED directive at %L",
+ &n->where);
+ }
if (n->expr)
{
if (!gfc_resolve_expr (n->expr)
@@ -4274,6 +4397,10 @@ resolve_omp_clauses (gfc_code *code, gfc
" construct at %L", &n->where);
linear_op = n->u.linear_op;
}
+ else if (omp_clauses->orderedc)
+ gfc_error ("LINEAR clause specified together with"
+ "ORDERED clause with argument at %L",
+ &n->where);
else if (n->u.linear_op != OMP_LINEAR_REF
&& n->sym->ts.type != BT_INTEGER)
gfc_error ("LINEAR variable %qs must be INTEGER "
@@ -4399,6 +4526,9 @@ resolve_omp_clauses (gfc_code *code, gfc
if (omp_clauses->wait_list)
for (el = omp_clauses->wait_list; el; el = el->next)
resolve_scalar_int_expr (el->expr, "WAIT");
+ if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
+ gfc_error ("SOURCE dependence type only allowed "
+ "on ORDERED directive at %L", &code->loc);
}
@@ -4880,7 +5010,10 @@ gfc_resolve_omp_do_blocks (gfc_code *cod
gfc_code *c;
omp_current_do_code = code->block->next;
- omp_current_do_collapse = code->ext.omp_clauses->collapse;
+ if (code->ext.omp_clauses->orderedc)
+ omp_current_do_collapse = code->ext.omp_clauses->orderedc;
+ else
+ omp_current_do_collapse = code->ext.omp_clauses->collapse;
for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
{
c = c->block;
@@ -5108,9 +5241,14 @@ resolve_omp_do (gfc_code *code)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
do_code = code->block->next;
- collapse = code->ext.omp_clauses->collapse;
- if (collapse <= 0)
- collapse = 1;
+ if (code->ext.omp_clauses->orderedc)
+ collapse = code->ext.omp_clauses->orderedc;
+ else
+ {
+ collapse = code->ext.omp_clauses->collapse;
+ if (collapse <= 0)
+ collapse = 1;
+ }
for (i = 1; i <= collapse; i++)
{
if (do_code->op == EXEC_DO_WHILE)
@@ -161,6 +161,7 @@ match gfc_match_omp_do_simd (void);
match gfc_match_omp_flush (void);
match gfc_match_omp_master (void);
match gfc_match_omp_ordered (void);
+match gfc_match_omp_ordered_depend (void);
match gfc_match_omp_parallel (void);
match gfc_match_omp_parallel_do (void);
match gfc_match_omp_parallel_do_simd (void);
@@ -2554,21 +2554,25 @@ match_exit_cycle (gfc_statement st, gfc_
|| o->head->op == EXEC_OMP_DO_SIMD
|| o->head->op == EXEC_OMP_PARALLEL_DO_SIMD))
{
- int collapse = 1;
+ int count = 1;
gcc_assert (o->head->next != NULL
&& (o->head->next->op == EXEC_DO
|| o->head->next->op == EXEC_DO_WHILE)
&& o->previous != NULL
&& o->previous->tail->op == o->head->op);
- if (o->previous->tail->ext.omp_clauses != NULL
- && o->previous->tail->ext.omp_clauses->collapse > 1)
- collapse = o->previous->tail->ext.omp_clauses->collapse;
- if (st == ST_EXIT && cnt <= collapse)
+ if (o->previous->tail->ext.omp_clauses != NULL)
+ {
+ if (o->previous->tail->ext.omp_clauses->collapse > 1)
+ count = o->previous->tail->ext.omp_clauses->collapse;
+ if (o->previous->tail->ext.omp_clauses->orderedc)
+ count = o->previous->tail->ext.omp_clauses->orderedc;
+ }
+ if (st == ST_EXIT && cnt <= count)
{
gfc_error ("EXIT statement at %C terminating !$OMP DO loop");
return MATCH_ERROR;
}
- if (st == ST_CYCLE && cnt < collapse)
+ if (st == ST_CYCLE && cnt < count)
{
gfc_error ("CYCLE statement at %C to non-innermost collapsed"
" !$OMP DO loop");