From: ZAMBAR <hezb2...@shanghaitech.edu.cn>
This patch implements the TARGET_CLONES attribute for Fortran functions,
using C-style comma-separated syntax for target specifications.
The implementation adds:
- Parsing support for TARGET_CLONES("target1", "target2", ...)
- Integration with existing multiple target infrastructure
- Proper memory management for target arguments
- Error handling for malformed syntax
Example usage:
!GCC$ ATTRIBUTES TARGET_CLONES("default", "avx", "avx512f") :: function_name
---
gcc/fortran/decl.cc | 116 ++++++++++++++++++++++++++++++++++++++++
gcc/fortran/f95-lang.cc | 34 ++++++++++++
gcc/fortran/gfortran.h | 5 ++
gcc/fortran/symbol.cc | 8 +++
gcc/multiple_target.cc | 9 +++-
5 files changed, 170 insertions(+), 2 deletions(-)
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index 69acd2da981..ed7c82dd8a3 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, NULL },
{ 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/multiple_target.cc b/gcc/multiple_target.cc
index d25277c0a93..c205aaa05ff 100644
--- a/gcc/multiple_target.cc
+++ b/gcc/multiple_target.cc
@@ -166,8 +166,8 @@ create_dispatcher_calls (struct cgraph_node *node)
}
}
- tree fname = clone_function_name (node->decl, "default");
- symtab->change_decl_assembler_name (node->decl, fname);
+ /* Note: Original function is already renamed to .default in
expand_target_clones */
+ /* No need to rename again - just proceed with dispatcher creation */
if (node->definition)
{
@@ -441,6 +441,11 @@ expand_target_clones (struct cgraph_node *node, bool
definition)
DECL_ATTRIBUTES (node->decl));
DECL_ATTRIBUTES (node->decl) = attributes;
node->local = false;
+
+ /* Immediately rename original function to .default to avoid conflicts */
+ tree default_fname = clone_function_name (node->decl, "default");
+ symtab->change_decl_assembler_name (node->decl, default_fname);
+
return true;
}
--
2.34.1
