This patch enables passing TARGET_CLNOES as a GCC attribute, which
allows C-style argument syntax:
`!GCC$ ATTRIBUTES TARGET_CLONES("default", "avx", "avx512f") :: MySub`
or
`!GCC$ ATTRIBUTES TARGET_CLONES('default', 'avx512f') :: MySub`
This feature added a parser in f95-lang.cc to support parsing
arguments, and added `TARGET_CLONES` as a attribute in `ext_attr_list`
Signed-off-by: ZAMBAR <zam...@163.com>
gcc/fortran/ChangeLog:
* decl.cc (gfc_match_gcc_attributes): Add target_clones attribute
parsing
* f95-lang.cc (gfc_handle_target_clones_attribute): Add handler for
target_clones attribute
* gfortran.h: Add target_clones_args and target_clones_count to
gfc_symbol
* symbol.cc (gfc_free_symbol): Free target_clones_args
* trans-decl.cc (add_attributes_to_decl): Add target_clones attribute
to the declaration
---
gcc/fortran/decl.cc | 116 ++++++++++++++++++++++++++++++++++++++
gcc/fortran/f95-lang.cc | 34 +++++++++++
gcc/fortran/gfortran.h | 5 ++
gcc/fortran/symbol.cc | 8 +++
gcc/fortran/trans-decl.cc | 24 +++++++-
5 files changed, 186 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 69acd2da981..39d5fc31b82 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -11879,6 +11879,7 @@ const ext_attr_t ext_attr_list[] = {
{ "noinline", EXT_ATTR_NOINLINE, NULL },
{ "noreturn", EXT_ATTR_NORETURN, NULL },
{ "weak", EXT_ATTR_WEAK, NULL },
+ { "target_clones", EXT_ATTR_TARGET_CLONES, "target_clones" },
{ NULL, EXT_ATTR_LAST, NULL }
};
@@ -11896,6 +11897,13 @@ const ext_attr_t ext_attr_list[] = {
As there is absolutely no risk of confusion, we should never return
MATCH_NO. */
+
+/* Structure to temporarily hold target_clones arguments during parsing */
+typedef struct {
+ char **args;
+ int count;
+} target_clones_args_t;
+
match
gfc_match_gcc_attributes (void)
{
@@ -11904,6 +11912,7 @@ gfc_match_gcc_attributes (void)
unsigned id;
gfc_symbol *sym;
match m;
+ target_clones_args_t target_clones_data = { NULL, 0 };
gfc_clear_attr (&attr);
for(;;)
@@ -11926,6 +11935,85 @@ gfc_match_gcc_attributes (void)
if (!gfc_add_ext_attribute (&attr, (ext_attr_id_t)id,
&gfc_current_locus))
return MATCH_ERROR;
+ /* Handle target_clones attribute with arguments */
+ if (id == EXT_ATTR_TARGET_CLONES)
+ {
+ /* Expect opening parenthesis for target_clones */
+ if (gfc_match_char ('(') != MATCH_YES)
+ {
+ gfc_error ("Expected '(' after TARGET_CLONES attribute at %C");
+ return MATCH_ERROR;
+ }
+
+ /* Parse comma-separated list of target specifications */
+ for (;;)
+ {
+ gfc_expr *expr = NULL;
+
+ /* Match quoted string argument */
+ if (gfc_match_literal_constant (&expr, 0) == MATCH_YES)
+ {
+ /* Verify it's a character constant */
+ if (expr->expr_type == EXPR_CONSTANT && expr->ts.type ==
BT_CHARACTER)
+ {
+ target_clones_data.count++;
+ target_clones_data.args = (char **) xrealloc
(target_clones_data.args,
+
target_clones_data.count * sizeof (char *));
+
+ /* Convert gfc_char_t* to char* */
+ int len = expr->value.character.length;
+ char *arg_str = (char *) xmalloc (len + 1);
+ for (int i = 0; i < len; i++)
+ arg_str[i] = (char) expr->value.character.string[i];
+ arg_str[len] = '\0';
+
+ target_clones_data.args[target_clones_data.count - 1] =
arg_str;
+ gfc_free_expr (expr);
+
+ /* Check for comma (more arguments) or closing
parenthesis */
+ gfc_gobble_whitespace ();
+ if (gfc_match_char (',') == MATCH_YES)
+ {
+ gfc_gobble_whitespace ();
+ continue;
+ }
+ else if (gfc_match_char (')') == MATCH_YES)
+ break;
+ else
+ {
+ gfc_error ("Expected ',' or ')' in TARGET_CLONES
argument list at %C");
+ goto target_clones_error;
+ }
+ }
+ else
+ {
+ gfc_free_expr (expr);
+ gfc_error ("TARGET_CLONES arguments must be character
constants at %C");
+ goto target_clones_error;
+ }
+ }
+ else
+ {
+ gfc_error ("Expected quoted string argument in TARGET_CLONES
at %C");
+ goto target_clones_error;
+ }
+ }
+
+ goto attribute_parsed;
+
+target_clones_error:
+ if (target_clones_data.args)
+ {
+ for (int i = 0; i < target_clones_data.count; i++)
+ free (target_clones_data.args[i]);
+ free (target_clones_data.args);
+ target_clones_data.args = NULL;
+ target_clones_data.count = 0;
+ }
+ return MATCH_ERROR;
+ }
+
+attribute_parsed:
gfc_gobble_whitespace ();
ch = gfc_next_ascii_char ();
if (ch == ':')
@@ -11955,6 +12043,19 @@ gfc_match_gcc_attributes (void)
sym->attr.ext_attr |= attr.ext_attr;
+ /* Apply target_clones arguments if this attribute was specified */
+ if (attr.ext_attr & (1 << EXT_ATTR_TARGET_CLONES))
+ {
+ if (target_clones_data.args && target_clones_data.count > 0)
+ {
+ sym->target_clones_args = (char **) xmalloc
(target_clones_data.count * sizeof (char *));
+ sym->target_clones_count = target_clones_data.count;
+
+ for (int i = 0; i < target_clones_data.count; i++)
+ sym->target_clones_args[i] = xstrdup
(target_clones_data.args[i]);
+ }
+ }
+
if (gfc_match_eos () == MATCH_YES)
break;
@@ -11962,9 +12063,24 @@ gfc_match_gcc_attributes (void)
goto syntax;
}
+ /* Clean up target_clones temporary data */
+ if (target_clones_data.args)
+ {
+ for (int i = 0; i < target_clones_data.count; i++)
+ free (target_clones_data.args[i]);
+ free (target_clones_data.args);
+ }
+
return MATCH_YES;
syntax:
+ /* Clean up target_clones temporary data on error */
+ if (target_clones_data.args)
+ {
+ for (int i = 0; i < target_clones_data.count; i++)
+ free (target_clones_data.args[i]);
+ free (target_clones_data.args);
+ }
gfc_error ("Syntax error in !GCC$ ATTRIBUTES statement at %C");
return MATCH_ERROR;
}
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 1f09553142d..427b8f5b51c 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -87,6 +87,38 @@ gfc_handle_omp_declare_target_attribute (tree *, tree, tree,
int, bool *)
return NULL_TREE;
}
+/* Handle a "target_clones" attribute; arguments as in
+ struct attribute_spec.handler. */
+static tree
+gfc_handle_target_clones_attribute (tree *node, tree name, tree args,
+ int ARG_UNUSED (flags), bool *no_add_attrs)
+{
+ /* Ensure we have a function declaration. */
+ if (TREE_CODE (*node) == FUNCTION_DECL)
+ {
+ for (tree t = args; t != NULL_TREE; t = TREE_CHAIN (t))
+ {
+ tree value = TREE_VALUE (t);
+ if (TREE_CODE (value) != STRING_CST)
+ {
+ error ("%qE attribute argument not a string constant", name);
+ *no_add_attrs = true;
+ return NULL_TREE;
+ }
+ }
+
+ /* Do not inline functions with multiple clone targets. */
+ DECL_UNINLINABLE (*node) = 1;
+ }
+ else
+ {
+ warning (OPT_Wattributes, "%qE attribute ignored", name);
+ *no_add_attrs = true;
+ }
+
+ return NULL_TREE;
+}
+
/* Table of valid Fortran attributes. */
static const attribute_spec gfc_gnu_attributes[] =
{
@@ -100,6 +132,8 @@ static const attribute_spec gfc_gnu_attributes[] =
gfc_handle_omp_declare_target_attribute, NULL },
{ "oacc function", 0, -1, true, false, false, false,
gfc_handle_omp_declare_target_attribute, NULL },
+ { "target_clones", 1, -1, true, false, false, false,
+ gfc_handle_target_clones_attribute, NULL },
};
static const scoped_attribute_specs gfc_gnu_attribute_table =
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 46310a088f2..4baa54828ba 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -865,6 +865,7 @@ typedef enum
EXT_ATTR_NOINLINE,
EXT_ATTR_NORETURN,
EXT_ATTR_WEAK,
+ EXT_ATTR_TARGET_CLONES,
EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST
}
ext_attr_id_t;
@@ -2077,6 +2078,10 @@ typedef struct gfc_symbol
/* This is for determining where the symbol has been used first, for better
location of error messages. */
locus formal_at;
+
+ /* Storage for target_clones attribute arguments. */
+ char **target_clones_args;
+ int target_clones_count;
}
gfc_symbol;
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 81aa81df2ee..ff0564491f9 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3179,6 +3179,14 @@ gfc_free_symbol (gfc_symbol *&sym)
if (sym->param_list)
gfc_free_actual_arglist (sym->param_list);
+ /* Free target_clones arguments if present */
+ if (sym->target_clones_args)
+ {
+ for (int i = 0; i < sym->target_clones_count; i++)
+ free (sym->target_clones_args[i]);
+ free (sym->target_clones_args);
+ }
+
free (sym);
sym = NULL;
}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 43bd7be54cb..bf37b13830a 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1507,7 +1507,29 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol
*sym)
if (sym_attr.ext_attr & (1 << id) && ext_attr_list[id].middle_end_name)
{
tree ident = get_identifier (ext_attr_list[id].middle_end_name);
- list = tree_cons (ident, NULL_TREE, list);
+
+ /* Special handling for target_clones attribute with arguments */
+ if (id == EXT_ATTR_TARGET_CLONES && sym->target_clones_args &&
sym->target_clones_count > 0)
+ {
+ tree args = NULL_TREE;
+
+ /* Create string constants for each target clone argument */
+ for (int i = sym->target_clones_count - 1; i >= 0; i--)
+ {
+ tree str = build_string (strlen (sym->target_clones_args[i]),
+ sym->target_clones_args[i]);
+ TREE_TYPE (str) = build_array_type (char_type_node,
+ build_index_type (size_int
(strlen (sym->target_clones_args[i]))));
+ args = tree_cons (NULL_TREE, str, args);
+ }
+
+ /* Add the target_clones attribute with its arguments */
+ list = tree_cons (ident, args, list);
+ }
+ else
+ {
+ list = tree_cons (ident, NULL_TREE, list);
+ }
}
tree clauses = NULL_TREE;
--
2.34.1
