* [PATCH 1/7] openmp: Add C support for parsing metadirectives
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
@ 2021-12-10 17:31 ` Kwok Cheung Yeung
2022-02-18 21:09 ` [PATCH] openmp: Improve handling of nested OpenMP metadirectives in C and C++ (was: Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives) Kwok Cheung Yeung
2022-05-27 17:44 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Jakub Jelinek
2021-12-10 17:33 ` [PATCH 2/7] openmp: Add middle-end support for metadirectives Kwok Cheung Yeung
` (6 subsequent siblings)
7 siblings, 2 replies; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:31 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1671 bytes --]
This patch adds support for parsing metadirectives in the C parser.
Metadirectives are represented by a OMP_METADIRECTIVE tree node. It has
a single operand (accessed by OMP_METADIRECTIVE_CLAUSES) which contains
a chain of TREE_LIST nodes, each one representing a clause from the
metadirective. TREE_PURPOSE(clause) contains the selector of the clause,
while TREE_VALUE(clause) contains another TREE_LIST - the TREE_PURPOSE
contains the tree for the directive, while the TREE_VALUE contains the
standalone body (if any).
If an OMP directive has an associated body, it will be part of the tree
at TREE_PURPOSE(TREE_VALUE(clause)) - the standalone body at
TREE_VALUE(TREE_VALUE(clause) is only used for standalone directives
that do not have an associated body (strictly speaking, it isn't a part
of the directive variant at all). At present, all standalone bodies in a
metadirective are shared, and will point to the same tree node.
Labels in the statement body are handled by first scanning the body for
labels, then enclosing the statements in a lexical block with the found
labels declared as local using __label__. This prevents labels in the
body interfering with each other when the body is re-parsed.
I have removed support for the 'omp begin metadirective'..'omp end
metadirective' form of the directive that was originally in the WIP
patch. According to the spec, the only variant directives that can be
used in this form must have an 'end <directive>' form (apart from the
'nothing' directive), and in C/C++, the only directive that we support
with an end form is 'declare target', which we currently forbid since it
is declarative.
Kwok
[-- Attachment #2: 0001-openmp-Add-C-support-for-parsing-metadirectives.patch --]
[-- Type: text/plain, Size: 25231 bytes --]
From dc88559b0295104472a0cbf79de03b0549bd35f5 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 19:15:23 +0000
Subject: [PATCH 1/7] openmp: Add C support for parsing metadirectives
This patch implements parsing for the OpenMP metadirective introduced in
OpenMP 5.0. Metadirectives are parsed into an OMP_METADIRECTIVE node,
with the variant clauses forming a chain accessible via
OMP_METADIRECTIVE_CLAUSES. Each clause contains the context selector
and tree for the variant.
User conditions in the selector are now permitted to be non-constant when
used in metadirectives as specified in OpenMP 5.1.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* omp-general.c (omp_context_selector_matches): Add extra argument.
(omp_resolve_metadirective): New stub function.
* omp-general.h (struct omp_metadirective_variant): New.
(omp_context_selector_matches): Add extra argument.
(omp_resolve_metadirective): New prototype.
* tree.def (OMP_METADIRECTIVE): New.
* tree.h (OMP_METADIRECTIVE_CLAUSES): New macro.
gcc/c/
* c-parser.c (c_parser_skip_to_end_of_block_or_statement): Handle
parentheses in statement.
(c_parser_omp_metadirective): New prototype.
(c_parser_omp_context_selector): Add extra argument. Allow
non-constant expressions.
(c_parser_omp_context_selector_specification): Add extra argument and
propagate it to c_parser_omp_context_selector.
(analyze_metadirective_body): New.
(c_parser_omp_metadirective): New.
(c_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.
gcc/c-family
* c-common.h (enum c_omp_directive_kind): Add C_OMP_DIR_META.
(c_omp_expand_metadirective): New prototype.
* c-gimplify.c (genericize_omp_metadirective_stmt): New.
(c_genericize_control_stmt): Handle OMP_METADIRECTIVE tree nodes.
* c-omp.c (omp_directives): Classify metadirectives as C_OMP_DIR_META.
(c_omp_expand_metadirective): New stub function.
* c-pragma.c (omp_pragmas): Add entry for metadirective.
* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_METADIRECTIVE.
---
gcc/c-family/c-common.h | 4 +-
gcc/c-family/c-gimplify.c | 25 +++
gcc/c-family/c-omp.c | 14 +-
gcc/c-family/c-pragma.c | 1 +
gcc/c-family/c-pragma.h | 1 +
gcc/c/c-parser.c | 403 +++++++++++++++++++++++++++++++++++++-
gcc/omp-general.c | 14 +-
gcc/omp-general.h | 9 +-
gcc/tree.def | 5 +
gcc/tree.h | 3 +
10 files changed, 465 insertions(+), 14 deletions(-)
diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h
index c089fda12e4..ef37051791f 100644
--- a/gcc/c-family/c-common.h
+++ b/gcc/c-family/c-common.h
@@ -1257,7 +1257,8 @@ enum c_omp_directive_kind {
C_OMP_DIR_CONSTRUCT,
C_OMP_DIR_DECLARATIVE,
C_OMP_DIR_UTILITY,
- C_OMP_DIR_INFORMATIONAL
+ C_OMP_DIR_INFORMATIONAL,
+ C_OMP_DIR_META
};
struct c_omp_directive {
@@ -1270,6 +1271,7 @@ struct c_omp_directive {
extern const struct c_omp_directive *c_omp_categorize_directive (const char *,
const char *,
const char *);
+extern tree c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &);
/* Return next tree in the chain for chain_next walking of tree nodes. */
static inline tree
diff --git a/gcc/c-family/c-gimplify.c b/gcc/c-family/c-gimplify.c
index 0d38b706f4c..4c5feddf041 100644
--- a/gcc/c-family/c-gimplify.c
+++ b/gcc/c-family/c-gimplify.c
@@ -449,6 +449,26 @@ genericize_omp_for_stmt (tree *stmt_p, int *walk_subtrees, void *data,
finish_bc_block (&OMP_FOR_BODY (stmt), bc_continue, clab);
}
+/* Genericize a OMP_METADIRECTIVE node *STMT_P. */
+
+static void
+genericize_omp_metadirective_stmt (tree *stmt_p, int *walk_subtrees,
+ void *data, walk_tree_fn func,
+ walk_tree_lh lh)
+{
+ tree stmt = *stmt_p;
+
+ for (tree clause = OMP_METADIRECTIVE_CLAUSES (stmt);
+ clause != NULL_TREE;
+ clause = TREE_CHAIN (clause))
+ {
+ tree variant = TREE_VALUE (clause);
+ walk_tree_1 (&TREE_PURPOSE (variant), func, data, NULL, lh);
+ walk_tree_1 (&TREE_VALUE (variant), func, data, NULL, lh);
+ }
+
+ *walk_subtrees = 0;
+}
/* Lower structured control flow tree nodes, such as loops. The
STMT_P, WALK_SUBTREES, and DATA arguments are as for the walk_tree_fn
@@ -497,6 +517,11 @@ c_genericize_control_stmt (tree *stmt_p, int *walk_subtrees, void *data,
genericize_omp_for_stmt (stmt_p, walk_subtrees, data, func, lh);
break;
+ case OMP_METADIRECTIVE:
+ genericize_omp_metadirective_stmt (stmt_p, walk_subtrees, data, func,
+ lh);
+ break;
+
case STATEMENT_LIST:
if (TREE_SIDE_EFFECTS (stmt))
{
diff --git a/gcc/c-family/c-omp.c b/gcc/c-family/c-omp.c
index 3f84fd1b5cb..9a7a6834f1b 100644
--- a/gcc/c-family/c-omp.c
+++ b/gcc/c-family/c-omp.c
@@ -3133,7 +3133,7 @@ static const struct c_omp_directive omp_directives[] = {
/* { "begin", "declare", "variant", PRAGMA_OMP_BEGIN,
C_OMP_DIR_DECLARATIVE, false }, */
/* { "begin", "metadirective", nullptr, PRAGMA_OMP_BEGIN,
- C_OMP_DIR_???, ??? }, */
+ C_OMP_DIR_META, false }, */
{ "cancel", nullptr, nullptr, PRAGMA_OMP_CANCEL,
C_OMP_DIR_STANDALONE, false },
{ "cancellation", "point", nullptr, PRAGMA_OMP_CANCELLATION_POINT,
@@ -3163,7 +3163,7 @@ static const struct c_omp_directive omp_directives[] = {
/* { "end", "declare", "variant", PRAGMA_OMP_END,
C_OMP_DIR_DECLARATIVE, false }, */
/* { "end", "metadirective", nullptr, PRAGMA_OMP_END,
- C_OMP_DIR_???, ??? }, */
+ C_OMP_DIR_META, false }, */
/* error with at(execution) is C_OMP_DIR_STANDALONE. */
{ "error", nullptr, nullptr, PRAGMA_OMP_ERROR,
C_OMP_DIR_UTILITY, false },
@@ -3179,8 +3179,8 @@ static const struct c_omp_directive omp_directives[] = {
C_OMP_DIR_CONSTRUCT, true },
{ "master", nullptr, nullptr, PRAGMA_OMP_MASTER,
C_OMP_DIR_CONSTRUCT, true },
- /* { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
- C_OMP_DIR_???, ??? }, */
+ { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
+ C_OMP_DIR_META, false },
{ "nothing", nullptr, nullptr, PRAGMA_OMP_NOTHING,
C_OMP_DIR_UTILITY, false },
/* ordered with depend clause is C_OMP_DIR_STANDALONE. */
@@ -3263,3 +3263,9 @@ c_omp_categorize_directive (const char *first, const char *second,
}
return NULL;
}
+
+tree
+c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
+{
+ return NULL_TREE;
+}
diff --git a/gcc/c-family/c-pragma.c b/gcc/c-family/c-pragma.c
index c4ed4205820..bd27de7f126 100644
--- a/gcc/c-family/c-pragma.c
+++ b/gcc/c-family/c-pragma.c
@@ -1365,6 +1365,7 @@ static const struct omp_pragma_def omp_pragmas[] = {
{ "error", PRAGMA_OMP_ERROR },
{ "end", PRAGMA_OMP_END_DECLARE_TARGET },
{ "flush", PRAGMA_OMP_FLUSH },
+ { "metadirective", PRAGMA_OMP_METADIRECTIVE },
{ "nothing", PRAGMA_OMP_NOTHING },
{ "requires", PRAGMA_OMP_REQUIRES },
{ "scope", PRAGMA_OMP_SCOPE },
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index 0c5b07ab4e1..145260e0c20 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -61,6 +61,7 @@ enum pragma_kind {
PRAGMA_OMP_NOTHING,
PRAGMA_OMP_MASKED,
PRAGMA_OMP_MASTER,
+ PRAGMA_OMP_METADIRECTIVE,
PRAGMA_OMP_ORDERED,
PRAGMA_OMP_PARALLEL,
PRAGMA_OMP_REQUIRES,
diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index e99c84776f1..9689a221975 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -1390,6 +1390,17 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
++nesting_depth;
break;
+ case CPP_OPEN_PAREN:
+ /* Track parentheses in case the statement is a standalone 'for'
+ statement - we want to skip over the semicolons separating the
+ operands. */
+ nesting_depth++;
+ break;
+
+ case CPP_CLOSE_PAREN:
+ nesting_depth--;
+ break;
+
case CPP_PRAGMA:
/* If we see a pragma, consume the whole thing at once. We
have some safeguards against consuming pragmas willy-nilly.
@@ -1586,6 +1597,8 @@ static bool c_parser_omp_cancellation_point (c_parser *, enum pragma_context);
static bool c_parser_omp_target (c_parser *, enum pragma_context, bool *);
static void c_parser_omp_end_declare_target (c_parser *);
static bool c_parser_omp_declare (c_parser *, enum pragma_context);
+static tree c_parser_omp_metadirective (location_t, c_parser *, char *,
+ omp_clause_mask, tree *, bool *);
static void c_parser_omp_requires (c_parser *);
static bool c_parser_omp_error (c_parser *, enum pragma_context);
static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
@@ -19187,6 +19200,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
location_t for_loc;
bool tiling = false;
bool inscan = false;
+
vec<tree, va_gc> *for_block = make_tree_vector ();
for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
@@ -21398,7 +21412,8 @@ static const char *const omp_user_selectors[] = {
score(score-expression) */
static tree
-c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
+c_parser_omp_context_selector (c_parser *parser, tree set, tree parms,
+ bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -21606,10 +21621,16 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
{
mark_exp_read (t);
t = c_fully_fold (t, false, NULL);
- if (!INTEGRAL_TYPE_P (TREE_TYPE (t))
- || !tree_fits_shwi_p (t))
+ if (!metadirective_p
+ && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
+ || !tree_fits_shwi_p (t)))
error_at (token->location, "property must be "
- "constant integer expression");
+ "constant integer expression");
+ else if (metadirective_p
+ && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
+ /* Allow non-constant user expressions in metadirectives. */
+ error_at (token->location, "property must be "
+ "integer expression");
else
properties = tree_cons (NULL_TREE, t, properties);
}
@@ -21675,7 +21696,8 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
user */
static tree
-c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
+c_parser_omp_context_selector_specification (c_parser *parser, tree parms,
+ bool metadirective_p = false)
{
tree ret = NULL_TREE;
do
@@ -21721,7 +21743,8 @@ c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
if (!braces.require_open (parser))
return error_mark_node;
- tree selectors = c_parser_omp_context_selector (parser, set, parms);
+ tree selectors = c_parser_omp_context_selector (parser, set, parms,
+ metadirective_p);
if (selectors == error_mark_node)
ret = error_mark_node;
else if (ret != error_mark_node)
@@ -22930,6 +22953,368 @@ c_parser_omp_error (c_parser *parser, enum pragma_context context)
return false;
}
+/* Helper function for c_parser_omp_metadirective. */
+
+static void
+analyze_metadirective_body (c_parser *parser,
+ vec<c_token> &tokens,
+ vec<tree> &labels)
+{
+ int nesting_depth = 0;
+ int bracket_depth = 0;
+ bool ignore_label = false;
+
+ /* Read in the body tokens to the tokens for each candidate directive. */
+ while (1)
+ {
+ c_token *token = c_parser_peek_token (parser);
+ bool stop = false;
+
+ if (c_parser_next_token_is_keyword (parser, RID_CASE))
+ ignore_label = true;
+
+ switch (token->type)
+ {
+ case CPP_EOF:
+ break;
+ case CPP_NAME:
+ if (!ignore_label
+ && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+ labels.safe_push (token->value);
+ goto add;
+ case CPP_OPEN_BRACE:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_BRACE:
+ if (--nesting_depth == 0)
+ stop = true;
+ goto add;
+ case CPP_OPEN_PAREN:
+ ++bracket_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ --bracket_depth;
+ goto add;
+ case CPP_COLON:
+ ignore_label = false;
+ goto add;
+ case CPP_SEMICOLON:
+ if (nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ goto add;
+ default:
+ add:
+ tokens.safe_push (*token);
+ if (token->type == CPP_PRAGMA)
+ c_parser_consume_pragma (parser);
+ else if (token->type == CPP_PRAGMA_EOL)
+ c_parser_skip_to_pragma_eol (parser);
+ else
+ c_parser_consume_token (parser);
+ if (stop)
+ break;
+ continue;
+ }
+ break;
+ }
+}
+
+/* OpenMP 5.0:
+
+ # pragma omp metadirective [clause[, clause]]
+*/
+
+static tree
+c_parser_omp_metadirective (location_t loc, c_parser *parser,
+ char *p_name, omp_clause_mask, tree *,
+ bool *if_p)
+{
+ tree ret;
+ auto_vec<c_token> directive_tokens;
+ auto_vec<c_token> body_tokens;
+ auto_vec<tree> body_labels;
+ auto_vec<const struct c_omp_directive *> directives;
+ auto_vec<tree> ctxs;
+ vec<struct omp_metadirective_variant> candidates;
+ bool default_seen = false;
+ int directive_token_idx = 0;
+ tree standalone_body = NULL_TREE;
+
+ ret = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (ret, loc);
+ TREE_TYPE (ret) = void_type_node;
+ OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
+ strcat (p_name, " metadirective");
+
+ while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+ {
+ if (c_parser_next_token_is_not (parser, CPP_NAME)
+ && c_parser_next_token_is_not (parser, CPP_KEYWORD))
+ {
+ c_parser_error (parser, "expected %<when%> or %<default%>");
+ goto error;
+ }
+
+ location_t match_loc = c_parser_peek_token (parser)->location;
+ const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ c_parser_consume_token (parser);
+ bool default_p = strcmp (p, "default") == 0;
+ if (default_p)
+ {
+ if (default_seen)
+ {
+ c_parser_error (parser, "there can only be one default clause "
+ "in a metadirective");
+ goto error;
+ }
+ default_seen = true;
+ }
+ if (!(strcmp (p, "when") == 0 || default_p))
+ {
+ c_parser_error (parser, "expected %<when%> or %<default%>");
+ goto error;
+ }
+
+ matching_parens parens;
+ tree ctx = NULL_TREE;
+ bool skip = false;
+
+ if (!parens.require_open (parser))
+ goto error;
+
+ if (!default_p)
+ {
+ ctx = c_parser_omp_context_selector_specification (parser,
+ NULL_TREE, true);
+ if (ctx == error_mark_node)
+ goto error;
+ ctx = omp_check_context_selector (match_loc, ctx);
+ if (ctx == error_mark_node)
+ goto error;
+
+ /* Remove the selector from further consideration if can be
+ evaluated as a non-match at this point. */
+ skip = (omp_context_selector_matches (ctx, true) == 0);
+
+ if (c_parser_next_token_is_not (parser, CPP_COLON))
+ {
+ c_parser_error (parser, "expected colon");
+ goto error;
+ }
+ c_parser_consume_token (parser);
+ }
+
+ /* Read in the directive type and create a dummy pragma token for
+ it. */
+ location_t loc = c_parser_peek_token (parser)->location;
+
+ p = NULL;
+ if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
+ p = "nothing";
+ else if (c_parser_next_token_is_keyword (parser, RID_FOR))
+ {
+ p = "for";
+ c_parser_consume_token (parser);
+ }
+ else if (c_parser_next_token_is (parser, CPP_NAME))
+ {
+ p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+ c_parser_consume_token (parser);
+ }
+
+ if (p == NULL)
+ {
+ c_parser_error (parser, "expected directive name");
+ goto error;
+ }
+
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive (p, NULL, NULL);
+
+ if (omp_directive == NULL)
+ {
+ c_parser_error (parser, "unknown directive name");
+ goto error;
+ }
+ if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+ {
+ c_parser_error (parser,
+ "metadirectives cannot be used as directive "
+ "variants");
+ goto error;
+ }
+ if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+ {
+ sorry_at (loc, "declarative directive variants are not supported");
+ goto error;
+ }
+
+ if (!skip)
+ {
+ c_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = loc;
+ pragma_token.pragma_kind = (enum pragma_kind) omp_directive->id;
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (ctx);
+ }
+
+ /* Read in tokens for the directive clauses. */
+ int nesting_depth = 0;
+ while (1)
+ {
+ c_token *token = c_parser_peek_token (parser);
+ switch (token->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ break;
+ case CPP_OPEN_PAREN:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ if (nesting_depth-- == 0)
+ break;
+ goto add;
+ default:
+ add:
+ if (!skip)
+ directive_tokens.safe_push (*token);
+ c_parser_consume_token (parser);
+ continue;
+ }
+ break;
+ }
+
+ c_parser_consume_token (parser);
+
+ if (!skip)
+ {
+ c_token eol_token;
+ memset (&eol_token, 0, sizeof (eol_token));
+ eol_token.type = CPP_PRAGMA_EOL;
+ directive_tokens.safe_push (eol_token);
+ }
+ }
+ c_parser_skip_to_pragma_eol (parser);
+
+ if (!default_seen)
+ {
+ /* Add a default clause that evaluates to 'omp nothing'. */
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive ("nothing", NULL, NULL);
+
+ c_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = UNKNOWN_LOCATION;
+ pragma_token.pragma_kind = PRAGMA_OMP_NOTHING;
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (NULL_TREE);
+
+ c_token eol_token;
+ memset (&eol_token, 0, sizeof (eol_token));
+ eol_token.type = CPP_PRAGMA_EOL;
+ directive_tokens.safe_push (eol_token);
+ }
+
+ analyze_metadirective_body (parser, body_tokens, body_labels);
+
+ /* Process each candidate directive. */
+ unsigned i;
+ tree ctx;
+
+ FOR_EACH_VEC_ELT (ctxs, i, ctx)
+ {
+ auto_vec<c_token> tokens;
+
+ /* Add the directive tokens. */
+ do
+ tokens.safe_push (directive_tokens [directive_token_idx++]);
+ while (tokens.last ().type != CPP_PRAGMA_EOL);
+
+ /* Add the body tokens. */
+ for (unsigned j = 0; j < body_tokens.length (); j++)
+ tokens.safe_push (body_tokens[j]);
+
+ /* Make sure nothing tries to read past the end of the tokens. */
+ c_token eof_token;
+ memset (&eof_token, 0, sizeof (eof_token));
+ eof_token.type = CPP_EOF;
+ tokens.safe_push (eof_token);
+ tokens.safe_push (eof_token);
+
+ unsigned int old_tokens_avail = parser->tokens_avail;
+ c_token *old_tokens = parser->tokens;
+
+ parser->tokens = tokens.address ();
+ parser->tokens_avail = tokens.length ();
+
+ tree directive = c_begin_compound_stmt (true);
+
+ /* Declare all non-local labels that occur within the directive body
+ as local. */
+ for (unsigned j = 0; j < body_labels.length (); j++)
+ {
+ tree label = declare_label (body_labels[j]);
+
+ C_DECLARED_LABEL_FLAG (label) = 1;
+ add_stmt (build_stmt (loc, DECL_EXPR, label));
+ }
+
+ c_parser_pragma (parser, pragma_compound, if_p);
+ directive = c_end_compound_stmt (loc, directive, true);
+ bool standalone_p
+ = directives[i]->kind == C_OMP_DIR_STANDALONE
+ || directives[i]->kind == C_OMP_DIR_UTILITY;
+ if (standalone_p)
+ {
+ /* Parsing standalone directives will not consume the body
+ tokens, so do that here. */
+ if (standalone_body == NULL_TREE)
+ {
+ standalone_body = push_stmt_list ();
+ c_parser_statement (parser, if_p);
+ standalone_body = pop_stmt_list (standalone_body);
+ }
+ else
+ c_parser_skip_to_end_of_block_or_statement (parser);
+ }
+
+ tree body = standalone_p ? standalone_body : NULL_TREE;
+ tree variant = build_tree_list (ctx, build_tree_list (directive, body));
+ OMP_METADIRECTIVE_CLAUSES (ret)
+ = chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
+
+ /* Check that all valid tokens have been consumed. */
+ gcc_assert (parser->tokens_avail == 2);
+ gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
+ gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+
+ parser->tokens = old_tokens;
+ parser->tokens_avail = old_tokens_avail;
+ }
+
+ /* Try to resolve the metadirective early. */
+ candidates = omp_resolve_metadirective (ret);
+ if (!candidates.is_empty ())
+ ret = c_omp_expand_metadirective (candidates);
+
+ add_stmt (ret);
+
+ return ret;
+
+error:
+ if (parser->in_pragma)
+ c_parser_skip_to_pragma_eol (parser);
+ c_parser_skip_to_end_of_block_or_statement (parser);
+
+ return NULL_TREE;
+}
+
/* Main entry point to parsing most OpenMP pragmas. */
static void
@@ -23003,6 +23388,11 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
strcpy (p_name, "#pragma omp");
stmt = c_parser_omp_master (loc, parser, p_name, mask, NULL, if_p);
break;
+ case PRAGMA_OMP_METADIRECTIVE:
+ strcpy (p_name, "#pragma omp");
+ stmt = c_parser_omp_metadirective (loc, parser, p_name, mask, NULL,
+ if_p);
+ break;
case PRAGMA_OMP_PARALLEL:
strcpy (p_name, "#pragma omp");
stmt = c_parser_omp_parallel (loc, parser, p_name, mask, NULL, if_p);
@@ -23043,7 +23433,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
gcc_assert (EXPR_LOCATION (stmt) != UNKNOWN_LOCATION);
}
-
/* OpenMP 2.5:
# pragma omp threadprivate (variable-list) */
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 8fcca730471..9926cfd9d5f 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1260,7 +1260,7 @@ omp_context_name_list_prop (tree prop)
IPA, others until vectorization. */
int
-omp_context_selector_matches (tree ctx)
+omp_context_selector_matches (tree ctx, bool)
{
int ret = 1;
for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
@@ -2624,6 +2624,18 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
INSERT) = entryp;
}
+/* Return a vector of dynamic replacement candidates for the metadirective
+ statement in METADIRECTIVE. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+vec<struct omp_metadirective_variant>
+omp_resolve_metadirective (tree)
+{
+ vec<struct omp_metadirective_variant> variants = {};
+
+ return variants;
+}
+
/* Encode an oacc launch argument. This matches the GOMP_LAUNCH_PACK
macro on gomp-constants.h. We do not check for overflow. */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index a0c7c71148c..8c6009e9854 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -89,6 +89,12 @@ struct omp_for_data
tree adjn1;
};
+/* A structure describing a variant in a metadirective. */
+
+struct omp_metadirective_variant
+{
+};
+
#define OACC_FN_ATTRIB "oacc function"
extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
@@ -108,10 +114,11 @@ extern int omp_constructor_traits_to_codes (tree, enum tree_code *);
extern tree omp_check_context_selector (location_t loc, tree ctx);
extern void omp_mark_declare_variant (location_t loc, tree variant,
tree construct);
-extern int omp_context_selector_matches (tree);
+extern int omp_context_selector_matches (tree, bool = false);
extern int omp_context_selector_set_compare (const char *, tree, tree);
extern tree omp_get_context_selector (tree, const char *, const char *);
extern tree omp_resolve_declare_variant (tree);
+extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/tree.def b/gcc/tree.def
index e27bc3e2b1f..91f8c4db1e3 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1274,6 +1274,11 @@ DEFTREECODE (OMP_TARGET_ENTER_DATA, "omp_target_enter_data", tcc_statement, 1)
Operand 0: OMP_TARGET_EXIT_DATA_CLAUSES: List of clauses. */
DEFTREECODE (OMP_TARGET_EXIT_DATA, "omp_target_exit_data", tcc_statement, 1)
+/* OpenMP - #pragma omp metadirective [clause1 ... clauseN]
+ Operand 0: OMP_METADIRECTIVE_CLAUSES: List of selectors and directive
+ variants. */
+DEFTREECODE (OMP_METADIRECTIVE, "omp_metadirective", tcc_statement, 1)
+
/* OMP_ATOMIC through OMP_ATOMIC_CAPTURE_NEW must be consecutive,
or OMP_ATOMIC_SEQ_CST needs adjusting. */
diff --git a/gcc/tree.h b/gcc/tree.h
index 094501bd9b1..06c8140e011 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1471,6 +1471,9 @@ class auto_suppress_location_wrappers
#define OMP_TARGET_EXIT_DATA_CLAUSES(NODE)\
TREE_OPERAND (OMP_TARGET_EXIT_DATA_CHECK (NODE), 0)
+#define OMP_METADIRECTIVE_CLAUSES(NODE) \
+ TREE_OPERAND (OMP_METADIRECTIVE_CHECK (NODE), 0)
+
#define OMP_SCAN_BODY(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0)
#define OMP_SCAN_CLAUSES(NODE) TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1)
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH] openmp: Improve handling of nested OpenMP metadirectives in C and C++ (was: Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives)
2021-12-10 17:31 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Kwok Cheung Yeung
@ 2022-02-18 21:09 ` Kwok Cheung Yeung
2022-02-18 21:26 ` [og11][committed] openmp: Improve handling of nested OpenMP metadirectives in C and C++ Kwok Cheung Yeung
2022-05-27 17:44 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Jakub Jelinek
1 sibling, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2022-02-18 21:09 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1188 bytes --]
This patch (to be applied on top of the metadirective patch series)
addresses issues found in the C/C++ parsers when nested metadirectives
are used.
analyze_metadirective_body when encountering code like:
#pragma omp metadirective when {set={...}: A)
#pragma omp metadirective when (set={...}: B)
would stop just before ': B' before it naively assumes that the '}'
marks the end of the body associated with the first metadirective, when
it needs to include the whole of the second metadirective plus its
associated body. This is fixed by checking that the nesting level of
parentheses is zero as well before stopping the gathering of tokens.
The assert on the remaining tokens after parsing a clause can fail
(resulting in an ICE) if there is a parse error in the directive or the
body, since in that case not all tokens may be processed before parsing
aborts early. The assert is therefore not enforced if any parse errors
occur in the clause.
I have also moved the handling of the metadirective pragma from
c_parser_omp_construct to c_parser_pragma (and their C++ equivalents),
since c_parser_omp_construct has some checks that do not apply to
metadirectives.
Kwok
[-- Attachment #2: 0001-openmp-Improve-handling-of-nested-OpenMP-metadirecti.patch --]
[-- Type: text/plain, Size: 13354 bytes --]
From a9e4936b8476b97f11bb81b416ef3d28fa60cd37 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 18 Feb 2022 19:00:57 +0000
Subject: [PATCH] openmp: Improve handling of nested OpenMP metadirectives in C
and C++
This patch fixes a misparsing issue when encountering code like:
#pragma omp metadirective when {<selector_set>={...}: A)
#pragma omp metadirective when (<selector_set>={...}: B)
When called for the first metadirective, analyze_metadirective_body would
stop just before the colon in the second metadirective because it naively
assumes that the '}' marks the end of a code block.
The assertion for clauses to end parsing at the same point is now disabled
if a parse error has occurred during the parsing of the clause, since some
tokens may not be consumed if a parse error cuts parsing short.
2022-02-18 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/c/
* c-parser.cc (c_parser_omp_construct): Move handling of
PRAGMA_OMP_METADIRECTIVE from here...
(c_parser_pragma): ...to here.
(analyze_metadirective_body): Check that the bracket nesting level
is also zero before stopping the adding of tokens on encountering a
close brace.
(c_parser_omp_metadirective): Modify function signature and update.
Do not assert on remaining tokens if there has been a parse error.
gcc/cp/
* parser.cc (cp_parser_omp_construct): Move handling of
PRAGMA_OMP_METADIRECTIVE from here...
(cp_parser_pragma): ...to here.
(analyze_metadirective_body): Check that the bracket
nesting level is also zero before stopping the adding of tokens on
encountering a close brace.
(cp_parser_omp_metadirective): Modify function signature and update.
Do not assert on remaining tokens if there has been a parse error.
gcc/testsuite/
* c-c++-common/gomp/metadirective-1.c (f): Add test for
improperly nested metadirectives.
---
gcc/c/c-parser.cc | 47 +++++++++----------
gcc/cp/parser.cc | 33 ++++++-------
.../c-c++-common/gomp/metadirective-1.c | 13 +++++
3 files changed, 51 insertions(+), 42 deletions(-)
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 58fcbb398ee..6a134e0fb50 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -1592,6 +1592,7 @@ static void c_parser_omp_taskwait (c_parser *);
static void c_parser_omp_taskyield (c_parser *);
static void c_parser_omp_cancel (c_parser *);
static void c_parser_omp_nothing (c_parser *);
+static void c_parser_omp_metadirective (c_parser *, bool *);
enum pragma_context { pragma_external, pragma_struct, pragma_param,
pragma_stmt, pragma_compound };
@@ -1600,8 +1601,6 @@ static bool c_parser_omp_cancellation_point (c_parser *, enum pragma_context);
static bool c_parser_omp_target (c_parser *, enum pragma_context, bool *);
static void c_parser_omp_end_declare_target (c_parser *);
static bool c_parser_omp_declare (c_parser *, enum pragma_context);
-static tree c_parser_omp_metadirective (location_t, c_parser *, char *,
- omp_clause_mask, tree *, bool *);
static void c_parser_omp_requires (c_parser *);
static bool c_parser_omp_error (c_parser *, enum pragma_context);
static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
@@ -12551,6 +12550,10 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
c_parser_omp_nothing (parser);
return false;
+ case PRAGMA_OMP_METADIRECTIVE:
+ c_parser_omp_metadirective (parser, if_p);
+ return true;
+
case PRAGMA_OMP_ERROR:
return c_parser_omp_error (parser, context);
@@ -23020,7 +23023,7 @@ analyze_metadirective_body (c_parser *parser,
++nesting_depth;
goto add;
case CPP_CLOSE_BRACE:
- if (--nesting_depth == 0)
+ if (--nesting_depth == 0 && bracket_depth == 0)
stop = true;
goto add;
case CPP_OPEN_PAREN:
@@ -23058,10 +23061,8 @@ analyze_metadirective_body (c_parser *parser,
# pragma omp metadirective [clause[, clause]]
*/
-static tree
-c_parser_omp_metadirective (location_t loc, c_parser *parser,
- char *p_name, omp_clause_mask, tree *,
- bool *if_p)
+static void
+c_parser_omp_metadirective (c_parser *parser, bool *if_p)
{
tree ret;
auto_vec<c_token> directive_tokens;
@@ -23073,13 +23074,14 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
bool default_seen = false;
int directive_token_idx = 0;
tree standalone_body = NULL_TREE;
+ location_t pragma_loc = c_parser_peek_token (parser)->location;
ret = make_node (OMP_METADIRECTIVE);
- SET_EXPR_LOCATION (ret, loc);
+ SET_EXPR_LOCATION (ret, pragma_loc);
TREE_TYPE (ret) = void_type_node;
OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
- strcat (p_name, " metadirective");
+ c_parser_consume_pragma (parser);
while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
{
if (c_parser_next_token_is_not (parser, CPP_NAME)
@@ -23287,6 +23289,7 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
parser->tokens = tokens.address ();
parser->tokens_avail = tokens.length ();
+ int prev_errorcount = errorcount;
tree directive = c_begin_compound_stmt (true);
/* Declare all non-local labels that occur within the directive body
@@ -23296,11 +23299,11 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
tree label = declare_label (body_labels[j]);
C_DECLARED_LABEL_FLAG (label) = 1;
- add_stmt (build_stmt (loc, DECL_EXPR, label));
+ add_stmt (build_stmt (pragma_loc, DECL_EXPR, label));
}
c_parser_pragma (parser, pragma_compound, if_p);
- directive = c_end_compound_stmt (loc, directive, true);
+ directive = c_end_compound_stmt (pragma_loc, directive, true);
bool standalone_p
= directives[i]->kind == C_OMP_DIR_STANDALONE
|| directives[i]->kind == C_OMP_DIR_UTILITY;
@@ -23323,10 +23326,14 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
OMP_METADIRECTIVE_CLAUSES (ret)
= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
- /* Check that all valid tokens have been consumed. */
- gcc_assert (parser->tokens_avail == 2);
- gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
- gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+ /* Check that all valid tokens have been consumed if no parse errors
+ encountered. */
+ if (errorcount == prev_errorcount)
+ {
+ gcc_assert (parser->tokens_avail == 2);
+ gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
+ gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+ }
parser->tokens = old_tokens;
parser->tokens_avail = old_tokens_avail;
@@ -23338,15 +23345,12 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
ret = c_omp_expand_metadirective (candidates);
add_stmt (ret);
-
- return ret;
+ return;
error:
if (parser->in_pragma)
c_parser_skip_to_pragma_eol (parser);
c_parser_skip_to_end_of_block_or_statement (parser);
-
- return NULL_TREE;
}
/* Main entry point to parsing most OpenMP pragmas. */
@@ -23422,11 +23426,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
strcpy (p_name, "#pragma omp");
stmt = c_parser_omp_master (loc, parser, p_name, mask, NULL, if_p);
break;
- case PRAGMA_OMP_METADIRECTIVE:
- strcpy (p_name, "#pragma omp");
- stmt = c_parser_omp_metadirective (loc, parser, p_name, mask, NULL,
- if_p);
- break;
case PRAGMA_OMP_PARALLEL:
strcpy (p_name, "#pragma omp");
stmt = c_parser_omp_parallel (loc, parser, p_name, mask, NULL, if_p);
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index aa23688814a..ef33cb1611f 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -45985,7 +45985,7 @@ cp_parser_omp_end_declare_target (cp_parser *parser, cp_token *pragma_tok)
}
-/* Helper function for c_parser_omp_metadirective. */
+/* Helper function for cp_parser_omp_metadirective. */
static void
analyze_metadirective_body (cp_parser *parser,
@@ -46021,7 +46021,7 @@ analyze_metadirective_body (cp_parser *parser,
++nesting_depth;
goto add;
case CPP_CLOSE_BRACE:
- if (--nesting_depth == 0)
+ if (--nesting_depth == 0 && bracket_depth == 0)
stop = true;
goto add;
case CPP_OPEN_PAREN:
@@ -46056,9 +46056,8 @@ analyze_metadirective_body (cp_parser *parser,
# pragma omp metadirective [clause[, clause]]
*/
-static tree
+static void
cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
- char *p_name, omp_clause_mask, tree *,
bool *if_p)
{
tree ret;
@@ -46069,15 +46068,14 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
auto_vec<tree> ctxs;
bool default_seen = false;
int directive_token_idx = 0;
- location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+ location_t pragma_loc = pragma_tok->location;
tree standalone_body = NULL_TREE;
vec<struct omp_metadirective_variant> candidates;
ret = make_node (OMP_METADIRECTIVE);
- SET_EXPR_LOCATION (ret, loc);
+ SET_EXPR_LOCATION (ret, pragma_loc);
TREE_TYPE (ret) = void_type_node;
OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
- strcat (p_name, " metadirective");
while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
{
@@ -46296,6 +46294,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
parser->lexer = lexer;
cp_lexer_set_source_position_from_token (lexer->next_token);
+ int prev_errorcount = errorcount;
tree directive = push_stmt_list ();
tree directive_stmt = begin_compound_stmt (0);
@@ -46330,8 +46329,10 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
OMP_METADIRECTIVE_CLAUSES (ret)
= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
- /* Check that all valid tokens have been consumed. */
- gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
+ /* Check that all valid tokens have been consumed if no parse errors
+ encountered. */
+ gcc_assert (errorcount != prev_errorcount
+ || cp_lexer_next_token_is (parser->lexer, CPP_EOF));
parser->lexer = old_lexer;
cp_lexer_set_source_position_from_token (old_lexer->next_token);
@@ -46343,8 +46344,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
ret = c_omp_expand_metadirective (candidates);
add_stmt (ret);
-
- return ret;
+ return;
fail:
/* Skip the metadirective pragma. */
@@ -46352,7 +46352,6 @@ fail:
/* Skip the metadirective body. */
cp_parser_skip_to_end_of_block_or_statement (parser);
- return error_mark_node;
}
@@ -47602,11 +47601,6 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
if_p);
break;
- case PRAGMA_OMP_METADIRECTIVE:
- strcpy (p_name, "#pragma omp");
- stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
- NULL, if_p);
- break;
case PRAGMA_OMP_PARALLEL:
strcpy (p_name, "#pragma omp");
stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
@@ -48257,7 +48251,6 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
case PRAGMA_OMP_LOOP:
case PRAGMA_OMP_MASKED:
case PRAGMA_OMP_MASTER:
- case PRAGMA_OMP_METADIRECTIVE:
case PRAGMA_OMP_PARALLEL:
case PRAGMA_OMP_SCOPE:
case PRAGMA_OMP_SECTIONS:
@@ -48289,6 +48282,10 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
cp_parser_omp_nothing (parser, pragma_tok);
return false;
+ case PRAGMA_OMP_METADIRECTIVE:
+ cp_parser_omp_metadirective (parser, pragma_tok, if_p);
+ return true;
+
case PRAGMA_OMP_ERROR:
return cp_parser_omp_error (parser, pragma_tok, context);
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
index 72cf0abbbd7..543063a3324 100644
--- a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -4,6 +4,8 @@
void f (int a[], int b[], int c[])
{
+ int i;
+
#pragma omp metadirective \
default (teams loop) \
default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */
@@ -26,4 +28,15 @@ void f (int a[], int b[], int c[])
#pragma omp metadirective \
default (metadirective default (flush)) /* { dg-error "metadirectives cannot be used as directive variants before 'default'" } */
for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ /* Test improperly nested metadirectives - even though the second
+ metadirective resolves to 'omp nothing', that is not the same as there
+ being literally nothing there. */
+ #pragma omp metadirective \
+ when (implementation={vendor("gnu")}: parallel for)
+ #pragma omp metadirective \
+ when (implementation={vendor("cray")}: parallel for)
+ /* { dg-error "for statement expected before '#pragma'" "" { target c } .-2 } */
+ /* { dg-error "'#pragma' is not allowed here" "" { target c++ } .-3 } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
}
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives
2021-12-10 17:31 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Kwok Cheung Yeung
2022-02-18 21:09 ` [PATCH] openmp: Improve handling of nested OpenMP metadirectives in C and C++ (was: Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives) Kwok Cheung Yeung
@ 2022-05-27 17:44 ` Jakub Jelinek
1 sibling, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-27 17:44 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:31:08PM +0000, Kwok Cheung Yeung wrote:
> This patch adds support for parsing metadirectives in the C parser.
>
> Metadirectives are represented by a OMP_METADIRECTIVE tree node. It has a
> single operand (accessed by OMP_METADIRECTIVE_CLAUSES) which contains a
I think naming this OMP_METADIRECTIVE_CLAUSES when the operand isn't
a chain of OMP_CLAUSE trees is misleading, I think better would be
OMP_METADIRECTIVE_VARIANTS.
> I have removed support for the 'omp begin metadirective'..'omp end
> metadirective' form of the directive that was originally in the WIP patch.
> According to the spec, the only variant directives that can be used in this
> form must have an 'end <directive>' form (apart from the 'nothing'
> directive), and in C/C++, the only directive that we support with an end
> form is 'declare target', which we currently forbid since it is declarative.
I guess that is fine initially, but eventually we should have support
for parsing of omp begin metadirective and omp end metadirective even
if we just always sorry then.
> --- a/gcc/c/c-parser.c
> +++ b/gcc/c/c-parser.c
> @@ -1390,6 +1390,17 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
> ++nesting_depth;
> break;
>
> + case CPP_OPEN_PAREN:
> + /* Track parentheses in case the statement is a standalone 'for'
> + statement - we want to skip over the semicolons separating the
> + operands. */
> + nesting_depth++;
> + break;
> +
> + case CPP_CLOSE_PAREN:
> + nesting_depth--;
> + break;
> +
> case CPP_PRAGMA:
> /* If we see a pragma, consume the whole thing at once. We
> have some safeguards against consuming pragmas willy-nilly.
I find this hunk very risky, it is used in many places and I'm not convinced
that is the behavior we want everywhere else.
I'd say the options are either to copy the function and add this only to the
copy and use that in metadirective handling, or add a default bool argument
and only do something about nesting_depth if the argument is non-default.
Furthermore, I don't think we want to just blindly decrement nesting_depth,
the CPP_CLOSE_BRACE takes care of never decrementing it below zero.
And, the function uses ++nesting_depth etc. instead of nesting_depth++
so some consistency would be nice.
> @@ -19187,6 +19200,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
> location_t for_loc;
> bool tiling = false;
> bool inscan = false;
> +
> vec<tree, va_gc> *for_block = make_tree_vector ();
>
> for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
Why?
> @@ -21606,10 +21621,16 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
> {
> mark_exp_read (t);
> t = c_fully_fold (t, false, NULL);
> - if (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> - || !tree_fits_shwi_p (t))
> + if (!metadirective_p
> + && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> + || !tree_fits_shwi_p (t)))
> error_at (token->location, "property must be "
> - "constant integer expression");
> + "constant integer expression");
> + else if (metadirective_p
> + && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
> + /* Allow non-constant user expressions in metadirectives. */
> + error_at (token->location, "property must be "
> + "integer expression");
> else
> properties = tree_cons (NULL_TREE, t, properties);
> }
I don't understand this change. In OpenMP 5.0, condition selector had to be
constant. In OpenMP 5.1, it can be non-constant and then it is a dynamic
selector. But there is no restriction that it must be constant for
declare variant.
I think enabling this is orthogonal to the metadirective support, so either
the initial version shouldn't support dynamic selectors and a follow-up
patch should add support for them for both metadirectives and declare
variant, or the support should be added for both at the same time.
> @@ -22930,6 +22953,368 @@ c_parser_omp_error (c_parser *parser, enum pragma_context context)
> return false;
> }
>
> +/* Helper function for c_parser_omp_metadirective. */
> +
> +static void
> +analyze_metadirective_body (c_parser *parser,
> + vec<c_token> &tokens,
> + vec<tree> &labels)
> +{
> + int nesting_depth = 0;
> + int bracket_depth = 0;
> + bool ignore_label = false;
> +
> + /* Read in the body tokens to the tokens for each candidate directive. */
> + while (1)
> + {
> + c_token *token = c_parser_peek_token (parser);
> + bool stop = false;
> +
> + if (c_parser_next_token_is_keyword (parser, RID_CASE))
> + ignore_label = true;
> +
> + switch (token->type)
> + {
> + case CPP_EOF:
> + break;
> + case CPP_NAME:
> + if (!ignore_label
> + && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
> + labels.safe_push (token->value);
This looks risky, not all CPP_NAME CPP_COLON adjacent tokens will be
actually labels.
E.g. in
{ struct S { int a, b; } c = { a: 1, b: 2 }; }
a and b aren't labels.
I'm afraid we need real parsing to find out what is a label and what is not.
Or for C
{ void bar (void) { goto a; a:; } bar (); }
a is indeed a label, but in a nested function (for C++ e.g. in lambda)
and I doubt we want to privatize those either.
Gathering this way just potential label candidates and later marking only
those that were actually encountered during parsing might work.
> +c_parser_omp_metadirective (location_t loc, c_parser *parser,
> + char *p_name, omp_clause_mask, tree *,
> + bool *if_p)
> +{
> + tree ret;
> + auto_vec<c_token> directive_tokens;
> + auto_vec<c_token> body_tokens;
> + auto_vec<tree> body_labels;
> + auto_vec<const struct c_omp_directive *> directives;
> + auto_vec<tree> ctxs;
> + vec<struct omp_metadirective_variant> candidates;
> + bool default_seen = false;
> + int directive_token_idx = 0;
> + tree standalone_body = NULL_TREE;
> +
> + ret = make_node (OMP_METADIRECTIVE);
> + SET_EXPR_LOCATION (ret, loc);
> + TREE_TYPE (ret) = void_type_node;
> + OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
> + strcat (p_name, " metadirective");
> +
> + while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
> + {
> + if (c_parser_next_token_is_not (parser, CPP_NAME)
> + && c_parser_next_token_is_not (parser, CPP_KEYWORD))
> + {
> + c_parser_error (parser, "expected %<when%> or %<default%>");
Consistency would suggest
"expected %<#pragma omp%> clause"
or, if you want to spell those out,
"expected %<when%> or %<default%> clause"
But note that we'll need to add %<otherwise%> clause to the list soon
as an alias to %<default%>.
> + goto error;
> + }
> +
> + location_t match_loc = c_parser_peek_token (parser)->location;
> + const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> + c_parser_consume_token (parser);
> + bool default_p = strcmp (p, "default") == 0;
> + if (default_p)
> + {
> + if (default_seen)
> + {
> + c_parser_error (parser, "there can only be one default clause "
> + "in a metadirective");
As I said elsewhere, "too many %qs clauses", "default"
> + goto error;
> + }
> + default_seen = true;
> + }
> + if (!(strcmp (p, "when") == 0 || default_p))
> + {
> + c_parser_error (parser, "expected %<when%> or %<default%>");
Consistency would suggest
error_at (here, "%qs is not valid for %qs", p, "metadirective");
> + /* Remove the selector from further consideration if can be
> + evaluated as a non-match at this point. */
> + skip = (omp_context_selector_matches (ctx, true) == 0);
The outer ()s aren't needed.
> +
> + if (c_parser_next_token_is_not (parser, CPP_COLON))
> + {
> + c_parser_error (parser, "expected colon");
> + goto error;
> + }
c_parser_require (parser, CPP_COLON, "expected %<:%>")
instead? Or at least "expected %<:%>"
> + /* Read in the directive type and create a dummy pragma token for
> + it. */
> + location_t loc = c_parser_peek_token (parser)->location;
> +
> + p = NULL;
> + if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
> + p = "nothing";
> + else if (c_parser_next_token_is_keyword (parser, RID_FOR))
> + {
> + p = "for";
> + c_parser_consume_token (parser);
> + }
> + else if (c_parser_next_token_is (parser, CPP_NAME))
> + {
> + p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> + c_parser_consume_token (parser);
> + }
> +
> + if (p == NULL)
> + {
> + c_parser_error (parser, "expected directive name");
> + goto error;
> + }
> +
> + const struct c_omp_directive *omp_directive
> + = c_omp_categorize_directive (p, NULL, NULL);
The NULL, NULL looks wrong. I don't see how you'd handle
say when (whatever: target enter data) correctly then,
or any other multiple identifier directive.
You should simply peek (raw) at the next token after it and
if it is also a CPP_NAME, supply the other name, and in that
case look for the token even after it and if it is CPP_NAME, supply
that too.
const char *directive[3] = {};
for (int i = 0; i < 3; i++)
{
tree id = NULL_TREE;
if (first + i == last)
break;
if (first[i].type == CPP_NAME)
id = first[i].u.value;
else if (first[i].type == CPP_KEYWORD)
id = ridpointers[(int) first[i].keyword];
else
break;
directive[i] = IDENTIFIER_POINTER (id);
}
is what the C++ FE does.
> +
> + if (omp_directive == NULL)
> + {
> + c_parser_error (parser, "unknown directive name");
> + goto error;
> + }
> + if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
> + {
> + c_parser_error (parser,
> + "metadirectives cannot be used as directive "
> + "variants");
"variants of a %<metadirective%>" ?
> + goto error;
> + }
> + if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
> + {
> + sorry_at (loc, "declarative directive variants are not supported");
"declarative directive variants of a %<metadirective%> not supported" ?
> + analyze_metadirective_body (parser, body_tokens, body_labels);
I think the code above this should determine if all the directives are
standalone/informational/utility and in that case don't try to analyze
any body, no?
> @@ -23043,7 +23433,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
> gcc_assert (EXPR_LOCATION (stmt) != UNKNOWN_LOCATION);
> }
>
> -
> /* OpenMP 2.5:
> # pragma omp threadprivate (variable-list) */
>
Why?
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 2/7] openmp: Add middle-end support for metadirectives
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
2021-12-10 17:31 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Kwok Cheung Yeung
@ 2021-12-10 17:33 ` Kwok Cheung Yeung
2022-05-30 10:54 ` Jakub Jelinek
2021-12-10 17:35 ` [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification Kwok Cheung Yeung
` (5 subsequent siblings)
7 siblings, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:33 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1863 bytes --]
This patch contains the required support for metadirectives in the
middle-end.
The tree metadirective representation is gimplified into the high Gimple
representation, which is structured like this:
#pragma omp metadirective
when (<selector1>):
<directive body 1>
goto body_label|end_label
when (<selector2>>:
<directive body 2>
goto body_label|end_label
default:
<directive body N>
goto body_label|end_label
body_label:
<standalone body>
end_label:
Each variant ends with an explicit goto to either the shared standalone
body (if the variant uses it) or to the point after the body (if it does
not).
When lowered to low Gimple, the directive bodies move outside of the
metadirective statement, retaining only the labels to the bodies, so it
looks like this instead:
#pragma omp metadirective
when (<selector1>): goto body1_label
when (<selector2>>: goto body2_label
default: goto default_label
body1_label:
<directive body 1>
goto body_label|end_label
body2_label:
<directive body 2>
goto body_label|end_label
default_label:
<directive body N>
goto body_label|end_label
body_label:
<standalone body>
end_label:
When scanning the OpenMP regions in the ompexp pass, we create a 'clone'
of the surrounding context when recursively scanning the directive
variants. If the same outer context was used for all variants, then it
would appear as if all the variants were inside the region at the same
time (only one variant of the metadirective is ever active at a time),
which can lead to spurious errors.
The rest of the code is the plumbing required to allow the Gimple
metadirective statement to pass through the middle-end. GCC will emit an
ICE if it makes it through to the back-end though, as the metadirective
is supposed to be eliminated before it gets that far.
Kwok
[-- Attachment #2: 0002-openmp-Add-middle-end-support-for-metadirectives.patch --]
[-- Type: text/plain, Size: 31056 bytes --]
From 1a2fcbb2191fd1dd694ea5730e54fab19d6465b4 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:29:34 +0000
Subject: [PATCH 2/7] openmp: Add middle-end support for metadirectives
This adds a new Gimple statement type GIMPLE_OMP_METADIRECTIVE, which
represents the metadirective in Gimple. In high Gimple, the statement
contains the body of the directive variants, whereas in low Gimple, it
only contains labels to the bodies.
This patch adds support for converting metadirectives from tree to Gimple
form, and handling of the Gimple form (Gimple lowering, OpenMP lowering
and expansion, inlining, SSA handling etc).
Metadirectives should be resolved before they reach the back-end, otherwise
the compiler will crash as GCC does not know how to convert metadirective
Gimple statements to RTX.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* gimple-low.c (lower_omp_metadirective): New.
(lower_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
* gimple-pretty-print.c (dump_gimple_omp_metadirective): New.
(pp_gimple_stmt_1): Handle GIMPLE_OMP_METADIRECTIVE.
* gimple-walk.c (walk_gimple_op): Handle GIMPLE_OMP_METADIRECTIVE.
(walk_gimple_stmt): Likewise.
* gimple.c (gimple_alloc_omp_metadirective): New.
(gimple_build_omp_metadirective): New.
(gimple_build_omp_metadirective_variant): New.
* gimple.def (GIMPLE_OMP_METADIRECTIVE): New.
(GIMPLE_OMP_METADIRECTIVE_VARIANT): New.
* gimple.h (gomp_metadirective_variant): New.
(gomp_metadirective): New.
(is_a_helper <gomp_metadirective *>::test): New.
(is_a_helper <gomp_metadirective_variant *>::test): New.
(is_a_helper <const gomp_metadirective *>::test): New.
(is_a_helper <const gomp_metadirective_variant *>::test): New.
(gimple_alloc_omp_metadirective): New prototype.
(gimple_build_omp_metadirective): New prototype.
(gimple_build_omp_metadirective_variant): New prototype.
(gimple_has_substatements): Add GIMPLE_OMP_METADIRECTIVE case.
(gimple_has_ops): Add GIMPLE_OMP_METADIRECTIVE.
(gimple_omp_metadirective_label): New.
(gimple_omp_metadirective_set_label): New.
(gimple_omp_metadirective_variants): New.
(gimple_omp_metadirective_set_variants): New.
(CASE_GIMPLE_OMP): Add GIMPLE_OMP_METADIRECTIVE.
* gimplify.c (is_gimple_stmt): Add OMP_METADIRECTIVE.
(expand_omp_metadirective): New.
(gimplify_omp_metadirective): New.
(gimplify_expr): Add case for OMP_METADIRECTIVE.
* gsstruct.def (GSS_OMP_METADIRECTIVE): New.
(GSS_OMP_METADIRECTIVE_VARIANT): New.
* omp-expand.c (build_omp_regions_1): Handle GIMPLE_OMP_METADIRECTIVE.
(omp_make_gimple_edges): Likewise.
* omp-low.c (struct omp_context): Add next_clone field.
(new_omp_context): Initialize next_clone field.
(clone_omp_context): New.
(delete_omp_context): Delete clone contexts.
(scan_omp_metadirective): New.
(scan_omp_1_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
(lower_omp_metadirective): New.
(lower_omp_1): Handle GIMPLE_OMP_METADIRECTIVE.
* tree-cfg.c (cleanup_dead_labels): Handle GIMPLE_OMP_METADIRECTIVE.
(gimple_redirect_edge_and_branch): Likewise.
* tree-inline.c (remap_gimple_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
(estimate_num_insns): Likewise.
* tree-pretty-print.c (dump_generic_node): Handle OMP_METADIRECTIVE.
* tree-ssa-operands.c (parse_ssa_operands): Handle
GIMPLE_OMP_METADIRECTIVE.
---
gcc/gimple-low.c | 34 +++++++++++++
gcc/gimple-pretty-print.c | 63 ++++++++++++++++++++++++
gcc/gimple-walk.c | 31 ++++++++++++
gcc/gimple.c | 35 +++++++++++++
gcc/gimple.def | 7 +++
gcc/gimple.h | 100 +++++++++++++++++++++++++++++++++++++-
gcc/gimplify.c | 94 +++++++++++++++++++++++++++++++++++
gcc/gsstruct.def | 2 +
gcc/omp-expand.c | 28 +++++++++++
gcc/omp-low.c | 66 +++++++++++++++++++++++++
gcc/tree-cfg.c | 24 +++++++++
gcc/tree-inline.c | 36 ++++++++++++++
gcc/tree-pretty-print.c | 34 +++++++++++++
gcc/tree-ssa-operands.c | 27 ++++++++++
14 files changed, 580 insertions(+), 1 deletion(-)
diff --git a/gcc/gimple-low.c b/gcc/gimple-low.c
index 7e39c22df44..723c8b1d516 100644
--- a/gcc/gimple-low.c
+++ b/gcc/gimple-low.c
@@ -234,6 +234,34 @@ lower_omp_directive (gimple_stmt_iterator *gsi, struct lower_data *data)
gsi_next (gsi);
}
+/* Lower the OpenMP metadirective statement pointed by GSI. */
+
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi, struct lower_data *data)
+{
+ gimple *stmt = gsi_stmt (*gsi);
+ gimple *variant = gimple_omp_metadirective_variants (stmt);
+ unsigned i;
+
+ /* The variants are not used after lowering. */
+ gimple_omp_metadirective_set_variants (stmt, NULL);
+
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = create_artificial_label (UNKNOWN_LOCATION);
+ gimple_omp_metadirective_set_label (stmt, i, label);
+ gsi_insert_after (gsi, gimple_build_label (label), GSI_CONTINUE_LINKING);
+
+ gimple_seq *directive_ptr = gimple_omp_body_ptr (variant);
+ lower_sequence (directive_ptr, data);
+ gsi_insert_seq_after (gsi, *directive_ptr, GSI_CONTINUE_LINKING);
+
+ variant = variant->next;
+ }
+
+ gsi_next (gsi);
+}
+
/* Lower statement GSI. DATA is passed through the recursion. We try to
track the fallthruness of statements and get rid of unreachable return
@@ -400,6 +428,12 @@ lower_stmt (gimple_stmt_iterator *gsi, struct lower_data *data)
data->cannot_fallthru = false;
return;
+ case GIMPLE_OMP_METADIRECTIVE:
+ data->cannot_fallthru = false;
+ lower_omp_metadirective (gsi, data);
+ data->cannot_fallthru = false;
+ return;
+
case GIMPLE_TRANSACTION:
lower_sequence (gimple_transaction_body_ptr (
as_a <gtransaction *> (stmt)),
diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c
index 1cd1597359e..da263137f5b 100644
--- a/gcc/gimple-pretty-print.c
+++ b/gcc/gimple-pretty-print.c
@@ -2051,6 +2051,63 @@ dump_gimple_omp_return (pretty_printer *buffer, const gimple *gs, int spc,
}
}
+/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER. */
+
+static void
+dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
+ int spc, dump_flags_t flags)
+{
+ if (flags & TDF_RAW)
+ {
+ dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
+ gimple_omp_body (gs));
+ }
+ else
+ {
+ pp_string (buffer, "#pragma omp metadirective");
+ newline_and_indent (buffer, spc + 2);
+
+ gimple *variant = gimple_omp_metadirective_variants (gs);
+
+ for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+ {
+ tree selector = gimple_op (gs, i);
+
+ if (selector == NULL_TREE)
+ pp_string (buffer, "default:");
+ else
+ {
+ pp_string (buffer, "when (");
+ dump_generic_node (buffer, selector, spc, flags, false);
+ pp_string (buffer, "):");
+ }
+
+ if (variant != NULL)
+ {
+ newline_and_indent (buffer, spc + 4);
+ pp_left_brace (buffer);
+ pp_newline (buffer);
+ dump_gimple_seq (buffer, gimple_omp_body (variant), spc + 6,
+ flags);
+ newline_and_indent (buffer, spc + 4);
+ pp_right_brace (buffer);
+
+ variant = variant->next;
+ }
+ else
+ {
+ tree label = gimple_omp_metadirective_label (gs, i);
+
+ pp_string (buffer, " ");
+ dump_generic_node (buffer, label, spc, flags, false);
+ }
+
+ if (i != gimple_num_ops (gs) - 1)
+ newline_and_indent (buffer, spc + 2);
+ }
+ }
+}
+
/* Dump a GIMPLE_TRANSACTION tuple on the pretty_printer BUFFER. */
static void
@@ -2823,6 +2880,12 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc,
flags);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ dump_gimple_omp_metadirective (buffer,
+ as_a <const gomp_metadirective *> (gs),
+ spc, flags);
+ break;
+
case GIMPLE_CATCH:
dump_gimple_catch (buffer, as_a <const gcatch *> (gs), spc, flags);
break;
diff --git a/gcc/gimple-walk.c b/gcc/gimple-walk.c
index e15fd4697ba..b8db0fe34b2 100644
--- a/gcc/gimple-walk.c
+++ b/gcc/gimple-walk.c
@@ -485,6 +485,21 @@ walk_gimple_op (gimple *stmt, walk_tree_fn callback_op,
}
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ gimple *variant = gimple_omp_metadirective_variants (stmt);
+
+ while (variant)
+ {
+ ret = walk_gimple_op (gimple_omp_body (variant), callback_op, wi);
+ if (ret)
+ return ret;
+
+ variant = variant->next;
+ }
+ }
+ break;
+
case GIMPLE_TRANSACTION:
{
gtransaction *txn = as_a <gtransaction *> (stmt);
@@ -700,6 +715,22 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
return wi->callback_result;
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ gimple *variant = gimple_omp_metadirective_variants (stmt);
+
+ while (variant)
+ {
+ ret = walk_gimple_seq_mod (gimple_omp_body_ptr (variant),
+ callback_stmt, callback_op, wi);
+ if (ret)
+ return wi->callback_result;
+
+ variant = variant->next;
+ }
+ }
+ break;
+
case GIMPLE_WITH_CLEANUP_EXPR:
ret = walk_gimple_seq_mod (gimple_wce_cleanup_ptr (stmt), callback_stmt,
callback_op, wi);
diff --git a/gcc/gimple.c b/gcc/gimple.c
index 037c6e4c827..99f3a8de2ea 100644
--- a/gcc/gimple.c
+++ b/gcc/gimple.c
@@ -1267,6 +1267,41 @@ gimple_build_omp_atomic_store (tree val, enum omp_memory_order mo)
return p;
}
+/* Allocate extra memory for a GIMPLE_OMP_METADIRECTIVE statement. */
+
+void
+gimple_alloc_omp_metadirective (gimple *g)
+{
+ gomp_metadirective *p = as_a <gomp_metadirective *> (g);
+
+ p->labels = ggc_cleared_vec_alloc<tree> (gimple_num_ops (p));
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE statement. */
+
+gomp_metadirective *
+gimple_build_omp_metadirective (int num_variants)
+{
+ gomp_metadirective *p
+ = as_a <gomp_metadirective *> (gimple_alloc (GIMPLE_OMP_METADIRECTIVE,
+ num_variants));
+ gimple_alloc_omp_metadirective (p);
+ gimple_omp_metadirective_set_variants (p, NULL);
+
+ return p;
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE_VARIANT statement. */
+
+gomp_metadirective_variant *
+gimple_build_omp_metadirective_variant (gimple_seq body)
+{
+ gomp_metadirective_variant *variant = as_a <gomp_metadirective_variant *>
+ (gimple_alloc (GIMPLE_OMP_METADIRECTIVE_VARIANT, 0));
+ gimple_omp_set_body (variant, body);
+ return variant;
+}
+
/* Build a GIMPLE_TRANSACTION statement. */
gtransaction *
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 193b2506523..55ff9883193 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -393,6 +393,13 @@ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
CLAUSES is an OMP_CLAUSE chain holding the associated clauses. */
DEFGSCODE(GIMPLE_OMP_ORDERED, "gimple_omp_ordered", GSS_OMP_SINGLE_LAYOUT)
+/* GIMPLE_OMP_METADIRECTIVE represents #pragma omp metadirective. */
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE, "gimple_omp_metadirective",
+ GSS_OMP_METADIRECTIVE)
+
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE_VARIANT,
+ "gimple_omp_metadirective_variant", GSS_OMP_METADIRECTIVE_VARIANT)
+
/* GIMPLE_PREDICT <PREDICT, OUTCOME> specifies a hint for branch prediction.
PREDICT is one of the predictors from predict.def.
diff --git a/gcc/gimple.h b/gcc/gimple.h
index f7fdefc5362..8554d288e42 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -824,6 +824,30 @@ struct GTY((tag("GSS_OMP_ATOMIC_STORE_LAYOUT")))
stmt->code == GIMPLE_OMP_RETURN. */
};
+struct GTY((tag("GSS_OMP_METADIRECTIVE_VARIANT")))
+ gomp_metadirective_variant : public gimple_statement_omp
+{
+ /* The body in the base class contains the directive for this variant. */
+
+ /* No extra fields; adds invariant:
+ stmt->code == GIMPLE_OMP_METADIRECTIVE_VARIANT. */};
+
+struct GTY((tag("GSS_OMP_METADIRECTIVE")))
+ gomp_metadirective : public gimple_statement_with_ops_base
+{
+ /* [ WORD 1-7 ] : base class */
+
+ /* [ WORD 8 ] : a list of bodies associated with the directive variants. */
+ gomp_metadirective_variant *variants;
+
+ /* [ WORD 9 ] : label vector. */
+ tree * GTY((length ("%h.num_ops"))) labels;
+
+ /* [ WORD 10 ] : operand vector. Used to hold the selectors for the
+ directive variants. */
+ tree GTY((length ("%h.num_ops"))) op[1];
+};
+
/* GIMPLE_TRANSACTION. */
/* Bits to be stored in the GIMPLE_TRANSACTION subcode. */
@@ -1235,6 +1259,22 @@ is_a_helper <gomp_task *>::test (gimple *gs)
return gs->code == GIMPLE_OMP_TASK;
}
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective *>::test (gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective_variant *>::test (gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
template <>
template <>
inline bool
@@ -1477,6 +1517,22 @@ is_a_helper <const gomp_task *>::test (const gimple *gs)
return gs->code == GIMPLE_OMP_TASK;
}
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective *>::test (const gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective_variant *>::test (const gimple *gs)
+{
+ return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
template <>
template <>
inline bool
@@ -1576,6 +1632,9 @@ gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
enum omp_memory_order);
gomp_atomic_store *gimple_build_omp_atomic_store (tree, enum omp_memory_order);
+void gimple_alloc_omp_metadirective (gimple *g);
+gomp_metadirective *gimple_build_omp_metadirective (int num_variants);
+gomp_metadirective_variant *gimple_build_omp_metadirective_variant (gimple_seq body);
gtransaction *gimple_build_transaction (gimple_seq);
extern void gimple_seq_add_stmt (gimple_seq *, gimple *);
extern void gimple_seq_add_stmt_without_update (gimple_seq *, gimple *);
@@ -1853,6 +1912,7 @@ gimple_has_substatements (gimple *g)
case GIMPLE_OMP_TARGET:
case GIMPLE_OMP_TEAMS:
case GIMPLE_OMP_CRITICAL:
+ case GIMPLE_OMP_METADIRECTIVE:
case GIMPLE_WITH_CLEANUP_EXPR:
case GIMPLE_TRANSACTION:
return true;
@@ -2110,7 +2170,8 @@ gimple_init_singleton (gimple *g)
static inline bool
gimple_has_ops (const gimple *g)
{
- return gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN;
+ return (gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN)
+ || gimple_code (g) == GIMPLE_OMP_METADIRECTIVE;
}
template <>
@@ -6488,6 +6549,42 @@ gimple_omp_continue_set_control_use (gomp_continue *cont_stmt, tree use)
cont_stmt->control_use = use;
}
+
+static inline tree
+gimple_omp_metadirective_label (const gimple *g, unsigned i)
+{
+ const gomp_metadirective *omp_metadirective
+ = as_a <const gomp_metadirective *> (g);
+ return omp_metadirective->labels[i];
+}
+
+
+static inline void
+gimple_omp_metadirective_set_label (gimple *g, unsigned i, tree label)
+{
+ gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+ omp_metadirective->labels[i] = label;
+}
+
+
+static inline gomp_metadirective_variant *
+gimple_omp_metadirective_variants (const gimple *g)
+{
+ const gomp_metadirective *omp_metadirective
+ = as_a <const gomp_metadirective *> (g);
+ return omp_metadirective->variants;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_variants (gimple *g, gimple *variants)
+{
+ gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+ omp_metadirective->variants
+ = variants ? as_a <gomp_metadirective_variant *> (variants) : NULL;
+}
+
+
/* Return a pointer to the body for the GIMPLE_TRANSACTION statement
TRANSACTION_STMT. */
@@ -6638,6 +6735,7 @@ gimple_return_set_retval (greturn *gs, tree retval)
case GIMPLE_OMP_RETURN: \
case GIMPLE_OMP_ATOMIC_LOAD: \
case GIMPLE_OMP_ATOMIC_STORE: \
+ case GIMPLE_OMP_METADIRECTIVE: \
case GIMPLE_OMP_CONTINUE
static inline bool
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index b118c72f62c..ed72162bb7f 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -5787,6 +5787,7 @@ is_gimple_stmt (tree t)
case OMP_TASKGROUP:
case OMP_ORDERED:
case OMP_CRITICAL:
+ case OMP_METADIRECTIVE:
case OMP_TASK:
case OMP_TARGET:
case OMP_TARGET_DATA:
@@ -14680,6 +14681,94 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
return gimple_build_omp_ordered (body, OMP_ORDERED_CLAUSES (expr));
}
+/* Replace a metadirective with the candidate directive variants in
+ CANDIDATES. */
+
+static enum gimplify_status
+expand_omp_metadirective (vec<struct omp_metadirective_variant> &,
+ gimple_seq *)
+{
+ return GS_ERROR;
+}
+
+/* Gimplify an OMP_METADIRECTIVE construct. EXPR is the tree version.
+ The metadirective will be resolved at this point if possible. */
+
+static enum gimplify_status
+gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
+ bool (*) (tree), fallback_t)
+{
+ auto_vec<tree> selectors;
+
+ /* Try to resolve the metadirective. */
+ vec<struct omp_metadirective_variant> candidates
+ = omp_resolve_metadirective (*expr_p);
+ if (!candidates.is_empty ())
+ return expand_omp_metadirective (candidates, pre_p);
+
+ /* The metadirective cannot be resolved yet. */
+
+ gomp_metadirective_variant *first_variant = NULL;
+ gomp_metadirective_variant *prev_variant = NULL;
+ gimple_seq standalone_body = NULL;
+ tree body_label = NULL;
+ tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ for (tree clause = OMP_METADIRECTIVE_CLAUSES (*expr_p); clause != NULL_TREE;
+ clause = TREE_CHAIN (clause))
+ {
+ tree selector = TREE_PURPOSE (clause);
+ tree directive = TREE_PURPOSE (TREE_VALUE (clause));
+ tree body = TREE_VALUE (TREE_VALUE (clause));
+
+ selectors.safe_push (selector);
+ gomp_metadirective_variant *variant
+ = gimple_build_omp_metadirective_variant (NULL);
+ gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+
+ gimplify_stmt (&directive, directive_p);
+ if (body != NULL_TREE)
+ {
+ if (standalone_body == NULL)
+ {
+ gimplify_stmt (&body, &standalone_body);
+ body_label = create_artificial_label (UNKNOWN_LOCATION);
+ }
+ gimplify_seq_add_stmt (directive_p, gimple_build_goto (body_label));
+ }
+ else
+ gimplify_seq_add_stmt (directive_p, gimple_build_goto (end_label));
+
+ if (!first_variant)
+ first_variant = variant;
+ if (prev_variant)
+ {
+ prev_variant->next = variant;
+ variant->prev = prev_variant;
+ }
+ prev_variant = variant;
+ }
+
+ gomp_metadirective *stmt
+ = gimple_build_omp_metadirective (selectors.length ());
+ gimple_omp_metadirective_set_variants (stmt, first_variant);
+
+ tree selector;
+ unsigned int i;
+ FOR_EACH_VEC_ELT (selectors, i, selector)
+ gimple_set_op (stmt, i, selector);
+
+ gimplify_seq_add_stmt (pre_p, stmt);
+ if (standalone_body)
+ {
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (body_label));
+ gimplify_seq_add_stmt (pre_p, standalone_body);
+ }
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+ return GS_ALL_DONE;
+}
+
/* Convert the GENERIC expression tree *EXPR_P to GIMPLE. If the
expression produces a value to be used as an operand inside a GIMPLE
statement, the value will be stored back in *EXPR_P. This value will
@@ -15586,6 +15675,11 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
ret = gimplify_omp_atomic (expr_p, pre_p);
break;
+ case OMP_METADIRECTIVE:
+ ret = gimplify_omp_metadirective (expr_p, pre_p, post_p,
+ gimple_test_f, fallback);
+ break;
+
case TRANSACTION_EXPR:
ret = gimplify_transaction (expr_p, pre_p);
break;
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index 8f777e2bb95..ff10605baec 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -50,4 +50,6 @@ DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false)
DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false)
DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false)
DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE, gomp_metadirective, true)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE_VARIANT, gomp_metadirective_variant, false)
DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false)
diff --git a/gcc/omp-expand.c b/gcc/omp-expand.c
index c5fa5a01aac..3bf81e1ae95 100644
--- a/gcc/omp-expand.c
+++ b/gcc/omp-expand.c
@@ -10418,6 +10418,10 @@ build_omp_regions_1 (basic_block bb, struct omp_region *parent,
/* GIMPLE_OMP_SECTIONS_SWITCH is part of
GIMPLE_OMP_SECTIONS, and we do nothing for it. */
}
+ else if (code == GIMPLE_OMP_METADIRECTIVE)
+ {
+ /* Do nothing for metadirectives. */
+ }
else
{
region = new_omp_region (bb, code, parent);
@@ -10791,6 +10795,30 @@ omp_make_gimple_edges (basic_block bb, struct omp_region **region,
}
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ /* Create an edge to the beginning of the body of each candidate
+ directive. */
+ {
+ gimple *stmt = last_stmt (bb);
+ unsigned i;
+ bool seen_default = false;
+
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree dest = gimple_omp_metadirective_label (stmt, i);
+ basic_block dest_bb = label_to_block (cfun, dest);
+ make_edge (bb, dest_bb, 0);
+
+ if (gimple_op (stmt, i) == NULL_TREE)
+ seen_default = true;
+ }
+
+ gcc_assert (seen_default);
+
+ fallthru = false;
+ }
+ break;
+
default:
gcc_unreachable ();
}
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 2a07beb4eaf..accea81e8af 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -183,6 +183,10 @@ struct omp_context
/* Candidates for adjusting OpenACC privatization level. */
vec<tree> oacc_privatization_candidates;
+
+ /* Only used for omp metadirectives. Links to the next shallow
+ clone of this context. */
+ struct omp_context *next_clone;
};
static splay_tree all_contexts;
@@ -985,6 +989,7 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
splay_tree_insert (all_contexts, (splay_tree_key) stmt,
(splay_tree_value) ctx);
ctx->stmt = stmt;
+ ctx->next_clone = NULL;
if (outer_ctx)
{
@@ -1014,6 +1019,18 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
return ctx;
}
+static omp_context *
+clone_omp_context (omp_context *ctx)
+{
+ omp_context *clone_ctx = XCNEW (omp_context);
+
+ memcpy (clone_ctx, ctx, sizeof (omp_context));
+ ctx->next_clone = clone_ctx;
+ clone_ctx->next_clone = NULL;
+
+ return clone_ctx;
+}
+
static gimple_seq maybe_catch_exception (gimple_seq);
/* Finalize task copyfn. */
@@ -1060,6 +1077,15 @@ delete_omp_context (splay_tree_value value)
{
omp_context *ctx = (omp_context *) value;
+ /* Delete clones. */
+ omp_context *clone = ctx->next_clone;
+ while (clone)
+ {
+ omp_context *next_clone = clone->next_clone;
+ XDELETE (clone);
+ clone = next_clone;
+ }
+
delete ctx->cb.decl_map;
if (ctx->field_map)
@@ -3091,6 +3117,24 @@ scan_omp_teams (gomp_teams *stmt, omp_context *outer_ctx)
ctx->record_type = ctx->receiver_decl = NULL;
}
+/* Scan an OpenMP metadirective. */
+
+static void
+scan_omp_metadirective (gomp_metadirective *stmt, omp_context *outer_ctx)
+{
+ gomp_metadirective_variant *variant
+ = gimple_omp_metadirective_variants (stmt);
+
+ while (variant)
+ {
+ gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+ omp_context *ctx = outer_ctx ? clone_omp_context (outer_ctx) : NULL;
+
+ scan_omp (directive_p, ctx);
+ variant = (gomp_metadirective_variant *) variant->next;
+ }
+}
+
/* Check nesting restrictions. */
static bool
check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
@@ -4235,6 +4279,10 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
scan_omp_teams (as_a <gomp_teams *> (stmt), ctx);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ scan_omp_metadirective (as_a <gomp_metadirective *> (stmt), ctx);
+ break;
+
case GIMPLE_BIND:
{
tree var;
@@ -10654,6 +10702,21 @@ oacc_privatization_scan_decl_chain (omp_context *ctx, tree decls)
}
}
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+{
+ gimple *stmt = gsi_stmt (*gsi_p);
+ gomp_metadirective_variant *variant
+ = gimple_omp_metadirective_variants (stmt);
+ while (variant)
+ {
+ gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+ lower_omp (directive_p, ctx);
+
+ variant = (gomp_metadirective_variant *) (variant->next);
+ }
+}
+
/* Callback for walk_gimple_seq. Find #pragma omp scan statement. */
static tree
@@ -14230,6 +14293,9 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
else
lower_omp_teams (gsi_p, ctx);
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ lower_omp_metadirective (gsi_p, ctx);
+ break;
case GIMPLE_CALL:
tree fndecl;
call_stmt = as_a <gcall *> (stmt);
diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c
index ebbd894ae03..7066d9fb471 100644
--- a/gcc/tree-cfg.c
+++ b/gcc/tree-cfg.c
@@ -1670,6 +1670,18 @@ cleanup_dead_labels (void)
}
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ label = gimple_omp_metadirective_label (stmt, i);
+ new_label = main_block_label (label, label_for_bb);
+ if (new_label != label)
+ gimple_omp_metadirective_set_label (stmt, i, new_label);
+ }
+ }
+ break;
+
default:
break;
}
@@ -6147,6 +6159,18 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
gimple_block_label (dest));
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ {
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ if (label_to_block (cfun, label) == e->dest)
+ gimple_omp_metadirective_set_label (stmt, i,
+ gimple_block_label (dest));
+ }
+ }
+ break;
+
default:
/* Otherwise it must be a fallthru edge, and we don't need to
do anything besides redirecting it. */
diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c
index bc5ff0bb052..0f0035fef3b 100644
--- a/gcc/tree-inline.c
+++ b/gcc/tree-inline.c
@@ -1674,6 +1674,35 @@ remap_gimple_stmt (gimple *stmt, copy_body_data *id)
(s1, gimple_omp_masked_clauses (stmt));
break;
+ case GIMPLE_OMP_METADIRECTIVE:
+ copy = gimple_build_omp_metadirective (gimple_num_ops (stmt));
+ {
+ gimple *first_variant = NULL;
+ gimple **prev_next = &first_variant;
+ for (gimple *variant = gimple_omp_metadirective_variants (stmt);
+ variant; variant = variant->next)
+ {
+ s1 = remap_gimple_seq (gimple_omp_body (variant), id);
+ gimple *new_variant
+ = gimple_build_omp_metadirective_variant (s1);
+
+ *prev_next = new_variant;
+ prev_next = &new_variant->next;
+ }
+ gimple_omp_metadirective_set_variants (copy, first_variant);
+ }
+
+ memset (&wi, 0, sizeof (wi));
+ wi.info = id;
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ walk_tree (&label, remap_gimple_op_r, &wi, NULL);
+ gimple_omp_metadirective_set_label (copy, i, label);
+ gimple_set_op (copy, i, gimple_op (stmt, i));
+ }
+ break;
+
case GIMPLE_OMP_SCOPE:
s1 = remap_gimple_seq (gimple_omp_body (stmt), id);
copy = gimple_build_omp_scope
@@ -4590,6 +4619,13 @@ estimate_num_insns (gimple *stmt, eni_weights *weights)
return (weights->omp_cost
+ estimate_num_insns_seq (gimple_omp_body (stmt), weights));
+ case GIMPLE_OMP_METADIRECTIVE:
+ /* The actual instruction will disappear eventually, so metadirective
+ statements have zero additional cost (if only static selectors
+ are used). */
+ /* TODO: Estimate the cost of evaluating dynamic selectors */
+ return 0;
+
case GIMPLE_TRANSACTION:
return (weights->tm_cost
+ estimate_num_insns_seq (gimple_transaction_body (
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index a81ba401ef9..eb45f7d6bdf 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3751,6 +3751,40 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
is_expr = false;
break;
+ case OMP_METADIRECTIVE:
+ {
+ pp_string (pp, "#pragma omp metadirective");
+ newline_and_indent (pp, spc + 2);
+ pp_left_brace (pp);
+
+ tree clause = OMP_METADIRECTIVE_CLAUSES (node);
+ while (clause != NULL_TREE)
+ {
+ newline_and_indent (pp, spc + 4);
+ if (TREE_PURPOSE (clause) == NULL_TREE)
+ pp_string (pp, "default:");
+ else
+ {
+ pp_string (pp, "when (");
+ dump_generic_node (pp, TREE_PURPOSE (clause), spc + 4, flags,
+ false);
+ pp_string (pp, "):");
+ }
+ newline_and_indent (pp, spc + 6);
+
+ tree variant = TREE_VALUE (clause);
+ dump_generic_node (pp, TREE_PURPOSE (variant), spc + 6, flags,
+ false);
+ newline_and_indent (pp, spc + 6);
+ dump_generic_node (pp, TREE_VALUE (variant), spc + 6, flags,
+ false);
+ clause = TREE_CHAIN (clause);
+ }
+ newline_and_indent (pp, spc + 2);
+ pp_right_brace (pp);
+ }
+ break;
+
case TRANSACTION_EXPR:
if (TRANSACTION_EXPR_OUTER (node))
pp_string (pp, "__transaction_atomic [[outer]]");
diff --git a/gcc/tree-ssa-operands.c b/gcc/tree-ssa-operands.c
index ebf7eea3b04..d17e4144df7 100644
--- a/gcc/tree-ssa-operands.c
+++ b/gcc/tree-ssa-operands.c
@@ -973,6 +973,33 @@ operands_scanner::parse_ssa_operands ()
append_vuse (gimple_vop (fn));
goto do_default;
+ case GIMPLE_OMP_METADIRECTIVE:
+ n = gimple_num_ops (stmt);
+ for (i = start; i < n; i++)
+ {
+ for (tree selector = gimple_op (stmt, i);
+ selector != NULL;
+ selector = TREE_CHAIN (selector))
+ {
+ if (TREE_PURPOSE (selector) == get_identifier ("user"))
+ {
+ for (tree property = TREE_VALUE (selector);
+ property != NULL;
+ property = TREE_CHAIN (property))
+ if (TREE_PURPOSE (property)
+ == get_identifier ("condition"))
+ {
+ for (tree condition = TREE_VALUE (property);
+ condition != NULL;
+ condition = TREE_CHAIN (condition))
+ get_expr_operands (&TREE_VALUE (condition),
+ opf_use);
+ }
+ }
+ }
+ }
+ break;
+
case GIMPLE_CALL:
/* Add call-clobbered operands, if needed. */
maybe_add_call_vops (as_a <gcall *> (stmt));
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 2/7] openmp: Add middle-end support for metadirectives
2021-12-10 17:33 ` [PATCH 2/7] openmp: Add middle-end support for metadirectives Kwok Cheung Yeung
@ 2022-05-30 10:54 ` Jakub Jelinek
0 siblings, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-30 10:54 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:33:25PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
>
> gcc/
> * gimple-low.c (lower_omp_metadirective): New.
> (lower_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> * gimple-pretty-print.c (dump_gimple_omp_metadirective): New.
> (pp_gimple_stmt_1): Handle GIMPLE_OMP_METADIRECTIVE.
> * gimple-walk.c (walk_gimple_op): Handle GIMPLE_OMP_METADIRECTIVE.
> (walk_gimple_stmt): Likewise.
> * gimple.c (gimple_alloc_omp_metadirective): New.
> (gimple_build_omp_metadirective): New.
> (gimple_build_omp_metadirective_variant): New.
> * gimple.def (GIMPLE_OMP_METADIRECTIVE): New.
> (GIMPLE_OMP_METADIRECTIVE_VARIANT): New.
> * gimple.h (gomp_metadirective_variant): New.
> (gomp_metadirective): New.
> (is_a_helper <gomp_metadirective *>::test): New.
> (is_a_helper <gomp_metadirective_variant *>::test): New.
> (is_a_helper <const gomp_metadirective *>::test): New.
> (is_a_helper <const gomp_metadirective_variant *>::test): New.
> (gimple_alloc_omp_metadirective): New prototype.
> (gimple_build_omp_metadirective): New prototype.
> (gimple_build_omp_metadirective_variant): New prototype.
> (gimple_has_substatements): Add GIMPLE_OMP_METADIRECTIVE case.
> (gimple_has_ops): Add GIMPLE_OMP_METADIRECTIVE.
> (gimple_omp_metadirective_label): New.
> (gimple_omp_metadirective_set_label): New.
> (gimple_omp_metadirective_variants): New.
> (gimple_omp_metadirective_set_variants): New.
> (CASE_GIMPLE_OMP): Add GIMPLE_OMP_METADIRECTIVE.
> * gimplify.c (is_gimple_stmt): Add OMP_METADIRECTIVE.
> (expand_omp_metadirective): New.
> (gimplify_omp_metadirective): New.
> (gimplify_expr): Add case for OMP_METADIRECTIVE.
> * gsstruct.def (GSS_OMP_METADIRECTIVE): New.
> (GSS_OMP_METADIRECTIVE_VARIANT): New.
> * omp-expand.c (build_omp_regions_1): Handle GIMPLE_OMP_METADIRECTIVE.
> (omp_make_gimple_edges): Likewise.
> * omp-low.c (struct omp_context): Add next_clone field.
> (new_omp_context): Initialize next_clone field.
> (clone_omp_context): New.
> (delete_omp_context): Delete clone contexts.
> (scan_omp_metadirective): New.
> (scan_omp_1_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> (lower_omp_metadirective): New.
> (lower_omp_1): Handle GIMPLE_OMP_METADIRECTIVE.
> * tree-cfg.c (cleanup_dead_labels): Handle GIMPLE_OMP_METADIRECTIVE.
> (gimple_redirect_edge_and_branch): Likewise.
> * tree-inline.c (remap_gimple_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> (estimate_num_insns): Likewise.
> * tree-pretty-print.c (dump_generic_node): Handle OMP_METADIRECTIVE.
> * tree-ssa-operands.c (parse_ssa_operands): Handle
> GIMPLE_OMP_METADIRECTIVE.
> --- a/gcc/gimple-pretty-print.c
> +++ b/gcc/gimple-pretty-print.c
> @@ -2051,6 +2051,63 @@ dump_gimple_omp_return (pretty_printer *buffer, const gimple *gs, int spc,
> }
> }
>
> +/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER. */
> +
> +static void
> +dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
> + int spc, dump_flags_t flags)
> +{
> + if (flags & TDF_RAW)
> + {
> + dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
> + gimple_omp_body (gs));
> + }
No need for {}s around a single statement.
> + else
> + {
> + pp_string (buffer, "#pragma omp metadirective");
> + newline_and_indent (buffer, spc + 2);
> +
> + gimple *variant = gimple_omp_metadirective_variants (gs);
> +
> + for (unsigned i = 0; i < gimple_num_ops (gs); i++)
> + {
> + tree selector = gimple_op (gs, i);
> +
> + if (selector == NULL_TREE)
> + pp_string (buffer, "default:");
> + else
> + {
> + pp_string (buffer, "when (");
> + dump_generic_node (buffer, selector, spc, flags, false);
> + pp_string (buffer, "):");
> + }
> +
> + if (variant != NULL)
> + {
> + newline_and_indent (buffer, spc + 4);
> + pp_left_brace (buffer);
> + pp_newline (buffer);
> + dump_gimple_seq (buffer, gimple_omp_body (variant), spc + 6,
> + flags);
> + newline_and_indent (buffer, spc + 4);
> + pp_right_brace (buffer);
> +
> + variant = variant->next;
> + }
> + else
> + {
> + tree label = gimple_omp_metadirective_label (gs, i);
> +
> + pp_string (buffer, " ");
> + dump_generic_node (buffer, label, spc, flags, false);
> + }
> +
> + if (i != gimple_num_ops (gs) - 1)
> + newline_and_indent (buffer, spc + 2);
I think better would be to use a gimple_stmt_iterator to walk the variants,
so no variant->next etc., but gimple_omp_metadirective_variants returning
a gimple_seq instead of gimple * (it is the same thing under the hood),
then
gimple_seq variant_seq = gimple_omp_metadirective_variants (gs);
gimple_stmt_iterator gsi = gsi_start (variant_seq);
and in the loop
gimple *variant = gsi_stmt (gsi);
and gsi_next (&gsi); at the end. Similarly for all other spots that walk
gimple_omp_metadirective_variants.
> + case GIMPLE_OMP_METADIRECTIVE:
> + {
> + gimple *variant = gimple_omp_metadirective_variants (stmt);
> +
> + while (variant)
> + {
> + ret = walk_gimple_op (gimple_omp_body (variant), callback_op, wi);
> + if (ret)
> + return ret;
> +
> + variant = variant->next;
> + }
So here too...
> + }
> + break;
> +
> case GIMPLE_TRANSACTION:
> {
> gtransaction *txn = as_a <gtransaction *> (stmt);
> @@ -700,6 +715,22 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
> return wi->callback_result;
> break;
>
> + case GIMPLE_OMP_METADIRECTIVE:
> + {
> + gimple *variant = gimple_omp_metadirective_variants (stmt);
> +
> + while (variant)
> + {
> + ret = walk_gimple_seq_mod (gimple_omp_body_ptr (variant),
> + callback_stmt, callback_op, wi);
> + if (ret)
> + return wi->callback_result;
> +
> + variant = variant->next;
> + }
and here etc.
> --- a/gcc/omp-expand.c
> +++ b/gcc/omp-expand.c
> @@ -10418,6 +10418,10 @@ build_omp_regions_1 (basic_block bb, struct omp_region *parent,
> /* GIMPLE_OMP_SECTIONS_SWITCH is part of
> GIMPLE_OMP_SECTIONS, and we do nothing for it. */
> }
> + else if (code == GIMPLE_OMP_METADIRECTIVE)
> + {
> + /* Do nothing for metadirectives. */
> + }
No {}s around the comment, just /* ... */;
> --- a/gcc/tree-cfg.c
> +++ b/gcc/tree-cfg.c
> @@ -1670,6 +1670,18 @@ cleanup_dead_labels (void)
> }
> break;
>
> + case GIMPLE_OMP_METADIRECTIVE:
> + {
> + for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
> + {
> + label = gimple_omp_metadirective_label (stmt, i);
> + new_label = main_block_label (label, label_for_bb);
> + if (new_label != label)
> + gimple_omp_metadirective_set_label (stmt, i, new_label);
> + }
> + }
> + break;
Why the {} around the for?
> @@ -6147,6 +6159,18 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
> gimple_block_label (dest));
> break;
>
> + case GIMPLE_OMP_METADIRECTIVE:
> + {
> + for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
> + {
> + tree label = gimple_omp_metadirective_label (stmt, i);
> + if (label_to_block (cfun, label) == e->dest)
> + gimple_omp_metadirective_set_label (stmt, i,
> + gimple_block_label (dest));
> + }
> + }
> + break;
Likewise.
> --- a/gcc/tree-ssa-operands.c
> +++ b/gcc/tree-ssa-operands.c
> @@ -973,6 +973,33 @@ operands_scanner::parse_ssa_operands ()
> append_vuse (gimple_vop (fn));
> goto do_default;
>
> + case GIMPLE_OMP_METADIRECTIVE:
> + n = gimple_num_ops (stmt);
> + for (i = start; i < n; i++)
> + {
Why the {}s around the inner for?
> + for (tree selector = gimple_op (stmt, i);
> + selector != NULL;
> + selector = TREE_CHAIN (selector))
> + {
Why the {}s around the if ?
> + if (TREE_PURPOSE (selector) == get_identifier ("user"))
> + {
> + for (tree property = TREE_VALUE (selector);
> + property != NULL;
> + property = TREE_CHAIN (property))
> + if (TREE_PURPOSE (property)
> + == get_identifier ("condition"))
> + {
> + for (tree condition = TREE_VALUE (property);
> + condition != NULL;
> + condition = TREE_CHAIN (condition))
> + get_expr_operands (&TREE_VALUE (condition),
> + opf_use);
> + }
> + }
> + }
> + }
> + break;
> +
Also, I wonder how does LTO saving/restoring handle the
GIMPLE_OMP_METADIRECTIVE statements.
Otherwise LGTM.
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
2021-12-10 17:31 ` [PATCH 1/7] openmp: Add C support for parsing metadirectives Kwok Cheung Yeung
2021-12-10 17:33 ` [PATCH 2/7] openmp: Add middle-end support for metadirectives Kwok Cheung Yeung
@ 2021-12-10 17:35 ` Kwok Cheung Yeung
2022-05-30 11:13 ` Jakub Jelinek
2021-12-10 17:36 ` [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO Kwok Cheung Yeung
` (4 subsequent siblings)
7 siblings, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:35 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1474 bytes --]
This patch contains code to resolve metadirectives, either during
parsing or Gimplification.
The dynamic candidate selection algorithm from the OpenMP 5.1 spec is
implemented in omp_get_dynamic_candidates in omp-general.c, which
returns a vector containing information on the top-scoring candidate
variants. The vector always consists of entries with dynamic selectors
first, followed by a single entry with an all-static selector (which can
be the default clause if all the other clauses are dynamic). If all
selectors are static (i.e. OpenMP 5.0), then omp_get_dynamic_candidates
will return a vector of at most length 1.
If any part of the selectors in the candidate list cannot be resolved at
the current stage of compilation, an empty list is returned. Note that
it is possible to resolve metadirectives even with some selectors
unresolvable as long as those selectors are not part of the candidate list.
omp_context_selector_matches should always return 1 for dynamic
selectors (since we can generate code to evaluate the condition at any
time). omp_dynamic_cond, when given a selector, should return just the
part of it that must be evaluated at run-time.
Metadirectives are resolved in both tree and Gimple form by generating a
sequence of if..then..else statements that evaluate the dynamic selector
of each candidate returned from omp_get_dynamic_candidates in order,
jumping to the directive body if true, to the next evaluation if not.
Kwok
[-- Attachment #2: 0003-openmp-Add-support-for-resolving-metadirectives-duri.patch --]
[-- Type: text/plain, Size: 16738 bytes --]
From 65ee7342256db3c81cc6741ce2c96e36dd4a9ca6 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:49:23 +0000
Subject: [PATCH 3/7] openmp: Add support for resolving metadirectives during
parsing and Gimplification
This adds support for resolving metadirectives according to the OpenMP 5.1
specification. The variants are sorted by score, then gathered into a list
of dynamic replacement candidates. The metadirective is then expanded into
a sequence of 'if..else' statements to test the dynamic selector and execute
the variant if the selector is satisfied.
If any of the selectors in the list are unresolvable, GCC will give up on
resolving the metadirective and try again later.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* gimplify.c (expand_omp_metadirective): New.
* omp-general.c: Include tree-pretty-print.h.
(DELAY_METADIRECTIVES_AFTER_LTO): New macro.
(omp_context_selector_matches): Delay resolution of selectors. Allow
non-constant expressions.
(omp_dynamic_cond): New.
(omp_dynamic_selector_p): New.
(sort_variant): New.
(omp_get_dynamic_candidates): New.
(omp_resolve_metadirective): New.
(omp_resolve_metadirective): New.
* omp-general.h (struct omp_metadirective_variant): New.
(omp_resolve_metadirective): New prototype.
gcc/c-family/
* c-omp.c (c_omp_expand_metadirective_r): New.
(c_omp_expand_metadirective): New.
---
gcc/c-family/c-omp.c | 45 ++++++++-
gcc/gimplify.c | 72 +++++++++++++-
gcc/omp-general.c | 232 ++++++++++++++++++++++++++++++++++++++++++-
gcc/omp-general.h | 7 ++
4 files changed, 346 insertions(+), 10 deletions(-)
diff --git a/gcc/c-family/c-omp.c b/gcc/c-family/c-omp.c
index 9a7a6834f1b..fedaec566ee 100644
--- a/gcc/c-family/c-omp.c
+++ b/gcc/c-family/c-omp.c
@@ -3264,8 +3264,49 @@ c_omp_categorize_directive (const char *first, const char *second,
return NULL;
}
+static tree
+c_omp_expand_metadirective_r (vec<struct omp_metadirective_variant> &candidates,
+ hash_map<tree, tree> &body_labels,
+ unsigned index)
+{
+ struct omp_metadirective_variant &candidate = candidates[index];
+ tree if_block = push_stmt_list ();
+ if (candidate.directive != NULL_TREE)
+ add_stmt (candidate.directive);
+ if (candidate.body != NULL_TREE)
+ {
+ tree *label = body_labels.get (candidate.body);
+ if (label != NULL)
+ add_stmt (build1 (GOTO_EXPR, void_type_node, *label));
+ else
+ {
+ tree body_label = create_artificial_label (UNKNOWN_LOCATION);
+ add_stmt (build1 (LABEL_EXPR, void_type_node, body_label));
+ add_stmt (candidate.body);
+ body_labels.put (candidate.body, body_label);
+ }
+ }
+ if_block = pop_stmt_list (if_block);
+
+ if (index == candidates.length () - 1)
+ return if_block;
+
+ tree cond = candidate.selector;
+ gcc_assert (cond != NULL_TREE);
+
+ tree else_block = c_omp_expand_metadirective_r (candidates, body_labels,
+ index + 1);
+ tree ret = push_stmt_list ();
+ tree stmt = build3 (COND_EXPR, void_type_node, cond, if_block, else_block);
+ add_stmt (stmt);
+ ret = pop_stmt_list (ret);
+
+ return ret;
+}
+
tree
-c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
+c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &candidates)
{
- return NULL_TREE;
+ hash_map<tree, tree> body_labels;
+ return c_omp_expand_metadirective_r (candidates, body_labels, 0);
}
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index ed72162bb7f..5d9aa2c2145 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -14685,10 +14685,76 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
CANDIDATES. */
static enum gimplify_status
-expand_omp_metadirective (vec<struct omp_metadirective_variant> &,
- gimple_seq *)
+expand_omp_metadirective (vec<struct omp_metadirective_variant> &candidates,
+ gimple_seq *pre_p)
{
- return GS_ERROR;
+ auto_vec<tree> selectors;
+ auto_vec<tree> directive_labels;
+ auto_vec<gimple_seq> directive_bodies;
+ tree body_label = NULL_TREE;
+ tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+ /* Construct bodies for each candidate. */
+ for (unsigned i = 0; i < candidates.length(); i++)
+ {
+ struct omp_metadirective_variant &candidate = candidates[i];
+ gimple_seq body = NULL;
+
+ selectors.safe_push (candidate.selector);
+ directive_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+
+ gimplify_seq_add_stmt (&body,
+ gimple_build_label (directive_labels.last ()));
+ if (candidate.directive != NULL_TREE)
+ gimplify_stmt (&candidate.directive, &body);
+ if (candidate.body != NULL_TREE)
+ {
+ if (body_label != NULL_TREE)
+ gimplify_seq_add_stmt (&body, gimple_build_goto (body_label));
+ else
+ {
+ body_label = create_artificial_label (UNKNOWN_LOCATION);
+ gimplify_seq_add_stmt (&body, gimple_build_label (body_label));
+ gimplify_stmt (&candidate.body, &body);
+ }
+ }
+
+ directive_bodies.safe_push (body);
+ }
+
+ auto_vec<tree> cond_labels;
+
+ cond_labels.safe_push (NULL_TREE);
+ for (unsigned i = 1; i < candidates.length () - 1; i++)
+ cond_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+ if (candidates.length () > 1)
+ cond_labels.safe_push (directive_labels.last ());
+
+ /* Generate conditionals to test each dynamic selector in turn, executing
+ the directive candidate if successful. */
+ for (unsigned i = 0; i < candidates.length () - 1; i++)
+ {
+ if (i != 0)
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (cond_labels [i]));
+
+ enum gimplify_status ret = gimplify_expr (&selectors[i], pre_p, NULL,
+ is_gimple_val, fb_rvalue);
+ if (ret == GS_ERROR || ret == GS_UNHANDLED)
+ return ret;
+
+ gcond *cond_stmt
+ = gimple_build_cond_from_tree (selectors[i], directive_labels[i],
+ cond_labels[i + 1]);
+
+ gimplify_seq_add_stmt (pre_p, cond_stmt);
+ gimplify_seq_add_seq (pre_p, directive_bodies[i]);
+ gimplify_seq_add_stmt (pre_p, gimple_build_goto (end_label));
+ }
+
+ gimplify_seq_add_seq (pre_p, directive_bodies.last ());
+ gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+ return GS_ALL_DONE;
}
/* Gimplify an OMP_METADIRECTIVE construct. EXPR is the tree version.
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 9926cfd9d5f..6340d1600a6 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see
#include "data-streamer.h"
#include "streamer-hooks.h"
#include "opts.h"
+#include "tree-pretty-print.h"
enum omp_requires omp_requires_mask;
@@ -1253,14 +1254,22 @@ omp_context_name_list_prop (tree prop)
}
}
+#define DELAY_METADIRECTIVES_AFTER_LTO { \
+ if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev)) \
+ return -1; \
+}
+
/* Return 1 if context selector matches the current OpenMP context, 0
if it does not and -1 if it is unknown and need to be determined later.
Some properties can be checked right away during parsing (this routine),
others need to wait until the whole TU is parsed, others need to wait until
- IPA, others until vectorization. */
+ IPA, others until vectorization.
+
+ Dynamic properties (which are evaluated at run-time) should always
+ return 1. */
int
-omp_context_selector_matches (tree ctx, bool)
+omp_context_selector_matches (tree ctx, bool metadirective_p)
{
int ret = 1;
for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
@@ -1381,6 +1390,8 @@ omp_context_selector_matches (tree ctx, bool)
const char *arch = omp_context_name_list_prop (t3);
if (arch == NULL)
return 0;
+ DELAY_METADIRECTIVES_AFTER_LTO;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_arch,
@@ -1505,6 +1516,8 @@ omp_context_selector_matches (tree ctx, bool)
#endif
continue;
}
+ DELAY_METADIRECTIVES_AFTER_LTO;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_kind,
@@ -1544,6 +1557,8 @@ omp_context_selector_matches (tree ctx, bool)
const char *isa = omp_context_name_list_prop (t3);
if (isa == NULL)
return 0;
+ DELAY_METADIRECTIVES_AFTER_LTO;
+
int r = 0;
if (targetm.omp.device_kind_arch_isa != NULL)
r = targetm.omp.device_kind_arch_isa (omp_device_isa,
@@ -1595,6 +1610,12 @@ omp_context_selector_matches (tree ctx, bool)
for (tree t3 = TREE_VALUE (t2); t3; t3 = TREE_CHAIN (t3))
if (TREE_PURPOSE (t3) == NULL_TREE)
{
+ /* OpenMP 5.1 allows non-constant conditions for
+ metadirectives. */
+ if (metadirective_p
+ && !tree_fits_shwi_p (TREE_VALUE (t3)))
+ break;
+
if (integer_zerop (TREE_VALUE (t3)))
return 0;
if (integer_nonzerop (TREE_VALUE (t3)))
@@ -1610,6 +1631,8 @@ omp_context_selector_matches (tree ctx, bool)
return ret;
}
+#undef DELAY_METADIRECTIVES_AFTER_LTO
+
/* Compare construct={simd} CLAUSES1 with CLAUSES2, return 0/-1/1/2 as
in omp_context_selector_set_compare. */
@@ -1967,6 +1990,32 @@ omp_get_context_selector (tree ctx, const char *set, const char *sel)
return NULL_TREE;
}
+/* Return a tree expression representing the dynamic part of the context
+ * selector CTX. */
+
+static tree
+omp_dynamic_cond (tree ctx)
+{
+ tree user = omp_get_context_selector (ctx, "user", "condition");
+ if (user)
+ {
+ tree expr_list = TREE_VALUE (user);
+
+ gcc_assert (TREE_PURPOSE (expr_list) == NULL_TREE);
+ return TREE_VALUE (expr_list);
+ }
+ return NULL_TREE;
+}
+
+/* Return true iff the context selector CTX contains a dynamic element
+ that cannot be resolved at compile-time. */
+
+static bool
+omp_dynamic_selector_p (tree ctx)
+{
+ return omp_dynamic_cond (ctx) != NULL_TREE;
+}
+
/* Compute *SCORE for context selector CTX. Return true if the score
would be different depending on whether it is a declare simd clone or
not. DECLARE_SIMD should be true for the case when it would be
@@ -2624,16 +2673,189 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
INSERT) = entryp;
}
+static int
+sort_variant (const void * a, const void *b, void *)
+{
+ widest_int score1 = ((const struct omp_metadirective_variant *) a)->score;
+ widest_int score2 = ((const struct omp_metadirective_variant *) b)->score;
+
+ if (score1 > score2)
+ return -1;
+ else if (score1 < score2)
+ return 1;
+ else
+ return 0;
+}
+
+/* Return a vector of dynamic replacement candidates for the directive
+ candidates in ALL_VARIANTS. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+static vec<struct omp_metadirective_variant>
+omp_get_dynamic_candidates (vec <struct omp_metadirective_variant> &all_variants)
+{
+ auto_vec <struct omp_metadirective_variant> variants;
+ struct omp_metadirective_variant default_variant;
+ bool default_found = false;
+
+ for (unsigned int i = 0; i < all_variants.length (); i++)
+ {
+ struct omp_metadirective_variant variant = all_variants[i];
+
+ if (all_variants[i].selector == NULL_TREE)
+ {
+ default_found = true;
+ default_variant = all_variants[i];
+ default_variant.score = 0;
+ default_variant.resolvable_p = true;
+ default_variant.dynamic_p = false;
+ continue;
+ }
+
+ variant.resolvable_p = true;
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "Considering selector ");
+ print_generic_expr (dump_file, variant.selector);
+ fprintf (dump_file, " as candidate - ");
+ }
+
+ switch (omp_context_selector_matches (variant.selector, true))
+ {
+ case -1:
+ variant.resolvable_p = false;
+ if (dump_file)
+ fprintf (dump_file, "unresolvable");
+ /* FALLTHRU */
+ case 1:
+ /* TODO: Handle SIMD score?. */
+ omp_context_compute_score (variant.selector, &variant.score, false);
+ variant.dynamic_p = omp_dynamic_selector_p (variant.selector);
+ variants.safe_push (variant);
+ break;
+ case 0:
+ if (dump_file)
+ fprintf (dump_file, "no match");
+ break;
+ }
+
+ if (dump_file)
+ fprintf (dump_file, "\n");
+ }
+
+ /* There must be one default variant. */
+ gcc_assert (default_found);
+
+ /* A context selector that is a strict subset of another context selector
+ has a score of zero. */
+ for (unsigned int i = 0; i < variants.length (); i++)
+ for (unsigned int j = i + 1; j < variants.length (); j++)
+ {
+ int r = omp_context_selector_compare (variants[i].selector,
+ variants[j].selector);
+ if (r == -1)
+ {
+ /* variant1 is a strict subset of variant2. */
+ variants[i].score = 0;
+ break;
+ }
+ else if (r == 1)
+ /* variant2 is a strict subset of variant1. */
+ variants[j].score = 0;
+ }
+
+ /* Sort the variants by decreasing score, preserving the original order
+ in case of a tie. */
+ variants.stablesort (sort_variant, NULL);
+
+ /* Add the default as a final choice. */
+ variants.safe_push (default_variant);
+
+ /* Build the dynamic candidate list. */
+ for (unsigned i = 0; i < variants.length (); i++)
+ {
+ /* If one of the candidates is unresolvable, give up for now. */
+ if (!variants[i].resolvable_p)
+ {
+ variants.truncate (0);
+ break;
+ }
+
+ /* Replace the original selector with just the dynamic part. */
+ variants[i].selector = omp_dynamic_cond (variants[i].selector);
+
+ if (dump_file)
+ {
+ fprintf (dump_file, "Adding directive variant with ");
+
+ if (variants[i].selector)
+ {
+ fprintf (dump_file, "selector ");
+ print_generic_expr (dump_file, variants[i].selector);
+ }
+ else
+ fprintf (dump_file, "default selector");
+
+ fprintf (dump_file, " as candidate.\n");
+ }
+
+ /* The last of the candidates is ended by a static selector. */
+ if (!variants[i].dynamic_p)
+ {
+ variants.truncate (i + 1);
+ break;
+ }
+ }
+
+ return variants.copy ();
+}
+
/* Return a vector of dynamic replacement candidates for the metadirective
statement in METADIRECTIVE. Return an empty vector if the metadirective
cannot be resolved. */
vec<struct omp_metadirective_variant>
-omp_resolve_metadirective (tree)
+omp_resolve_metadirective (tree metadirective)
+{
+ auto_vec <struct omp_metadirective_variant> variants;
+ tree clause = OMP_METADIRECTIVE_CLAUSES (metadirective);
+
+ while (clause)
+ {
+ struct omp_metadirective_variant variant;
+
+ variant.selector = TREE_PURPOSE (clause);
+ variant.directive = TREE_PURPOSE (TREE_VALUE (clause));
+ variant.body = TREE_VALUE (TREE_VALUE (clause));
+
+ variants.safe_push (variant);
+ clause = TREE_CHAIN (clause);
+ }
+
+ return omp_get_dynamic_candidates (variants);
+}
+
+/* Return a vector of dynamic replacement candidates for the metadirective
+ Gimple statement in GS. Return an empty vector if the metadirective
+ cannot be resolved. */
+
+vec<struct omp_metadirective_variant>
+omp_resolve_metadirective (gimple *gs)
{
- vec<struct omp_metadirective_variant> variants = {};
+ auto_vec <struct omp_metadirective_variant> variants;
+
+ for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+ {
+ struct omp_metadirective_variant variant;
+
+ variant.selector = gimple_op (gs, i);
+ variant.directive = gimple_omp_metadirective_label (gs, i);
+
+ variants.safe_push (variant);
+ }
- return variants;
+ return omp_get_dynamic_candidates (variants);
}
/* Encode an oacc launch argument. This matches the GOMP_LAUNCH_PACK
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 8c6009e9854..5a0747b2791 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -93,6 +93,12 @@ struct omp_for_data
struct omp_metadirective_variant
{
+ widest_int score;
+ tree selector;
+ tree directive;
+ tree body;
+ bool dynamic_p : 1;
+ bool resolvable_p : 1;
};
#define OACC_FN_ATTRIB "oacc function"
@@ -119,6 +125,7 @@ extern int omp_context_selector_set_compare (const char *, tree, tree);
extern tree omp_get_context_selector (tree, const char *, const char *);
extern tree omp_resolve_declare_variant (tree);
extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
+extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (gimple *);
extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
extern void oacc_replace_fn_attrib (tree fn, tree dims);
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification
2021-12-10 17:35 ` [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification Kwok Cheung Yeung
@ 2022-05-30 11:13 ` Jakub Jelinek
0 siblings, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-30 11:13 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:35:05PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
>
> gcc/
> * gimplify.c (expand_omp_metadirective): New.
> * omp-general.c: Include tree-pretty-print.h.
> (DELAY_METADIRECTIVES_AFTER_LTO): New macro.
> (omp_context_selector_matches): Delay resolution of selectors. Allow
> non-constant expressions.
> (omp_dynamic_cond): New.
> (omp_dynamic_selector_p): New.
> (sort_variant): New.
> (omp_get_dynamic_candidates): New.
> (omp_resolve_metadirective): New.
> (omp_resolve_metadirective): New.
> * omp-general.h (struct omp_metadirective_variant): New.
> (omp_resolve_metadirective): New prototype.
>
> gcc/c-family/
> * c-omp.c (c_omp_expand_metadirective_r): New.
> (c_omp_expand_metadirective): New.
> --- a/gcc/c-family/c-omp.c
> +++ b/gcc/c-family/c-omp.c
> @@ -3264,8 +3264,49 @@ c_omp_categorize_directive (const char *first, const char *second,
> return NULL;
> }
>
Missing function comment.
> +static tree
> +c_omp_expand_metadirective_r (vec<struct omp_metadirective_variant> &candidates,
> + hash_map<tree, tree> &body_labels,
> + unsigned index)
> +{
> + struct omp_metadirective_variant &candidate = candidates[index];
> + tree if_block = push_stmt_list ();
> + if (candidate.directive != NULL_TREE)
> + add_stmt (candidate.directive);
> + if (candidate.body != NULL_TREE)
> + {
> + tree *label = body_labels.get (candidate.body);
> + if (label != NULL)
> + add_stmt (build1 (GOTO_EXPR, void_type_node, *label));
> + else
> + {
> + tree body_label = create_artificial_label (UNKNOWN_LOCATION);
> + add_stmt (build1 (LABEL_EXPR, void_type_node, body_label));
> + add_stmt (candidate.body);
> + body_labels.put (candidate.body, body_label);
> + }
> + }
> + if_block = pop_stmt_list (if_block);
> +
> + if (index == candidates.length () - 1)
> + return if_block;
> +
> + tree cond = candidate.selector;
> + gcc_assert (cond != NULL_TREE);
> +
> + tree else_block = c_omp_expand_metadirective_r (candidates, body_labels,
> + index + 1);
> + tree ret = push_stmt_list ();
> + tree stmt = build3 (COND_EXPR, void_type_node, cond, if_block, else_block);
> + add_stmt (stmt);
> + ret = pop_stmt_list (ret);
> +
> + return ret;
> +}
> +
Likewise.
> tree
> -c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
> +c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &candidates)
> {
> - return NULL_TREE;
> + hash_map<tree, tree> body_labels;
> + return c_omp_expand_metadirective_r (candidates, body_labels, 0);
> }
> --- a/gcc/omp-general.c
> +++ b/gcc/omp-general.c
> @@ -45,6 +45,7 @@ along with GCC; see the file COPYING3. If not see
> #include "data-streamer.h"
> #include "streamer-hooks.h"
> #include "opts.h"
> +#include "tree-pretty-print.h"
>
> enum omp_requires omp_requires_mask;
>
> @@ -1253,14 +1254,22 @@ omp_context_name_list_prop (tree prop)
> }
> }
>
> +#define DELAY_METADIRECTIVES_AFTER_LTO { \
> + if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev)) \
> + return -1; \
Why this? Is that just some testing hack (which then the choice of
selectors in the testsuite relies on)? I don't see why those selectors
shouldn't be resolved as early as possible.
> @@ -2624,16 +2673,189 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
> INSERT) = entryp;
> }
>
Missing function comment.
> +static int
> +sort_variant (const void * a, const void *b, void *)
> +{
> + widest_int score1 = ((const struct omp_metadirective_variant *) a)->score;
> + widest_int score2 = ((const struct omp_metadirective_variant *) b)->score;
> +
> + if (score1 > score2)
> + return -1;
> + else if (score1 < score2)
> + return 1;
> + else
> + return 0;
> +}
Note, resolving at the end of parsing (during gimplification) is still not
during parsing. For resolving during parsing we'll need another mode, in
which the FEs somehow track e.g. selected OpenMP constructs that surround
the code being currently parsed. Obviously that can be handled
incrementally.
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
` (2 preceding siblings ...)
2021-12-10 17:35 ` [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification Kwok Cheung Yeung
@ 2021-12-10 17:36 ` Kwok Cheung Yeung
2022-05-30 11:33 ` Jakub Jelinek
2021-12-10 17:37 ` [PATCH 5/7] openmp: Add C++ support for parsing metadirectives Kwok Cheung Yeung
` (3 subsequent siblings)
7 siblings, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:36 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 284 bytes --]
This patch adds support for streaming the Gimple metadirective
representation during LTO. An extra pass (also using
omp_get_dynamic_candidates) is also added to resolve metadirectives
after LTO, which is required for selectors that need to be resolved on
the accel compiler.
Kwok
[-- Attachment #2: 0004-openmp-Add-support-for-streaming-metadirectives-and-.patch --]
[-- Type: text/plain, Size: 10464 bytes --]
From 85826d05e029571fd003dd629aa04ce3e17d9c71 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:56:07 +0000
Subject: [PATCH 4/7] openmp: Add support for streaming metadirectives and
resolving them after LTO
This patch adds support for streaming metadirective Gimple statements during
LTO, and adds a metadirective expansion pass that runs after LTO. This is
required for metadirectives with selectors that can only be resolved from
within the accel compiler.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* Makefile.in (OBJS): Add omp-expand-metadirective.o.
* gimple-streamer-in.c (input_gimple_stmt): Add case for
GIMPLE_OMP_METADIRECTIVE. Handle metadirective labels.
* gimple-streamer-out.c (output_gimple_stmt): Likewise.
* omp-expand-metadirective.cc: New.
* passes.def: Add pass_omp_expand_metadirective.
* tree-pass.h (make_pass_omp_expand_metadirective): New prototype.
---
gcc/Makefile.in | 1 +
gcc/gimple-streamer-in.c | 10 ++
gcc/gimple-streamer-out.c | 6 +
gcc/omp-expand-metadirective.cc | 191 ++++++++++++++++++++++++++++++++
gcc/passes.def | 1 +
gcc/tree-pass.h | 1 +
6 files changed, 210 insertions(+)
create mode 100644 gcc/omp-expand-metadirective.cc
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 2a0be9e66a6..34a17f36922 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -1519,6 +1519,7 @@ OBJS = \
omp-oacc-kernels-decompose.o \
omp-oacc-neuter-broadcast.o \
omp-simd-clone.o \
+ omp-expand-metadirective.o \
opt-problem.o \
optabs.o \
optabs-libfuncs.o \
diff --git a/gcc/gimple-streamer-in.c b/gcc/gimple-streamer-in.c
index 1c979f438a5..b821aa3ca30 100644
--- a/gcc/gimple-streamer-in.c
+++ b/gcc/gimple-streamer-in.c
@@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
case GIMPLE_COND:
case GIMPLE_GOTO:
case GIMPLE_DEBUG:
+ case GIMPLE_OMP_METADIRECTIVE:
for (i = 0; i < num_ops; i++)
{
tree *opp, op = stream_read_tree (ib, data_in);
@@ -188,6 +189,15 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
else
gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
}
+ if (gomp_metadirective *metadirective_stmt
+ = dyn_cast <gomp_metadirective*> (stmt))
+ {
+ gimple_alloc_omp_metadirective (metadirective_stmt);
+ for (i = 0; i < num_ops; i++)
+ gimple_omp_metadirective_set_label (metadirective_stmt, i,
+ stream_read_tree (ib,
+ data_in));
+ }
break;
case GIMPLE_NOP:
diff --git a/gcc/gimple-streamer-out.c b/gcc/gimple-streamer-out.c
index fcbf92300d4..c19dff74261 100644
--- a/gcc/gimple-streamer-out.c
+++ b/gcc/gimple-streamer-out.c
@@ -127,6 +127,7 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
case GIMPLE_COND:
case GIMPLE_GOTO:
case GIMPLE_DEBUG:
+ case GIMPLE_OMP_METADIRECTIVE:
for (i = 0; i < gimple_num_ops (stmt); i++)
{
tree op = gimple_op (stmt, i);
@@ -169,6 +170,11 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
else
stream_write_tree (ob, gimple_call_fntype (stmt), true);
}
+ if (gimple_code (stmt) == GIMPLE_OMP_METADIRECTIVE)
+ for (i = 0; i < gimple_num_ops (stmt); i++)
+ stream_write_tree (ob, gimple_omp_metadirective_label (stmt, i),
+ true);
+
break;
case GIMPLE_NOP:
diff --git a/gcc/omp-expand-metadirective.cc b/gcc/omp-expand-metadirective.cc
new file mode 100644
index 00000000000..aaf048a699a
--- /dev/null
+++ b/gcc/omp-expand-metadirective.cc
@@ -0,0 +1,191 @@
+/* Expand an OpenMP metadirective.
+
+ Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "backend.h"
+#include "target.h"
+#include "tree.h"
+#include "langhooks.h"
+#include "gimple.h"
+#include "tree-pass.h"
+#include "cgraph.h"
+#include "fold-const.h"
+#include "gimplify.h"
+#include "gimple-iterator.h"
+#include "gimple-walk.h"
+#include "gomp-constants.h"
+#include "omp-general.h"
+#include "diagnostic-core.h"
+#include "tree-cfg.h"
+#include "cfganal.h"
+#include "ssa.h"
+#include "tree-into-ssa.h"
+#include "cfghooks.h"
+
+static void
+omp_expand_metadirective (function *fun, basic_block bb)
+{
+ gimple *stmt = last_stmt (bb);
+ vec<struct omp_metadirective_variant> candidates
+ = omp_resolve_metadirective (stmt);
+
+ /* This is the last chance for the metadirective to be resolved. */
+ if (candidates.is_empty ())
+ gcc_unreachable ();
+
+ auto_vec<tree> labels;
+
+ for (unsigned int i = 0; i < candidates.length (); i++)
+ labels.safe_push (candidates[i].directive);
+
+ /* Delete BBs for all variants not in the candidate list. */
+ for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+ {
+ tree label = gimple_omp_metadirective_label (stmt, i);
+ if (!labels.contains (label))
+ {
+ edge e = find_edge (bb, label_to_block (fun, label));
+ remove_edge_and_dominated_blocks (e);
+ }
+ }
+
+ /* Remove the metadirective statement. */
+ gimple_stmt_iterator gsi = gsi_last_bb (bb);
+ gsi_remove (&gsi, true);
+
+ if (candidates.length () == 1)
+ {
+ /* Special case if there is only one selector - there should be one
+ remaining edge from BB to the selected variant. */
+ edge e = find_edge (bb, label_to_block (fun,
+ candidates.last ().directive));
+ e->flags |= EDGE_FALLTHRU;
+
+ return;
+ }
+
+ basic_block cur_bb = bb;
+
+ /* For each candidate, create a conditional that checks the dynamic
+ condition, branching to the candidate directive if true, to the
+ next candidate check if false. */
+ for (unsigned i = 0; i < candidates.length () - 1; i++)
+ {
+ basic_block next_bb = NULL;
+ gcond *cond_stmt = gimple_build_cond_from_tree (candidates[i].selector,
+ NULL_TREE, NULL_TREE);
+ gsi = gsi_last_bb (cur_bb);
+ gsi_insert_seq_after (&gsi, cond_stmt, GSI_NEW_STMT);
+
+ if (i < candidates.length () - 2)
+ {
+ edge e_false = split_block (cur_bb, cond_stmt);
+ e_false->flags &= ~EDGE_FALLTHRU;
+ e_false->flags |= EDGE_FALSE_VALUE;
+ e_false->probability = profile_probability::uninitialized ();
+
+ next_bb = e_false->dest;
+ }
+
+ /* Redirect the source of the edge from BB to the candidate directive
+ to the conditional. Reusing the edge avoids disturbing phi nodes in
+ the destination BB. */
+ edge e = find_edge (bb, label_to_block (fun, candidates[i].directive));
+ redirect_edge_pred (e, cur_bb);
+ e->flags |= EDGE_TRUE_VALUE;
+
+ if (next_bb)
+ cur_bb = next_bb;
+ }
+
+ /* The last of the candidates is always static. */
+ edge e = find_edge (cur_bb, label_to_block (fun,
+ candidates.last ().directive));
+ e->flags |= EDGE_FALSE_VALUE;
+}
+
+namespace {
+
+const pass_data pass_data_omp_expand_metadirective =
+{
+ GIMPLE_PASS, /* type */
+ "omp_expand_metadirective", /* name */
+ OPTGROUP_OMP, /* optinfo_flags */
+ TV_NONE, /* tv_id */
+ PROP_gimple_lcf, /* properties_required */
+ 0, /* properties_provided */
+ 0, /* properties_destroyed */
+ 0, /* todo_flags_start */
+ TODO_update_ssa | TODO_cleanup_cfg, /* todo_flags_finish */
+};
+
+class pass_omp_expand_metadirective : public gimple_opt_pass
+{
+public:
+ pass_omp_expand_metadirective (gcc::context *ctxt)
+ : gimple_opt_pass (pass_data_omp_expand_metadirective, ctxt)
+ {}
+
+ /* opt_pass methods: */
+ virtual bool gate (function *)
+ {
+ return (flag_openmp);
+ }
+
+ virtual unsigned int execute (function *fun);
+}; // class pass_omp_oacc_kernels_decompose
+
+unsigned int
+pass_omp_expand_metadirective::execute (function *fun)
+{
+ basic_block bb;
+ auto_vec<basic_block> metadirective_bbs;
+
+ FOR_EACH_BB_FN (bb, fun)
+ {
+ gimple *stmt = last_stmt (bb);
+ if (stmt && is_a<gomp_metadirective *> (stmt))
+ metadirective_bbs.safe_push (bb);
+ }
+
+ if (metadirective_bbs.is_empty ())
+ return 0;
+
+ calculate_dominance_info (CDI_DOMINATORS);
+
+ for (unsigned i = 0; i < metadirective_bbs.length (); i++)
+ omp_expand_metadirective (fun, metadirective_bbs[i]);
+
+ free_dominance_info (fun, CDI_DOMINATORS);
+ mark_virtual_operands_for_renaming (fun);
+
+ return 0;
+}
+
+} // anon namespace
+
+
+gimple_opt_pass *
+make_pass_omp_expand_metadirective (gcc::context *ctxt)
+{
+ return new pass_omp_expand_metadirective (ctxt);
+}
diff --git a/gcc/passes.def b/gcc/passes.def
index 37ea0d318d1..b80a53c4051 100644
--- a/gcc/passes.def
+++ b/gcc/passes.def
@@ -189,6 +189,7 @@ along with GCC; see the file COPYING3. If not see
NEXT_PASS (pass_oacc_device_lower);
NEXT_PASS (pass_omp_device_lower);
NEXT_PASS (pass_omp_target_link);
+ NEXT_PASS (pass_omp_expand_metadirective);
NEXT_PASS (pass_adjust_alignment);
NEXT_PASS (pass_all_optimizations);
PUSH_INSERT_PASSES_WITHIN (pass_all_optimizations)
diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h
index 3559c3c9f1b..e4315e2fe85 100644
--- a/gcc/tree-pass.h
+++ b/gcc/tree-pass.h
@@ -422,6 +422,7 @@ extern gimple_opt_pass *make_pass_lower_switch_O0 (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_lower_vector (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_lower_vector_ssa (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_omp_oacc_kernels_decompose (gcc::context *ctxt);
+extern gimple_opt_pass *make_pass_omp_expand_metadirective (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_lower_omp (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_diagnose_omp_blocks (gcc::context *ctxt);
extern gimple_opt_pass *make_pass_expand_omp (gcc::context *ctxt);
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO
2021-12-10 17:36 ` [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO Kwok Cheung Yeung
@ 2022-05-30 11:33 ` Jakub Jelinek
0 siblings, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-30 11:33 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:36:20PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
>
> gcc/
> * Makefile.in (OBJS): Add omp-expand-metadirective.o.
> * gimple-streamer-in.c (input_gimple_stmt): Add case for
> GIMPLE_OMP_METADIRECTIVE. Handle metadirective labels.
> * gimple-streamer-out.c (output_gimple_stmt): Likewise.
> * omp-expand-metadirective.cc: New.
> * passes.def: Add pass_omp_expand_metadirective.
> * tree-pass.h (make_pass_omp_expand_metadirective): New prototype.
> ---
> gcc/Makefile.in | 1 +
> gcc/gimple-streamer-in.c | 10 ++
> gcc/gimple-streamer-out.c | 6 +
> gcc/omp-expand-metadirective.cc | 191 ++++++++++++++++++++++++++++++++
> gcc/passes.def | 1 +
> gcc/tree-pass.h | 1 +
> 6 files changed, 210 insertions(+)
> create mode 100644 gcc/omp-expand-metadirective.cc
>
> @@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
> case GIMPLE_COND:
> case GIMPLE_GOTO:
> case GIMPLE_DEBUG:
> + case GIMPLE_OMP_METADIRECTIVE:
> for (i = 0; i < num_ops; i++)
> {
> tree *opp, op = stream_read_tree (ib, data_in);
> @@ -188,6 +189,15 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
> else
> gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
> }
> + if (gomp_metadirective *metadirective_stmt
> + = dyn_cast <gomp_metadirective*> (stmt))
> + {
> + gimple_alloc_omp_metadirective (metadirective_stmt);
> + for (i = 0; i < num_ops; i++)
> + gimple_omp_metadirective_set_label (metadirective_stmt, i,
> + stream_read_tree (ib,
> + data_in));
> + }
Ah, sorry for the comment about LTO streaming, here it is.
> --- /dev/null
> +++ b/gcc/omp-expand-metadirective.cc
> @@ -0,0 +1,191 @@
> +/* Expand an OpenMP metadirective.
> +
> + Copyright (C) 2021 Free Software Foundation, Inc.
We have 2022 now...
> +
Missing function comment.
> +static void
> +omp_expand_metadirective (function *fun, basic_block bb)
> +{
> + gimple *stmt = last_stmt (bb);
> + vec<struct omp_metadirective_variant> candidates
> + = omp_resolve_metadirective (stmt);
> +
> + /* This is the last chance for the metadirective to be resolved. */
> + if (candidates.is_empty ())
> + gcc_unreachable ();
gcc_assert (!candidates.is_empty ());
?
> + /* opt_pass methods: */
> + virtual bool gate (function *)
> + {
> + return (flag_openmp);
Useless ()s around it.
But much more importantly, I don't really like this to be a separate pass,
walking the whole IL once more is expensive, even when you restrict it
to just flag_openmp.
Late declare variant resolving is done in the (now a little bit misnamed)
pass_omp_device_lower.
The gate of that pass is right now:
return (!(fun->curr_properties & PROP_gimple_lomp_dev)
|| (flag_openmp
&& cgraph_node::get (fun->decl)->calls_declare_variant_alt));
so it would be nice to track (conservatively)
whether current function has any metadirectives
in it which aren't yet resolved (but perhaps the calls_declare_variant_alt
bit could be abused for that too) andin that case also deal with those.
You can surely gather them in the omp-offload.cc pass and then call
a function in your new file to handle that.
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 5/7] openmp: Add C++ support for parsing metadirectives
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
` (3 preceding siblings ...)
2021-12-10 17:36 ` [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO Kwok Cheung Yeung
@ 2021-12-10 17:37 ` Kwok Cheung Yeung
2022-05-30 11:52 ` Jakub Jelinek
2021-12-10 17:39 ` [PATCH 6/7] openmp, fortran: Add Fortran " Kwok Cheung Yeung
` (2 subsequent siblings)
7 siblings, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:37 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 146 bytes --]
This patch adds metadirective parsing support to the C++ parser. This is
basically just a straight port of the C code to the C++ front end.
Kwok
[-- Attachment #2: 0005-openmp-Add-C-support-for-parsing-metadirectives.patch --]
[-- Type: text/plain, Size: 15927 bytes --]
From e9bb138d4c3f560e48e408facce2361533685a98 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:58:01 +0000
Subject: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives
This adds support for parsing OpenMP metadirectives in the C++ front end.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/cp/
* parser.c (cp_parser_skip_to_end_of_statement): Handle parentheses.
(cp_parser_skip_to_end_of_block_or_statement): Likewise.
(cp_parser_omp_context_selector): Add extra argument. Allow
non-constant expressions.
(cp_parser_omp_context_selector_specification): Add extra argument and
propagate to cp_parser_omp_context_selector.
(analyze_metadirective_body): New.
(cp_parser_omp_metadirective): New.
(cp_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.
(cp_parser_pragma): Handle PRAGMA_OMP_METADIRECTIVE.
---
gcc/cp/parser.c | 425 +++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 417 insertions(+), 8 deletions(-)
diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 6f273bfe21f..afbfe148949 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -3907,6 +3907,17 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
++nesting_depth;
break;
+ case CPP_OPEN_PAREN:
+ /* Track parentheses in case the statement is a standalone 'for'
+ statement - we want to skip over the semicolons separating the
+ operands. */
+ ++nesting_depth;
+ break;
+
+ case CPP_CLOSE_PAREN:
+ --nesting_depth;
+ break;
+
case CPP_KEYWORD:
if (token->keyword != RID__EXPORT
&& token->keyword != RID__MODULE
@@ -3996,6 +4007,17 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
nesting_depth++;
break;
+ case CPP_OPEN_PAREN:
+ /* Track parentheses in case the statement is a standalone 'for'
+ statement - we want to skip over the semicolons separating the
+ operands. */
+ nesting_depth++;
+ break;
+
+ case CPP_CLOSE_PAREN:
+ nesting_depth--;
+ break;
+
case CPP_KEYWORD:
if (token->keyword != RID__EXPORT
&& token->keyword != RID__MODULE
@@ -44972,7 +44994,8 @@ static const char *const omp_user_selectors[] = {
score(score-expression) */
static tree
-cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
+cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p,
+ bool metadirective_p)
{
tree ret = NULL_TREE;
do
@@ -45188,15 +45211,21 @@ cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
while (1);
break;
case CTX_PROPERTY_EXPR:
- t = cp_parser_constant_expression (parser);
+ /* Allow non-constant expressions in metadirectives. */
+ t = metadirective_p
+ ? cp_parser_expression (parser)
+ : cp_parser_constant_expression (parser);
if (t != error_mark_node)
{
t = fold_non_dependent_expr (t);
- if (!value_dependent_expression_p (t)
- && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
- || !tree_fits_shwi_p (t)))
+ if (metadirective_p && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
error_at (token->location, "property must be "
- "constant integer expression");
+ "integer expression");
+ else if (!metadirective_p && !value_dependent_expression_p (t)
+ && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
+ || !tree_fits_shwi_p (t)))
+ error_at (token->location, "property must be constant "
+ "integer expression");
else
properties = tree_cons (NULL_TREE, t, properties);
}
@@ -45260,7 +45289,8 @@ cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
static tree
cp_parser_omp_context_selector_specification (cp_parser *parser,
- bool has_parms_p)
+ bool has_parms_p,
+ bool metadirective_p = false)
{
tree ret = NULL_TREE;
do
@@ -45308,7 +45338,8 @@ cp_parser_omp_context_selector_specification (cp_parser *parser,
return error_mark_node;
tree selectors
- = cp_parser_omp_context_selector (parser, set, has_parms_p);
+ = cp_parser_omp_context_selector (parser, set, has_parms_p,
+ metadirective_p);
if (selectors == error_mark_node)
{
cp_parser_skip_to_closing_brace (parser);
@@ -45831,6 +45862,378 @@ cp_parser_omp_end_declare_target (cp_parser *parser, cp_token *pragma_tok)
}
}
+
+/* Helper function for c_parser_omp_metadirective. */
+
+static void
+analyze_metadirective_body (cp_parser *parser,
+ vec<cp_token> &tokens,
+ vec<tree> &labels)
+{
+ int nesting_depth = 0;
+ int bracket_depth = 0;
+ bool in_case = false;
+ bool in_label_decl = false;
+
+ while (1)
+ {
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+ bool stop = false;
+
+ if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CASE))
+ in_case = true;
+ else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_LABEL))
+ in_label_decl = true;
+
+ switch (token->type)
+ {
+ case CPP_EOF:
+ break;
+ case CPP_NAME:
+ if ((!in_case
+ && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+ || in_label_decl)
+ labels.safe_push (token->u.value);
+ goto add;
+ case CPP_OPEN_BRACE:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_BRACE:
+ if (--nesting_depth == 0)
+ stop = true;
+ goto add;
+ case CPP_OPEN_PAREN:
+ ++bracket_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ --bracket_depth;
+ goto add;
+ case CPP_COLON:
+ in_case = false;
+ goto add;
+ case CPP_SEMICOLON:
+ if (nesting_depth == 0 && bracket_depth == 0)
+ stop = true;
+ /* Local label declarations are terminated by a semicolon. */
+ in_label_decl = false;
+ goto add;
+ default:
+ add:
+ tokens.safe_push (*token);
+ cp_lexer_consume_token (parser->lexer);
+ if (stop)
+ break;
+ continue;
+ }
+ break;
+ }
+}
+
+/* OpenMP 5.0:
+
+ # pragma omp metadirective [clause[, clause]]
+*/
+
+static tree
+cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
+ char *p_name, omp_clause_mask, tree *,
+ bool *if_p)
+{
+ tree ret;
+ auto_vec<cp_token> directive_tokens;
+ auto_vec<cp_token> body_tokens;
+ auto_vec<tree> body_labels;
+ auto_vec<const struct c_omp_directive *> directives;
+ auto_vec<tree> ctxs;
+ bool default_seen = false;
+ int directive_token_idx = 0;
+ location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+ tree standalone_body = NULL_TREE;
+ vec<struct omp_metadirective_variant> candidates;
+
+ ret = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (ret, loc);
+ TREE_TYPE (ret) = void_type_node;
+ OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
+ strcat (p_name, " metadirective");
+
+ while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
+ {
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME)
+ && cp_lexer_next_token_is_not (parser->lexer, CPP_KEYWORD))
+ {
+ cp_parser_error (parser, "expected %<when%> or %<default%>");
+ goto fail;
+ }
+
+ location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
+ const char *p
+ = IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
+ cp_lexer_consume_token (parser->lexer);
+ bool default_p = strcmp (p, "default") == 0;
+ if (default_p)
+ {
+ if (default_seen)
+ {
+ cp_parser_error (parser, "there can only be one default clause "
+ "in a metadirective");
+ goto fail;
+ }
+ else
+ default_seen = true;
+ }
+ if (!strcmp (p, "when") == 0 && !default_p)
+ {
+ cp_parser_error (parser, "expected %<when%> or %<default%>");
+ goto fail;
+ }
+
+ matching_parens parens;
+ tree ctx = NULL_TREE;
+ bool skip = false;
+
+ if (!parens.require_open (parser))
+ goto fail;
+
+ if (!default_p)
+ {
+ ctx = cp_parser_omp_context_selector_specification (parser, false,
+ true);
+ if (ctx == error_mark_node)
+ goto fail;
+ ctx = omp_check_context_selector (match_loc, ctx);
+ if (ctx == error_mark_node)
+ goto fail;
+
+ /* Remove the selector from further consideration if can be
+ evaluated as a non-match at this point. */
+ skip = (omp_context_selector_matches (ctx, true) == 0);
+
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
+ {
+ cp_parser_error (parser, "expected colon");
+ goto fail;
+ }
+ cp_lexer_consume_token (parser->lexer);
+ }
+
+ /* Read in the directive type and create a dummy pragma token for
+ it. */
+ location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+
+ p = NULL;
+ if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_PAREN))
+ p = "nothing";
+ else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
+ {
+ p = "for";
+ cp_lexer_consume_token (parser->lexer);
+ }
+ else if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+ {
+ cp_token *token = cp_lexer_consume_token (parser->lexer);
+ p = IDENTIFIER_POINTER (token->u.value);
+ }
+
+ if (p == NULL)
+ {
+ cp_parser_error (parser, "expected directive name");
+ goto fail;
+ }
+
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive (p, NULL, NULL);
+
+ if (omp_directive == NULL)
+ {
+ cp_parser_error (parser, "unknown directive name");
+ goto fail;
+ }
+ if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+ {
+ cp_parser_error (parser,
+ "metadirectives cannot be used as directive "
+ "variants");
+ goto fail;
+ }
+ if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+ {
+ sorry_at (loc, "declarative directive variants are not supported");
+ goto fail;
+ }
+
+ if (!skip)
+ {
+ cp_token pragma_token;
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.location = loc;
+ pragma_token.u.value = build_int_cst (NULL, omp_directive->id);
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (ctx);
+ }
+
+ /* Read in tokens for the directive clauses. */
+ int nesting_depth = 0;
+ while (1)
+ {
+ cp_token *token = cp_lexer_peek_token (parser->lexer);
+ switch (token->type)
+ {
+ case CPP_EOF:
+ case CPP_PRAGMA_EOL:
+ break;
+ case CPP_OPEN_PAREN:
+ ++nesting_depth;
+ goto add;
+ case CPP_CLOSE_PAREN:
+ if (nesting_depth-- == 0)
+ break;
+ goto add;
+ default:
+ add:
+ if (!skip)
+ directive_tokens.safe_push (*token);
+ cp_lexer_consume_token (parser->lexer);
+ continue;
+ }
+ break;
+ }
+
+ cp_lexer_consume_token (parser->lexer);
+
+ if (!skip)
+ {
+ cp_token eol_token = {};
+ eol_token.type = CPP_PRAGMA_EOL;
+ eol_token.keyword = RID_MAX;
+ directive_tokens.safe_push (eol_token);
+ }
+ }
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+ if (!default_seen)
+ {
+ /* Add a default clause that evaluates to 'omp nothing'. */
+ const struct c_omp_directive *omp_directive
+ = c_omp_categorize_directive ("nothing", NULL, NULL);
+
+ cp_token pragma_token = {};
+ pragma_token.type = CPP_PRAGMA;
+ pragma_token.keyword = RID_MAX;
+ pragma_token.location = UNKNOWN_LOCATION;
+ pragma_token.u.value = build_int_cst (NULL, PRAGMA_OMP_NOTHING);
+
+ directives.safe_push (omp_directive);
+ directive_tokens.safe_push (pragma_token);
+ ctxs.safe_push (NULL_TREE);
+
+ cp_token eol_token = {};
+ eol_token.type = CPP_PRAGMA_EOL;
+ eol_token.keyword = RID_MAX;
+ directive_tokens.safe_push (eol_token);
+ }
+
+ analyze_metadirective_body (parser, body_tokens, body_labels);
+
+ /* Process each candidate directive. */
+ unsigned i;
+ tree ctx;
+ cp_lexer *lexer;
+
+ lexer = cp_lexer_alloc ();
+ lexer->debugging_p = parser->lexer->debugging_p;
+ vec_safe_reserve (lexer->buffer,
+ directive_tokens.length () + body_tokens.length () + 2);
+
+ FOR_EACH_VEC_ELT (ctxs, i, ctx)
+ {
+ lexer->buffer->truncate (0);
+
+ /* Add the directive tokens. */
+ do
+ lexer->buffer->quick_push (directive_tokens [directive_token_idx++]);
+ while (lexer->buffer->last ().type != CPP_PRAGMA_EOL);
+
+ /* Add the body tokens. */
+ for (unsigned j = 0; j < body_tokens.length (); j++)
+ lexer->buffer->quick_push (body_tokens[j]);
+
+ /* Make sure nothing tries to read past the end of the tokens. */
+ cp_token eof_token = {};
+ eof_token.type = CPP_EOF;
+ eof_token.keyword = RID_MAX;
+ lexer->buffer->quick_push (eof_token);
+ lexer->buffer->quick_push (eof_token);
+
+ lexer->next_token = lexer->buffer->address();
+ lexer->last_token = lexer->next_token + lexer->buffer->length () - 1;
+
+ cp_lexer *old_lexer = parser->lexer;
+ parser->lexer = lexer;
+ cp_lexer_set_source_position_from_token (lexer->next_token);
+
+ tree directive = push_stmt_list ();
+ tree directive_stmt = begin_compound_stmt (0);
+
+ /* Declare all labels that occur within the directive body as
+ local. */
+ for (unsigned j = 0; j < body_labels.length (); j++)
+ finish_label_decl (body_labels[j]);
+ cp_parser_pragma (parser, pragma_compound, if_p);
+
+ finish_compound_stmt (directive_stmt);
+ directive = pop_stmt_list (directive);
+
+ bool standalone_p
+ = directives[i]->kind == C_OMP_DIR_STANDALONE
+ || directives[i]->kind == C_OMP_DIR_UTILITY;
+ if (standalone_p)
+ {
+ /* Parsing standalone directives will not consume the body
+ tokens, so do that here. */
+ if (standalone_body == NULL_TREE)
+ {
+ standalone_body = push_stmt_list ();
+ cp_parser_statement (parser, NULL_TREE, false, if_p);
+ standalone_body = pop_stmt_list (standalone_body);
+ }
+ else
+ cp_parser_skip_to_end_of_block_or_statement (parser);
+ }
+
+ tree body = standalone_p ? standalone_body : NULL_TREE;
+ tree variant = build_tree_list (ctx, build_tree_list (directive, body));
+ OMP_METADIRECTIVE_CLAUSES (ret)
+ = chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
+
+ /* Check that all valid tokens have been consumed. */
+ gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
+
+ parser->lexer = old_lexer;
+ cp_lexer_set_source_position_from_token (old_lexer->next_token);
+ }
+
+ /* Try to resolve the metadirective early. */
+ candidates = omp_resolve_metadirective (ret);
+ if (!candidates.is_empty ())
+ ret = c_omp_expand_metadirective (candidates);
+
+ add_stmt (ret);
+
+ return ret;
+
+fail:
+ /* Skip the metadirective pragma. */
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+ /* Skip the metadirective body. */
+ cp_parser_skip_to_end_of_block_or_statement (parser);
+ return error_mark_node;
+}
+
+
/* Helper function of cp_parser_omp_declare_reduction. Parse the combiner
expression and optional initializer clause of
#pragma omp declare reduction. We store the expression(s) as
@@ -47077,6 +47480,11 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
if_p);
break;
+ case PRAGMA_OMP_METADIRECTIVE:
+ strcpy (p_name, "#pragma omp");
+ stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
+ NULL, if_p);
+ break;
case PRAGMA_OMP_PARALLEL:
strcpy (p_name, "#pragma omp");
stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
@@ -47727,6 +48135,7 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
case PRAGMA_OMP_LOOP:
case PRAGMA_OMP_MASKED:
case PRAGMA_OMP_MASTER:
+ case PRAGMA_OMP_METADIRECTIVE:
case PRAGMA_OMP_PARALLEL:
case PRAGMA_OMP_SCOPE:
case PRAGMA_OMP_SECTIONS:
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives
2021-12-10 17:37 ` [PATCH 5/7] openmp: Add C++ support for parsing metadirectives Kwok Cheung Yeung
@ 2022-05-30 11:52 ` Jakub Jelinek
0 siblings, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-30 11:52 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:37:34PM +0000, Kwok Cheung Yeung wrote:
> From e9bb138d4c3f560e48e408facce2361533685a98 Mon Sep 17 00:00:00 2001
> From: Kwok Cheung Yeung <kcy@codesourcery.com>
> Date: Mon, 6 Dec 2021 22:58:01 +0000
> Subject: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives
>
> This adds support for parsing OpenMP metadirectives in the C++ front end.
>
> 2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
>
> gcc/cp/
> * parser.c (cp_parser_skip_to_end_of_statement): Handle parentheses.
> (cp_parser_skip_to_end_of_block_or_statement): Likewise.
> (cp_parser_omp_context_selector): Add extra argument. Allow
> non-constant expressions.
> (cp_parser_omp_context_selector_specification): Add extra argument and
> propagate to cp_parser_omp_context_selector.
> (analyze_metadirective_body): New.
> (cp_parser_omp_metadirective): New.
> (cp_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.
> (cp_parser_pragma): Handle PRAGMA_OMP_METADIRECTIVE.
> ---
> gcc/cp/parser.c | 425 +++++++++++++++++++++++++++++++++++++++++++++++-
> 1 file changed, 417 insertions(+), 8 deletions(-)
>
> diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
> index 6f273bfe21f..afbfe148949 100644
> --- a/gcc/cp/parser.c
> +++ b/gcc/cp/parser.c
> @@ -3907,6 +3907,17 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
> ++nesting_depth;
> break;
>
> + case CPP_OPEN_PAREN:
> + /* Track parentheses in case the statement is a standalone 'for'
> + statement - we want to skip over the semicolons separating the
> + operands. */
> + ++nesting_depth;
> + break;
> +
> + case CPP_CLOSE_PAREN:
> + --nesting_depth;
> + break;
> +
> case CPP_KEYWORD:
> if (token->keyword != RID__EXPORT
> && token->keyword != RID__MODULE
> @@ -3996,6 +4007,17 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
> nesting_depth++;
> break;
>
> + case CPP_OPEN_PAREN:
> + /* Track parentheses in case the statement is a standalone 'for'
> + statement - we want to skip over the semicolons separating the
> + operands. */
> + nesting_depth++;
> + break;
> +
> + case CPP_CLOSE_PAREN:
> + nesting_depth--;
> + break;
> +
Like for C FE, I think this is too risky.
> case CTX_PROPERTY_EXPR:
> - t = cp_parser_constant_expression (parser);
> + /* Allow non-constant expressions in metadirectives. */
> + t = metadirective_p
> + ? cp_parser_expression (parser)
> + : cp_parser_constant_expression (parser);
> if (t != error_mark_node)
> {
> t = fold_non_dependent_expr (t);
> - if (!value_dependent_expression_p (t)
> - && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> - || !tree_fits_shwi_p (t)))
> + if (metadirective_p && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
Like in the other patch, but more importantly, if t is
type_dependent_expression_p, you shouldn't diagnose it, it might be
integral after instantiation. But it needs to be diagnosed later during
instantiation if it isn't integral then...
> + cp_token *token = cp_lexer_peek_token (parser->lexer);
> + bool stop = false;
> +
> + if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CASE))
> + in_case = true;
> + else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_LABEL))
> + in_label_decl = true;
> +
> + switch (token->type)
> + {
> + case CPP_EOF:
> + break;
> + case CPP_NAME:
> + if ((!in_case
> + && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
> + || in_label_decl)
> + labels.safe_push (token->u.value);
Similar thing as for C, identifier : can appear in various spots even when
it isn't a label, in C++ even in many more cases. Say
nested struct definition, struct S : T {}; or (that is for both C and C++)
e.g. bitfields struct V { int v : 13; };
> + goto add;
> + case CPP_OPEN_BRACE:
> + ++nesting_depth;
> + goto add;
> + case CPP_CLOSE_BRACE:
> + if (--nesting_depth == 0)
> + stop = true;
> + goto add;
> + case CPP_OPEN_PAREN:
> + ++bracket_depth;
> + goto add;
> + case CPP_CLOSE_PAREN:
> + --bracket_depth;
> + goto add;
> + case CPP_COLON:
> + in_case = false;
> + goto add;
> + case CPP_SEMICOLON:
> + if (nesting_depth == 0 && bracket_depth == 0)
> + stop = true;
> + /* Local label declarations are terminated by a semicolon. */
> + in_label_decl = false;
> + goto add;
> + default:
> + add:
> + tokens.safe_push (*token);
> + cp_lexer_consume_token (parser->lexer);
> + if (stop)
> + break;
> + continue;
> + }
> + break;
> + }
> +}
> +
> +/* OpenMP 5.0:
> +
> + # pragma omp metadirective [clause[, clause]]
> +*/
> +
> +static tree
> +cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
> + char *p_name, omp_clause_mask, tree *,
> + bool *if_p)
> +{
> + tree ret;
> + auto_vec<cp_token> directive_tokens;
> + auto_vec<cp_token> body_tokens;
> + auto_vec<tree> body_labels;
> + auto_vec<const struct c_omp_directive *> directives;
> + auto_vec<tree> ctxs;
> + bool default_seen = false;
> + int directive_token_idx = 0;
> + location_t loc = cp_lexer_peek_token (parser->lexer)->location;
> + tree standalone_body = NULL_TREE;
> + vec<struct omp_metadirective_variant> candidates;
> +
> + ret = make_node (OMP_METADIRECTIVE);
Better write tree ret = make_node ...
i.e. at least where easily possible declare vars on first use rather than
at the start of function.
Also, same comments I wrote in the C FE patch.
> + SET_EXPR_LOCATION (ret, loc);
> + TREE_TYPE (ret) = void_type_node;
> + OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
> + strcat (p_name, " metadirective");
> +
> + while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
> + {
> + if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME)
> + && cp_lexer_next_token_is_not (parser->lexer, CPP_KEYWORD))
> + {
> + cp_parser_error (parser, "expected %<when%> or %<default%>");
> + goto fail;
> + }
> +
> + location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
> + const char *p
> + = IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
> + cp_lexer_consume_token (parser->lexer);
> + bool default_p = strcmp (p, "default") == 0;
> + if (default_p)
> + {
> + if (default_seen)
> + {
> + cp_parser_error (parser, "there can only be one default clause "
> + "in a metadirective");
> + goto fail;
> + }
> + else
> + default_seen = true;
> + }
> + if (!strcmp (p, "when") == 0 && !default_p)
> + {
> + cp_parser_error (parser, "expected %<when%> or %<default%>");
> + goto fail;
> + }
> +
> + matching_parens parens;
> + tree ctx = NULL_TREE;
> + bool skip = false;
> +
> + if (!parens.require_open (parser))
> + goto fail;
> +
> + if (!default_p)
> + {
> + ctx = cp_parser_omp_context_selector_specification (parser, false,
> + true);
> + if (ctx == error_mark_node)
> + goto fail;
> + ctx = omp_check_context_selector (match_loc, ctx);
> + if (ctx == error_mark_node)
> + goto fail;
> +
> + /* Remove the selector from further consideration if can be
> + evaluated as a non-match at this point. */
> + skip = (omp_context_selector_matches (ctx, true) == 0);
> +
> + if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
> + {
> + cp_parser_error (parser, "expected colon");
> + goto fail;
> + }
> + cp_lexer_consume_token (parser->lexer);
> + }
> +
> + /* Read in the directive type and create a dummy pragma token for
> + it. */
> + location_t loc = cp_lexer_peek_token (parser->lexer)->location;
> +
> + p = NULL;
> + if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_PAREN))
> + p = "nothing";
> + else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
> + {
> + p = "for";
> + cp_lexer_consume_token (parser->lexer);
> + }
> + else if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
> + {
> + cp_token *token = cp_lexer_consume_token (parser->lexer);
> + p = IDENTIFIER_POINTER (token->u.value);
> + }
> +
> + if (p == NULL)
> + {
> + cp_parser_error (parser, "expected directive name");
> + goto fail;
> + }
> +
> + const struct c_omp_directive *omp_directive
> + = c_omp_categorize_directive (p, NULL, NULL);
> +
> + if (omp_directive == NULL)
> + {
> + cp_parser_error (parser, "unknown directive name");
> + goto fail;
> + }
> + if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
> + {
> + cp_parser_error (parser,
> + "metadirectives cannot be used as directive "
> + "variants");
> + goto fail;
> + }
> + if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
> + {
> + sorry_at (loc, "declarative directive variants are not supported");
> + goto fail;
> + }
> +
> + if (!skip)
> + {
> + cp_token pragma_token;
> + pragma_token.type = CPP_PRAGMA;
> + pragma_token.location = loc;
> + pragma_token.u.value = build_int_cst (NULL, omp_directive->id);
> +
> + directives.safe_push (omp_directive);
> + directive_tokens.safe_push (pragma_token);
> + ctxs.safe_push (ctx);
> + }
> +
> + /* Read in tokens for the directive clauses. */
> + int nesting_depth = 0;
> + while (1)
> + {
> + cp_token *token = cp_lexer_peek_token (parser->lexer);
> + switch (token->type)
> + {
> + case CPP_EOF:
> + case CPP_PRAGMA_EOL:
> + break;
> + case CPP_OPEN_PAREN:
> + ++nesting_depth;
> + goto add;
> + case CPP_CLOSE_PAREN:
> + if (nesting_depth-- == 0)
> + break;
> + goto add;
> + default:
> + add:
> + if (!skip)
> + directive_tokens.safe_push (*token);
> + cp_lexer_consume_token (parser->lexer);
> + continue;
> + }
> + break;
> + }
> +
> + cp_lexer_consume_token (parser->lexer);
> +
> + if (!skip)
> + {
> + cp_token eol_token = {};
> + eol_token.type = CPP_PRAGMA_EOL;
> + eol_token.keyword = RID_MAX;
> + directive_tokens.safe_push (eol_token);
> + }
> + }
> + cp_parser_skip_to_pragma_eol (parser, pragma_tok);
> +
> + if (!default_seen)
> + {
> + /* Add a default clause that evaluates to 'omp nothing'. */
> + const struct c_omp_directive *omp_directive
> + = c_omp_categorize_directive ("nothing", NULL, NULL);
> +
> + cp_token pragma_token = {};
> + pragma_token.type = CPP_PRAGMA;
> + pragma_token.keyword = RID_MAX;
> + pragma_token.location = UNKNOWN_LOCATION;
> + pragma_token.u.value = build_int_cst (NULL, PRAGMA_OMP_NOTHING);
> +
> + directives.safe_push (omp_directive);
> + directive_tokens.safe_push (pragma_token);
> + ctxs.safe_push (NULL_TREE);
> +
> + cp_token eol_token = {};
> + eol_token.type = CPP_PRAGMA_EOL;
> + eol_token.keyword = RID_MAX;
> + directive_tokens.safe_push (eol_token);
> + }
> +
> + analyze_metadirective_body (parser, body_tokens, body_labels);
> +
> + /* Process each candidate directive. */
> + unsigned i;
> + tree ctx;
> + cp_lexer *lexer;
> +
> + lexer = cp_lexer_alloc ();
> + lexer->debugging_p = parser->lexer->debugging_p;
> + vec_safe_reserve (lexer->buffer,
> + directive_tokens.length () + body_tokens.length () + 2);
> +
> + FOR_EACH_VEC_ELT (ctxs, i, ctx)
> + {
> + lexer->buffer->truncate (0);
> +
> + /* Add the directive tokens. */
> + do
> + lexer->buffer->quick_push (directive_tokens [directive_token_idx++]);
> + while (lexer->buffer->last ().type != CPP_PRAGMA_EOL);
> +
> + /* Add the body tokens. */
> + for (unsigned j = 0; j < body_tokens.length (); j++)
> + lexer->buffer->quick_push (body_tokens[j]);
> +
> + /* Make sure nothing tries to read past the end of the tokens. */
> + cp_token eof_token = {};
> + eof_token.type = CPP_EOF;
> + eof_token.keyword = RID_MAX;
> + lexer->buffer->quick_push (eof_token);
> + lexer->buffer->quick_push (eof_token);
> +
> + lexer->next_token = lexer->buffer->address();
> + lexer->last_token = lexer->next_token + lexer->buffer->length () - 1;
> +
> + cp_lexer *old_lexer = parser->lexer;
> + parser->lexer = lexer;
> + cp_lexer_set_source_position_from_token (lexer->next_token);
> +
> + tree directive = push_stmt_list ();
> + tree directive_stmt = begin_compound_stmt (0);
> +
> + /* Declare all labels that occur within the directive body as
> + local. */
> + for (unsigned j = 0; j < body_labels.length (); j++)
> + finish_label_decl (body_labels[j]);
> + cp_parser_pragma (parser, pragma_compound, if_p);
> +
> + finish_compound_stmt (directive_stmt);
> + directive = pop_stmt_list (directive);
> +
> + bool standalone_p
> + = directives[i]->kind == C_OMP_DIR_STANDALONE
> + || directives[i]->kind == C_OMP_DIR_UTILITY;
> + if (standalone_p)
> + {
> + /* Parsing standalone directives will not consume the body
> + tokens, so do that here. */
> + if (standalone_body == NULL_TREE)
> + {
> + standalone_body = push_stmt_list ();
> + cp_parser_statement (parser, NULL_TREE, false, if_p);
> + standalone_body = pop_stmt_list (standalone_body);
> + }
> + else
> + cp_parser_skip_to_end_of_block_or_statement (parser);
> + }
> +
> + tree body = standalone_p ? standalone_body : NULL_TREE;
> + tree variant = build_tree_list (ctx, build_tree_list (directive, body));
> + OMP_METADIRECTIVE_CLAUSES (ret)
> + = chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
> +
> + /* Check that all valid tokens have been consumed. */
> + gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
> +
> + parser->lexer = old_lexer;
> + cp_lexer_set_source_position_from_token (old_lexer->next_token);
> + }
> +
> + /* Try to resolve the metadirective early. */
> + candidates = omp_resolve_metadirective (ret);
> + if (!candidates.is_empty ())
> + ret = c_omp_expand_metadirective (candidates);
> +
> + add_stmt (ret);
> +
> + return ret;
> +
> +fail:
> + /* Skip the metadirective pragma. */
> + cp_parser_skip_to_pragma_eol (parser, pragma_tok);
> +
> + /* Skip the metadirective body. */
> + cp_parser_skip_to_end_of_block_or_statement (parser);
> + return error_mark_node;
> +}
> +
> +
> /* Helper function of cp_parser_omp_declare_reduction. Parse the combiner
> expression and optional initializer clause of
> #pragma omp declare reduction. We store the expression(s) as
> @@ -47077,6 +47480,11 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
> stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
> if_p);
> break;
> + case PRAGMA_OMP_METADIRECTIVE:
> + strcpy (p_name, "#pragma omp");
> + stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
> + NULL, if_p);
> + break;
> case PRAGMA_OMP_PARALLEL:
> strcpy (p_name, "#pragma omp");
> stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
> @@ -47727,6 +48135,7 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
> case PRAGMA_OMP_LOOP:
> case PRAGMA_OMP_MASKED:
> case PRAGMA_OMP_MASTER:
> + case PRAGMA_OMP_METADIRECTIVE:
> case PRAGMA_OMP_PARALLEL:
> case PRAGMA_OMP_SCOPE:
> case PRAGMA_OMP_SECTIONS:
> --
I miss handling of OMP_METADIRECTIVE in pt.c and testsuite coverage
of metadirectives in templates (both function templates and class templates
in whose methods metadirectives are used).
And something I forgot to note in the C FE patch, there is the
"The context selector that appears in a when clause must not specify any properties
for the simd selector."
restriction I haven't seen being checked for (and tested in the testsuite).
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
` (4 preceding siblings ...)
2021-12-10 17:37 ` [PATCH 5/7] openmp: Add C++ support for parsing metadirectives Kwok Cheung Yeung
@ 2021-12-10 17:39 ` Kwok Cheung Yeung
2022-02-14 15:09 ` Kwok Cheung Yeung
2022-02-14 15:17 ` Kwok Cheung Yeung
2021-12-10 17:40 ` [PATCH 7/7] openmp: Add testcases for metadirectives Kwok Cheung Yeung
2022-01-24 21:28 ` [PATCH] openmp: Metadirective patch fixes Kwok Cheung Yeung
7 siblings, 2 replies; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:39 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek, Tobias Burnus
[-- Attachment #1: Type: text/plain, Size: 1250 bytes --]
This patch implements metadirective parsing in the Fortran frontend.
The code previously used to process context selectors in 'declare
variant' is refactored so that it can be reused in metadirectives. The
big case lists in parse_executable are moved into macros, since
parse_omp_metadirective_body needs to know how to act depending on the
type of directive variant. The selection of end statements in
parse_omp_do and parse_omp_structured_block are also delegated to
gfc_omp_end_stmt.
Labels in directive variant bodies are handled by assigning a unique
number to each statement body parsed in a metadirective, and adding this
number as a field to gfc_st_label, such that labels with identical
numbers but different region ids are considered different.
I have also reverted my previous changes to the TREE_STRING_LENGTH check
in omp_check_context_selector and omp_context_name_list_prop. This is
because in the accel compiler, lang_GNU_Fortran returns 0 even when the
code is in Fortran, resulting in the selector failing to match. Instead,
I opted to increment the TREE_STRING_LENGTH when it is created in
gfc_trans_omp_set_selector - this should be safe as it is an internal
implementation detail not visible to end users.
Kwok
[-- Attachment #2: 0006-openmp-fortran-Add-Fortran-support-for-parsing-metad.patch --]
[-- Type: text/plain, Size: 55661 bytes --]
From eed8a06fca397edd5fb451f08c8b1a6f7d67951a Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:59:36 +0000
Subject: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing
metadirectives
This adds support for parsing OpenMP metadirectives in the Fortran front end.
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* omp-general.c (omp_check_context_selector): Revert string length
check.
(omp_context_name_list_prop): Likewise.
gcc/fortran/
* decl.c (gfc_match_end): Handle COMP_OMP_METADIRECTIVE and
COMP_OMP_BEGIN_METADIRECTIVE.
* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_METADIRECTIVE.
(show_code_node): Handle EXEC_OMP_METADIRECTIVE.
* gfortran.h (enum gfc_statement): Add ST_OMP_METADIRECTIVE,
ST_OMP_BEGIN_METADIRECTIVE and ST_OMP_END_METADIRECTIVE.
(struct gfc_omp_metadirective_clause): New structure.
(gfc_get_omp_metadirective_clause): New macro.
(struct gfc_st_label): Add omp_region field.
(enum gfc_exec_op): Add EXEC_OMP_METADIRECTIVE.
(struct gfc_code): Add omp_metadirective_clauses field.
(gfc_free_omp_metadirective_clauses): New prototype.
(match_omp_directive): New prototype.
* io.c (format_asterisk): Initialize omp_region field.
* match.h (gfc_match_omp_begin_metadirective): New prototype.
(gfc_match_omp_metadirective): New prototype.
* openmp.c (gfc_match_omp_eos): Match ')' in context selectors.
(gfc_free_omp_metadirective_clauses): New.
(gfc_match_omp_clauses): Remove context_selector argument. Rely on
gfc_match_omp_eos to match end of clauses.
(match_omp): Remove extra argument to gfc_match_omp_clauses.
(gfc_match_omp_context_selector): Remove extra argument to
gfc_match_omp_clauses. Set gfc_matching_omp_context_selector
before call to gfc_match_omp_clauses and reset after.
(gfc_match_omp_context_selector_specification): Modify to take a
gfc_omp_set_selector** argument.
(gfc_match_omp_declare_variant): Pass set_selectors to
gfc_match_omp_context_selector_specification.
(match_omp_metadirective): New.
(gfc_match_omp_begin_metadirective): New.
(gfc_match_omp_metadirective): New.
(resolve_omp_metadirective): New.
(gfc_resolve_omp_directive): Handle EXEC_OMP_METADIRECTIVE.
* parse.c (gfc_matching_omp_context_selector): New variable.
(gfc_in_metadirective_body): New variable.
(gfc_omp_region_count): New variable.
(decode_omp_directive): Match 'begin metadirective',
'end metadirective' and 'metadirective'.
(match_omp_directive): New.
(case_omp_structured_block): New.
(case_omp_do): New.
(gfc_ascii_statement): Handle metadirective statements.
(gfc_omp_end_stmt): New.
(parse_omp_do): Delegate to gfc_omp_end_stmt.
(parse_omp_structured_block): Delegate to gfc_omp_end_stmt. Handle
ST_OMP_END_METADIRECTIVE.
(parse_omp_metadirective_body): New.
(parse_executable): Delegate to case_omp_structured_block and
case_omp_do. Return after one statement if compiling regular
metadirective. Handle metadirective statements.
(gfc_parse_file): Reset gfc_omp_region_count,
gfc_in_metadirective_body and gfc_matching_omp_context_selector.
* parse.h (enum gfc_compile_state): Add COMP_OMP_METADIRECTIVE and
COMP_OMP_BEGIN_METADIRECTIVE.
(gfc_omp_end_stmt): New prototype.
(gfc_matching_omp_context_selector): New declaration.
(gfc_in_metadirective_body): New declaration.
(gfc_omp_region_count): New declaration.
* resolve.c (gfc_resolve_code): Handle EXEC_OMP_METADIRECTIVE.
* st.c (gfc_free_statement): Handle EXEC_OMP_METADIRECTIVE.
* symbol.c (compare_st_labels): Take omp_region into account.
(gfc_get_st_labels): Incorporate omp_region into label.
* trans-decl.c (gfc_get_label_decl): Add omp_region into translated
label name.
* trans-openmp.c (gfc_trans_omp_directive): Handle
EXEC_OMP_METADIRECTIVE.
(gfc_trans_omp_set_selector): Hoist code from...
(gfc_trans_omp_declare_variant): ...here.
(gfc_trans_omp_metadirective): New.
* trans-stmt.h (gfc_trans_omp_metadirective): New prototype.
* trans.c (trans_code): Handle EXEC_OMP_METADIRECTIVE.
---
gcc/fortran/decl.c | 8 +
gcc/fortran/dump-parse-tree.c | 20 ++
gcc/fortran/gfortran.h | 17 ++
gcc/fortran/io.c | 2 +-
gcc/fortran/match.h | 2 +
gcc/fortran/openmp.c | 222 ++++++++++++--
gcc/fortran/parse.c | 532 ++++++++++++++++++++--------------
gcc/fortran/parse.h | 8 +-
gcc/fortran/resolve.c | 12 +
gcc/fortran/st.c | 4 +
gcc/fortran/symbol.c | 18 +-
gcc/fortran/trans-decl.c | 5 +-
gcc/fortran/trans-openmp.c | 190 +++++++-----
gcc/fortran/trans-stmt.h | 1 +
gcc/fortran/trans.c | 1 +
gcc/omp-general.c | 5 +-
16 files changed, 729 insertions(+), 318 deletions(-)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 4971638f9b6..d50c3ea2277 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8323,6 +8323,8 @@ gfc_match_end (gfc_statement *st)
case COMP_CONTAINS:
case COMP_DERIVED_CONTAINS:
+ case COMP_OMP_METADIRECTIVE:
+ case COMP_OMP_BEGIN_METADIRECTIVE:
state = gfc_state_stack->previous->state;
block_name = gfc_state_stack->previous->sym == NULL
? NULL : gfc_state_stack->previous->sym->name;
@@ -8475,6 +8477,12 @@ gfc_match_end (gfc_statement *st)
gfc_free_enum_history ();
break;
+ case COMP_OMP_BEGIN_METADIRECTIVE:
+ *st = ST_OMP_END_METADIRECTIVE;
+ target = " metadirective";
+ eos_ok = 0;
+ break;
+
default:
gfc_error ("Unexpected END statement at %C");
goto cleanup;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 2aa44ff864c..4ec64ad5ea3 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -2015,6 +2015,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_MASTER: name = "MASTER"; break;
case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break;
case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "MASTER TASKLOOP SIMD"; break;
+ case EXEC_OMP_METADIRECTIVE: name = "METADIRECTIVE"; break;
case EXEC_OMP_ORDERED: name = "ORDERED"; break;
case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
@@ -2209,6 +2210,24 @@ show_omp_node (int level, gfc_code *c)
d = d->block;
}
}
+ else if (c->op == EXEC_OMP_METADIRECTIVE)
+ {
+ gfc_omp_metadirective_clause *clause = c->ext.omp_metadirective_clauses;
+
+ while (clause)
+ {
+ code_indent (level + 1, 0);
+ if (clause->selectors)
+ fputs ("WHEN ()\n", dumpfile);
+ else
+ fputs ("DEFAULT ()\n", dumpfile);
+ /* TODO: Print selector. */
+ show_code (level + 2, clause->code);
+ if (clause->next)
+ fputs ("\n", dumpfile);
+ clause = clause->next;
+ }
+ }
else
show_code (level + 1, c->block->next);
if (c->op == EXEC_OMP_ATOMIC)
@@ -3335,6 +3354,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e5d2dd7971e..5025df1bda2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,7 @@ enum gfc_statement
ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
+ ST_OMP_METADIRECTIVE, ST_OMP_BEGIN_METADIRECTIVE, ST_OMP_END_METADIRECTIVE,
ST_OMP_ERROR, ST_NONE
};
@@ -1658,6 +1659,17 @@ typedef struct gfc_omp_declare_variant
gfc_omp_declare_variant;
#define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
+typedef struct gfc_omp_metadirective_clause
+{
+ struct gfc_omp_metadirective_clause *next;
+ locus where; /* Where the metadirective clause occurred. */
+
+ gfc_omp_set_selector *selectors;
+ enum gfc_statement stmt;
+ struct gfc_code *code;
+
+} gfc_omp_metadirective_clause;
+#define gfc_get_omp_metadirective_clause() XCNEW (gfc_omp_metadirective_clause)
typedef struct gfc_omp_udr
{
@@ -1706,6 +1718,7 @@ typedef struct gfc_st_label
locus where;
gfc_namespace *ns;
+ int omp_region;
}
gfc_st_label;
@@ -2922,6 +2935,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
+ EXEC_OMP_METADIRECTIVE,
EXEC_OMP_ERROR
};
@@ -2978,6 +2992,7 @@ typedef struct gfc_code
gfc_omp_clauses *omp_clauses;
const char *omp_name;
gfc_omp_namelist *omp_namelist;
+ gfc_omp_metadirective_clause *omp_metadirective_clauses;
bool omp_bool;
}
ext; /* Points to additional structures required by statement */
@@ -3552,6 +3567,7 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
+void gfc_free_omp_metadirective_clauses (gfc_omp_metadirective_clause *);
gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
@@ -3827,6 +3843,7 @@ void debug (gfc_expr *);
bool gfc_parse_file (void);
void gfc_global_used (gfc_gsymbol *, locus *);
gfc_namespace* gfc_build_block_ns (gfc_namespace *);
+gfc_statement match_omp_directive (void);
/* dependency.c */
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index fc97df79eca..adb811a423c 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -29,7 +29,7 @@ along with GCC; see the file COPYING3. If not see
gfc_st_label
format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
- 0, {NULL, NULL}, NULL};
+ 0, {NULL, NULL}, NULL, 0};
typedef struct
{
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index e9368db281d..cf0f711f4ec 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -151,6 +151,7 @@ match gfc_match_oacc_routine (void);
match gfc_match_omp_eos_error (void);
match gfc_match_omp_atomic (void);
match gfc_match_omp_barrier (void);
+match gfc_match_omp_begin_metadirective (void);
match gfc_match_omp_cancel (void);
match gfc_match_omp_cancellation_point (void);
match gfc_match_omp_critical (void);
@@ -174,6 +175,7 @@ match gfc_match_omp_masked_taskloop_simd (void);
match gfc_match_omp_master (void);
match gfc_match_omp_master_taskloop (void);
match gfc_match_omp_master_taskloop_simd (void);
+match gfc_match_omp_metadirective (void);
match gfc_match_omp_nothing (void);
match gfc_match_omp_ordered (void);
match gfc_match_omp_ordered_depend (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 846fd7b5c5a..1a423c8e041 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -31,7 +31,8 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h" /* For gfc_encode_character. */
/* Match an end of OpenMP directive. End of OpenMP directive is optional
- whitespace, followed by '\n' or comment '!'. */
+ whitespace, followed by '\n' or comment '!'. In the special case where a
+ context selector is being matched, match against ')' instead. */
static match
gfc_match_omp_eos (void)
@@ -42,17 +43,25 @@ gfc_match_omp_eos (void)
old_loc = gfc_current_locus;
gfc_gobble_whitespace ();
- c = gfc_next_ascii_char ();
- switch (c)
+ if (gfc_matching_omp_context_selector)
{
- case '!':
- do
- c = gfc_next_ascii_char ();
- while (c != '\n');
- /* Fall through */
+ if (gfc_peek_ascii_char () == ')')
+ return MATCH_YES;
+ }
+ else
+ {
+ c = gfc_next_ascii_char ();
+ switch (c)
+ {
+ case '!':
+ do
+ c = gfc_next_ascii_char ();
+ while (c != '\n');
+ /* Fall through */
- case '\n':
- return MATCH_YES;
+ case '\n':
+ return MATCH_YES;
+ }
}
gfc_current_locus = old_loc;
@@ -248,6 +257,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr)
}
}
+/* Free clauses of an !$omp metadirective construct. */
+
+void
+gfc_free_omp_metadirective_clauses (gfc_omp_metadirective_clause *clause)
+{
+ while (clause)
+ {
+ gfc_omp_metadirective_clause *next_clause = clause->next;
+ gfc_free_omp_set_selector_list (clause->selectors);
+ free (clause);
+ clause = next_clause;
+ }
+}
static gfc_omp_udr *
gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
@@ -1434,8 +1456,7 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
static match
gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
bool first = true, bool needs_space = true,
- bool openacc = false, bool context_selector = false,
- bool openmp_target = false)
+ bool openacc = false, bool openmp_target = false)
{
bool error = false;
gfc_omp_clauses *c = gfc_get_omp_clauses ();
@@ -2982,9 +3003,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
end:
- if (error
- || (context_selector && gfc_peek_ascii_char () != ')')
- || (!context_selector && gfc_match_omp_eos () != MATCH_YES))
+ if (error || gfc_match_omp_eos () != MATCH_YES)
{
if (!gfc_error_flag_test ())
gfc_error ("Failed to match clause at %C");
@@ -3655,7 +3674,7 @@ static match
match_omp (gfc_exec_op op, const omp_mask mask)
{
gfc_omp_clauses *c;
- if (gfc_match_omp_clauses (&c, mask, true, true, false, false,
+ if (gfc_match_omp_clauses (&c, mask, true, true, false,
op == EXEC_OMP_TARGET) != MATCH_YES)
return MATCH_ERROR;
new_st.op = op;
@@ -4804,14 +4823,17 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
break;
case CTX_PROPERTY_SIMD:
{
+ gfc_matching_omp_context_selector = true;
if (gfc_match_omp_clauses (&otp->clauses,
OMP_DECLARE_SIMD_CLAUSES,
- true, false, false, true)
+ true, false, false)
!= MATCH_YES)
{
- gfc_error ("expected simd clause at %C");
+ gfc_matching_omp_context_selector = false;
+ gfc_error ("expected simd clause at %C");
return MATCH_ERROR;
}
+ gfc_matching_omp_context_selector = false;
break;
}
default:
@@ -4857,7 +4879,7 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
user */
match
-gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
+gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head)
{
do
{
@@ -4897,9 +4919,9 @@ gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
}
gfc_omp_set_selector *oss = gfc_get_omp_set_selector ();
- oss->next = odv->set_selectors;
+ oss->next = *oss_head;
oss->trait_set_selector_name = selector_sets[i];
- odv->set_selectors = oss;
+ *oss_head = oss;
if (gfc_match_omp_context_selector (oss) != MATCH_YES)
return MATCH_ERROR;
@@ -5000,7 +5022,8 @@ gfc_match_omp_declare_variant (void)
return MATCH_ERROR;
}
- if (gfc_match_omp_context_selector_specification (odv) != MATCH_YES)
+ if (gfc_match_omp_context_selector_specification (&odv->set_selectors)
+ != MATCH_YES)
return MATCH_ERROR;
if (gfc_match (" )") != MATCH_YES)
@@ -5016,6 +5039,145 @@ gfc_match_omp_declare_variant (void)
}
+static match
+match_omp_metadirective (bool begin_p)
+{
+ locus old_loc = gfc_current_locus;
+ gfc_omp_metadirective_clause *clause_head;
+ gfc_omp_metadirective_clause **next_clause = &clause_head;
+ bool default_seen = false;
+
+ /* Parse the context selectors. */
+ for (;;)
+ {
+ bool default_p = false;
+ gfc_omp_set_selector *selectors = NULL;
+
+ if (gfc_match (" default ( ") == MATCH_YES)
+ default_p = true;
+ else if (gfc_match_eos () == MATCH_YES)
+ break;
+ else if (gfc_match (" when ( ") != MATCH_YES)
+ {
+ gfc_error ("expected 'default' or 'when' at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (default_p && default_seen)
+ {
+ gfc_error ("there can only be one default clause in a "
+ "metadirective at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (!default_p)
+ {
+ if (gfc_match_omp_context_selector_specification (&selectors)
+ != MATCH_YES)
+ return MATCH_ERROR;
+
+ if (gfc_match (" : ") != MATCH_YES)
+ {
+ gfc_error ("expected ':' at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ gfc_commit_symbols ();
+ }
+
+ gfc_matching_omp_context_selector = true;
+ gfc_statement directive = match_omp_directive ();
+ gfc_matching_omp_context_selector = false;
+
+ if (gfc_error_flag_test ())
+ {
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (gfc_match (" )") != MATCH_YES)
+ {
+ gfc_error ("Expected ')' at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ gfc_commit_symbols ();
+
+ if (begin_p && directive != ST_NONE
+ && gfc_omp_end_stmt (directive) == ST_NONE)
+ {
+ gfc_error ("variant directive used in OMP BEGIN METADIRECTIVE "
+ "at %C must have a corresponding end directive");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ if (default_p)
+ default_seen = true;
+
+ gfc_omp_metadirective_clause *omc = gfc_get_omp_metadirective_clause ();
+ omc->selectors = selectors;
+ omc->stmt = directive;
+ if (directive == ST_NONE)
+ {
+ /* The directive was a 'nothing' directive. */
+ omc->code = gfc_get_code (EXEC_CONTINUE);
+ omc->code->ext.omp_clauses = NULL;
+ }
+ else
+ {
+ omc->code = gfc_get_code (new_st.op);
+ omc->code->ext.omp_clauses = new_st.ext.omp_clauses;
+ /* Prevent the OpenMP clauses from being freed via NEW_ST. */
+ new_st.ext.omp_clauses = NULL;
+ }
+
+ *next_clause = omc;
+ next_clause = &omc->next;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after OMP METADIRECTIVE at %C");
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+ }
+
+ /* Add a 'default (nothing)' clause if no default is explicitly given. */
+ if (!default_seen)
+ {
+ gfc_omp_metadirective_clause *omc = gfc_get_omp_metadirective_clause ();
+ omc->stmt = ST_NONE;
+ omc->code = gfc_get_code (EXEC_CONTINUE);
+ omc->code->ext.omp_clauses = NULL;
+ omc->selectors = NULL;
+
+ *next_clause = omc;
+ next_clause = &omc->next;
+ }
+
+ new_st.op = EXEC_OMP_METADIRECTIVE;
+ new_st.ext.omp_metadirective_clauses = clause_head;
+
+ return MATCH_YES;
+}
+
+match
+gfc_match_omp_begin_metadirective (void)
+{
+ return match_omp_metadirective (true);
+}
+
+match
+gfc_match_omp_metadirective (void)
+{
+ return match_omp_metadirective (false);
+}
+
match
gfc_match_omp_threadprivate (void)
{
@@ -8486,6 +8648,19 @@ resolve_omp_do (gfc_code *code)
}
}
+static void
+resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
+{
+ gfc_omp_metadirective_clause *clause = code->ext.omp_metadirective_clauses;
+
+ while (clause)
+ {
+ gfc_code *clause_code = clause->code;
+ gfc_resolve_code (clause_code, ns);
+ clause = clause->next;
+ }
+}
+
static gfc_statement
omp_code_to_statement (gfc_code *code)
@@ -9113,6 +9288,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
code->ext.omp_clauses->if_present = false;
resolve_omp_clauses (code, code->ext.omp_clauses, ns);
break;
+ case EXEC_OMP_METADIRECTIVE:
+ resolve_omp_metadirective (code, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1f111091b0a..a96c892c608 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -40,6 +40,10 @@ static jmp_buf eof_buf;
gfc_state_data *gfc_state_stack;
static bool last_was_use_stmt = false;
+bool gfc_matching_omp_context_selector;
+bool gfc_in_metadirective_body;
+int gfc_omp_region_count;
+
/* TODO: Re-order functions to kill these forward decls. */
static void check_statement_label (gfc_statement);
static void undo_new_statement (void);
@@ -889,6 +893,8 @@ decode_omp_directive (void)
break;
case 'b':
matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+ matcho ("begin metadirective", gfc_match_omp_begin_metadirective,
+ ST_OMP_BEGIN_METADIRECTIVE);
break;
case 'c':
matcho ("cancellation% point", gfc_match_omp_cancellation_point,
@@ -936,6 +942,8 @@ decode_omp_directive (void)
matcho ("end master taskloop", gfc_match_omp_eos_error,
ST_OMP_END_MASTER_TASKLOOP);
matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER);
+ matcho ("end metadirective", gfc_match_omp_eos_error,
+ ST_OMP_END_METADIRECTIVE);
matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED);
matchs ("end parallel do simd", gfc_match_omp_eos_error,
ST_OMP_END_PARALLEL_DO_SIMD);
@@ -1018,6 +1026,8 @@ decode_omp_directive (void)
matcho ("master taskloop", gfc_match_omp_master_taskloop,
ST_OMP_MASTER_TASKLOOP);
matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
+ matcho ("metadirective", gfc_match_omp_metadirective,
+ ST_OMP_METADIRECTIVE);
break;
case 'n':
matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
@@ -1146,6 +1156,10 @@ decode_omp_directive (void)
gfc_error_now ("Unclassifiable OpenMP directive at %C");
}
+ /* If parsing a metadirective, let the caller deal with the cleanup. */
+ if (gfc_matching_omp_context_selector)
+ return ST_NONE;
+
reject_statement ();
gfc_error_recovery ();
@@ -1213,6 +1227,12 @@ decode_omp_directive (void)
return ST_GET_FCN_CHARACTERISTICS;
}
+gfc_statement
+match_omp_directive (void)
+{
+ return decode_omp_directive ();
+}
+
static gfc_statement
decode_gcc_attribute (void)
{
@@ -1734,6 +1754,43 @@ next_statement (void)
case ST_OMP_DECLARE_VARIANT: \
case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
+/* OpenMP statements that are followed by a structured block. */
+
+#define case_omp_structured_block case ST_OMP_PARALLEL: \
+ case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: \
+ case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_ORDERED: \
+ case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASTER: \
+ case ST_OMP_SCOPE: case ST_OMP_SECTIONS: case ST_OMP_SINGLE: \
+ case ST_OMP_TARGET: case ST_OMP_TARGET_DATA: case ST_OMP_TARGET_PARALLEL: \
+ case ST_OMP_TARGET_TEAMS: case ST_OMP_TEAMS: case ST_OMP_TASK: \
+ case ST_OMP_TASKGROUP: \
+ case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE
+
+/* OpenMP statements that are followed by a do loop. */
+
+#define case_omp_do case ST_OMP_DISTRIBUTE: \
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_DISTRIBUTE_SIMD: \
+ case ST_OMP_DO: case ST_OMP_DO_SIMD: case ST_OMP_LOOP: \
+ case ST_OMP_PARALLEL_DO: case ST_OMP_PARALLEL_DO_SIMD: \
+ case ST_OMP_PARALLEL_LOOP: case ST_OMP_PARALLEL_MASKED_TASKLOOP: \
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: \
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP: \
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \
+ case ST_OMP_MASKED_TASKLOOP: case ST_OMP_MASKED_TASKLOOP_SIMD: \
+ case ST_OMP_MASTER_TASKLOOP: case ST_OMP_MASTER_TASKLOOP_SIMD: \
+ case ST_OMP_SIMD: \
+ case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \
+ case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_SIMD: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TARGET_TEAMS_LOOP: \
+ case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
+ case ST_OMP_TEAMS_DISTRIBUTE: case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: \
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: \
+ case ST_OMP_TEAMS_DISTRIBUTE_SIMD: case ST_OMP_TEAMS_LOOP
+
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@@ -2357,6 +2414,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_BARRIER:
p = "!$OMP BARRIER";
break;
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ p = "!$OMP BEGIN METADIRECTIVE";
+ break;
case ST_OMP_CANCEL:
p = "!$OMP CANCEL";
break;
@@ -2450,6 +2510,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_END_MASTER_TASKLOOP_SIMD:
p = "!$OMP END MASTER TASKLOOP SIMD";
break;
+ case ST_OMP_END_METADIRECTIVE:
+ p = "!OMP END METADIRECTIVE";
+ break;
case ST_OMP_END_ORDERED:
p = "!$OMP END ORDERED";
break;
@@ -2594,6 +2657,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_MASTER_TASKLOOP_SIMD:
p = "!$OMP MASTER TASKLOOP SIMD";
break;
+ case ST_OMP_METADIRECTIVE:
+ p = "!$OMP METADIRECTIVE";
+ break;
case ST_OMP_ORDERED:
case ST_OMP_ORDERED_DEPEND:
p = "!$OMP ORDERED";
@@ -2848,6 +2914,8 @@ accept_statement (gfc_statement st)
break;
case ST_ENTRY:
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
case_executable:
case_exec_markers:
add_statement ();
@@ -5124,6 +5192,138 @@ loop:
accept_statement (st);
}
+/* Get the corresponding ending statement type for the OpenMP directive
+ OMP_ST. If it does not have one, return ST_NONE. */
+
+gfc_statement
+gfc_omp_end_stmt (gfc_statement omp_st,
+ bool omp_do_p, bool omp_structured_p)
+{
+ if (omp_do_p)
+ {
+ switch (omp_st)
+ {
+ case ST_OMP_DISTRIBUTE: return ST_OMP_END_DISTRIBUTE;
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_DISTRIBUTE_SIMD:
+ return ST_OMP_END_DISTRIBUTE_SIMD;
+ case ST_OMP_DO: return ST_OMP_END_DO;
+ case ST_OMP_DO_SIMD: return ST_OMP_END_DO_SIMD;
+ case ST_OMP_LOOP: return ST_OMP_END_LOOP;
+ case ST_OMP_PARALLEL_DO: return ST_OMP_END_PARALLEL_DO;
+ case ST_OMP_PARALLEL_DO_SIMD:
+ return ST_OMP_END_PARALLEL_DO_SIMD;
+ case ST_OMP_PARALLEL_LOOP:
+ return ST_OMP_END_PARALLEL_LOOP;
+ case ST_OMP_SIMD: return ST_OMP_END_SIMD;
+ case ST_OMP_TARGET_PARALLEL_DO:
+ return ST_OMP_END_TARGET_PARALLEL_DO;
+ case ST_OMP_TARGET_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
+ case ST_OMP_TARGET_PARALLEL_LOOP:
+ return ST_OMP_END_TARGET_PARALLEL_LOOP;
+ case ST_OMP_TARGET_SIMD: return ST_OMP_END_TARGET_SIMD;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+ return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
+ case ST_OMP_TARGET_TEAMS_LOOP:
+ return ST_OMP_END_TARGET_TEAMS_LOOP;
+ case ST_OMP_TASKLOOP: return ST_OMP_END_TASKLOOP;
+ case ST_OMP_TASKLOOP_SIMD: return ST_OMP_END_TASKLOOP_SIMD;
+ case ST_OMP_MASKED_TASKLOOP: return ST_OMP_END_MASKED_TASKLOOP;
+ case ST_OMP_MASKED_TASKLOOP_SIMD:
+ return ST_OMP_END_MASKED_TASKLOOP_SIMD;
+ case ST_OMP_MASTER_TASKLOOP: return ST_OMP_END_MASTER_TASKLOOP;
+ case ST_OMP_MASTER_TASKLOOP_SIMD:
+ return ST_OMP_END_MASTER_TASKLOOP_SIMD;
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+ return ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
+ case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+ return ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+ return ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
+ case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+ return ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
+ case ST_OMP_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TEAMS_DISTRIBUTE;
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
+ case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+ case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
+ return ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
+ case ST_OMP_TEAMS_LOOP:
+ return ST_OMP_END_TEAMS_LOOP;
+ default:
+ break;
+ }
+ }
+
+ if (omp_structured_p)
+ {
+ switch (omp_st)
+ {
+ case ST_OMP_PARALLEL:
+ return ST_OMP_END_PARALLEL;
+ case ST_OMP_PARALLEL_MASKED:
+ return ST_OMP_END_PARALLEL_MASKED;
+ case ST_OMP_PARALLEL_MASTER:
+ return ST_OMP_END_PARALLEL_MASTER;
+ case ST_OMP_PARALLEL_SECTIONS:
+ return ST_OMP_END_PARALLEL_SECTIONS;
+ case ST_OMP_SCOPE:
+ return ST_OMP_END_SCOPE;
+ case ST_OMP_SECTIONS:
+ return ST_OMP_END_SECTIONS;
+ case ST_OMP_ORDERED:
+ return ST_OMP_END_ORDERED;
+ case ST_OMP_CRITICAL:
+ return ST_OMP_END_CRITICAL;
+ case ST_OMP_MASKED:
+ return ST_OMP_END_MASKED;
+ case ST_OMP_MASTER:
+ return ST_OMP_END_MASTER;
+ case ST_OMP_SINGLE:
+ return ST_OMP_END_SINGLE;
+ case ST_OMP_TARGET:
+ return ST_OMP_END_TARGET;
+ case ST_OMP_TARGET_DATA:
+ return ST_OMP_END_TARGET_DATA;
+ case ST_OMP_TARGET_PARALLEL:
+ return ST_OMP_END_TARGET_PARALLEL;
+ case ST_OMP_TARGET_TEAMS:
+ return ST_OMP_END_TARGET_TEAMS;
+ case ST_OMP_TASK:
+ return ST_OMP_END_TASK;
+ case ST_OMP_TASKGROUP:
+ return ST_OMP_END_TASKGROUP;
+ case ST_OMP_TEAMS:
+ return ST_OMP_END_TEAMS;
+ case ST_OMP_TEAMS_DISTRIBUTE:
+ return ST_OMP_END_TEAMS_DISTRIBUTE;
+ case ST_OMP_DISTRIBUTE:
+ return ST_OMP_END_DISTRIBUTE;
+ case ST_OMP_WORKSHARE:
+ return ST_OMP_END_WORKSHARE;
+ case ST_OMP_PARALLEL_WORKSHARE:
+ return ST_OMP_END_PARALLEL_WORKSHARE;
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ return ST_OMP_END_METADIRECTIVE;
+ default:
+ break;
+ }
+ }
+
+ return ST_NONE;
+}
/* Parse the statements of OpenMP do/parallel do. */
@@ -5174,94 +5374,16 @@ parse_omp_do (gfc_statement omp_st)
pop_state ();
st = next_statement ();
- gfc_statement omp_end_st = ST_OMP_END_DO;
- switch (omp_st)
- {
- case ST_OMP_DISTRIBUTE: omp_end_st = ST_OMP_END_DISTRIBUTE; break;
- case ST_OMP_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break;
- case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break;
- case ST_OMP_LOOP: omp_end_st = ST_OMP_END_LOOP; break;
- case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break;
- case ST_OMP_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_PARALLEL_LOOP:
- omp_end_st = ST_OMP_END_PARALLEL_LOOP;
- break;
- case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break;
- case ST_OMP_TARGET_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO;
- break;
- case ST_OMP_TARGET_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TARGET_PARALLEL_LOOP:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL_LOOP;
- break;
- case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_TARGET_TEAMS_LOOP:
- omp_end_st = ST_OMP_END_TARGET_TEAMS_LOOP;
- break;
- case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
- case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
- case ST_OMP_MASKED_TASKLOOP: omp_end_st = ST_OMP_END_MASKED_TASKLOOP; break;
- case ST_OMP_MASKED_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_MASKED_TASKLOOP_SIMD;
- break;
- case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
- case ST_OMP_MASTER_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
- break;
- case ST_OMP_PARALLEL_MASKED_TASKLOOP:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
- break;
- case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
- break;
- case ST_OMP_PARALLEL_MASTER_TASKLOOP:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
- break;
- case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
- break;
- case ST_OMP_TEAMS_LOOP:
- omp_end_st = ST_OMP_END_TEAMS_LOOP;
- break;
- default: gcc_unreachable ();
- }
+ gfc_statement omp_end_st = gfc_omp_end_stmt (omp_st, true, false);
+ if (omp_st == ST_NONE)
+ gcc_unreachable ();
+
+ /* If handling a metadirective variant, treat 'omp end metadirective'
+ as the expected end statement for the current construct. */
+ if (st == ST_OMP_END_METADIRECTIVE
+ && gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ st = omp_end_st;
+
if (st == omp_end_st)
{
if (new_st.op == EXEC_OMP_END_NOWAIT)
@@ -5496,77 +5618,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
np->op = cp->op;
np->block = NULL;
- switch (omp_st)
- {
- case ST_OMP_PARALLEL:
- omp_end_st = ST_OMP_END_PARALLEL;
- break;
- case ST_OMP_PARALLEL_MASKED:
- omp_end_st = ST_OMP_END_PARALLEL_MASKED;
- break;
- case ST_OMP_PARALLEL_MASTER:
- omp_end_st = ST_OMP_END_PARALLEL_MASTER;
- break;
- case ST_OMP_PARALLEL_SECTIONS:
- omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
- break;
- case ST_OMP_SCOPE:
- omp_end_st = ST_OMP_END_SCOPE;
- break;
- case ST_OMP_SECTIONS:
- omp_end_st = ST_OMP_END_SECTIONS;
- break;
- case ST_OMP_ORDERED:
- omp_end_st = ST_OMP_END_ORDERED;
- break;
- case ST_OMP_CRITICAL:
- omp_end_st = ST_OMP_END_CRITICAL;
- break;
- case ST_OMP_MASKED:
- omp_end_st = ST_OMP_END_MASKED;
- break;
- case ST_OMP_MASTER:
- omp_end_st = ST_OMP_END_MASTER;
- break;
- case ST_OMP_SINGLE:
- omp_end_st = ST_OMP_END_SINGLE;
- break;
- case ST_OMP_TARGET:
- omp_end_st = ST_OMP_END_TARGET;
- break;
- case ST_OMP_TARGET_DATA:
- omp_end_st = ST_OMP_END_TARGET_DATA;
- break;
- case ST_OMP_TARGET_PARALLEL:
- omp_end_st = ST_OMP_END_TARGET_PARALLEL;
- break;
- case ST_OMP_TARGET_TEAMS:
- omp_end_st = ST_OMP_END_TARGET_TEAMS;
- break;
- case ST_OMP_TASK:
- omp_end_st = ST_OMP_END_TASK;
- break;
- case ST_OMP_TASKGROUP:
- omp_end_st = ST_OMP_END_TASKGROUP;
- break;
- case ST_OMP_TEAMS:
- omp_end_st = ST_OMP_END_TEAMS;
- break;
- case ST_OMP_TEAMS_DISTRIBUTE:
- omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
- break;
- case ST_OMP_DISTRIBUTE:
- omp_end_st = ST_OMP_END_DISTRIBUTE;
- break;
- case ST_OMP_WORKSHARE:
- omp_end_st = ST_OMP_END_WORKSHARE;
- break;
- case ST_OMP_PARALLEL_WORKSHARE:
- omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
- break;
- default:
- gcc_unreachable ();
- }
+ omp_end_st = gfc_omp_end_stmt (omp_st, false, true);
+ if (omp_st == ST_NONE)
+ gcc_unreachable ();
bool block_construct = false;
gfc_namespace *my_ns = NULL;
@@ -5665,6 +5719,14 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
}
else
st = parse_executable (st);
+
+ /* If handling a metadirective variant, treat 'omp end metadirective'
+ as the expected end statement for the current construct. */
+ if (st == ST_OMP_END_METADIRECTIVE
+ && gfc_state_stack->previous != NULL
+ && gfc_state_stack->previous->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ st = omp_end_st;
+
if (st == ST_NONE)
unexpected_eof ();
else if (st == ST_OMP_SECTION
@@ -5734,6 +5796,70 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
return st;
}
+static gfc_statement
+parse_omp_metadirective_body (gfc_statement omp_st)
+{
+ gfc_omp_metadirective_clause *clause = new_st.ext.omp_metadirective_clauses;
+ locus body_locus = gfc_current_locus;
+
+ accept_statement (omp_st);
+
+ gfc_statement next_st = ST_NONE;
+
+ while (clause)
+ {
+ gfc_current_locus = body_locus;
+ gfc_state_data s;
+ bool workshare_p = clause->stmt == ST_OMP_WORKSHARE
+ || clause->stmt == ST_OMP_PARALLEL_WORKSHARE;
+ enum gfc_compile_state new_state =
+ (omp_st == ST_OMP_METADIRECTIVE)
+ ? COMP_OMP_METADIRECTIVE : COMP_OMP_BEGIN_METADIRECTIVE;
+
+ new_st = *clause->code;
+ push_state (&s, new_state, NULL);
+
+ gfc_statement st;
+ bool old_in_metadirective_body = gfc_in_metadirective_body;
+ gfc_in_metadirective_body = true;
+
+ gfc_omp_region_count++;
+ switch (clause->stmt)
+ {
+ case_omp_structured_block:
+ st = parse_omp_structured_block (clause->stmt, workshare_p);
+ break;
+ case_omp_do:
+ st = parse_omp_do (clause->stmt);
+ /* TODO: Does st == ST_IMPLIED_ENDDO need special handling? */
+ break;
+ default:
+ accept_statement (clause->stmt);
+ st = parse_executable (next_statement ());
+ break;
+ }
+
+ gfc_in_metadirective_body = old_in_metadirective_body;
+
+ *clause->code = *gfc_state_stack->head;
+ pop_state ();
+
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ if (clause->next)
+ gfc_clear_new_st ();
+
+ /* Sanity-check that each clause finishes parsing at the same place. */
+ if (next_st == ST_NONE)
+ next_st = st;
+ else
+ gcc_assert (st == next_st);
+
+ clause = clause->next;
+ }
+
+ return next_st;
+}
/* Accept a series of executable statements. We return the first
statement that doesn't fit to the caller. Any block statements are
@@ -5744,12 +5870,19 @@ static gfc_statement
parse_executable (gfc_statement st)
{
int close_flag;
+ bool one_stmt_p = false;
if (st == ST_NONE)
st = next_statement ();
for (;;)
{
+ /* Only parse one statement for the form of metadirective without
+ an explicit begin..end. */
+ if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE && one_stmt_p)
+ return st;
+ one_stmt_p = true;
+
close_flag = check_do_closure ();
if (close_flag)
switch (st)
@@ -5854,67 +5987,13 @@ parse_executable (gfc_statement st)
parse_oacc_structured_block (st);
break;
- case ST_OMP_PARALLEL:
- case ST_OMP_PARALLEL_MASKED:
- case ST_OMP_PARALLEL_MASTER:
- case ST_OMP_PARALLEL_SECTIONS:
- case ST_OMP_ORDERED:
- case ST_OMP_CRITICAL:
- case ST_OMP_MASKED:
- case ST_OMP_MASTER:
- case ST_OMP_SCOPE:
- case ST_OMP_SECTIONS:
- case ST_OMP_SINGLE:
- case ST_OMP_TARGET:
- case ST_OMP_TARGET_DATA:
- case ST_OMP_TARGET_PARALLEL:
- case ST_OMP_TARGET_TEAMS:
- case ST_OMP_TEAMS:
- case ST_OMP_TASK:
- case ST_OMP_TASKGROUP:
- st = parse_omp_structured_block (st, false);
- continue;
-
- case ST_OMP_WORKSHARE:
- case ST_OMP_PARALLEL_WORKSHARE:
- st = parse_omp_structured_block (st, true);
+ case_omp_structured_block:
+ st = parse_omp_structured_block (st,
+ st == ST_OMP_WORKSHARE
+ || st == ST_OMP_PARALLEL_WORKSHARE);
continue;
- case ST_OMP_DISTRIBUTE:
- case ST_OMP_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_DISTRIBUTE_SIMD:
- case ST_OMP_DO:
- case ST_OMP_DO_SIMD:
- case ST_OMP_LOOP:
- case ST_OMP_PARALLEL_DO:
- case ST_OMP_PARALLEL_DO_SIMD:
- case ST_OMP_PARALLEL_LOOP:
- case ST_OMP_PARALLEL_MASKED_TASKLOOP:
- case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- case ST_OMP_PARALLEL_MASTER_TASKLOOP:
- case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- case ST_OMP_MASKED_TASKLOOP:
- case ST_OMP_MASKED_TASKLOOP_SIMD:
- case ST_OMP_MASTER_TASKLOOP:
- case ST_OMP_MASTER_TASKLOOP_SIMD:
- case ST_OMP_SIMD:
- case ST_OMP_TARGET_PARALLEL_DO:
- case ST_OMP_TARGET_PARALLEL_DO_SIMD:
- case ST_OMP_TARGET_PARALLEL_LOOP:
- case ST_OMP_TARGET_SIMD:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case ST_OMP_TARGET_TEAMS_LOOP:
- case ST_OMP_TASKLOOP:
- case ST_OMP_TASKLOOP_SIMD:
- case ST_OMP_TEAMS_DISTRIBUTE:
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
- case ST_OMP_TEAMS_LOOP:
+ case_omp_do:
st = parse_omp_do (st);
if (st == ST_IMPLIED_ENDDO)
return st;
@@ -5928,6 +6007,19 @@ parse_executable (gfc_statement st)
st = parse_omp_oacc_atomic (true);
continue;
+ case ST_OMP_METADIRECTIVE:
+ case ST_OMP_BEGIN_METADIRECTIVE:
+ st = parse_omp_metadirective_body (st);
+ continue;
+
+ case ST_OMP_END_METADIRECTIVE:
+ if (gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+ {
+ st = next_statement ();
+ return st;
+ }
+ /* FALLTHRU */
+
default:
return st;
}
@@ -6700,6 +6792,10 @@ gfc_parse_file (void)
gfc_statement_label = NULL;
+ gfc_omp_region_count = 0;
+ gfc_in_metadirective_body = false;
+ gfc_matching_omp_context_selector = false;
+
if (setjmp (eof_buf))
return false; /* Come here on unexpected EOF */
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 66b275de89b..43bdd91aa14 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -31,7 +31,8 @@ enum gfc_compile_state
COMP_STRUCTURE, COMP_UNION, COMP_MAP,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
- COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
+ COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK,
+ COMP_OMP_METADIRECTIVE, COMP_OMP_BEGIN_METADIRECTIVE
};
/* Stack element for the current compilation state. These structures
@@ -67,10 +68,15 @@ int gfc_check_do_variable (gfc_symtree *);
bool gfc_find_state (gfc_compile_state);
gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
const char *gfc_ascii_statement (gfc_statement);
+gfc_statement gfc_omp_end_stmt (gfc_statement, bool = true, bool = true);
match gfc_match_enum (void);
match gfc_match_enumerator_def (void);
void gfc_free_enum_history (void);
extern bool gfc_matching_function;
+extern bool gfc_matching_omp_context_selector;
+extern bool gfc_in_metadirective_body;
+extern int gfc_omp_region_count;
+
match gfc_match_prefix (gfc_typespec *);
bool is_oacc (gfc_state_data *);
#endif /* GFC_PARSE_H */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0ed31970f8b..1a07aef6771 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11834,6 +11834,17 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
gfc_resolve_forall (code, ns, forall_save);
forall_flag = 2;
}
+ else if (code->op == EXEC_OMP_METADIRECTIVE)
+ {
+ gfc_omp_metadirective_clause *clause
+ = code->ext.omp_metadirective_clauses;
+
+ while (clause)
+ {
+ gfc_resolve_code (clause->code, ns);
+ clause = clause->next;
+ }
+ }
else if (code->block)
{
omp_workshare_save = -1;
@@ -12322,6 +12333,7 @@ start:
case EXEC_OMP_MASKED:
case EXEC_OMP_MASKED_TASKLOOP:
case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_SCAN:
case EXEC_OMP_SCOPE:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 6bf730c9062..b15a0885e2e 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -296,6 +296,10 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_TASKYIELD:
break;
+ case EXEC_OMP_METADIRECTIVE:
+ gfc_free_omp_metadirective_clauses (p->ext.omp_metadirective_clauses);
+ break;
+
default:
gfc_internal_error ("gfc_free_statement(): Bad statement");
}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ebd99846610..8a56ee31b33 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2624,10 +2624,13 @@ free_components (gfc_component *p)
static int
compare_st_labels (void *a1, void *b1)
{
- int a = ((gfc_st_label *) a1)->value;
- int b = ((gfc_st_label *) b1)->value;
+ gfc_st_label *a = (gfc_st_label *) a1;
+ gfc_st_label *b = (gfc_st_label *) b1;
- return (b - a);
+ int a_value = a->value + 10000 * a->omp_region;
+ int b_value = b->value + 10000 * b->omp_region;
+
+ return (b_value - a_value);
}
@@ -2677,6 +2680,7 @@ gfc_get_st_label (int labelno)
{
gfc_st_label *lp;
gfc_namespace *ns;
+ int omp_region = gfc_in_metadirective_body ? gfc_omp_region_count : 0;
if (gfc_current_state () == COMP_DERIVED)
ns = gfc_current_block ()->f2k_derived;
@@ -2693,10 +2697,13 @@ gfc_get_st_label (int labelno)
lp = ns->st_labels;
while (lp)
{
- if (lp->value == labelno)
+ int a = lp->value + 10000 * lp->omp_region;
+ int b = labelno + 10000 * omp_region;
+
+ if (a == b)
return lp;
- if (lp->value < labelno)
+ if (a < b)
lp = lp->left;
else
lp = lp->right;
@@ -2708,6 +2715,7 @@ gfc_get_st_label (int labelno)
lp->defined = ST_LABEL_UNKNOWN;
lp->referenced = ST_LABEL_UNKNOWN;
lp->ns = ns;
+ lp->omp_region = omp_region;
gfc_insert_bbt (&ns->st_labels, lp, compare_st_labels);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cb7f684d52c..69ea7f02871 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -326,7 +326,10 @@ gfc_get_label_decl (gfc_st_label * lp)
gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE);
/* Build a mangled name for the label. */
- sprintf (label_name, "__label_%.6d", lp->value);
+ if (lp->omp_region)
+ sprintf (label_name, "__label_%d_%.6d", lp->omp_region, lp->value);
+ else
+ sprintf (label_name, "__label_%.6d", lp->value);
/* Build the LABEL_DECL node. */
label_decl = gfc_build_label_decl (get_identifier (label_name));
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d8229a5ac30..3be453a513a 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7207,6 +7207,8 @@ gfc_trans_omp_directive (gfc_code *code)
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
return gfc_trans_omp_master_masked_taskloop (code, code->op);
+ case EXEC_OMP_METADIRECTIVE:
+ return gfc_trans_omp_metadirective (code);
case EXEC_OMP_ORDERED:
return gfc_trans_omp_ordered (code);
case EXEC_OMP_PARALLEL:
@@ -7298,6 +7300,87 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
}
}
+static tree
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+{
+ tree set_selectors = NULL_TREE;
+ gfc_omp_set_selector *oss;
+
+ for (oss = gfc_selectors; oss; oss = oss->next)
+ {
+ tree selectors = NULL_TREE;
+ gfc_omp_selector *os;
+ for (os = oss->trait_selectors; os; os = os->next)
+ {
+ tree properties = NULL_TREE;
+ gfc_omp_trait_property *otp;
+
+ for (otp = os->properties; otp; otp = otp->next)
+ {
+ switch (otp->property_kind)
+ {
+ case CTX_PROPERTY_USER:
+ case CTX_PROPERTY_EXPR:
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, otp->expr);
+ properties = tree_cons (NULL_TREE, se.expr,
+ properties);
+ }
+ break;
+ case CTX_PROPERTY_ID:
+ properties = tree_cons (get_identifier (otp->name),
+ NULL_TREE, properties);
+ break;
+ case CTX_PROPERTY_NAME_LIST:
+ {
+ tree prop = NULL_TREE, value = NULL_TREE;
+ if (otp->is_name)
+ prop = get_identifier (otp->name);
+ else
+ {
+ value = gfc_conv_constant_to_tree (otp->expr);
+
+ /* The string length is expected to include the null
+ terminator in context selectors. This is safe as
+ build_string always null-terminates strings. */
+ ++TREE_STRING_LENGTH (value);
+ }
+
+ properties = tree_cons (prop, value, properties);
+ }
+ break;
+ case CTX_PROPERTY_SIMD:
+ properties = gfc_trans_omp_clauses (NULL, otp->clauses,
+ where, true);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+ }
+
+ if (os->score)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, os->score);
+ properties = tree_cons (get_identifier (" score"),
+ se.expr, properties);
+ }
+
+ selectors = tree_cons (get_identifier (os->trait_selector_name),
+ properties, selectors);
+ }
+
+ set_selectors
+ = tree_cons (get_identifier (oss->trait_set_selector_name),
+ selectors, set_selectors);
+ }
+
+ return set_selectors;
+}
+
void
gfc_trans_omp_declare_variant (gfc_namespace *ns)
{
@@ -7373,73 +7456,8 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
&& strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
continue;
- tree set_selectors = NULL_TREE;
- gfc_omp_set_selector *oss;
-
- for (oss = odv->set_selectors; oss; oss = oss->next)
- {
- tree selectors = NULL_TREE;
- gfc_omp_selector *os;
- for (os = oss->trait_selectors; os; os = os->next)
- {
- tree properties = NULL_TREE;
- gfc_omp_trait_property *otp;
-
- for (otp = os->properties; otp; otp = otp->next)
- {
- switch (otp->property_kind)
- {
- case CTX_PROPERTY_USER:
- case CTX_PROPERTY_EXPR:
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, otp->expr);
- properties = tree_cons (NULL_TREE, se.expr,
- properties);
- }
- break;
- case CTX_PROPERTY_ID:
- properties = tree_cons (get_identifier (otp->name),
- NULL_TREE, properties);
- break;
- case CTX_PROPERTY_NAME_LIST:
- {
- tree prop = NULL_TREE, value = NULL_TREE;
- if (otp->is_name)
- prop = get_identifier (otp->name);
- else
- value = gfc_conv_constant_to_tree (otp->expr);
-
- properties = tree_cons (prop, value, properties);
- }
- break;
- case CTX_PROPERTY_SIMD:
- properties = gfc_trans_omp_clauses (NULL, otp->clauses,
- odv->where, true);
- break;
- default:
- gcc_unreachable ();
- }
- }
-
- if (os->score)
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, os->score);
- properties = tree_cons (get_identifier (" score"),
- se.expr, properties);
- }
-
- selectors = tree_cons (get_identifier (os->trait_selector_name),
- properties, selectors);
- }
-
- set_selectors
- = tree_cons (get_identifier (oss->trait_set_selector_name),
- selectors, set_selectors);
- }
+ tree set_selectors = gfc_trans_omp_set_selector (odv->set_selectors,
+ odv->where);
const char *variant_proc_name = odv->variant_proc_symtree->name;
gfc_symbol *variant_proc_sym = odv->variant_proc_symtree->n.sym;
@@ -7501,3 +7519,41 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
}
}
}
+
+tree
+gfc_trans_omp_metadirective (gfc_code *code)
+{
+ gfc_omp_metadirective_clause *clause = code->ext.omp_metadirective_clauses;
+
+ tree metadirective_tree = make_node (OMP_METADIRECTIVE);
+ SET_EXPR_LOCATION (metadirective_tree, gfc_get_location (&code->loc));
+ TREE_TYPE (metadirective_tree) = void_type_node;
+ OMP_METADIRECTIVE_CLAUSES (metadirective_tree) = NULL_TREE;
+
+ tree tree_body = NULL_TREE;
+
+ while (clause)
+ {
+ tree selectors = gfc_trans_omp_set_selector (clause->selectors,
+ clause->where);
+ gfc_code *next_code = clause->code->next;
+ if (next_code && tree_body == NULL_TREE)
+ tree_body = gfc_trans_code (next_code);
+
+ if (next_code)
+ clause->code->next = NULL;
+ tree directive = gfc_trans_code (clause->code);
+ if (next_code)
+ clause->code->next = next_code;
+
+ tree body = next_code ? tree_body : NULL_TREE;
+ tree variant = build_tree_list (selectors, build_tree_list (directive, body));
+ OMP_METADIRECTIVE_CLAUSES (metadirective_tree)
+ = chainon (OMP_METADIRECTIVE_CLAUSES (metadirective_tree), variant);
+ clause = clause->next;
+ }
+
+ /* TODO: Resolve the metadirective here if possible. */
+
+ return metadirective_tree;
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index e824caf4d08..08355e582c8 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -71,6 +71,7 @@ tree gfc_trans_deallocate (gfc_code *);
tree gfc_trans_omp_directive (gfc_code *);
void gfc_trans_omp_declare_simd (gfc_namespace *);
void gfc_trans_omp_declare_variant (gfc_namespace *);
+tree gfc_trans_omp_metadirective (gfc_code *code);
tree gfc_trans_oacc_directive (gfc_code *);
tree gfc_trans_oacc_declare (gfc_namespace *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index a377d0eeb24..007ee65a169 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2161,6 +2161,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_MASTER:
case EXEC_OMP_MASTER_TASKLOOP:
case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+ case EXEC_OMP_METADIRECTIVE:
case EXEC_OMP_ORDERED:
case EXEC_OMP_PARALLEL:
case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 6340d1600a6..5a8a34573c8 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1198,7 +1198,7 @@ omp_check_context_selector (location_t loc, tree ctx)
const char *str = TREE_STRING_POINTER (TREE_VALUE (t2));
if (!strcmp (str, props[i].props[j])
&& ((size_t) TREE_STRING_LENGTH (TREE_VALUE (t2))
- == strlen (str) + (lang_GNU_Fortran () ? 0 : 1)))
+ == strlen (str) + 1))
break;
}
else if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
@@ -1247,8 +1247,7 @@ omp_context_name_list_prop (tree prop)
else
{
const char *ret = TREE_STRING_POINTER (TREE_VALUE (prop));
- if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop))
- == strlen (ret) + (lang_GNU_Fortran () ? 0 : 1))
+ if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop)) == strlen (ret) + 1)
return ret;
return NULL;
}
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives
2021-12-10 17:39 ` [PATCH 6/7] openmp, fortran: Add Fortran " Kwok Cheung Yeung
@ 2022-02-14 15:09 ` Kwok Cheung Yeung
2022-02-14 15:17 ` Kwok Cheung Yeung
1 sibling, 0 replies; 29+ messages in thread
From: Kwok Cheung Yeung @ 2022-02-14 15:09 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 1881 bytes --]
> This patch implements metadirective parsing in the Fortran frontend.
This patch (to be applied on top of the current set of metadirective
patches) implements a feature that was present in the C and C++
front-ends but not in Fortran - the early culling of metadirective
variants that can be eliminated during parsing because their selectors
are resolvable at parse-time and still do not match. This is more
efficient, and allows code with nested metadirectives like this (which
works on other compilers) to compile:
!$omp metadirective when (implementation={vendor("ibm")}: &
!$omp& target teams distribute)
!$omp metadirective when (implementation={vendor("gnu")}: parallel do)
This would currently fail because when parsing the body of the 'target
teams distribute', the parser sees the metadirective when it is
expecting a loop nest. If the vendor("ibm") is eliminated early though,
it would just evaluate to '!$omp nothing' and the following
metadirective would not be incorrect. This doesn't work for selectors
such as 'arch' that would need to be deferred until later passes though.
As the selector matching code (omp_context_selector_matches in
omp-general.cc) works on Generic trees, I have allowed for a limited
translation from the GFortran AST form to tree form during parsing,
skipping over things like expression translation that must be done later.
I have also fixed another FE issue with nested metadirectives, that
occurs when you have something like:
program P
!$omp metadirective
!$omp metadirective
!$omp metadirective
<do statement>
end program P
When gfc_match_end is called after parsing the do statement, it needs to
drop down multiple levels from the innermost metadirective state to that
of 'program P' in order to find the proper end type, and not just one
level as it currently does.
Thanks
Kwok
[-- Attachment #2: 0001-openmp-Eliminate-non-matching-metadirective-variants.patch --]
[-- Type: text/plain, Size: 7909 bytes --]
From 5a7b109a014422a5b43e43669df1dc0d59e830cf Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 11 Feb 2022 11:20:18 +0000
Subject: [PATCH 1/2] openmp: Eliminate non-matching metadirective variants
early in Fortran front-end
This patch checks during parsing if a metadirective selector is both
resolvable and non-matching - if so, it is removed from further
consideration. This is both more efficient, and avoids spurious
syntax errors caused by considering combinations of selectors that
lead to invalid combinations of OpenMP directives, when that
combination would never arise in the first place.
This exposes another bug - when metadirectives that are not of the
begin-end variety are nested, we might have to drill up through
multiple layers of the state stack to reach the state for the
next statement. This is now fixed.
2022-02-11 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/
* omp-general.cc (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
non-null before derefencing.
gcc/fortran/
* decl.cc (gfc_match_end): Search for first previous state that is not
COMP_OMP_METADIRECTIVE.
* gfortran.h (gfc_skip_omp_metadirective_clause): Add prototype.
* openmp.cc (match_omp_metadirective): Skip clause if
result of gfc_skip_omp_metadirective_clause is true.
* trans-openmp.cc (gfc_trans_omp_set_selector): Add argument and
disable expression conversion if false.
(gfc_skip_omp_metadirective_clause): New.
gcc/testsuite/
* gfortran.dg/gomp/metadirective-8.f90: New.
---
gcc/fortran/decl.cc | 21 +++++++++-
gcc/fortran/gfortran.h | 4 ++
gcc/fortran/openmp.cc | 7 +++-
gcc/fortran/trans-openmp.cc | 38 ++++++++++++++-----
gcc/omp-general.cc | 5 ++-
.../gfortran.dg/gomp/metadirective-8.f90 | 22 +++++++++++
6 files changed, 81 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index e024e360c88..a77ac768175 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -8325,15 +8325,32 @@ gfc_match_end (gfc_statement *st)
case COMP_CONTAINS:
case COMP_DERIVED_CONTAINS:
- case COMP_OMP_METADIRECTIVE:
case COMP_OMP_BEGIN_METADIRECTIVE:
state = gfc_state_stack->previous->state;
block_name = gfc_state_stack->previous->sym == NULL
- ? NULL : gfc_state_stack->previous->sym->name;
+ ? NULL : gfc_state_stack->previous->sym->name;
abreviated_modproc_decl = gfc_state_stack->previous->sym
&& gfc_state_stack->previous->sym->abr_modproc_decl;
break;
+ case COMP_OMP_METADIRECTIVE:
+ {
+ /* Metadirectives can be nested, so we need to drill down to the
+ first state that is not COMP_OMP_METADIRECTIVE. */
+ gfc_state_data *state_data = gfc_state_stack;
+
+ do
+ {
+ state_data = state_data->previous;
+ state = state_data->state;
+ block_name = state_data->sym == NULL
+ ? NULL : state_data->sym->name;
+ abreviated_modproc_decl = state_data->sym
+ && state_data->sym->abr_modproc_decl;
+ }
+ while (state == COMP_OMP_METADIRECTIVE);
+ }
+ break;
default:
break;
}
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3d8c65ff1be..bdb4b0f6aa5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3940,4 +3940,8 @@ bool gfc_is_reallocatable_lhs (gfc_expr *);
void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
void gfc_adjust_builtins (void);
+/* trans-openmp.c */
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *);
+
#endif /* GCC_GFORTRAN_H */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 1a97a62462f..5e87e18ce0d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5195,8 +5195,11 @@ match_omp_metadirective (bool begin_p)
new_st.ext.omp_clauses = NULL;
}
- *next_clause = omc;
- next_clause = &omc->next;
+ if (!gfc_skip_omp_metadirective_clause (omc))
+ {
+ *next_clause = omc;
+ next_clause = &omc->next;
+ }
}
if (gfc_match_omp_eos () != MATCH_YES)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a19d916d98c..84e569d2664 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -7499,7 +7499,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
}
static tree
-gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where,
+ bool conv_expr_p = true)
{
tree set_selectors = NULL_TREE;
gfc_omp_set_selector *oss;
@@ -7520,11 +7521,15 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
case CTX_PROPERTY_USER:
case CTX_PROPERTY_EXPR:
{
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, otp->expr);
- properties = tree_cons (NULL_TREE, se.expr,
- properties);
+ tree expr = NULL_TREE;
+ if (conv_expr_p)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, otp->expr);
+ expr = se.expr;
+ }
+ properties = tree_cons (NULL_TREE, expr, properties);
}
break;
case CTX_PROPERTY_ID:
@@ -7560,11 +7565,16 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
if (os->score)
{
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, os->score);
+ tree expr = NULL_TREE;
+ if (conv_expr_p)
+ {
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, os->score);
+ expr = se.expr;
+ }
properties = tree_cons (get_identifier (" score"),
- se.expr, properties);
+ expr, properties);
}
selectors = tree_cons (get_identifier (os->trait_selector_name),
@@ -7755,3 +7765,11 @@ gfc_trans_omp_metadirective (gfc_code *code)
return metadirective_tree;
}
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *clause)
+{
+ tree selector = gfc_trans_omp_set_selector (clause->selectors,
+ clause->where, false);
+
+ return omp_context_selector_matches (selector, true) == 0;
+}
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 842e9fd868f..b032e1de697 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1254,8 +1254,9 @@ omp_context_name_list_prop (tree prop)
}
#define DELAY_METADIRECTIVES_AFTER_LTO { \
- if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev)) \
- return -1; \
+ if (metadirective_p \
+ && !(cfun && cfun->curr_properties & PROP_gimple_lomp_dev)) \
+ return -1; \
}
/* Return 1 if context selector matches the current OpenMP context, 0
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
new file mode 100644
index 00000000000..e1347910332
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+ integer :: i
+ integer, parameter :: N = 100
+ integer :: sum = 0
+
+ ! The compiler should never consider a situation where both metadirectives
+ ! match. If it does, then the nested metadirective would be an error
+ ! as it is not a loop-nest as per the OpenMP specification.
+
+ !$omp metadirective when (implementation={vendor("ibm")}: &
+ !$omp& target teams distribute)
+ !$omp metadirective when (implementation={vendor("gnu")}: parallel do)
+ do i = 1, N
+ sum = sum + i
+ end do
+end program
+
+! { dg-final { scan-tree-dump-not "when \\(implementation vendor \"ibm\"\\):" "original" } }
+! { dg-final { scan-tree-dump-times "when \\(implementation vendor \"gnu\"\\):" 1 "original" } }
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives
2021-12-10 17:39 ` [PATCH 6/7] openmp, fortran: Add Fortran " Kwok Cheung Yeung
2022-02-14 15:09 ` Kwok Cheung Yeung
@ 2022-02-14 15:17 ` Kwok Cheung Yeung
1 sibling, 0 replies; 29+ messages in thread
From: Kwok Cheung Yeung @ 2022-02-14 15:17 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 373 bytes --]
This patch (again, to be applied on top of the current set of
metadirective patches) fixes two minor issues with metadirectives in the
Fortran front-end.
- 'sorry' is called if a declarative OpenMP directive is found in a
metadirective clause.
- An ICE that occurs with an empty metadirective (i.e. just '!$omp
metadirective' with nothing else) is fixed.
Thanks
Kwok
[-- Attachment #2: 0002-openmp-More-Fortran-front-end-fixes-for-metadirectiv.patch --]
[-- Type: text/plain, Size: 3653 bytes --]
From 153b8dbd19cf90b1869be7f409d55d1ab5ba81d5 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 11 Feb 2022 15:42:50 +0000
Subject: [PATCH 2/2] openmp: More Fortran front-end fixes for metadirectives
This adds a check for declarative OpenMP directives in metadirective
variants (already present in the C/C++ front-ends), and fixes an
ICE when an empty metadirective (i.e. just '!$omp metadirective')
is presented.
2022-02-11 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/fortran/
* gfortran.h (is_omp_declarative_stmt): New.
* openmp.cc (match_omp_metadirective): Reject declarative OpenMP
directives with 'sorry'.
* parse.cc (parse_omp_metadirective_body): Check that state stack head
is non-null before dereferencing.
(is_omp_declarative_stmt): New.
gcc/testsuite/
* gfortran.dg/gomp/metadirective-2.f90 (main): Test empty
metadirective.
---
gcc/fortran/gfortran.h | 1 +
gcc/fortran/openmp.cc | 3 +++
gcc/fortran/parse.cc | 16 +++++++++++++++-
.../gfortran.dg/gomp/metadirective-2.f90 | 5 ++++-
4 files changed, 23 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bdb4b0f6aa5..37eb039b6d4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3852,6 +3852,7 @@ bool gfc_parse_file (void);
void gfc_global_used (gfc_gsymbol *, locus *);
gfc_namespace* gfc_build_block_ns (gfc_namespace *);
gfc_statement match_omp_directive (void);
+bool is_omp_declarative_stmt (gfc_statement);
/* dependency.cc */
int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5e87e18ce0d..0071484817d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5151,6 +5151,9 @@ match_omp_metadirective (bool begin_p)
gfc_statement directive = match_omp_directive ();
gfc_matching_omp_context_selector = false;
+ if (is_omp_declarative_stmt (directive))
+ sorry ("declarative directive variants are not supported");
+
if (gfc_error_flag_test ())
{
gfc_current_locus = old_loc;
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index cd18315697e..cb8acb3c68f 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5841,7 +5841,8 @@ parse_omp_metadirective_body (gfc_statement omp_st)
gfc_in_metadirective_body = old_in_metadirective_body;
- *clause->code = *gfc_state_stack->head;
+ if (gfc_state_stack->head)
+ *clause->code = *gfc_state_stack->head;
pop_state ();
gfc_commit_symbols ();
@@ -7081,3 +7082,16 @@ is_oacc (gfc_state_data *sd)
return false;
}
}
+
+/* Return true if ST is a declarative OpenMP statement. */
+bool
+is_omp_declarative_stmt (gfc_statement st)
+{
+ switch (st)
+ {
+ case_omp_decl:
+ return true;
+ default:
+ return false;
+ }
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
index 06c324589d0..cdd5e85068e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
@@ -43,7 +43,7 @@ program main
end do
!$omp end metadirective
- ! Test labels in the body
+ ! Test labels in the body.
!$omp begin metadirective &
!$omp& when (device={arch("nvptx")}: parallel do) &
!$omp& when (device={arch("gcn")}: parallel)
@@ -56,4 +56,7 @@ program main
20 continue
end do
!$omp end metadirective
+
+ ! Test empty metadirective.
+ !$omp metadirective
end program
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH 7/7] openmp: Add testcases for metadirectives
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
` (5 preceding siblings ...)
2021-12-10 17:39 ` [PATCH 6/7] openmp, fortran: Add Fortran " Kwok Cheung Yeung
@ 2021-12-10 17:40 ` Kwok Cheung Yeung
2022-05-27 13:42 ` Jakub Jelinek
2022-01-24 21:28 ` [PATCH] openmp: Metadirective patch fixes Kwok Cheung Yeung
7 siblings, 1 reply; 29+ messages in thread
From: Kwok Cheung Yeung @ 2021-12-10 17:40 UTC (permalink / raw)
To: gcc-patches, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 45 bytes --]
This adds testcases for metadirectives.
Kwok
[-- Attachment #2: 0007-openmp-Add-testcases-for-metadirectives.patch --]
[-- Type: text/plain, Size: 30942 bytes --]
From d3f80b603298fb2f3501a28b888acfdbc02a64e7 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Tue, 7 Dec 2021 11:25:33 +0000
Subject: [PATCH 7/7] openmp: Add testcases for metadirectives
2021-12-10 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/testsuite/
* c-c++-common/gomp/metadirective-1.c: New.
* c-c++-common/gomp/metadirective-2.c: New.
* c-c++-common/gomp/metadirective-3.c: New.
* c-c++-common/gomp/metadirective-4.c: New.
* c-c++-common/gomp/metadirective-5.c: New.
* c-c++-common/gomp/metadirective-6.c: New.
* gcc.dg/gomp/metadirective-1.c: New.
* gfortran.dg/gomp/metadirective-1.f90: New.
* gfortran.dg/gomp/metadirective-2.f90: New.
* gfortran.dg/gomp/metadirective-3.f90: New.
* gfortran.dg/gomp/metadirective-4.f90: New.
* gfortran.dg/gomp/metadirective-5.f90: New.
* gfortran.dg/gomp/metadirective-6.f90: New.
libgomp/
* testsuite/libgomp.c-c++-common/metadirective-1.c: New.
* testsuite/libgomp.c-c++-common/metadirective-2.c: New.
* testsuite/libgomp.c-c++-common/metadirective-3.c: New.
* testsuite/libgomp.c-c++-common/metadirective-4.c: New.
* testsuite/libgomp.fortran/metadirective-1.f90: New.
* testsuite/libgomp.fortran/metadirective-2.f90: New.
* testsuite/libgomp.fortran/metadirective-3.f90: New.
* testsuite/libgomp.fortran/metadirective-4.f90: New.
---
.../c-c++-common/gomp/metadirective-1.c | 29 ++++++++
.../c-c++-common/gomp/metadirective-2.c | 74 +++++++++++++++++++
.../c-c++-common/gomp/metadirective-3.c | 31 ++++++++
.../c-c++-common/gomp/metadirective-4.c | 40 ++++++++++
.../c-c++-common/gomp/metadirective-5.c | 24 ++++++
.../c-c++-common/gomp/metadirective-6.c | 31 ++++++++
gcc/testsuite/gcc.dg/gomp/metadirective-1.c | 15 ++++
.../gfortran.dg/gomp/metadirective-1.f90 | 41 ++++++++++
.../gfortran.dg/gomp/metadirective-2.f90 | 59 +++++++++++++++
.../gfortran.dg/gomp/metadirective-3.f90 | 34 +++++++++
.../gfortran.dg/gomp/metadirective-4.f90 | 39 ++++++++++
.../gfortran.dg/gomp/metadirective-5.f90 | 30 ++++++++
.../gfortran.dg/gomp/metadirective-6.f90 | 31 ++++++++
.../libgomp.c-c++-common/metadirective-1.c | 35 +++++++++
.../libgomp.c-c++-common/metadirective-2.c | 41 ++++++++++
.../libgomp.c-c++-common/metadirective-3.c | 34 +++++++++
.../libgomp.c-c++-common/metadirective-4.c | 52 +++++++++++++
.../libgomp.fortran/metadirective-1.f90 | 33 +++++++++
.../libgomp.fortran/metadirective-2.f90 | 40 ++++++++++
.../libgomp.fortran/metadirective-3.f90 | 29 ++++++++
.../libgomp.fortran/metadirective-4.f90 | 46 ++++++++++++
21 files changed, 788 insertions(+)
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-2.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-3.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-4.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-5.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-6.c
create mode 100644 gcc/testsuite/gcc.dg/gomp/metadirective-1.c
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-4.f90
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
new file mode 100644
index 00000000000..72cf0abbbd7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -0,0 +1,29 @@
+/* { dg-do compile } */
+
+#define N 100
+
+void f (int a[], int b[], int c[])
+{
+ #pragma omp metadirective \
+ default (teams loop) \
+ default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (bad_directive) /* { dg-error "unknown directive name before '\\)' token" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (teams loop) \
+ where (device={arch("nvptx")}: parallel loop) /* { dg-error "expected 'when' or 'default' before '\\(' token" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (teams loop) \
+ when (device={arch("nvptx")} parallel loop) /* { dg-error "expected colon before 'parallel'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+ #pragma omp metadirective \
+ default (metadirective default (flush)) /* { dg-error "metadirectives cannot be used as directive variants before 'default'" } */
+ for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-2.c b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
new file mode 100644
index 00000000000..ea6904c9c12
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
@@ -0,0 +1,74 @@
+/* { dg-do compile } */
+
+#define N 100
+
+int main (void)
+{
+ int x = 0;
+ int y = 0;
+
+ /* Test implicit default (nothing). */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: barrier)
+ x = 1;
+
+ /* Test with multiple standalone directives. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: barrier) \
+ default (flush)
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a statement
+ body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel) \
+ default (barrier)
+ x = 1;
+
+ /* Test combining a standalone directive with one that takes a for loop. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel for) \
+ default (barrier)
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test combining a directive that takes a for loop with one that takes
+ a regular statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: parallel for) \
+ default (parallel)
+ for (int i = 0; i < N; i++)
+ x += i;
+
+ /* Test labels inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ /* Test local labels inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ //__label__ l1, l2;
+
+ if (x)
+ goto l1;
+ else
+ goto l2;
+ l1: ;
+ l2: ;
+ }
+
+ return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-3.c b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
new file mode 100644
index 00000000000..80c93b1521d
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* { dg-additional-options "-fdump-tree-optimized" } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+ int i;
+
+ #pragma omp target map(to: x, y) map(from: z)
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams loop) \
+ default (parallel loop)
+ for (i = 0; i < N; i++)
+ z[i] = x[i] * y[i];
+}
+
+/* The metadirective should be resolved after Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(device arch .nvptx.\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-4.c b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
new file mode 100644
index 00000000000..c4b109295db
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
@@ -0,0 +1,40 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+#pragma omp declare target
+void f(double a[], double x) {
+ int i;
+
+ #pragma omp metadirective \
+ when (construct={target}: distribute parallel for) \
+ default (parallel for simd)
+ for (i = 0; i < N; i++)
+ a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+ double a[N];
+
+ #pragma omp target teams map(from: a[0:N])
+ f (a, 3.14159);
+
+ /* TODO: This does not execute a version of f with the default clause
+ active as might be expected. */
+ f (a, 2.71828);
+
+ return 0;
+ }
+
+ /* The metadirective should be resolved during Gimplification. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct target.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-5.c b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
new file mode 100644
index 00000000000..4a9f1aa85a6
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
@@ -0,0 +1,24 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+#define N 100
+
+void f (int a[], int flag)
+{
+ int i;
+ #pragma omp metadirective \
+ when (user={condition(flag)}: \
+ target teams distribute parallel for map(from: a[0:N])) \
+ default (parallel for)
+ for (i = 0; i < N; i++)
+ a[i] = i;
+}
+
+/* The metadirective should be resolved at parse time. */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp distribute" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 2 "original" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-6.c b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
new file mode 100644
index 00000000000..c77c0065e17
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+void bar (int a[], int run_parallel, int run_guided)
+{
+ #pragma omp metadirective \
+ when (user={condition(run_parallel)}: parallel)
+ {
+ int i;
+ #pragma omp metadirective \
+ when (construct={parallel}, user={condition(run_guided)}: \
+ for schedule(guided)) \
+ when (construct={parallel}: for schedule(static))
+ for (i = 0; i < N; i++)
+ a[i] = i;
+ }
+ }
+
+/* The outer metadirective should be resolved at parse time. */
+/* The inner metadirective should be resolved during Gimplificiation. */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct parallel" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/gcc.dg/gomp/metadirective-1.c b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
new file mode 100644
index 00000000000..2ac81bfde75
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
@@ -0,0 +1,15 @@
+int main (void)
+{
+ int x, y;
+
+ /* Test nested functions inside statement body. */
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams num_teams(512)) \
+ when (device={arch("gcn")}: teams num_teams(256)) \
+ default (teams num_teams(4))
+ {
+ int f (int x) { return x * 3; }
+
+ y = f (x);
+ }
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
new file mode 100644
index 00000000000..aa439fc855e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+
+program main
+ integer, parameter :: N = 10
+ integer, dimension(N) :: a
+ integer, dimension(N) :: b
+ integer, dimension(N) :: c
+ integer :: i
+
+ do i = 1, N
+ a(i) = i * 2
+ b(i) = i * 3
+ end do
+
+ !$omp metadirective &
+ !$omp& default (teams loop) &
+ !$omp& default (parallel loop) ! { dg-error "there can only be one default clause in a metadirective at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective default (xyz) ! { dg-error "Unclassifiable OpenMP directive at .1." }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp metadirective &
+ !$omp& default (teams loop) & ! { dg-error "expected 'default' or 'when' at .1." }
+ !$omp& where (device={arch("nvptx")}: parallel loop)
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (barrier) ! { dg-error "variant directive used in OMP BEGIN METADIRECTIVE at .1. must have a corresponding end directive" }
+ do i = 1, N
+ c(i) = a(i) * b(i)
+ end do
+ !$omp end metadirective ! { dg-error "Unexpected !OMP END METADIRECTIVE statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
new file mode 100644
index 00000000000..06c324589d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+
+program main
+ integer, parameter :: N = 100
+ integer :: x = 0
+ integer :: y = 0
+ integer :: i
+
+ ! Test implicit default directive
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: barrier)
+ x = 1
+
+ ! Test implicit default directive combined with a directive that takes a
+ ! do loop.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do)
+ do i = 1, N
+ x = x + i
+ end do
+
+ ! Test with multiple standalone directives.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: barrier) &
+ !$omp& default (flush)
+ x = 1
+
+ ! Test combining a standalone directive with one that takes a do loop.
+ !$omp metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (barrier)
+ do i = 1, N
+ x = x + i
+ end do
+
+ ! Test combining a directive that takes a do loop with one that takes
+ ! a statement body.
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& default (parallel)
+ do i = 1, N
+ x = x + i
+ end do
+ !$omp end metadirective
+
+ ! Test labels in the body
+ !$omp begin metadirective &
+ !$omp& when (device={arch("nvptx")}: parallel do) &
+ !$omp& when (device={arch("gcn")}: parallel)
+ do i = 1, N
+ x = x + i
+ if (x .gt. N/2) goto 10
+10 x = x + 1
+ goto 20
+ x = x + 2
+20 continue
+ end do
+ !$omp end metadirective
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
new file mode 100644
index 00000000000..c36a462bf51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-optimized" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: v1, v2) map(from: v3)
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ !$omp end target
+ end subroutine
+end module
+
+! The metadirective should be resolved after Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(device arch .nvptx.\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
new file mode 100644
index 00000000000..b82c9ea96d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program test
+ implicit none
+ integer, parameter :: N = 100
+ real :: a(N)
+
+ !$omp target map(from: a)
+ call f (a, 3.14159)
+ !$omp end target
+
+ ! TODO: This does not execute a version of f with the default clause
+ ! active as might be expected.
+ call f (a, 2.71828)
+contains
+ subroutine f (a, x)
+ integer :: i
+ real :: a(N), x
+ !$omp declare target
+
+ !$omp metadirective &
+ !$omp& when (construct={target}: distribute parallel do ) &
+ !$omp& default(parallel do simd)
+ do i = 1, N
+ a(i) = x * i
+ end do
+ end subroutine
+end program
+
+! The metadirective should be resolved during Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(construct target.*\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
new file mode 100644
index 00000000000..03970393eb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (a, flag)
+ integer :: a(N)
+ logical :: flag
+ integer :: i
+
+ !$omp metadirective &
+ !$omp& when (user={condition(flag)}: &
+ !$omp& target teams distribute parallel do map(from: a(1:N))) &
+ !$omp& default(parallel do)
+ do i = 1, N
+ a(i) = i
+ end do
+ end subroutine
+end module
+
+! The metadirective should be resolved at parse time, but is currently
+! resolved during Gimplification
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp distribute" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
new file mode 100644
index 00000000000..9b6c371296f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+ integer, parameter :: N = 100
+contains
+ subroutine f (a, run_parallel, run_guided)
+ integer :: a(N)
+ logical :: run_parallel, run_guided
+ integer :: i
+
+ !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+ !$omp metadirective &
+ !$omp& when(construct={parallel}, user={condition(run_guided)}: &
+ !$omp& do schedule(guided)) &
+ !$omp& when(construct={parallel}: do schedule(static))
+ do i = 1, N
+ a(i) = i
+ end do
+ !$omp end metadirective
+ end subroutine
+end module
+
+! The outer metadirective should be resolved at parse time, but is
+! currently resolved during Gimplification.
+
+! The inner metadirective should be resolved during Gimplificiation.
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
new file mode 100644
index 00000000000..0de59cbe3d3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
@@ -0,0 +1,35 @@
+/* { dg-do run } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+ int i;
+
+ #pragma omp target map(to: x[0:N], y[0:N]) map(from: z[0:N])
+ #pragma omp metadirective \
+ when (device={arch("nvptx")}: teams loop) \
+ default (parallel loop)
+ for (i = 0; i < N; i++)
+ z[i] = x[i] * y[i];
+}
+
+int main (void)
+{
+ int x[N], y[N], z[N];
+ int i;
+
+ for (i = 0; i < N; i++)
+ {
+ x[i] = i;
+ y[i] = -i;
+ }
+
+ f (x, y, z);
+
+ for (i = 0; i < N; i++)
+ if (z[i] != x[i] * y[i])
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
new file mode 100644
index 00000000000..cd5c6c5e21a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
@@ -0,0 +1,41 @@
+/* { dg-do run } */
+
+#include <math.h>
+
+#define N 100
+#define EPSILON 0.001
+
+#pragma omp declare target
+void f(double a[], double x) {
+ int i;
+
+ #pragma omp metadirective \
+ when (construct={target}: distribute parallel for) \
+ default (parallel for simd)
+ for (i = 0; i < N; i++)
+ a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+ double a[N];
+ int i;
+
+ #pragma omp target teams map(from: a[0:N])
+ f (a, M_PI);
+
+ for (i = 0; i < N; i++)
+ if (fabs (a[i] - (M_PI * i)) > EPSILON)
+ return 1;
+
+ /* TODO: This does not execute a version of f with the default clause
+ active as might be expected. */
+ f (a, M_E);
+
+ for (i = 0; i < N; i++)
+ if (fabs (a[i] - (M_E * i)) > EPSILON)
+ return 1;
+
+ return 0;
+ }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
new file mode 100644
index 00000000000..e31daf2cb64
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
@@ -0,0 +1,34 @@
+/* { dg-do run } */
+
+#define N 100
+
+int f (int a[], int flag)
+{
+ int i;
+ int res = 0;
+
+ #pragma omp metadirective \
+ when (user={condition(!flag)}: \
+ target teams distribute parallel for \
+ map(from: a[0:N]) private(res)) \
+ default (parallel for)
+ for (i = 0; i < N; i++)
+ {
+ a[i] = i;
+ res = 1;
+ }
+
+ return res;
+}
+
+int main (void)
+{
+ int a[N];
+
+ if (f (a, 0))
+ return 1;
+ if (!f (a, 1))
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
new file mode 100644
index 00000000000..7fc601eaba6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
@@ -0,0 +1,52 @@
+/* { dg-do run } */
+
+#include <omp.h>
+
+#define N 100
+
+int f (int a[], int run_parallel, int run_static)
+{
+ int is_parallel = 0;
+ int is_static = 0;
+
+ #pragma omp metadirective \
+ when (user={condition(run_parallel)}: parallel)
+ {
+ int i;
+
+ if (omp_in_parallel ())
+ is_parallel = 1;
+
+ #pragma omp metadirective \
+ when (construct={parallel}, user={condition(!run_static)}: \
+ for schedule(guided) private(is_static)) \
+ when (construct={parallel}: for schedule(static))
+ for (i = 0; i < N; i++)
+ {
+ a[i] = i;
+ is_static = 1;
+ }
+ }
+
+ return (is_parallel << 1) | is_static;
+}
+
+int main (void)
+{
+ int a[N];
+
+ /* is_static is always set if run_parallel is false. */
+ if (f (a, 0, 0) != 1)
+ return 1;
+
+ if (f (a, 0, 1) != 1)
+ return 1;
+
+ if (f (a, 1, 0) != 2)
+ return 1;
+
+ if (f (a, 1, 1) != 3)
+ return 1;
+
+ return 0;
+}
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
new file mode 100644
index 00000000000..9f6a07459e0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: x(N), y(N), z(N)
+ integer :: i
+
+ do i = 1, N
+ x(i) = i;
+ y(i) = -i;
+ end do
+
+ call f (x, y, z)
+
+ do i = 1, N
+ if (z(i) .ne. x(i) * y(i)) stop 1
+ end do
+contains
+ subroutine f (x, y, z)
+ integer :: x(N), y(N), z(N)
+
+ !$omp target map (to: x, y) map(from: z)
+ !$omp metadirective &
+ !$omp& when(device={arch("nvptx")}: teams loop) &
+ !$omp& default(parallel loop)
+ do i = 1, N
+ z(i) = x(i) * y(i)
+ enddo
+ !$omp end target
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-2.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
new file mode 100644
index 00000000000..32017a00077
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program test
+ implicit none
+ integer, parameter :: N = 100
+ real, parameter :: PI_CONST = 3.14159
+ real, parameter :: E_CONST = 2.71828
+ real, parameter :: EPSILON = 0.001
+ integer :: i
+ real :: a(N)
+
+ !$omp target map(from: a)
+ call f (a, PI_CONST)
+ !$omp end target
+
+ do i = 1, N
+ if (abs (a(i) - (PI_CONST * i)) .gt. EPSILON) stop 1
+ end do
+
+ ! TODO: This does not execute a version of f with the default clause
+ ! active as might be expected.
+ call f (a, E_CONST)
+
+ do i = 1, N
+ if (abs (a(i) - (E_CONST * i)) .gt. EPSILON) stop 2
+ end do
+contains
+ subroutine f (a, x)
+ integer :: i
+ real :: a(N), x
+ !$omp declare target
+
+ !$omp metadirective &
+ !$omp& when (construct={target}: distribute parallel do ) &
+ !$omp& default(parallel do simd)
+ do i = 1, N
+ a(i) = x * i
+ end do
+ end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-3.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
new file mode 100644
index 00000000000..693c40bca5a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program test
+ implicit none
+
+ integer, parameter :: N = 100
+ integer :: a(N)
+ integer :: res
+
+ if (f (a, .false.)) stop 1
+ if (.not. f (a, .true.)) stop 2
+contains
+ logical function f (a, flag)
+ integer :: a(N)
+ logical :: flag
+ logical :: res = .false.
+ integer :: i
+ f = .false.
+ !$omp metadirective &
+ !$omp& when (user={condition(.not. flag)}: &
+ !$omp& target teams distribute parallel do &
+ !$omp& map(from: a(1:N)) private(res)) &
+ !$omp& default(parallel do)
+ do i = 1, N
+ a(i) = i
+ f = .true.
+ end do
+ end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-4.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
new file mode 100644
index 00000000000..04fdf61489c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+program test
+ use omp_lib
+
+ implicit none
+ integer, parameter :: N = 100
+ integer :: a(N)
+ logical :: is_parallel, is_static
+
+ ! is_static is always set if run_parallel is false.
+ call f (a, .false., .false., is_parallel, is_static)
+ if (is_parallel .or. .not. is_static) stop 1
+
+ call f (a, .false., .true., is_parallel, is_static)
+ if (is_parallel .or. .not. is_static) stop 2
+
+ call f (a, .true., .false., is_parallel, is_static)
+ if (.not. is_parallel .or. is_static) stop 3
+
+ call f (a, .true., .true., is_parallel, is_static)
+ if (.not. is_parallel .or. .not. is_static) stop 4
+contains
+ subroutine f (a, run_parallel, run_static, is_parallel, is_static)
+ integer :: a(N)
+ logical, intent(in) :: run_parallel, run_static
+ logical, intent(out) :: is_parallel, is_static
+ integer :: i
+
+ is_parallel = .false.
+ is_static = .false.
+
+ !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+ if (omp_in_parallel ()) is_parallel = .true.
+
+ !$omp metadirective &
+ !$omp& when(construct={parallel}, user={condition(.not. run_static)}: &
+ !$omp& do schedule(guided) private(is_static)) &
+ !$omp& when(construct={parallel}: do schedule(static))
+ do i = 1, N
+ a(i) = i
+ is_static = .true.
+ end do
+ !$omp end metadirective
+ end subroutine
+end program
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread
* Re: [PATCH 7/7] openmp: Add testcases for metadirectives
2021-12-10 17:40 ` [PATCH 7/7] openmp: Add testcases for metadirectives Kwok Cheung Yeung
@ 2022-05-27 13:42 ` Jakub Jelinek
0 siblings, 0 replies; 29+ messages in thread
From: Jakub Jelinek @ 2022-05-27 13:42 UTC (permalink / raw)
To: Kwok Cheung Yeung; +Cc: gcc-patches
On Fri, Dec 10, 2021 at 05:40:36PM +0000, Kwok Cheung Yeung wrote:
> This adds testcases for metadirectives.
Let me start with the last patch.
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
> @@ -0,0 +1,29 @@
> +/* { dg-do compile } */
> +
> +#define N 100
> +
> +void f (int a[], int b[], int c[])
> +{
> + #pragma omp metadirective \
> + default (teams loop) \
> + default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */
I'd prefer consistency, check_no_duplicate_clause prints for similar bugs
too many %qs clauses
so it would be nice if this emitted the same (and the before '\\(' token
part would be nice to avoid as well (i.e. use error rather than parse
error).
> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
> @@ -0,0 +1,74 @@
> +/* { dg-do compile } */
> +
> +#define N 100
> +
> +int main (void)
> +{
> + int x = 0;
> + int y = 0;
> +
> + /* Test implicit default (nothing). */
> + #pragma omp metadirective \
> + when (device={arch("nvptx")}: barrier)
> + x = 1;
I'm not really sure if device={arch("nvptx")} in main is
the best idea for most of such tests.
Because we should be able to decide that right away, main isn't
declare target to (and better shouldn't be) and so when we know host
isn't nvptx and that it won't be offloaded, it is clear it can't be
that arch.
Of course, we need to test such a case too in a few spots, but it would
be nice to have more diversity in the tests.
One possibility is non-main function with declare target to after the
function definition (but one can't then use teams in the metadirectives).
But would be nice to use more variety in selectors, user, implementation, device
with isa or kind, etc. instead of using always the same thing in most of the
tests.
Also it would be nice to cover say a directive which needs loop, a directive
which needs a normal body and say 2 directives which are standalone.
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
> @@ -0,0 +1,31 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +/* { dg-additional-options "-fdump-tree-gimple" } */
> +/* { dg-additional-options "-fdump-tree-optimized" } */
> +
> +#define N 100
> +
> +void f (int x[], int y[], int z[])
> +{
> + int i;
> +
> + #pragma omp target map(to: x, y) map(from: z)
> + #pragma omp metadirective \
> + when (device={arch("nvptx")}: teams loop) \
> + default (parallel loop)
It would be nice to have many of the tests where all the metadirective
variants are actually possible. Here the nvptx variant
is quite unlikely, nvptx is rarely tested as host arch,
f is not declare target to and even if it was, teams is not allowed
inside of target regions like that.
> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
> +
> + /* TODO: This does not execute a version of f with the default clause
> + active as might be expected. */
Might be nice to mention that it is correct 5.0 behavior, 5.1 is just
broken in this regard and 5.2 changed the behavior so that parallel loop
is actually invoked.
> + f (a, 2.71828);
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
> @@ -0,0 +1,24 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +
> +#define N 100
> +
> +void f (int a[], int flag)
> +{
> + int i;
> + #pragma omp metadirective \
> + when (user={condition(flag)}: \
> + target teams distribute parallel for map(from: a[0:N])) \
> + default (parallel for)
> + for (i = 0; i < N; i++)
> + a[i] = i;
> +}
> +
> +/* The metadirective should be resolved at parse time. */
??? How can it? The above is invalid in OpenMP 5.0 (condition
should be constant expression), it is valid in OpenMP 5.1, but is then
resolved at runtime, certainly not at parse time.
Would be nice to also test user={condition(1)} etc. where it would
be resolved at parse time.
And, please add some tests even with user scores.
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
> @@ -0,0 +1,31 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +/* { dg-additional-options "-fdump-tree-gimple" } */
> +
> +#define N 100
> +
> +void bar (int a[], int run_parallel, int run_guided)
> +{
> + #pragma omp metadirective \
> + when (user={condition(run_parallel)}: parallel)
> + {
> + int i;
> + #pragma omp metadirective \
> + when (construct={parallel}, user={condition(run_guided)}: \
> + for schedule(guided)) \
> + when (construct={parallel}: for schedule(static))
> + for (i = 0; i < N; i++)
> + a[i] = i;
> + }
> + }
> +
> +/* The outer metadirective should be resolved at parse time. */
> +/* The inner metadirective should be resolved during Gimplificiation. */
Again, dynamic condition, so I don't see how this holds, both should be
resolved at runtime.
> +++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
> @@ -0,0 +1,35 @@
> +/* { dg-do run } */
> +
> +#define N 100
> +
> +void f (int x[], int y[], int z[])
> +{
> + int i;
> +
> + #pragma omp target map(to: x[0:N], y[0:N]) map(from: z[0:N])
> + #pragma omp metadirective \
> + when (device={arch("nvptx")}: teams loop) \
> + default (parallel loop)
> + for (i = 0; i < N; i++)
This doesn't really test which of them was selected and one of them is
extremely unlikely. Doesn't hurt to have some such tests, but would be
nice if there were tests that it could vary (e.g. same test triggering
both or all variants in different code paths, with selector chosen
such that it is possible) where it would return different results
and at runtime it would be possible to decide which one is which.
That can be done either through declare variant in the body, or say
nested metadirective which will say through data sharing or mapping
result in different values (say task shared(var) in one case and
task firstprivate(var) in another etc.).
Jakub
^ permalink raw reply [flat|nested] 29+ messages in thread
* [PATCH] openmp: Metadirective patch fixes
2021-12-10 17:29 ` [PATCH 0/7] openmp: " Kwok Cheung Yeung
` (6 preceding siblings ...)
2021-12-10 17:40 ` [PATCH 7/7] openmp: Add testcases for metadirectives Kwok Cheung Yeung
@ 2022-01-24 21:28 ` Kwok Cheung Yeung
7 siblings, 0 replies; 29+ messages in thread
From: Kwok Cheung Yeung @ 2022-01-24 21:28 UTC (permalink / raw)
To: Jakub Jelinek, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 1073 bytes --]
Hello
This patch fixes a couple of issues with the latest patch series for
metadirectives.
Firstly, the changes to c_parser_skip_to_end_of_block_or_statement and
its C++ equivalent cause a couple of tests (e.g. gcc.dg/attr-malloc.c)
to regress.
This is because these tests cause the parser to skip code starting from
within a pair of brackets - this causes the unsigned nesting_depth to
wrap around to UINT_MAX when a ')' is encountered and so semicolons no
longer stop the skipping, causing too much code to be skipped and
resulting in the test regressions. This is fixed by tracking the bracket
nesting level separately from the brace nesting level in a signed int,
and to allow skipping to end with negative values.
Secondly, user condition selectors containing only compile-time
constants should be treated as static rather than dynamic. In practice
though it doesn't matter much, as GCC readily eliminates the resulting
'if (<const>)' statements via constant folding.
These fixes should be merged into the original metadirective patches.
Thanks
Kwok
[-- Attachment #2: 0008-openmp-Metadirective-fixes.patch --]
[-- Type: text/plain, Size: 4511 bytes --]
From 77f419aef8a608440789b0ebb4a08f11d69f00e2 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 21 Jan 2022 18:23:57 +0000
Subject: [PATCH 8/9] openmp: Metadirective fixes
Fix regressions introduced by block/statement skipping.
If user condition selector is constant, do not return it as a dynamic
selector.
2022-01-21 Kwok Cheung Yeung <kcy@codesourcery.com>
gcc/c/
* c-parser.cc (c_parser_skip_to_end_of_block_or_statement): Track
bracket depth separately from nesting depth.
gcc/cp/
* parser.cc (cp_parser_skip_to_end_of_statement): Revert.
(cp_parser_skip_to_end_of_block_or_statement): Track bracket depth
separately from nesting depth.
gcc/
* omp-general.cc (omp_dynamic_cond): Do not return user condition if
constant.
---
gcc/c/c-parser.cc | 9 ++++++---
gcc/cp/parser.cc | 20 ++++++--------------
gcc/omp-general.cc | 8 ++++++--
3 files changed, 18 insertions(+), 19 deletions(-)
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 47075973bfe..f3afc38eb65 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -1344,6 +1344,7 @@ static void
c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
{
unsigned nesting_depth = 0;
+ int bracket_depth = 0;
bool save_error = parser->error;
while (true)
@@ -1366,7 +1367,7 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
case CPP_SEMICOLON:
/* If the next token is a ';', we have reached the
end of the statement. */
- if (!nesting_depth)
+ if (!nesting_depth && bracket_depth <= 0)
{
/* Consume the ';'. */
c_parser_consume_token (parser);
@@ -1394,11 +1395,13 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
/* Track parentheses in case the statement is a standalone 'for'
statement - we want to skip over the semicolons separating the
operands. */
- nesting_depth++;
+ if (nesting_depth == 0)
+ ++bracket_depth;
break;
case CPP_CLOSE_PAREN:
- nesting_depth--;
+ if (nesting_depth == 0)
+ --bracket_depth;
break;
case CPP_PRAGMA:
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index de35f42d7c4..7cfaff9d65b 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -3931,17 +3931,6 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
++nesting_depth;
break;
- case CPP_OPEN_PAREN:
- /* Track parentheses in case the statement is a standalone 'for'
- statement - we want to skip over the semicolons separating the
- operands. */
- ++nesting_depth;
- break;
-
- case CPP_CLOSE_PAREN:
- --nesting_depth;
- break;
-
case CPP_KEYWORD:
if (token->keyword != RID__EXPORT
&& token->keyword != RID__MODULE
@@ -3991,6 +3980,7 @@ static void
cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
{
int nesting_depth = 0;
+ int bracket_depth = 0;
/* Unwind generic function template scope if necessary. */
if (parser->fully_implicit_function_template_p)
@@ -4012,7 +4002,7 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
case CPP_SEMICOLON:
/* Stop if this is an unnested ';'. */
- if (!nesting_depth)
+ if (!nesting_depth && bracket_depth <= 0)
nesting_depth = -1;
break;
@@ -4035,11 +4025,13 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
/* Track parentheses in case the statement is a standalone 'for'
statement - we want to skip over the semicolons separating the
operands. */
- nesting_depth++;
+ if (nesting_depth == 0)
+ bracket_depth++;
break;
case CPP_CLOSE_PAREN:
- nesting_depth--;
+ if (nesting_depth == 0)
+ bracket_depth--;
break;
case CPP_KEYWORD:
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 9db729e6d59..bab4a932f5d 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1990,7 +1990,7 @@ omp_get_context_selector (tree ctx, const char *set, const char *sel)
}
/* Return a tree expression representing the dynamic part of the context
- * selector CTX. */
+ selector CTX. */
static tree
omp_dynamic_cond (tree ctx)
@@ -2001,8 +2001,12 @@ omp_dynamic_cond (tree ctx)
tree expr_list = TREE_VALUE (user);
gcc_assert (TREE_PURPOSE (expr_list) == NULL_TREE);
- return TREE_VALUE (expr_list);
+
+ /* The user condition is not dynamic if it is constant. */
+ if (!tree_fits_shwi_p (TREE_VALUE (expr_list)))
+ return TREE_VALUE (expr_list);
}
+
return NULL_TREE;
}
--
2.25.1
^ permalink raw reply [flat|nested] 29+ messages in thread