aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/trans-common.cc21
-rw-r--r--gcc/fortran/trans-decl.cc81
2 files changed, 76 insertions, 26 deletions
diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc
index 5f44e7b..e714342 100644
--- a/gcc/fortran/trans-common.cc
+++ b/gcc/fortran/trans-common.cc
@@ -98,6 +98,9 @@ along with GCC; see the file COPYING3. If not see
#include "coretypes.h"
#include "tm.h"
#include "tree.h"
+#include "cgraph.h"
+#include "context.h"
+#include "omp-offload.h"
#include "gfortran.h"
#include "trans.h"
#include "stringpool.h"
@@ -497,6 +500,24 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
= tree_cons (get_identifier ("omp declare target"),
omp_clauses, DECL_ATTRIBUTES (decl));
+ if (com->omp_declare_target_link || com->omp_declare_target)
+ {
+ /* Add to offload_vars; get_create does so for omp_declare_target,
+ omp_declare_target_link requires manual work. */
+ gcc_assert (symtab_node::get (decl) == 0);
+ symtab_node *node = symtab_node::get_create (decl);
+ if (node != NULL && com->omp_declare_target_link)
+ {
+ node->offloadable = 1;
+ if (ENABLE_OFFLOADING)
+ {
+ g->have_offload = true;
+ if (is_a <varpool_node *> (node))
+ vec_safe_push (offload_vars, decl);
+ }
+ }
+ }
+
/* Place the back end declaration for this common block in
GLOBAL_BINDING_LEVEL. */
gfc_map_of_all_commons[identifier] = pushdecl_top_level (decl);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 82fa2bb..0fdc41b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -46,7 +46,9 @@ along with GCC; see the file COPYING3. If not see
#include "trans-stmt.h"
#include "gomp-constants.h"
#include "gimplify.h"
+#include "context.h"
#include "omp-general.h"
+#include "omp-offload.h"
#include "attr-fnspec.h"
#include "tree-iterator.h"
#include "dependency.h"
@@ -1472,19 +1474,18 @@ gfc_add_assign_aux_vars (gfc_symbol * sym)
}
-static tree
-add_attributes_to_decl (symbol_attribute sym_attr, tree list)
+static void
+add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym)
{
unsigned id;
- tree attr;
+ tree list = NULL_TREE;
+ symbol_attribute sym_attr = sym->attr;
for (id = 0; id < EXT_ATTR_NUM; id++)
if (sym_attr.ext_attr & (1 << id) && ext_attr_list[id].middle_end_name)
{
- attr = build_tree_list (
- get_identifier (ext_attr_list[id].middle_end_name),
- NULL_TREE);
- list = chainon (list, attr);
+ tree ident = get_identifier (ext_attr_list[id].middle_end_name);
+ list = tree_cons (ident, NULL_TREE, list);
}
tree clauses = NULL_TREE;
@@ -1547,6 +1548,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
clauses = c;
}
+ bool has_declare = true;
if (sym_attr.omp_declare_target_link
|| sym_attr.oacc_declare_link)
list = tree_cons (get_identifier ("omp declare target link"),
@@ -1558,12 +1560,45 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
|| sym_attr.oacc_declare_device_resident)
list = tree_cons (get_identifier ("omp declare target"),
clauses, list);
+ else
+ has_declare = false;
if (sym_attr.omp_declare_target_indirect)
list = tree_cons (get_identifier ("omp declare target indirect"),
clauses, list);
- return list;
+ decl_attributes (decl_p, list, 0);
+
+ if (has_declare
+ && VAR_P (*decl_p)
+ && sym->ns->proc_name->attr.flavor != FL_MODULE)
+ {
+ has_declare = false;
+ for (gfc_namespace* ns = sym->ns->contained; ns; ns = ns->sibling)
+ if (ns->proc_name->attr.omp_declare_target)
+ {
+ has_declare = true;
+ break;
+ }
+ }
+
+ if (has_declare && VAR_P (*decl_p) && has_declare)
+ {
+ /* Add to offload_vars; get_create does so for omp_declare_target,
+ omp_declare_target_link requires manual work. */
+ gcc_assert (symtab_node::get (*decl_p) == 0);
+ symtab_node *node = symtab_node::get_create (*decl_p);
+ if (node != NULL && sym_attr.omp_declare_target_link)
+ {
+ node->offloadable = 1;
+ if (ENABLE_OFFLOADING)
+ {
+ g->have_offload = true;
+ if (is_a <varpool_node *> (node))
+ vec_safe_push (offload_vars, *decl_p);
+ }
+ }
+ }
}
@@ -1578,7 +1613,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
{
tree decl;
tree length = NULL_TREE;
- tree attributes;
int byref;
bool intrinsic_array_parameter = false;
bool fun_or_res;
@@ -1864,12 +1898,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
decl = build_decl (gfc_get_location (&sym->declared_at),
VAR_DECL, gfc_sym_identifier (sym), gfc_sym_type (sym));
- /* Add attributes to variables. Functions are handled elsewhere. */
- attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
- decl_attributes (&decl, attributes, 0);
- if (sym->ts.deferred && VAR_P (length))
- decl_attributes (&length, attributes, 0);
-
/* Symbols from modules should have their assembler names mangled.
This is done here rather than in gfc_finish_var_decl because it
is different for string length variables. */
@@ -2035,6 +2063,12 @@ gfc_get_symbol_decl (gfc_symbol * sym)
TREE_READONLY (decl) = 1;
}
+ /* Add attributes to variables. Functions are handled elsewhere. */
+ add_attributes_to_decl (&decl, sym);
+
+ if (sym->ts.deferred && VAR_P (length))
+ decl_attributes (&length, DECL_ATTRIBUTES (decl), 0);
+
return decl;
}
@@ -2071,7 +2105,6 @@ static tree
get_proc_pointer_decl (gfc_symbol *sym)
{
tree decl;
- tree attributes;
if (sym->module || sym->fn_result_spec)
{
@@ -2151,8 +2184,7 @@ get_proc_pointer_decl (gfc_symbol *sym)
&& (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
set_decl_tls_model (decl, decl_default_tls_model (decl));
- attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
- decl_attributes (&decl, attributes, 0);
+ add_attributes_to_decl (&decl, sym);
return decl;
}
@@ -2166,7 +2198,6 @@ gfc_get_extern_function_decl (gfc_symbol * sym, gfc_actual_arglist *actual_args,
{
tree type;
tree fndecl;
- tree attributes;
gfc_expr e;
gfc_intrinsic_sym *isym;
gfc_expr argexpr;
@@ -2364,8 +2395,7 @@ module_sym:
DECL_EXTERNAL (fndecl) = 1;
TREE_PUBLIC (fndecl) = 1;
- attributes = add_attributes_to_decl (sym->attr, NULL_TREE);
- decl_attributes (&fndecl, attributes, 0);
+ add_attributes_to_decl (&fndecl, sym);
gfc_set_decl_assembler_name (fndecl, mangled_name);
@@ -2424,7 +2454,7 @@ module_sym:
static void
build_function_decl (gfc_symbol * sym, bool global)
{
- tree fndecl, type, attributes;
+ tree fndecl, type;
symbol_attribute attr;
tree result_decl;
gfc_formal_arglist *f;
@@ -2475,15 +2505,14 @@ build_function_decl (gfc_symbol * sym, bool global)
if (sym->attr.referenced || sym->attr.entry_master)
TREE_USED (fndecl) = 1;
- attributes = add_attributes_to_decl (attr, NULL_TREE);
- decl_attributes (&fndecl, attributes, 0);
+ add_attributes_to_decl (&fndecl, sym);
/* Figure out the return type of the declared function, and build a
RESULT_DECL for it. If this is a subroutine with alternate
returns, build a RESULT_DECL for it. */
result_decl = NULL_TREE;
/* TODO: Shouldn't this just be TREE_TYPE (TREE_TYPE (fndecl)). */
- if (attr.function)
+ if (sym->attr.function)
{
if (gfc_return_by_reference (sym))
type = void_type_node;
@@ -2530,7 +2559,7 @@ build_function_decl (gfc_symbol * sym, bool global)
/* Set attributes for PURE functions. A call to a PURE function in the
Fortran 95 sense is both pure and without side effects in the C
sense. */
- if (attr.pure || attr.implicit_pure)
+ if (sym->attr.pure || sym->attr.implicit_pure)
{
/* TODO: check if a pure SUBROUTINE has no INTENT(OUT) arguments
including an alternate return. In that case it can also be
generated by cgit v1.1 at 2025-04-02 13:16:08 +0000