OpenMP/Fortran: Fix handling of 'declare target' with 'link' clause [PR115559]
Contrary to a normal 'declare target', the 'declare target link' attribute also needs to set node->offloadable and push the offload_vars in the front end. Linked variables require that the data is mapped. For module variables, this can happen anywhere. For variables in an external subprograms or the main programm, this can only happen in the either that program itself or in an internal subprogram. - Whether a variable is just normally mapped or linked then becomes relevant if a device routine exists that can access that variable, i.e. an internal procedure has then to be marked as declare target. PR fortran/115559 gcc/fortran/ChangeLog: * trans-common.cc (build_common_decl): Add 'omp declare target' and 'omp declare target link' variables to offload_vars. * trans-decl.cc (add_attributes_to_decl): Likewise; update args and call decl_attributes. (get_proc_pointer_decl, gfc_get_extern_function_decl, build_function_decl): Update calls. (gfc_get_symbol_decl): Likewise; move after 'DECL_STATIC (t)=1' to avoid errors with symtab_node::get_create. libgomp/ChangeLog: * testsuite/libgomp.fortran/declare-target-link.f90: New test.
This commit is contained in:
Tobias Burnus
parent
14c47e7eb0
commit
29b1587e7d
3 changed files with 192 additions and 26 deletions
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
116
libgomp/testsuite/libgomp.fortran/declare-target-link.f90
Normal file
116
libgomp/testsuite/libgomp.fortran/declare-target-link.f90
Normal file
|
|
@ -0,0 +1,116 @@
|
|||
! { dg-additional-options "-Wall" }
|
||||
! PR fortran/115559
|
||||
|
||||
module m
|
||||
integer :: A
|
||||
!$omp declare target link(A)
|
||||
end module m
|
||||
|
||||
subroutine f
|
||||
implicit none (type, external)
|
||||
integer, save :: x, y ! { dg-warning "Unused variable 'y' declared" }
|
||||
!$omp declare target link(x, y)
|
||||
|
||||
! note: y is not 'link' as gfortran doesn't regard it as used
|
||||
x = 6
|
||||
call ii
|
||||
|
||||
contains
|
||||
subroutine k
|
||||
!$omp declare target
|
||||
use m
|
||||
A = 5
|
||||
end
|
||||
subroutine ii
|
||||
integer :: res
|
||||
!$omp target map(x) map(from: res)
|
||||
call k()
|
||||
call ll()
|
||||
res = get()
|
||||
!$omp end target
|
||||
! print *, res
|
||||
if (res /= 6 + 7 + 5) &
|
||||
stop 1
|
||||
end
|
||||
subroutine ll
|
||||
!$omp declare target
|
||||
x = x + 7
|
||||
end
|
||||
integer function get()
|
||||
use m
|
||||
!$omp declare target
|
||||
get = x + A
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
subroutine sub
|
||||
implicit none (type, external)
|
||||
integer, save :: arr(100), arr2(1:4)
|
||||
!$omp declare target link(arr,arr2)
|
||||
|
||||
call mapit
|
||||
call device1
|
||||
call re_mapit
|
||||
call device2
|
||||
contains
|
||||
subroutine mapit
|
||||
integer :: i
|
||||
arr = [(i, i=1,100)]
|
||||
!$omp target enter data map(to:arr(10:50)) map(alloc: arr2(1:4))
|
||||
end subroutine
|
||||
subroutine re_mapit
|
||||
integer :: i
|
||||
!$omp target exit data map(from:arr(10:50)) map(delete: arr2)
|
||||
|
||||
if (any (arr(1:9) /= [(i, i=1,9)])) stop 2
|
||||
if (any (arr(10:50) /= [(3-10*i, i=10,50)])) stop 3
|
||||
if (any (arr(51:100) /= [(i, i=51,100)])) stop 4
|
||||
end subroutine
|
||||
|
||||
subroutine device1
|
||||
integer :: res
|
||||
!$omp target map(from:res)
|
||||
res = run_device1()
|
||||
!$omp end target
|
||||
print *, res
|
||||
! FIXME: arr2 not link mapped -> PR115637
|
||||
! if (res /= -11436) stop 5
|
||||
if (res /= -11546) stop 5 ! FIXME
|
||||
end
|
||||
integer function run_device1()
|
||||
!$omp declare target
|
||||
integer :: i
|
||||
run_device1 = -99
|
||||
! FIXME: arr2 not link mapped -> PR115637
|
||||
! arr2 = [11,22,33,44]
|
||||
if (any (arr(10:50) /= [(i, i=10,50)])) then
|
||||
run_device1 = arr(11)
|
||||
return
|
||||
end if
|
||||
! FIXME: -> PR115637
|
||||
! run_device1 = sum(arr(10:13) + arr2)
|
||||
run_device1 = sum(arr(10:13) ) ! FIXME
|
||||
do i = 10, 50
|
||||
arr(i) = 3 - 10 * arr(i)
|
||||
end do
|
||||
run_device1 = run_device1 + sum(arr(15:50))
|
||||
end
|
||||
subroutine device2
|
||||
end
|
||||
integer function run_device2()
|
||||
!$omp declare target
|
||||
run_device2 = -99
|
||||
end
|
||||
end
|
||||
|
||||
|
||||
use m
|
||||
implicit none (type, external)
|
||||
external f
|
||||
external sub
|
||||
|
||||
!$omp target enter data map(alloc: A)
|
||||
call f()
|
||||
call sub
|
||||
end
|
||||
Loading…
Add table
Reference in a new issue