OpenMP: Add iterator support to Fortran's depend; add affinity clause
gcc/c-family/ChangeLog:
* c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY.
gcc/c/ChangeLog:
* c-parser.c (c_parser_omp_clause_affinity): New.
(c_parser_omp_clause_name, c_parser_omp_variable_list,
c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause.
* c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections,
c_finish_omp_clauses): Likewise.
gcc/cp/ChangeLog:
* parser.c (cp_parser_omp_clause_affinity): New.
(cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open,
cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity
clause.
* semantics.c (handle_omp_array_sections_1, handle_omp_array_sections,
finish_omp_clauses): Likewise.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_iterator): New.
(show_omp_namelist): Handle iterators.
(show_omp_clauses): Handle affinity.
* gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'.
* match.c (gfc_free_omp_namelist): Add are to choose union element.
* openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach): Update
call to gfc_free_omp_namelist.
(gfc_match_omp_variable_list): Likewise; permit preceeding whitespace.
(enum omp_mask1):
(gfc_match_iterator): New.
(gfc_match_omp_clause_reduction):
(gfc_match_omp_clauses):
(gfc_match_omp_flush):
(gfc_match_omp_taskwait): Match depend clause.
(resolve_omp_clauses): Handle affinity; update for udr/union change.
(gfc_resolve_omp_directive): Resolve clauses of taskwait.
* st.c (gfc_free_statement): Update gfc_free_omp_namelist call.
* trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise
(handle_iterator): New.
(gfc_trans_omp_clauses): Handle iterators for depend/affinity clause.
(gfc_trans_omp_taskwait): Handle depend clause.
(gfc_trans_omp_directive): Update call.
gcc/ChangeLog:
* (gimplify_scan_omp_clauses): Ignore affinity clause.
* tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY.
* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY.
* tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause.
(walk_tree_1): Handle OMP_CLAUSE_AFFINITY.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/depend-iterator-2.f90: New test.
gcc/testsuite/ChangeLog:
* c-c++-common/gomp/affinity-1.c: New test.
* c-c++-common/gomp/affinity-2.c: New test.
* c-c++-common/gomp/affinity-3.c: New test.
* c-c++-common/gomp/affinity-4.c: New test.
* gfortran.dg/gomp/affinity-clause-1.f90: New test.
* gfortran.dg/gomp/affinity-clause-2.f90: New test.
* gfortran.dg/gomp/depend-iterator-2.f90: New test.
* gfortran.dg/gomp/depend-iterator.f90: New test.
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-parser.c | 64 ++++-
gcc/c/c-typeck.c | 54 ++--
gcc/cp/parser.c | 76 +++++-
gcc/cp/semantics.c | 56 +++--
gcc/fortran/dump-parse-tree.c | 51 +++-
gcc/fortran/gfortran.h | 9 +-
gcc/fortran/match.c | 18 +-
gcc/fortran/openmp.c | 280 +++++++++++++++++----
gcc/fortran/st.c | 2 +-
gcc/fortran/trans-openmp.c | 168 ++++++++++---
gcc/gimplify.c | 4 +
gcc/testsuite/c-c++-common/gomp/affinity-1.c | 20 ++
gcc/testsuite/c-c++-common/gomp/affinity-2.c | 232 +++++++++++++++++
gcc/testsuite/c-c++-common/gomp/affinity-3.c | 77 ++++++
gcc/testsuite/c-c++-common/gomp/affinity-4.c | 77 ++++++
.../gfortran.dg/gomp/affinity-clause-1.f90 | 31 +++
.../gfortran.dg/gomp/affinity-clause-2.f90 | 27 ++
.../gfortran.dg/gomp/depend-iterator-1.f90 | 45 ++++
.../gfortran.dg/gomp/depend-iterator-3.f90 | 27 ++
gcc/testsuite/gfortran.dg/taskwait.f90 | 7 +
gcc/tree-core.h | 3 +
gcc/tree-pretty-print.c | 23 +-
gcc/tree.c | 3 +
.../libgomp.fortran/depend-iterator-2.f90 | 89 +++++++
25 files changed, 1304 insertions(+), 140 deletions(-)
@@ -86,6 +86,7 @@ enum pragma_kind {
enum pragma_omp_clause {
PRAGMA_OMP_CLAUSE_NONE = 0,
+ PRAGMA_OMP_CLAUSE_AFFINITY,
PRAGMA_OMP_CLAUSE_ALIGNED,
PRAGMA_OMP_CLAUSE_ALLOCATE,
PRAGMA_OMP_CLAUSE_BIND,
@@ -12601,7 +12601,9 @@ c_parser_omp_clause_name (c_parser *parser)
switch (p[0])
{
case 'a':
- if (!strcmp ("aligned", p))
+ if (!strcmp ("affinity", p))
+ result = PRAGMA_OMP_CLAUSE_AFFINITY;
+ else if (!strcmp ("aligned", p))
result = PRAGMA_OMP_CLAUSE_ALIGNED;
else if (!strcmp ("allocate", p))
result = PRAGMA_OMP_CLAUSE_ALLOCATE;
@@ -12900,7 +12902,7 @@ c_parser_omp_variable_list (c_parser *parser,
while (1)
{
bool array_section_p = false;
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
if (c_parser_next_token_is_not (parser, CPP_NAME)
|| c_parser_peek_token (parser)->id_kind != C_ID_ID)
@@ -13040,6 +13042,7 @@ c_parser_omp_variable_list (c_parser *parser,
t = build_component_ref (op_loc, t, ident, comp_loc);
}
/* FALLTHROUGH */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_IN_REDUCTION:
@@ -13090,7 +13093,7 @@ c_parser_omp_variable_list (c_parser *parser,
t = tree_cons (low_bound, length, t);
}
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& t != error_mark_node
&& parser->tokens_avail != 2)
{
@@ -13130,7 +13133,7 @@ c_parser_omp_variable_list (c_parser *parser,
else
list = tree_cons (t, NULL_TREE, list);
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
parser->tokens = &parser->tokens_buf[0];
parser->tokens_avail = tokens_avail;
@@ -15508,6 +15511,52 @@ c_parser_omp_iterators (c_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity( [depend-modifier :] variable-list)
+ depend-modifier:
+ iterator ( iterators-definition ) */
+
+static tree
+c_parser_omp_clause_affinity (c_parser *parser, tree list)
+{
+ location_t clause_loc = c_parser_peek_token (parser)->location;
+ tree nl, iterators = NULL_TREE;
+
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ if (strcmp ("iterator", p) == 0)
+ {
+ iterators = c_parser_omp_iterators (parser);
+ if (!c_parser_require (parser, CPP_COLON, "expected %<:%>"))
+ return list;
+ }
+ }
+ nl = c_parser_omp_variable_list (parser, clause_loc, OMP_CLAUSE_AFFINITY,
+ list);
+ if (iterators)
+ {
+ tree block = pop_scope ();
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ {
+ TREE_VEC_ELT (iterators, 5) = block;
+ for (tree c = nl; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
+ OMP_CLAUSE_DECL (c));
+ }
+ }
+
+ parens.skip_until_found_close (parser);
+ return nl;
+}
+
+
/* OpenMP 4.0:
depend ( depend-kind: variable-list )
@@ -16474,6 +16523,10 @@ c_parser_omp_all_clauses (c_parser *parser, omp_clause_mask mask,
clauses = c_parser_omp_clause_linear (parser, clauses);
c_name = "linear";
break;
+ case PRAGMA_OMP_CLAUSE_AFFINITY:
+ clauses = c_parser_omp_clause_affinity (parser, clauses);
+ c_name = "affinity";
+ break;
case PRAGMA_OMP_CLAUSE_DEPEND:
clauses = c_parser_omp_clause_depend (parser, clauses);
c_name = "depend";
@@ -19239,7 +19292,8 @@ c_parser_omp_single (location_t loc, c_parser *parser, bool *if_p)
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY))
static tree
c_parser_omp_task (location_t loc, c_parser *parser, bool *if_p)
@@ -13063,7 +13063,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
if (error_operand_p (t))
return error_mark_node;
ret = t;
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TYPE_ATOMIC (strip_array_types (TREE_TYPE (t))))
{
error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qE in %qs clause",
@@ -13114,14 +13115,16 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TYPE_ATOMIC (TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c), "%<_Atomic%> %qD in %qs clause",
t, omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& VAR_P (t)
&& DECL_THREAD_LOCAL_P (t))
{
@@ -13130,7 +13133,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
omp_clause_code_name[OMP_CLAUSE_CODE (c)]);
return error_mark_node;
}
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
&& TYPE_ATOMIC (TREE_TYPE (t))
&& POINTER_TYPE_P (TREE_TYPE (t)))
{
@@ -13201,7 +13205,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
{
if (!integer_nonzerop (length))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -13269,7 +13274,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (tree_int_cst_equal (size, low_bound))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -13290,7 +13296,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -13328,7 +13335,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -13373,6 +13381,7 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
/* If there is a pointer type anywhere but in the very first
array-section-subscript, the array section can't be contiguous. */
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
&& TREE_CODE (TREE_CHAIN (t)) == TREE_LIST)
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -13409,7 +13418,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
unsigned int first_non_one = 0;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
&& TREE_CODE (*tp) == TREE_LIST
&& TREE_PURPOSE (*tp)
&& TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
@@ -13421,7 +13431,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
return true;
if (first == NULL_TREE)
return false;
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
{
tree t = *tp;
tree tem = NULL_TREE;
@@ -14509,6 +14520,7 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
break;
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
t = OMP_CLAUSE_DECL (c);
if (t == NULL_TREE)
@@ -14517,7 +14529,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
== OMP_CLAUSE_DEPEND_SOURCE);
break;
}
- if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
gcc_assert (TREE_CODE (t) == TREE_LIST);
for (; t; t = TREE_CHAIN (t))
@@ -14563,7 +14576,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
if (handle_omp_array_sections (c, ort))
remove = true;
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
error_at (OMP_CLAUSE_LOCATION (c),
"%<depend%> clause with %<depobj%> dependence "
@@ -14578,17 +14592,24 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE is not lvalue expression nor array section in "
- "%<depend%> clause", t);
+ "%qs clause", t,
+ OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
remove = true;
}
else if (TREE_CODE (t) == COMPONENT_REF
&& DECL_C_BIT_FIELD (TREE_OPERAND (t, 1)))
{
+ gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY);
error_at (OMP_CLAUSE_LOCATION (c),
- "bit-field %qE in %qs clause", t, "depend");
+ "bit-field %qE in %qs clause", t,
+ OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
remove = true;
}
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
if (!c_omp_depend_t_p (TREE_TYPE (t)))
{
@@ -14599,7 +14620,8 @@ c_finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
remove = true;
}
}
- else if (c_omp_depend_t_p (TREE_TYPE (t)))
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && c_omp_depend_t_p (TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE should not have %<omp_depend_t%> type in "
@@ -35063,7 +35063,9 @@ cp_parser_omp_clause_name (cp_parser *parser)
switch (p[0])
{
case 'a':
- if (!strcmp ("aligned", p))
+ if (!strcmp ("affinity", p))
+ result = PRAGMA_OMP_CLAUSE_AFFINITY;
+ else if (!strcmp ("aligned", p))
result = PRAGMA_OMP_CLAUSE_ALIGNED;
else if (!strcmp ("allocate", p))
result = PRAGMA_OMP_CLAUSE_ALLOCATE;
@@ -35322,7 +35324,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
{
tree name, decl;
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
cp_parser_parse_tentatively (parser);
token = cp_lexer_peek_token (parser->lexer);
if (kind != 0
@@ -35351,7 +35353,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
/*optional_p=*/false);
if (name == error_mark_node)
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
@@ -35363,7 +35365,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
decl = name;
if (decl == error_mark_node)
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
cp_parser_name_lookup_error (parser, name, decl, NLE_NULL,
@@ -35409,6 +35411,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
&idk, loc);
}
/* FALLTHROUGH. */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
case OMP_CLAUSE_REDUCTION:
case OMP_CLAUSE_IN_REDUCTION:
@@ -35435,12 +35438,12 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
/* Look for `:'. */
if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
}
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
cp_parser_commit_to_tentative_parse (parser);
if (!cp_lexer_next_token_is (parser->lexer,
CPP_CLOSE_SQUARE))
@@ -35454,7 +35457,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
if (!cp_parser_require (parser, CPP_CLOSE_SQUARE,
RT_CLOSE_SQUARE))
{
- if (kind == OMP_CLAUSE_DEPEND
+ if ((kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
&& cp_parser_simulate_error (parser))
goto depend_lvalue;
goto skip_comma;
@@ -35467,7 +35470,7 @@ cp_parser_omp_var_list_no_open (cp_parser *parser, enum omp_clause_code kind,
break;
}
- if (kind == OMP_CLAUSE_DEPEND)
+ if (kind == OMP_CLAUSE_DEPEND || kind == OMP_CLAUSE_AFFINITY)
{
if (cp_lexer_next_token_is_not (parser->lexer, CPP_COMMA)
&& cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN)
@@ -37707,6 +37710,56 @@ cp_parser_omp_iterators (cp_parser *parser)
return ret ? ret : error_mark_node;
}
+/* OpenMP 5.0:
+ affinity( [depend-modifier :] variable-list)
+ depend-modifier:
+ iterator ( iterators-definition ) */
+
+static tree
+cp_parser_omp_clause_affinity (cp_parser *parser, tree list)
+{
+ tree nlist, c, iterators = NULL_TREE;
+
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return list;
+
+ if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+ const char *p = IDENTIFIER_POINTER (id);
+ if (strcmp ("iterator", p) == 0)
+ {
+ begin_scope (sk_omp, NULL);
+ iterators = cp_parser_omp_iterators (parser);
+ if (!cp_parser_require (parser, CPP_COLON, RT_COLON))
+ {
+ cp_parser_skip_to_closing_parenthesis (parser,
+ /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+ return list;
+ }
+ }
+ }
+ nlist = cp_parser_omp_var_list_no_open (parser, OMP_CLAUSE_AFFINITY,
+ list, NULL);
+ if (iterators)
+ {
+ tree block = poplevel (1, 1, 0);
+ if (iterators == error_mark_node)
+ iterators = NULL_TREE;
+ else
+ {
+ TREE_VEC_ELT (iterators, 5) = block;
+ for (c = nlist; c != list; c = OMP_CLAUSE_CHAIN (c))
+ OMP_CLAUSE_DECL (c) = build_tree_list (iterators,
+ OMP_CLAUSE_DECL (c));
+ }
+ }
+ return nlist;
+}
+
/* OpenMP 4.0:
depend ( depend-kind : variable-list )
@@ -38649,6 +38702,10 @@ cp_parser_omp_all_clauses (cp_parser *parser, omp_clause_mask mask,
}
c_name = "linear";
break;
+ case PRAGMA_OMP_CLAUSE_AFFINITY:
+ clauses = cp_parser_omp_clause_affinity (parser, clauses);
+ c_name = "affinity";
+ break;
case PRAGMA_OMP_CLAUSE_DEPEND:
clauses = cp_parser_omp_clause_depend (parser, clauses,
token->location);
@@ -41234,7 +41291,8 @@ cp_parser_omp_single (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_PRIORITY) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_ALLOCATE) \
| (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_IN_REDUCTION) \
- | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH))
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_DETACH) \
+ | (OMP_CLAUSE_MASK_1 << PRAGMA_OMP_CLAUSE_AFFINITY))
static tree
cp_parser_omp_task (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
@@ -4999,7 +4999,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
" clauses");
return error_mark_node;
}
- else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& VAR_P (t) && CP_DECL_THREAD_LOCAL_P (t))
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -5086,7 +5087,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
{
if (!integer_nonzerop (length))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -5154,7 +5156,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
if (tree_int_cst_equal (size, low_bound))
{
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION
|| OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TASK_REDUCTION)
@@ -5175,7 +5178,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -5213,7 +5217,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
else if (length == NULL_TREE)
{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IN_REDUCTION
&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TASK_REDUCTION)
@@ -5257,7 +5262,8 @@ handle_omp_array_sections_1 (tree c, tree t, vec<tree> &types,
}
/* If there is a pointer type anywhere but in the very first
array-section-subscript, the array section can't be contiguous. */
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
+ if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_AFFINITY
+ && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_DEPEND
&& TREE_CODE (TREE_CHAIN (t)) == TREE_LIST)
{
error_at (OMP_CLAUSE_LOCATION (c),
@@ -5305,7 +5311,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
unsigned int first_non_one = 0;
auto_vec<tree, 10> types;
tree *tp = &OMP_CLAUSE_DECL (c);
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
&& TREE_CODE (*tp) == TREE_LIST
&& TREE_PURPOSE (*tp)
&& TREE_CODE (TREE_PURPOSE (*tp)) == TREE_VEC)
@@ -5317,7 +5324,8 @@ handle_omp_array_sections (tree c, enum c_omp_region_type ort)
return true;
if (first == NULL_TREE)
return false;
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY)
{
tree t = *tp;
tree tem = NULL_TREE;
@@ -7428,6 +7436,7 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
}
goto handle_field_decl;
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_DEPEND:
t = OMP_CLAUSE_DECL (c);
if (t == NULL_TREE)
@@ -7436,7 +7445,8 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
== OMP_CLAUSE_DEPEND_SOURCE);
break;
}
- if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
if (cp_finish_omp_clause_depend_sink (c))
remove = true;
@@ -7461,7 +7471,9 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
{
if (handle_omp_array_sections (c, ort))
remove = true;
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c)
+ == OMP_CLAUSE_DEPEND_DEPOBJ)
{
error_at (OMP_CLAUSE_LOCATION (c),
"%<depend%> clause with %<depobj%> dependence "
@@ -7486,22 +7498,31 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
if (DECL_P (t))
error_at (OMP_CLAUSE_LOCATION (c),
"%qD is not lvalue expression nor array section "
- "in %<depend%> clause", t);
+ "in %qs clause", t,
+ OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
else
error_at (OMP_CLAUSE_LOCATION (c),
"%qE is not lvalue expression nor array section "
- "in %<depend%> clause", t);
+ "in %qs clause", t,
+ OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
remove = true;
}
else if (TREE_CODE (t) == COMPONENT_REF
&& TREE_CODE (TREE_OPERAND (t, 1)) == FIELD_DECL
&& DECL_BIT_FIELD (TREE_OPERAND (t, 1)))
{
+ gcc_assert (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_AFFINITY);
error_at (OMP_CLAUSE_LOCATION (c),
- "bit-field %qE in %qs clause", t, "depend");
+ "bit-field %qE in %qs clause", t,
+ OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ ? "depend" : "affinity");
remove = true;
}
- else if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_DEPOBJ)
{
if (!c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
? TREE_TYPE (TREE_TYPE (t))
@@ -7514,9 +7535,10 @@ finish_omp_clauses (tree clauses, enum c_omp_region_type ort)
remove = true;
}
}
- else if (c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
- ? TREE_TYPE (TREE_TYPE (t))
- : TREE_TYPE (t)))
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_DEPEND
+ && c_omp_depend_t_p (TYPE_REF_P (TREE_TYPE (t))
+ ? TREE_TYPE (TREE_TYPE (t))
+ : TREE_TYPE (t)))
{
error_at (OMP_CLAUSE_LOCATION (c),
"%qE should not have %<omp_depend_t%> type in "
@@ -1297,11 +1297,56 @@ show_code (int level, gfc_code *c)
show_code_node (level, c);
}
+static void
+show_iterator (gfc_namespace *ns)
+{
+ for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ if (sym != ns->proc_name)
+ fputc (',', dumpfile);
+ fputs (sym->name, dumpfile);
+ fputc ('=', dumpfile);
+ c = gfc_constructor_first (sym->value->value.constructor);
+ show_expr (c->expr);
+ fputc (':', dumpfile);
+ c = gfc_constructor_next (c);
+ show_expr (c->expr);
+ c = gfc_constructor_next (c);
+ if (c)
+ {
+ fputc (':', dumpfile);
+ show_expr (c->expr);
+ }
+ }
+}
+
static void
show_omp_namelist (int list_type, gfc_omp_namelist *n)
{
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ gfc_omp_namelist *n2 = n;
for (; n; n = n->next)
{
+ gfc_current_ns = ns_curr;
+ if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+ {
+ gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
+ if (n->u2.ns != ns_iter)
+ {
+ if (n != n2)
+ fputs (list_type == OMP_LIST_AFFINITY
+ ? ") AFFINITY(" : ") DEPEND(", dumpfile);
+ if (n->u2.ns)
+ {
+ fputs ("ITERATOR(", dumpfile);
+ show_iterator (n->u2.ns);
+ fputc (')', dumpfile);
+ fputc (list_type == OMP_LIST_AFFINITY ? ':' : ',', dumpfile);
+ }
+ }
+ ns_iter = n->u2.ns;
+ }
if (list_type == OMP_LIST_REDUCTION)
switch (n->u.reduction_op)
{
@@ -1321,8 +1366,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
case OMP_REDUCTION_USER:
- if (n->udr)
- fprintf (dumpfile, "%s:", n->udr->udr->name);
+ if (n->u2.udr)
+ fprintf (dumpfile, "%s:", n->u2.udr->udr->name);
break;
default: break;
}
@@ -1387,6 +1432,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
if (n->next)
fputc (',', dumpfile);
}
+ gfc_current_ns = ns_curr;
}
@@ -1610,6 +1656,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_SHARED: type = "SHARED"; break;
case OMP_LIST_COPYIN: type = "COPYIN"; break;
case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
+ case OMP_LIST_AFFINITY: type = "AFFINITY"; break;
case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
case OMP_LIST_LINEAR: type = "LINEAR"; break;
case OMP_LIST_DEPEND: type = "DEPEND"; break;
@@ -1256,7 +1256,11 @@ typedef struct gfc_omp_namelist
struct gfc_common_head *common;
bool lastprivate_conditional;
} u;
- struct gfc_omp_namelist_udr *udr;
+ union
+ {
+ struct gfc_omp_namelist_udr *udr;
+ gfc_namespace *ns;
+ } u2;
struct gfc_omp_namelist *next;
locus where;
}
@@ -1274,6 +1278,7 @@ enum
OMP_LIST_SHARED,
OMP_LIST_COPYIN,
OMP_LIST_UNIFORM,
+ OMP_LIST_AFFINITY,
OMP_LIST_ALIGNED,
OMP_LIST_LINEAR,
OMP_LIST_DEPEND,
@@ -3319,7 +3324,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *);
+void gfc_free_omp_namelist (gfc_omp_namelist *, bool);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);
@@ -5470,20 +5470,22 @@ gfc_free_namelist (gfc_namelist *name)
/* Free an OpenMP namelist structure. */
void
-gfc_free_omp_namelist (gfc_omp_namelist *name)
+gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns)
{
gfc_omp_namelist *n;
for (; name; name = n)
{
gfc_free_expr (name->expr);
- if (name->udr)
- {
- if (name->udr->combiner)
- gfc_free_statement (name->udr->combiner);
- if (name->udr->initializer)
- gfc_free_statement (name->udr->initializer);
- free (name->udr);
+ if (free_ns)
+ gfc_free_namespace (name->u2.ns);
+ else if (name->u2.udr)
+ {
+ if (name->u2.udr->combiner)
+ gfc_free_statement (name->u2.udr->combiner);
+ if (name->u2.udr->initializer)
+ gfc_free_statement (name->u2.udr->initializer);
+ free (name->u2.udr);
}
n = name->next;
free (name);
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3. If not see
#include "arith.h"
#include "match.h"
#include "parse.h"
+#include "constructor.h"
#include "diagnostic.h"
#include "gomp-constants.h"
@@ -103,7 +104,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_workers_expr);
gfc_free_expr (c->vector_length_expr);
for (i = 0; i < OMP_LIST_NUM; i++)
- gfc_free_omp_namelist (c->lists[i]);
+ gfc_free_omp_namelist (c->lists[i],
+ i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (CONST_CAST (char *, c->critical_name));
@@ -261,6 +263,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
case MATCH_YES:
gfc_expr *expr;
expr = NULL;
+ gfc_gobble_whitespace ();
if ((allow_sections && gfc_peek_ascii_char () == '(')
|| (allow_derived && gfc_peek_ascii_char () == '%'))
{
@@ -354,7 +357,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -444,7 +447,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -551,7 +554,7 @@ syntax:
gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
cleanup:
- gfc_free_omp_namelist (head);
+ gfc_free_omp_namelist (head, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@@ -842,6 +845,7 @@ enum omp_mask1
OMP_CLAUSE_CAPTURE, /* OpenMP 5.0. */
OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */
OMP_CLAUSE_DETACH, /* OpenMP 5.0. */
+ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */
OMP_CLAUSE_NOWAIT,
/* This must come last. */
OMP_MASK1_LAST
@@ -995,6 +999,107 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
return false;
}
+static match
+gfc_match_iterator (gfc_namespace **ns)
+{
+ if (gfc_match ("iterator ( ") != MATCH_YES)
+ return MATCH_NO;
+
+ gfc_typespec ts;
+ gfc_symbol *last = NULL;
+ gfc_expr *begin, *end, *step;
+ *ns = gfc_build_block_ns (gfc_current_ns);
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ while (true)
+ {
+ locus old_loc = gfc_current_locus;
+ if (gfc_match_type_spec (&ts) == MATCH_YES
+ && gfc_match (" :: ") == MATCH_YES)
+ {
+ if (ts.type != BT_INTEGER)
+ {
+ gfc_error ("Expected INTEGER type at %L", &old_loc);
+ return MATCH_ERROR;
+ }
+ }
+ else
+ {
+ ts.type = BT_INTEGER;
+ ts.kind = gfc_default_integer_kind;
+ gfc_current_locus = old_loc;
+ }
+ old_loc = gfc_current_locus;
+ if (gfc_match_name (name) != MATCH_YES)
+ {
+ gfc_error ("Expected identifier at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_find_symtree ((*ns)->sym_root, name))
+ {
+ gfc_error ("Same identifier %qs specified again at %C", name);
+ return MATCH_ERROR;
+ }
+
+ gfc_symbol *sym = gfc_new_symbol (name, *ns);
+ if (last)
+ last->tlink = sym;
+ else
+ (*ns)->proc_name = sym;
+ last = sym;
+ sym->declared_at = old_loc;
+ sym->ts = ts;
+ sym->attr.flavor = FL_VARIABLE;
+ sym->attr.artificial = 1;
+ sym->attr.referenced = 1;
+ sym->refs++;
+ gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name);
+ st->n.sym = sym;
+
+ old_loc = gfc_current_locus;
+ if (gfc_match (" = ") != MATCH_YES)
+ return MATCH_ERROR;
+ begin = end = step = NULL;
+ if (gfc_match ("%e : ", &begin) != MATCH_YES
+ || gfc_match ("%e ", &end) != MATCH_YES)
+ {
+ gfc_error ("Expected range-specification at %C");
+ gfc_free_expr (begin);
+ gfc_free_expr (end);
+ return MATCH_ERROR;
+ }
+ if (':' == gfc_peek_ascii_char ())
+ {
+ step = gfc_get_expr ();
+ if (gfc_match (": %e ", &step) != MATCH_YES)
+ {
+ gfc_free_expr (begin);
+ gfc_free_expr (end);
+ gfc_free_expr (step);
+ return MATCH_ERROR;
+ }
+ }
+
+ gfc_expr *e = gfc_get_expr ();
+ e->where = old_loc;
+ e->expr_type = EXPR_ARRAY;
+ e->ts = ts;
+ e->rank = 1;
+ e->shape = gfc_get_shape (1);
+ mpz_init_set_ui (e->shape[0], step ? 3 : 2);
+ gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where);
+ gfc_constructor_append_expr (&e->value.constructor, end, &end->where);
+ if (step)
+ gfc_constructor_append_expr (&e->value.constructor, step, &step->where);
+ sym->value = e;
+
+ if (gfc_match (") ") == MATCH_YES)
+ break;
+ if (gfc_match (", ") != MATCH_YES)
+ return MATCH_ERROR;
+ }
+ return MATCH_YES;
+}
+
/* reduction ( reduction-modifier, reduction-operator : variable-list )
in_reduction ( reduction-operator : variable-list )
task_reduction ( reduction-operator : variable-list ) */
@@ -1137,7 +1242,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
- gfc_free_omp_namelist (n);
+ gfc_free_omp_namelist (n, false);
}
else
for (n = *head; n; n = n->next)
@@ -1145,8 +1250,8 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
n->u.reduction_op = rop;
if (udr)
{
- n->udr = gfc_get_omp_namelist_udr ();
- n->udr->udr = udr;
+ n->u2.udr = gfc_get_omp_namelist_udr ();
+ n->u2.udr->udr = udr;
}
}
return MATCH_YES;
@@ -1201,7 +1306,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1229,6 +1334,33 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
needs_space = true;
continue;
}
+ if ((mask & OMP_CLAUSE_AFFINITY)
+ && gfc_match ("affinity ( ") == MATCH_YES)
+ {
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ match m = gfc_match_iterator (&ns_iter);
+ if (m == MATCH_ERROR)
+ break;
+ if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
+ break;
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ head = NULL;
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY],
+ false, NULL, &head, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_ERROR)
+ break;
+ if (ns_iter)
+ {
+ for (gfc_omp_namelist *n = *head; n; n = n->next)
+ {
+ n->u2.ns = ns_iter;
+ ns_iter->refs++;
+ }
+ }
+ continue;
+ }
if ((mask & OMP_CLAUSE_ASYNC)
&& !c->async
&& gfc_match ("async") == MATCH_YES)
@@ -1373,6 +1505,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if ((mask & OMP_CLAUSE_DEPEND)
&& gfc_match ("depend ( ") == MATCH_YES)
{
+ gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+ match m_it = gfc_match_iterator (&ns_iter);
+ if (m_it == MATCH_ERROR)
+ break;
+ if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
+ break;
match m = MATCH_YES;
gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
if (gfc_match ("inout") == MATCH_YES)
@@ -1388,11 +1526,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else if (!c->depend_source
&& gfc_match ("source )") == MATCH_YES)
{
+ if (m_it == MATCH_YES)
+ {
+ gfc_error ("ITERATOR may not be combined with SOURCE "
+ "at %C");
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+ }
c->depend_source = true;
continue;
}
else if (gfc_match ("sink : ") == MATCH_YES)
{
+ if (m_it == MATCH_YES)
+ {
+ gfc_error ("ITERATOR may not be combined with SINK "
+ "at %C");
+ break;
+ }
if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
== MATCH_YES)
continue;
@@ -1401,19 +1552,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else
m = MATCH_NO;
head = NULL;
- if (m == MATCH_YES
- && gfc_match_omp_variable_list (" : ",
- &c->lists[OMP_LIST_DEPEND],
- false, NULL, &head,
- true) == MATCH_YES)
+ if (ns_iter)
+ gfc_current_ns = ns_iter;
+ if (m == MATCH_YES)
+ m = gfc_match_omp_variable_list (" : ",
+ &c->lists[OMP_LIST_DEPEND],
+ false, NULL, &head, true);
+ gfc_current_ns = ns_curr;
+ if (m == MATCH_YES)
{
gfc_omp_namelist *n;
for (n = *head; n; n = n->next)
- n->u.depend_op = depend_op;
+ {
+ n->u.depend_op = depend_op;
+ n->u2.ns = ns_iter;
+ if (ns_iter)
+ ns_iter->refs++;
+ }
continue;
}
- else
- gfc_current_locus = old_loc;
+ break;
}
if ((mask & OMP_CLAUSE_DETACH)
&& !openacc
@@ -1665,7 +1823,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -1673,7 +1831,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
{
- gfc_free_omp_namelist (*head);
+ gfc_free_omp_namelist (*head, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@@ -2808,7 +2966,7 @@ cleanup:
| OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
| OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \
- | OMP_CLAUSE_DETACH)
+ | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
#define OMP_TASKLOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \
@@ -3061,14 +3219,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
- gfc_free_omp_namelist (list);
+ gfc_free_omp_namelist (list, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
- gfc_free_omp_namelist (list);
+ gfc_free_omp_namelist (list, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@@ -4209,14 +4367,13 @@ gfc_match_omp_taskloop_simd (void)
match
gfc_match_omp_taskwait (void)
{
- if (gfc_match_omp_eos () != MATCH_YES)
+ if (gfc_match_omp_eos () == MATCH_YES)
{
- gfc_error ("Unexpected junk after TASKWAIT clause at %C");
- return MATCH_ERROR;
+ new_st.op = EXEC_OMP_TASKWAIT;
+ new_st.ext.omp_clauses = NULL;
+ return MATCH_YES;
}
- new_st.op = EXEC_OMP_TASKWAIT;
- new_st.ext.omp_clauses = NULL;
- return MATCH_YES;
+ return match_omp (EXEC_OMP_TASKWAIT, omp_mask (OMP_CLAUSE_DEPEND));
}
@@ -4782,7 +4939,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
- "COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
+ "COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP",
"TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
"REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
"IN_REDUCTION", "TASK_REDUCTION",
@@ -5229,6 +5386,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
}
break;
+ case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
case OMP_LIST_MAP:
case OMP_LIST_TO:
@@ -5236,6 +5394,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
case OMP_LIST_CACHE:
for (; n != NULL; n = n->next)
{
+ if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+ && n->u2.ns && !n->u2.ns->resolved)
+ {
+ n->u2.ns->resolved = 1;
+ for (gfc_symbol *sym = n->u2.ns->proc_name; sym;
+ sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ c = gfc_constructor_first (sym->value->value.constructor);
+ if (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0)
+ gfc_error ("Scalar integer expression for range begin"
+ " expected at %L", &c->expr->where);
+ c = gfc_constructor_next (c);
+ if (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0)
+ gfc_error ("Scalar integer expression for range end "
+ "expected at %L", &c->expr->where);
+ c = gfc_constructor_next (c);
+ if (c && (!gfc_resolve_expr (c->expr)
+ || c->expr->ts.type != BT_INTEGER
+ || c->expr->rank != 0))
+ gfc_error ("Scalar integer expression for range step "
+ "expected at %L", &c->expr->where);
+ else if (c
+ && c->expr->expr_type == EXPR_CONSTANT
+ && mpz_cmp_si (c->expr->value.integer, 0) == 0)
+ gfc_error ("Nonzero range step expected at %L",
+ &c->expr->where);
+ }
+ }
+
if (list == OMP_LIST_DEPEND)
{
if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
@@ -5377,7 +5569,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->name, name, &n->where);
break;
}
- else if (list == OMP_LIST_DEPEND
+ else if ((list == OMP_LIST_DEPEND
+ || list == OMP_LIST_AFFINITY)
&& ar->start[i]
&& ar->start[i]->expr_type == EXPR_CONSTANT
&& ar->end[i]
@@ -5385,9 +5578,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& mpz_cmp (ar->start[i]->value.integer,
ar->end[i]->value.integer) > 0)
{
- gfc_error ("%qs in DEPEND clause at %L is a "
+ gfc_error ("%qs in %s clause at %L is a "
"zero size array section",
- n->sym->name, &n->where);
+ n->sym->name,
+ list == OMP_LIST_DEPEND
+ ? "DEPEND" : "AFFINITY", &n->where);
break;
}
}
@@ -5631,23 +5826,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
break;
}
if (!bad)
- n->udr = NULL;
+ n->u2.udr = NULL;
else
{
const char *udr_name = NULL;
- if (n->udr)
+ if (n->u2.udr)
{
- udr_name = n->udr->udr->name;
- n->udr->udr
+ udr_name = n->u2.udr->udr->name;
+ n->u2.udr->udr
= gfc_find_omp_udr (NULL, udr_name,
&n->sym->ts);
- if (n->udr->udr == NULL)
+ if (n->u2.udr->udr == NULL)
{
- free (n->udr);
- n->udr = NULL;
+ free (n->u2.udr);
+ n->u2.udr = NULL;
}
}
- if (n->udr == NULL)
+ if (n->u2.udr == NULL)
{
if (udr_name == NULL)
switch (n->u.reduction_op)
@@ -5686,14 +5881,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
else
{
- gfc_omp_udr *udr = n->udr->udr;
+ gfc_omp_udr *udr = n->u2.udr->udr;
n->u.reduction_op = OMP_REDUCTION_USER;
- n->udr->combiner
+ n->u2.udr->combiner
= resolve_omp_udr_clause (n, udr->combiner_ns,
udr->omp_out,
udr->omp_in);
if (udr->initializer_ns)
- n->udr->initializer
+ n->u2.udr->initializer
= resolve_omp_udr_clause (n,
udr->initializer_ns,
udr->omp_priv,
@@ -7321,6 +7516,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_TARGET_PARALLEL:
case EXEC_OMP_TARGET_TEAMS:
case EXEC_OMP_TASK:
+ case EXEC_OMP_TASKWAIT:
case EXEC_OMP_TEAMS:
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_DEPOBJ:
@@ -267,7 +267,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
- gfc_free_omp_namelist (p->ext.omp_namelist);
+ gfc_free_omp_namelist (p->ext.omp_namelist, false);
break;
case EXEC_OMP_BARRIER:
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see
#include "trans-array.h"
#include "trans-const.h"
#include "arith.h"
+#include "constructor.h"
#include "gomp-constants.h"
#include "omp-general.h"
#include "omp-low.h"
@@ -1750,7 +1751,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
locus old_loc = gfc_current_locus;
const char *iname;
bool t;
- gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
+ gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
decl = OMP_CLAUSE_DECL (c);
gfc_current_locus = where;
@@ -1869,9 +1870,9 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
t = gfc_resolve_expr (e2);
gcc_assert (t);
}
- else if (n->udr->initializer->op == EXEC_ASSIGN)
+ else if (n->u2.udr->initializer->op == EXEC_ASSIGN)
{
- e2 = gfc_copy_expr (n->udr->initializer->expr2);
+ e2 = gfc_copy_expr (n->u2.udr->initializer->expr2);
t = gfc_resolve_expr (e2);
gcc_assert (t);
}
@@ -1880,7 +1881,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
struct omp_udr_find_orig_data cd;
cd.omp_udr = udr;
cd.omp_orig_seen = false;
- gfc_code_walker (&n->udr->initializer,
+ gfc_code_walker (&n->u2.udr->initializer,
gfc_dummy_code_callback, omp_udr_find_orig, &cd);
if (cd.omp_orig_seen)
OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
@@ -1930,11 +1931,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
iname = "ieor";
break;
case ERROR_MARK:
- if (n->udr->combiner->op == EXEC_ASSIGN)
+ if (n->u2.udr->combiner->op == EXEC_ASSIGN)
{
gfc_free_expr (e3);
- e3 = gfc_copy_expr (n->udr->combiner->expr1);
- e4 = gfc_copy_expr (n->udr->combiner->expr2);
+ e3 = gfc_copy_expr (n->u2.udr->combiner->expr1);
+ e4 = gfc_copy_expr (n->u2.udr->combiner->expr2);
t = gfc_resolve_expr (e3);
gcc_assert (t);
t = gfc_resolve_expr (e4);
@@ -1984,7 +1985,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
if (e2)
stmt = gfc_trans_assignment (e1, e2, false, false);
else
- stmt = gfc_trans_call (n->udr->initializer, false,
+ stmt = gfc_trans_call (n->u2.udr->initializer, false,
NULL_TREE, NULL_TREE, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -1997,7 +1998,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
if (e4)
stmt = gfc_trans_assignment (e3, e4, false, true);
else
- stmt = gfc_trans_call (n->udr->combiner, false,
+ stmt = gfc_trans_call (n->u2.udr->combiner, false,
NULL_TREE, NULL_TREE, false);
if (TREE_CODE (stmt) != BIND_EXPR)
stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -2272,12 +2273,70 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
ptr, ptr2);
}
+static tree
+handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
+{
+ tree list = NULL_TREE;
+ for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+ {
+ gfc_constructor *c;
+ gfc_se se;
+
+ tree last = make_tree_vec (6);
+ tree iter_var = gfc_get_symbol_decl (sym);
+ tree type = TREE_TYPE (iter_var);
+ TREE_VEC_ELT (last, 0) = iter_var;
+ DECL_CHAIN (iter_var) = BLOCK_VARS (block);
+ BLOCK_VARS (block) = iter_var;
+
+ /* begin */
+ c = gfc_constructor_first (sym->value->value.constructor);
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ TREE_VEC_ELT (last, 1) = fold_convert (type, se.expr);
+
+ /* end */
+ c = gfc_constructor_next (c);
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ TREE_VEC_ELT (last, 2) = fold_convert (type, se.expr);
+
+ /* step */
+ c = gfc_constructor_next (c);
+ tree step;
+ if (c)
+ {
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, c->expr);
+ gfc_add_block_to_block (iter_block, &se.pre);
+ gfc_add_block_to_block (iter_block, &se.post);
+ gfc_conv_expr (&se, c->expr);
+ step = fold_convert (type, se.expr);
+ }
+ else
+ step = build_int_cst (type, 1);
+ TREE_VEC_ELT (last, 3) = step;
+ /* orig_step */
+ TREE_VEC_ELT (last, 4) = save_expr (step);
+ TREE_CHAIN (last) = list;
+ list = last;
+ }
+ return list;
+}
+
static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where, bool declare_simd = false,
bool openacc = false)
{
tree omp_clauses = NULL_TREE, chunk_size, c;
+ tree iterator = NULL_TREE;
+ tree tree_block = NULL_TREE;
+ stmtblock_t iter_block;
int list, ifc;
enum omp_clause_code clause_code;
gfc_se se;
@@ -2482,10 +2541,22 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
+ case OMP_LIST_AFFINITY:
case OMP_LIST_DEPEND:
for (; n != NULL; n = n->next)
{
- if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+ gfc_init_block (&iter_block);
+ iterator = NULL_TREE;
+ if (n->u2.ns)
+ {
+ tree_block = make_node (BLOCK);
+ TREE_USED (tree_block) = 1;
+ BLOCK_VARS (tree_block) = NULL_TREE;
+ iterator = handle_iterator (n->u2.ns, &iter_block,
+ tree_block);
+ }
+ if (list == OMP_LIST_DEPEND
+ && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
{
tree vec = NULL_TREE;
unsigned int i;
@@ -2539,7 +2610,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (!n->sym->attr.referenced)
continue;
- tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
+ tree node = build_omp_clause (input_location,
+ list == OMP_LIST_DEPEND
+ ? OMP_CLAUSE_DEPEND
+ : OMP_CLAUSE_AFFINITY);
if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
{
tree decl = gfc_trans_omp_variable (n->sym, false);
@@ -2573,33 +2647,42 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
gfc_conv_expr_descriptor (&se, n->expr);
ptr = gfc_conv_array_data (se.expr);
}
- gfc_add_block_to_block (block, &se.pre);
- gfc_add_block_to_block (block, &se.post);
+ gfc_add_block_to_block (&iter_block, &se.pre);
+ gfc_add_block_to_block (&iter_block, &se.post);
ptr = fold_convert (build_pointer_type (char_type_node),
ptr);
OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
}
- switch (n->u.depend_op)
+ if (list == OMP_LIST_DEPEND)
+ switch (n->u.depend_op)
+ {
+ case OMP_DEPEND_IN:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
+ break;
+ case OMP_DEPEND_OUT:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
+ break;
+ case OMP_DEPEND_INOUT:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
+ break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ OMP_CLAUSE_DEPEND_KIND (node)
+ = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+ break;
+ case OMP_DEPEND_DEPOBJ:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ if (n->u2.ns)
{
- case OMP_DEPEND_IN:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
- break;
- case OMP_DEPEND_OUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
- break;
- case OMP_DEPEND_INOUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
- break;
- case OMP_DEPEND_MUTEXINOUTSET:
- OMP_CLAUSE_DEPEND_KIND (node)
- = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
- break;
- case OMP_DEPEND_DEPOBJ:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
- break;
- default:
- gcc_unreachable ();
+ BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+ TREE_VEC_ELT (iterator, 5) = tree_block;
+ OMP_CLAUSE_DECL (node) = build_tree_list (iterator, OMP_CLAUSE_DECL (node));
}
+ else
+ gfc_add_block_to_block (block, &iter_block);
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
break;
@@ -5675,10 +5758,23 @@ gfc_trans_omp_taskgroup (gfc_code *code)
}
static tree
-gfc_trans_omp_taskwait (void)
+gfc_trans_omp_taskwait (gfc_code *code)
{
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
- return build_call_expr_loc (input_location, decl, 0);
+ if (!code->ext.omp_clauses)
+ {
+ tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
+ return build_call_expr_loc (input_location, decl, 0);
+ }
+ stmtblock_t block;
+ gfc_start_block (&block);
+ tree stmt = make_node (OMP_TASK);
+ TREE_TYPE (stmt) = void_type_node;
+ OMP_TASK_BODY (stmt) = NULL_TREE;
+ OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
+ code->ext.omp_clauses,
+ code->loc);
+ gfc_add_expr_to_block (&block, stmt);
+ return gfc_finish_block (&block);
}
static tree
@@ -6307,7 +6403,7 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_TASKLOOP_SIMD:
return gfc_trans_omp_taskloop (code);
case EXEC_OMP_TASKWAIT:
- return gfc_trans_omp_taskwait ();
+ return gfc_trans_omp_taskwait (code);
case EXEC_OMP_TASKYIELD:
return gfc_trans_omp_taskyield ();
case EXEC_OMP_TEAMS:
@@ -9506,6 +9506,10 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
goto do_add;
+ case OMP_CLAUSE_AFFINITY:
+ /* Ignore. */
+ remove = true;
+ break;
case OMP_CLAUSE_DEPEND:
if (OMP_CLAUSE_DEPEND_KIND (c) == OMP_CLAUSE_DEPEND_SINK)
{
new file mode 100644
@@ -0,0 +1,20 @@
+void
+foo(int x)
+{
+ int a, b[5], cc, d[5][5];
+#pragma omp taskgroup
+ {
+ #pragma omp task affinity(a)
+ { }
+ #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5, jj =2:5:2) : b[i], d[i][jj])
+ { }
+ #pragma omp task affinity(iterator(i=(int)__builtin_cos(1.0+a):5) : b[i], d[i][i])
+ { }
+ #pragma omp task affinity (iterator(i=1:5): a)
+ { }
+ #pragma omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x)
+ { }
+ #pragma omp task affinity (iterator(unsigned long j=1:5, k=7:4:-1) : b[j+k],a) affinity (cc)
+ { }
+ }
+}
new file mode 100644
@@ -0,0 +1,232 @@
+/* { dg-do compile } */
+/* { dg-options "-fopenmp" } */
+
+extern int a[][10], a2[][10];
+int b[10], c[10][2], d[10], e[10], f[10];
+int b2[10], c2[10][2], d2[10], e2[10], f2[10];
+int k[10], l[10], m[10], n[10], o;
+int *p;
+void bar (void);
+int t[10];
+#pragma omp threadprivate (t)
+
+void
+foo (int g[3][10], int h[4][8], int i[2][10], int j[][9],
+ int g2[3][10], int h2[4][8], int i2[2][10], int j2[][9])
+{
+ #pragma omp task affinity( bar[2:5]) /* { dg-error "is not a variable" } */
+ ;
+ #pragma omp task affinity( t[2:5])
+ ;
+ #pragma omp task affinity( k[0.5:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( l[:7.5f]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( m[p:]) /* { dg-error "low bound \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( n[:p]) /* { dg-error "length \[^\n\r]* of array section does not have integral type" } */
+ ;
+ #pragma omp task affinity( o[2:5]) /* { dg-error "does not have pointer or array type" } */
+ ;
+ #pragma omp task affinity( a[:][2:4]) /* { dg-error "array type length expression must be specified" } */
+ ;
+ #pragma omp task affinity( b[-1:]) /* { dg-error "negative low bound in array section" } */
+ ;
+ #pragma omp task affinity( c[:-3][1:1]) /* { dg-error "negative length in array section" } */
+ ;
+ #pragma omp task affinity( d[11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( e[:11]) /* { dg-error "length \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( f[1:10]) /* { dg-error "high bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( g[:][2:4]) /* { dg-error "for array function parameter length expression must be specified" } */
+ ;
+ #pragma omp task affinity( h[2:2][-1:]) /* { dg-error "negative low bound in array section" } */
+ ;
+ #pragma omp task affinity( h[:1][:-3]) /* { dg-error "negative length in array section" } */
+ ;
+ #pragma omp task affinity( i[:1][11:]) /* { dg-error "low bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( j[3:4][:10]) /* { dg-error "length \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( j[30:10][5:5]) /* { dg-error "high bound \[^\n\r]* above array section size" } */
+ ;
+ #pragma omp task affinity( a2[:3][2:4])
+ ;
+ #pragma omp task affinity( b2[0:])
+ ;
+ #pragma omp task affinity( c2[:3][1:1])
+ ;
+ #pragma omp task affinity( d2[9:])
+ ;
+ #pragma omp task affinity( e2[:10])
+ ;
+ #pragma omp task affinity( f2[1:9])
+ ;
+ #pragma omp task affinity( g2[:2][2:4])
+ ;
+ #pragma omp task affinity( h2[2:2][0:])
+ ;
+ #pragma omp task affinity( h2[:1][:3])
+ ;
+ #pragma omp task affinity( i2[:1][9:])
+ ;
+ #pragma omp task affinity( j2[3:4][:9])
+ ;
+ #pragma omp task affinity( j2[30:10][5:4])
+ ;
+}
+
+void bar2 (int a[10][10][10]);
+
+void
+foo2 (int a[10][10][10], int **b)
+{
+ int c[10][10][10];
+ #pragma omp task affinity( a[2:4][3:][:7], b[1:7][2:8])
+ bar2 (a);
+ int i = 1, j = 3, k = 2, l = 6;
+ #pragma omp task affinity( a[++i:++j][++k:][:++l])
+ bar2 (a);
+ #pragma omp task affinity( a[7:2][:][:], c[5:2][:][:])
+ {
+ bar2 (c);
+ bar2 (a);
+ }
+}
+
+void
+foo3 (int a[10][10][10], int **b, int x)
+{
+ int c[10][10][10];
+ #pragma omp task affinity( a[2:4][3:0][:7]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( b[:7][0:0][:0]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( c[:][:][10:]) /* { dg-error "zero length array section" } */
+ bar2 (c);
+ #pragma omp task affinity( a[2:4][3:0][:x]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( b[:x][0:0][:0]) /* { dg-error "zero length array section" } */
+ bar2 (a);
+ #pragma omp task affinity( c[:][x-2:x][10:]) /* { dg-error "zero length array section" } */
+ bar2 (c);
+}
+
+void
+foo4 (int *p, int (*q)[10], int r[10], int s[10][10])
+{
+ int a[10], b[10][10];
+ #pragma omp task affinity ( p[-1:2])
+ ;
+ #pragma omp task affinity ( q[-1:2][2:4])
+ ;
+ #pragma omp task affinity ( q[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( r[-1:2])
+ ;
+ #pragma omp task affinity ( s[-1:2][2:4])
+ ;
+ #pragma omp task affinity ( s[-1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( a[-1:2]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( b[-1:2][2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( b[1:2][-2:4]) /* { dg-error "negative low bound in array section in" } */
+ ;
+ #pragma omp task affinity ( p[2:-3]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( q[2:-3][:]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( q[2:3][0:-1]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( r[2:-5]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( s[2:-5][:]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( s[2:5][0:-4]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( a[2:-5]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( b[2:-5][0:10]) /* { dg-error "negative length in array section in" } */
+ ;
+ #pragma omp task affinity ( b[2:5][0:-4]) /* { dg-error "negative length in array section in" } */
+ ;
+}
+
+struct T { int c[3]; };
+struct S { int a; struct T *b; struct T g; };
+struct S sd[10];
+struct S *se[10];
+struct S *sf;
+struct S sh;
+struct U { int a : 5; };
+struct U si;
+
+
+void
+foo5 (void)
+{
+ #pragma omp task affinity( sd)
+ ;
+ #pragma omp task affinity( sd[2])
+ ;
+ #pragma omp task affinity( sd[:])
+ ;
+ #pragma omp task affinity( sd[2:2])
+ ;
+ #pragma omp task affinity( sd[:2])
+ ;
+ #pragma omp task affinity( sd[1].b->c[2])
+ ;
+ #pragma omp task affinity( sd[0].a)
+ ;
+ #pragma omp task affinity( se[3]->a)
+ ;
+ #pragma omp task affinity( se[2]->b->c)
+ ;
+ #pragma omp task affinity( se[1]->b->c[2])
+ ;
+ #pragma omp task affinity( (*sf).a)
+ ;
+ #pragma omp task affinity( sf->b->c[0])
+ ;
+ #pragma omp task affinity( sf)
+ ;
+ #pragma omp task affinity( *sf)
+ ;
+ #pragma omp task affinity( sf[0])
+ ;
+ #pragma omp task affinity( sf[0].a)
+ ;
+ #pragma omp task affinity( sh.g.c[2])
+ ;
+}
+
+void
+foo6 (void)
+{
+ #pragma omp task affinity( sd[:2].b->c[2]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sd[1:].b->c[2]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sd[0:1].a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[3:2]->a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[2:2]->b->c) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( se[1]->b->c[2:1]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sf + 0) /* { dg-error "'sf' is not lvalue expression nor array section in 'affinity' clause" } */
+ ;
+ #pragma omp task affinity( sf[0:1].a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( sh.g.c[2:1]) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity( si.a) /* { dg-error "bit-field 'si\\..*a' in 'affinity' clause" } */
+ ;
+}
+/* { dg-additional-options "-Wno-volatile" { target c++ } } */
new file mode 100644
@@ -0,0 +1,77 @@
+/* { dg-additional-options "-Wno-volatile" { target c++ } } */
+
+int arr[64], arr2[64];
+struct S { int a[4]; } k;
+short arr4[4];
+volatile int v;
+#define TEST_EQ(x,y) ({ int o[x == y ? 1 : -1]; 0; })
+
+void
+foo (unsigned char i, signed char j)
+{
+ #pragma omp task affinity (iterator (j=6:2:-2) : \
+ arr[TEST_EQ (sizeof (j), sizeof (int)), \
+ TEST_EQ (sizeof (i), sizeof (unsigned char)), \
+ TEST_EQ (sizeof (k), sizeof (struct S)), j], \
+ arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (i)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \
+ affinity(arr[0]) \
+ affinity (iterator (long long i=__LONG_LONG_MAX__ - 4:__LONG_LONG_MAX__ - 2:2, \
+ unsigned short j=~0U-16:~0U-8:3, \
+ short *k=&arr4[1]:&arr4[2]:1) : \
+ arr[TEST_EQ (sizeof (i), sizeof (long long)), \
+ TEST_EQ (sizeof (j), sizeof (unsigned short)), \
+ TEST_EQ (sizeof (k), sizeof (short *)), \
+ TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \
+ arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (j)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \
+ arr2[k - &arr4[0]]) \
+ affinity( k)
+ v++;
+}
+
+void
+bar (unsigned char i, signed char j)
+{
+ int m = j;
+ int n = j + 2;
+ #pragma omp task affinity (iterator (j=6:2:m) : \
+ arr[TEST_EQ (sizeof (j), sizeof (int)), \
+ TEST_EQ (sizeof (i), sizeof (unsigned char)), \
+ TEST_EQ (sizeof (k), sizeof (struct S)), j], \
+ arr2[TEST_EQ (((__typeof (j)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (i)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (k.a[0])) -1) < 0, 1), j]) \
+ affinity( arr[0]) \
+ affinity (iterator (long long i=__LONG_LONG_MAX__ - 4 - n:__LONG_LONG_MAX__ - 2:2, \
+ unsigned short j=~0U-16:~0U-8-n:3, \
+ short *k=&arr4[1]:&arr4[n + 2]:1) : \
+ arr[TEST_EQ (sizeof (i), sizeof (long long)), \
+ TEST_EQ (sizeof (j), sizeof (unsigned short)), \
+ TEST_EQ (sizeof (k), sizeof (short *)), \
+ TEST_EQ (sizeof (*k), sizeof (short)), i - __LONG_LONG_MAX__ + 4], \
+ arr2[TEST_EQ (((__typeof (i)) -1) < 0, 1), \
+ TEST_EQ (((__typeof (j)) -1) < 0, 0), \
+ TEST_EQ (((__typeof (*k)) -1) < 0, 1), j - (~0U-16)], \
+ arr2[k - &arr4[0]:10]) \
+ affinity( k)
+ v++;
+}
+
+void
+baz (void)
+{
+ #pragma omp parallel
+ #pragma omp master
+ {
+ #pragma omp task affinity(iterator(unsigned long int k = 0 : 2) : \
+ arr[TEST_EQ (sizeof (k), sizeof (unsigned long)), \
+ TEST_EQ (((__typeof (k)) -1) < 0, 0), k]) \
+ affinity(iterator(signed char s = -3 : -12 : -1) : \
+ arr[TEST_EQ (sizeof (s), sizeof (signed char)), \
+ TEST_EQ (((__typeof (s)) -1) < 0, 1), s + 12])
+ v++;
+ }
+}
new file mode 100644
@@ -0,0 +1,77 @@
+int a, b[64];
+struct S { int c; } *d, *e;
+struct T;
+struct T *f, *g;
+int *h;
+
+void
+f1 (void)
+{
+ #pragma omp task affinity (iterator : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (for = 0 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (5 = 0 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i : 0 : 2) : a) /* { dg-error "expected '='|name a type|expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0, 1 : 2) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = (0, 1) : 2) : a)
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 1 : 2 : 3) : a) /* { dg-error "expected '.'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 2, 3) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0 : 10 : 2, 3) : a) /* { dg-error "expected" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:1), iterator (j = 0:1) : a) /* { dg-error "expected ':' before ',' token" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:32) : b[i*2:2])
+ ;
+ #pragma omp task affinity (iterator (struct S i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (void i = 0:1) : a) /* { dg-error "iterator 'i' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (float f = 0.2:0.4) : a) /* { dg-error "iterator 'f' has neither integral nor pointer type" } */
+ ;
+ #pragma omp task affinity (iterator (struct S *p = d:e:2) : a)
+ ;
+ #pragma omp task affinity (iterator (struct T *p = f:g) , a) /* { dg-error "expected ':' before ',' token" } */
+ ;
+ #pragma omp task affinity (iterator (int i = 0:4, \
+ struct U { int (*p)[i + 2]; } *p = 0:2) : a) /* { dg-error "type of iterator 'p' refers to outer iterator 'i'" "" { target c } } */
+ ; /* { dg-error "types may not be defined in iterator type|not an integral constant" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 0:4, j = i:16) : a) /* { dg-error "begin expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:4, j = 2:i:1) : a) /* { dg-error "end expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = 0:4, j = 2:8:i) : a) /* { dg-error "step expression refers to outer iterator 'i'" } */
+ ;
+ #pragma omp task affinity (iterator (i = *d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */
+ ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 2:*d:2) : a) /* { dg-error "aggregate value used where an integer was expected" "" { target c } } */
+ ; /* { dg-error "invalid cast from type 'S' to type 'int'" "" { target c++ } .-1 } */
+ #pragma omp task affinity (iterator (i = 2:4:*d) : a) /* { dg-error "iterator step with non-integral type" } */
+ ;
+ #pragma omp task affinity (iterator (i = 1.25:2.5:3) : a)
+ ;
+ #pragma omp task affinity (iterator (i = 1:2:3.5) : a) /* { dg-error "iterator step with non-integral type" } */
+ ;
+ #pragma omp task affinity (iterator (int *p = 23 : h) : a)
+ ;
+ #pragma omp task affinity (iterator (short i=1:3:0) : a) /* { dg-error "iterator 'i' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (i = 1 : 3 : 3 - 3) : a) /* { dg-error "iterator 'i' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (int *p = &b[6]:&b[9]:4 - 4) : a) /* { dg-error "iterator 'p' has zero step" } */
+ ;
+ #pragma omp task affinity (iterator (const int i = 0 : 2) : a) /* { dg-error "const qualified" } */
+ ;
+ #pragma omp task affinity (iterator (const long long unsigned i = 0 : 2) : a) /* { dg-error "const qualified" } */
+ ;
+#if !defined (__cplusplus) && __STDC_VERSION__ >= 201112L
+ #pragma omp task affinity (iterator (_Atomic unsigned i = 0 : 2) : a) /* { dg-error "_Atomic" "" { target c } } */
+ ;
+#endif
+}
new file mode 100644
@@ -0,0 +1,31 @@
+! { dg-additional-options "-fdump-tree-original" }
+subroutine foo(x)
+ integer :: x
+ integer :: a, b(5), cc, d(5,5)
+ !$omp taskgroup
+ !$omp task affinity(a)
+ !$omp end task
+ !$omp task affinity(iterator(i=int(cos(1.0+a)):5, jj =2:5:2) : b(i), d(i,jj))
+ !$omp end task
+ !$omp task affinity(iterator(i=int(cos(1.0+a)):5) : b(i), d(i,i))
+ !$omp end task
+ !$omp task affinity (iterator(i=1:5): a)
+ !$omp end task
+ !$omp task affinity (iterator(i=1:5): a) affinity(iterator(i=1:5) : x)
+ !$omp end task
+ !$omp task affinity (iterator(integer(8) :: j=1:5, k=7:4:-1) : b(j+k),a) affinity (cc)
+ !$omp end task
+ !$omp end taskgroup
+end
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(a\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) jj=2:5:2, integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) jj \\* 5 \\+ \\(integer\\(kind=8\\)\\) i\\) \\+ -6\\\]\\)" 1 "original" } }
+
+! { dg final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e\\+0\\):5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(integer\\(kind=8\\)\\) i \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) i=\\(integer\\(kind=4\\)\\) __builtin_cosf \\(\\(real\\(kind=4\\)\\) a \\+ 1.0e+0\\):5:1\\):\\*\\(c_char \\*\\) &d\\\[\\(\\(integer\\(kind=8\\)\\) i \\+ -1\\) \\* 6\\\]\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\)\[^ \]" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):a\\) affinity\\(iterator\\(integer\\(kind=4\\) i=1:5:1\\):\\*x\\)" 1 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp task affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):\\*\\(c_char \\*\\) &b\\\[\\(\\(integer\\(kind=8\\)\\) k \\+ j\\) \\+ -1\\\]\\) affinity\\(iterator\\(integer\\(kind=4\\) k=7:4:-1, integer\\(kind=8\\) j=1:5:1\\):a\\) affinity\\(cc\\)" 1 "original" } }
new file mode 100644
@@ -0,0 +1,27 @@
+subroutine foo
+ implicit none
+ external bar
+ integer :: i, b(10)
+ !$omp task affinity(bar(1)) ! { dg-error "not a variable" }
+ !!$omp end task
+ !$omp task affinity(b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" }
+ !$omp end task
+ !$omp task affinity( iterator( real :: i=1.0:5:1) : b(i)) ! { dg-error "Expected INTEGER type" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1.0:5:1) : b(i)) ! { dg-error "Scalar integer expression for range begin expected" }
+ !$omp end task
+ !$omp task affinity(iterator(i=1:5.0:1) : b(i)) ! { dg-error "Scalar integer expression for range end expected" }
+ !$omp end task
+ !$omp task affinity(iterator(i=1:5:1.0) : b(i)) ! { dg-error "Scalar integer expression for range step expected" }
+ !$omp end task
+ !$omp task affinity(iterator(j=1:3:5, i=1:5:0) : b(i)) ! { dg-error "Nonzero range step expected" }
+ !$omp end task
+ !$omp task affinity(iterator(=1:5:0) : b(i)) ! { dg-error "Expected identifier" }
+ !!$omp end task
+ !$omp task affinity(iterator(b(2)=1:5:0) : b(i)) ! { dg-error "Failed to match clause" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1:5:0, i=4:6) : b(i)) ! { dg-error "Same identifier 'i' specified again" }
+ !!$omp end task
+ !$omp task affinity(iterator(i=1) : b(i)) ! { dg-error "Expected range-specification" }
+ !!$omp end task
+end
new file mode 100644
@@ -0,0 +1,45 @@
+! { dg-do run }
+
+module mymod
+ implicit none (type, external)
+ integer, target :: var(0:5) = [0,1,2,3,4,5]
+end module mymod
+
+program main
+ use mymod
+ implicit none
+
+ type t
+ integer :: x(0:64)
+ integer :: y
+ end type t
+ type(t) :: dep2(0:64)
+ integer :: dep1(0:64)
+
+ integer arr(0:63)
+ !$omp parallel
+ !$omp master
+ block
+ integer :: i
+ do i = 0, 63
+ !$omp task depend (iterator (j=i:i+1) , out : dep1 (j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%y)
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (iterator (j=i:i+1) , out : dep2 (j)%x(j))
+ arr(i) = i
+ !$omp end task
+ !$omp task depend (out : dep2 (:4))
+ arr(i) = i
+ !$omp end task
+ !$omp taskwait depend(out: dep1(1))
+ end do
+ end block
+ !$omp end master
+ !$omp end parallel
+end
new file mode 100644
@@ -0,0 +1,27 @@
+subroutine foo
+ implicit none
+ external bar
+ integer :: i, b(10)
+ !$omp task depend(in : bar(1)) ! { dg-error "not a variable" }
+ !!$omp end task
+ !$omp task depend(out : b(1.0)) ! { dg-warning "Legacy Extension: REAL array index" }
+ !$omp end task
+ !$omp task depend( iterator( real :: i=1.0:5:1), in : b(i)) ! { dg-error "Expected INTEGER type" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1.0:5:1), out : b(i)) ! { dg-error "Scalar integer expression for range begin expected" }
+ !$omp end task
+ !$omp task depend(iterator(i=1:5.0:1), in : b(i)) ! { dg-error "Scalar integer expression for range end expected" }
+ !$omp end task
+ !$omp task depend(iterator(i=1:5:1.0), in : b(i)) ! { dg-error "Scalar integer expression for range step expected" }
+ !$omp end task
+ !$omp task depend(iterator(j=1:3:5, i=1:5:0), out : b(i)) ! { dg-error "Nonzero range step expected" }
+ !$omp end task
+ !$omp task depend(iterator(=1:5:0), in : b(i)) ! { dg-error "Expected identifier" }
+ !!$omp end task
+ !$omp task depend(iterator(b(2)=1:5:1), in : b(i)) ! { dg-error "Failed to match clause" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1:5:0, i=4:6), out: b(i)) ! { dg-error "Same identifier 'i' specified again" }
+ !!$omp end task
+ !$omp task depend(iterator(i=1) ,out: b(i)) ! { dg-error "Expected range-specification" }
+ !!$omp end task
+end
new file mode 100644
@@ -0,0 +1,7 @@
+! { dg-additional-arguments "-fdump-tree-original" }
+!$omp taskwait
+!$omp taskwait depend(out:foo)
+end
+
+! { dg-final { scan-tree-dump-times "__builtin_GOMP_taskwait \\(\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp taskwait depend\\(out:foo\\)" 1 "original" } }
@@ -277,6 +277,9 @@ enum omp_clause_code {
/* OpenMP clause: linear (variable-list[:linear-step]). */
OMP_CLAUSE_LINEAR,
+ /* OpenMP clause: affinity([depend-modifier :] variable-list). */
+ OMP_CLAUSE_AFFINITY,
+
/* OpenMP clause: aligned (variable-list[:alignment]). */
OMP_CLAUSE_ALIGNED,
@@ -743,6 +743,22 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_right_paren (pp);
break;
+ case OMP_CLAUSE_AFFINITY:
+ pp_string (pp, "affinity(");
+ {
+ tree t = OMP_CLAUSE_DECL (clause);
+ if (TREE_CODE (t) == TREE_LIST
+ && TREE_PURPOSE (t)
+ && TREE_CODE (TREE_PURPOSE (t)) == TREE_VEC)
+ {
+ dump_omp_iterators (pp, TREE_PURPOSE (t), spc, flags);
+ pp_colon (pp);
+ t = TREE_VALUE (t);
+ }
+ dump_generic_node (pp, t, spc, flags, false);
+ }
+ pp_right_paren (pp);
+ break;
case OMP_CLAUSE_DEPEND:
pp_string (pp, "depend(");
switch (OMP_CLAUSE_DEPEND_KIND (clause))
@@ -803,8 +819,11 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
pp_colon (pp);
t = TREE_VALUE (t);
}
- pp_string (pp, name);
- pp_colon (pp);
+ if (name[0])
+ {
+ pp_string (pp, name);
+ pp_colon (pp);
+ }
dump_generic_node (pp, t, spc, flags, false);
pp_right_paren (pp);
}
@@ -290,6 +290,7 @@ unsigned const char omp_clause_num_ops[] =
1, /* OMP_CLAUSE_COPYIN */
1, /* OMP_CLAUSE_COPYPRIVATE */
3, /* OMP_CLAUSE_LINEAR */
+ 1, /* OMP_CLAUSE_AFFINITY */
2, /* OMP_CLAUSE_ALIGNED */
2, /* OMP_CLAUSE_ALLOCATE */
1, /* OMP_CLAUSE_DEPEND */
@@ -376,6 +377,7 @@ const char * const omp_clause_code_name[] =
"copyin",
"copyprivate",
"linear",
+ "affinity",
"aligned",
"allocate",
"depend",
@@ -12227,6 +12229,7 @@ walk_tree_1 (tree *tp, walk_tree_fn func, void *data,
WALK_SUBTREE (OMP_CLAUSE_OPERAND (*tp, 1));
/* FALLTHRU */
+ case OMP_CLAUSE_AFFINITY:
case OMP_CLAUSE_ASYNC:
case OMP_CLAUSE_WAIT:
case OMP_CLAUSE_WORKER:
new file mode 100644
@@ -0,0 +1,89 @@
+module m
+ implicit none (type, external)
+ integer, volatile :: v
+contains
+subroutine foo (p, i)
+ integer :: p(0:*)
+ integer :: i
+ !$omp task depend (out: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (in: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (inout: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (mutexinoutset: p(0))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (out: p(0)) depend (in: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (in: p(0)) depend (inout: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (inout: p(0)) depend (mutexinoutset: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (mutexinoutset: p(0)) depend (out: p(1))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , out : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , in : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , inout : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , out : p(j)) depend (iterator (j=0:2) , in : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , in : p(j)) depend (iterator (j=0:2) , inout : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , inout : p(j)) depend (iterator (j=0:2) , mutexinoutset : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:2) , mutexinoutset : p(j)) depend (iterator (j=0:2) , out : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , out : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , in : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , inout : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , out : p(j)) depend (iterator (j=0:i) , in : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , in : p(j)) depend (iterator (j=0:i) , inout : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , inout : p(j)) depend (iterator (j=0:i) , mutexinoutset : p(j + 2))
+ v = v + 1
+ !$omp end task
+ !$omp task depend (iterator (j=0:i) , mutexinoutset : p(j)) depend (iterator (j=0:i) , out : p(j + 2))
+ v = v + 1
+ !$omp end task
+end
+end module
+
+program main
+ use m
+ implicit none (external, type)
+ integer p(4)
+ call foo (p, 2)
+ call foo (p, -1)
+end