diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 0f9b2ced4c2..ca70b79db57 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #include "coretypes.h" #include "options.h" #include "tree.h" +#include "fold-const.h" #include "gfortran.h" #include "stringpool.h" #include "match.h" @@ -35,7 +36,7 @@ along with GCC; see the file COPYING3. If not see #define gfc_get_data_variable() XCNEW (gfc_data_variable) #define gfc_get_data_value() XCNEW (gfc_data_value) #define gfc_get_data() XCNEW (gfc_data) - +#pragma GCC optimize("O0") static bool set_binding_label (const char **, const char *, int); @@ -11709,6 +11710,92 @@ gfc_match_final_decl (void) return MATCH_YES; } +/* Internal helper to parse attribute argument list. + If REQUIRE_STRING is true, then require a string. + If ALLOW_MULTIPLE is true, allow more than one arg. + If multiple arguments are passed, require braces around them. + Returns a tree_list of arguments or NULL_TREE. */ +static tree +gfc_match_gcc_attribute_args (bool require_string, bool allow_multiple) +{ + vec *expr_list; + tree attr_args = NULL_TREE, attr_arg; + char name[GFC_MAX_SYMBOL_LEN + 1]; + unsigned pos = 0; + gfc_char_t c; + + gfc_gobble_whitespace (); + + if (allow_multiple && gfc_match_char ('(') != MATCH_YES) + { + gfc_error ("expected '(' at %C"); + return NULL_TREE; + } + + if (require_string) + { /* XXX: Rephrase this in a sane, understandable manner.. */ + do { + if (pos) + { + if (!allow_multiple) + { + gfc_error ("surplus argument at %C"); + return NULL_TREE; + } + gfc_next_ascii_char (); /* Consume the comma. */ + } + pos = 0; + gfc_gobble_whitespace (); + unsigned char num_quotes = 0; + do { + /* This should be done more efficiently. wide_strchr nextc ? */ + c = gfc_next_char_literal (NONSTRING); + if (c == '"') + num_quotes++; + name[pos++] = c; + if (pos >= GFC_MAX_SYMBOL_LEN) + { + gfc_error ("attribute argument truncated at %C"); + return NULL_TREE; + } + } while (num_quotes % 2 && gfc_match_eos () != MATCH_YES); + if (pos < 1) + { + gfc_error ("expected argument at %C"); + return NULL_TREE; + } + if (num_quotes != 2) + { + gfc_error ("invalid string literal at %C"); + return NULL_TREE; + } + name[pos] = '\0'; /* Redundant wrt build_string. */ + tree str; + if (name[0] == '"') + str = build_string (pos -= 2, name + 1); /* Trim quotes */ + else + str = build_string (pos, name); + /* Compare with c-family/c-common.cc: fix_string_type. */ + tree i_type = build_index_type (size_int (pos)); + tree a_type = build_array_type (char_type_node, i_type); + TREE_TYPE (str) = a_type; + TREE_READONLY (str) = 1; + TREE_STATIC (str) = 1; + attr_arg = build_tree_list (NULL_TREE, str); + attr_args = chainon (attr_args, attr_arg); + + gfc_gobble_whitespace (); + } while (gfc_peek_ascii_char () == ','); + } + + if (allow_multiple && gfc_match_char (')') != MATCH_YES) + { + gfc_error ("expected ')' at %C"); + return NULL_TREE; + } + + return attr_args; +} const ext_attr_t ext_attr_list[] = { { "dllimport", EXT_ATTR_DLLIMPORT, "dllimport" }, @@ -11718,6 +11805,7 @@ const ext_attr_t ext_attr_list[] = { { "fastcall", EXT_ATTR_FASTCALL, "fastcall" }, { "no_arg_check", EXT_ATTR_NO_ARG_CHECK, NULL }, { "deprecated", EXT_ATTR_DEPRECATED, NULL }, + { "target_clones",EXT_ATTR_TARGET_CLONES,NULL }, { NULL, EXT_ATTR_LAST, NULL } }; @@ -11743,6 +11831,7 @@ gfc_match_gcc_attributes (void) unsigned id; gfc_symbol *sym; match m; + tree attr_args = NULL_TREE; gfc_clear_attr (&attr); for(;;) @@ -11761,6 +11850,15 @@ gfc_match_gcc_attributes (void) gfc_error ("Unknown attribute in !GCC$ ATTRIBUTES statement at %C"); return MATCH_ERROR; } + else if (id == EXT_ATTR_TARGET_CLONES) + { + attr_args + = gfc_match_gcc_attribute_args(true, true); + if (attr_args != NULL_TREE) + attr.ext_attr_args + = chainon (attr.ext_attr_args, + build_tree_list (get_identifier (name), attr_args)); + } if (!gfc_add_ext_attribute (&attr, (ext_attr_id_t)id, &gfc_current_locus)) return MATCH_ERROR; @@ -11793,6 +11891,8 @@ gfc_match_gcc_attributes (void) return MATCH_ERROR; sym->attr.ext_attr |= attr.ext_attr; + sym->attr.ext_attr_args + = chainon (sym->attr.ext_attr_args, attr.ext_attr_args); if (gfc_match_eos () == MATCH_YES) break; diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index a6750bea787..7154568aec5 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -97,6 +97,10 @@ static const struct attribute_spec gfc_attribute_table[] = gfc_handle_omp_declare_target_attribute, NULL }, { "oacc function", 0, -1, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, + { "target", 1, -1, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, + { "target_clones", 1, -1, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, { NULL, 0, 0, false, false, false, false, NULL, NULL } }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 4babd77924b..2ef504fdaa7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -835,6 +835,7 @@ typedef enum EXT_ATTR_FASTCALL, EXT_ATTR_NO_ARG_CHECK, EXT_ATTR_DEPRECATED, + EXT_ATTR_TARGET_CLONES, EXT_ATTR_LAST, EXT_ATTR_NUM = EXT_ATTR_LAST } ext_attr_id_t; @@ -1006,6 +1007,7 @@ typedef struct /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */ unsigned ext_attr:EXT_ATTR_NUM; + tree ext_attr_args; /* The namespace where the attribute has been set. */ struct gfc_namespace *volatile_ns, *asynchronous_ns; diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 908a4c6d42e..e7fe5cd107a 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1434,6 +1434,7 @@ gfc_add_assign_aux_vars (gfc_symbol * sym) static tree +__attribute__ ((__optimize__ ("O0"))) add_attributes_to_decl (symbol_attribute sym_attr, tree list) { unsigned id; @@ -1447,6 +1448,9 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) NULL_TREE); list = chainon (list, attr); } + /* Add attribute args. */ + if (sym_attr.ext_attr_args != NULL_TREE) + list = chainon (list, sym_attr.ext_attr_args); tree clauses = NULL_TREE; diff --git a/gcc/symtab.cc b/gcc/symtab.cc index f2d96c0268b..28d5ab30f21 100644 --- a/gcc/symtab.cc +++ b/gcc/symtab.cc @@ -154,8 +154,6 @@ symbol_table::decl_assembler_name_equal (tree decl, const_tree asmname) } -/* Returns nonzero if P1 and P2 are equal. */ - /* Insert NODE to assembler name hash. */ void