procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

openmp, fortran: Add Fortran support for indirect clause on the declare target directive

Browse source 
2024-02-15  Kwok Cheung Yeung  <kcyeung@baylibre.com>

	gcc/fortran/
	* dump-parse-tree.cc (show_attr): Handle omp_declare_target_indirect
	attribute.
	* f95-lang.cc (gfc_gnu_attributes): Add entry for 'omp declare
	target indirect'.
	* gfortran.h (symbol_attribute): Add omp_declare_target_indirect
	field.
	(struct gfc_omp_clauses): Add indirect field.
	* openmp.cc (omp_mask2): Add OMP_CLAUSE_INDIRECT.
	(gfc_match_omp_clauses): Match indirect clause.
	(OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_INDIRECT.
	(gfc_match_omp_declare_target): Check omp_device_type and apply
	omp_declare_target_indirect attribute to symbol if indirect clause
	active.  Show warning if there are only device_type and/or indirect
	clauses on the directive.
	* trans-decl.cc (add_attributes_to_decl): Add 'omp declare target
	indirect' attribute if symbol has indirect attribute set.

	gcc/testsuite/
	* gfortran.dg/gomp/declare-target-4.f90 (f1): Update expected warning.
	* gfortran.dg/gomp/declare-target-indirect-1.f90: New.
	* gfortran.dg/gomp/declare-target-indirect-2.f90: New.

	libgomp/
	* testsuite/libgomp.fortran/declare-target-indirect-1.f90: New.
	* testsuite/libgomp.fortran/declare-target-indirect-2.f90: New.
	* testsuite/libgomp.fortran/declare-target-indirect-3.f90: New.
This commit is contained in:
Kwok Cheung Yeung 2024-02-15 20:59:39 +00:00
parent 617bd59c65
commit 451bb58660
11 changed files with 273 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
gcc/fortran/dump-parse-tree.cc
View file

@ -914,6 +914,8 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" OMP-DECLARE-TARGET", dumpfile);
if (attr->omp_declare_target_link)
fputs (" OMP-DECLARE-TARGET-LINK", dumpfile);
if (attr->omp_declare_target_indirect)
fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile);
if (attr->elemental)
fputs (" ELEMENTAL", dumpfile);
if (attr->pure)

2
gcc/fortran/f95-lang.cc
View file

@ -96,6 +96,8 @@ static const attribute_spec gfc_gnu_attributes[] =
gfc_handle_omp_declare_target_attribute, NULL },
{ "omp declare target link", 0, 0, true, false, false, false,
gfc_handle_omp_declare_target_attribute, NULL },
{ "omp declare target indirect", 0, 0, true, false, false, false,
gfc_handle_omp_declare_target_attribute, NULL },
{ "oacc function", 0, -1, true, false, false, false,
gfc_handle_omp_declare_target_attribute, NULL },
};

3
gcc/fortran/gfortran.h
View file

@ -999,6 +999,7 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
unsigned omp_declare_target_indirect:1;
ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
unsigned omp_allocate:1;
@ -1584,7 +1585,7 @@ typedef struct gfc_omp_clauses
unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1;
unsigned non_rectangular:1, order_concurrent:1;
unsigned contains_teams_construct:1, target_first_st_is_teams:1;
unsigned contained_in_target_construct:1;
unsigned contained_in_target_construct:1, indirect:1;
ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
ENUM_BITFIELD (gfc_omp_memorder) memorder:3;

50
gcc/fortran/openmp.cc
View file

@ -1096,6 +1096,7 @@ enum omp_mask2
OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */
OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */
/* This must come last. */
OMP_MASK2_LAST
};
@ -2798,6 +2799,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
needs_space = true;
continue;
}
if ((mask & OMP_CLAUSE_INDIRECT)
&& (m = gfc_match_dupl_check (!c->indirect, "indirect"))
!= MATCH_NO)
{
if (m == MATCH_ERROR)
goto error;
gfc_expr *indirect_expr = NULL;
m = gfc_match (" ( %e )", &indirect_expr);
if (m == MATCH_YES)
{
if (!gfc_resolve_expr (indirect_expr)
|| indirect_expr->ts.type != BT_LOGICAL
|| indirect_expr->expr_type != EXPR_CONSTANT)
{
gfc_error ("INDIRECT clause at %C requires a constant "
"logical expression");
gfc_free_expr (indirect_expr);
goto error;
}
c->indirect = indirect_expr->value.logical;
gfc_free_expr (indirect_expr);
}
else
c->indirect = 1;
continue;
}
if ((mask & OMP_CLAUSE_IS_DEVICE_PTR)
&& gfc_match_omp_variable_list
("is_device_ptr (",
@ -4460,7 +4487,7 @@ cleanup:
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
#define OMP_DECLARE_TARGET_CLAUSES \
(omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \
| OMP_CLAUSE_TO)
| OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT)
#define OMP_ATOMIC_CLAUSES \
(omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \
| OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \
@ -5513,6 +5540,15 @@ gfc_match_omp_declare_target (void)
n->sym->name, &n->where);
n->sym->attr.omp_device_type = c->device_type;
}
if (c->indirect)
{
if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
&& n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY)
gfc_error_now ("DEVICE_TYPE must be ANY when used with "
"INDIRECT at %L", &n->where);
n->sym->attr.omp_declare_target_indirect = c->indirect;
}
n->sym->mark = 1;
}
else if (n->u.common->omp_declare_target
@ -5558,15 +5594,23 @@ gfc_match_omp_declare_target (void)
" TARGET directive to a different DEVICE_TYPE",
s->name, &n->where);
s->attr.omp_device_type = c->device_type;
if (c->indirect
&& s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
&& s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY)
gfc_error_now ("DEVICE_TYPE must be ANY when used with "
"INDIRECT at %L", &n->where);
s->attr.omp_declare_target_indirect = c->indirect;
}
}
if (c->device_type
if ((c->device_type || c->indirect)
&& !c->lists[OMP_LIST_ENTER]
&& !c->lists[OMP_LIST_TO]
&& !c->lists[OMP_LIST_LINK])
gfc_warning_now (OPT_Wopenmp,
"OMP DECLARE TARGET directive at %L with only "
"DEVICE_TYPE clause is ignored", &old_loc);
"DEVICE_TYPE or INDIRECT clauses is ignored",
&old_loc);
gfc_buffer_error (true);

4
gcc/fortran/trans-decl.cc
View file

@ -1526,6 +1526,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = tree_cons (get_identifier ("omp declare target"),
clauses, list);
if (sym_attr.omp_declare_target_indirect)
list = tree_cons (get_identifier ("omp declare target indirect"),
clauses, list);
return list;
}

2
gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
View file

@ -2,7 +2,7 @@
! { dg-additional-options "-fdump-tree-original" }
subroutine f1
!$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" }
!$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" }
end subroutine
subroutine f2

62
gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 Normal file
View file

@ -0,0 +1,62 @@
! { dg-do compile }
! { dg-options "-fopenmp" }
module m
integer :: a
integer, parameter :: X = 1
integer, parameter :: Y = 2
! Indirect on a variable should have no effect.
integer :: z
!$omp declare target to (z) indirect
contains
subroutine sub1
!$omp declare target indirect to (sub1)
end subroutine
subroutine sub2
!$omp declare target enter (sub2) indirect (.true.)
end subroutine
subroutine sub3
!$omp declare target to (sub3) indirect (.false.)
end subroutine
subroutine sub4
!$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
end subroutine
! Compile-time non-constant expressions are not allowed.
subroutine sub5
!$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
end subroutine
! Compile-time constant expressions are permissible.
subroutine sub6
!$omp declare target indirect (X .eq. Y) to (sub6)
end subroutine
subroutine sub7
!$omp declare target indirect ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" }
end subroutine
subroutine sub8
!$omp declare target indirect (.true.) indirect (.false.) to (sub8) ! { dg-error "Duplicated .indirect. clause at .1." }
end subroutine
subroutine sub9
!$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
end subroutine
subroutine sub10
!$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" }
end subroutine
subroutine sub11
!$omp declare target indirect (.true.) device_type (host) enter (sub11) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." }
end subroutine
subroutine sub12
!$omp declare target indirect (.false.) device_type (nohost) enter (sub12)
end subroutine
end module

25
gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 Normal file
View file

@ -0,0 +1,25 @@
! { dg-do compile }
! { dg-options "-fopenmp -fdump-tree-gimple" }
module m
contains
subroutine sub1
!$omp declare target indirect enter (sub1)
end subroutine
! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub1" "gimple" } }
subroutine sub2
!$omp declare target indirect (.false.) to (sub2)
end subroutine
! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } }
subroutine sub3
!$omp declare target indirect (.true.) to (sub3)
end subroutine
! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub3" "gimple" } }
subroutine sub4
!$omp declare target indirect (.false.) enter (sub4)
end subroutine
! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } }
end module

39
libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 Normal file
View file

@ -0,0 +1,39 @@
! { dg-do run }
module m
contains
integer function foo ()
!$omp declare target to (foo) indirect
foo = 5
end function
integer function bar ()
!$omp declare target to (bar) indirect
bar = 8
end function
integer function baz ()
!$omp declare target to (baz) indirect
baz = 11
end function
end module
program main
use m
implicit none
integer :: x, expected
procedure (foo), pointer :: foo_ptr, bar_ptr, baz_ptr
foo_ptr => foo
bar_ptr => bar
baz_ptr => baz
expected = foo () + bar () + baz ()
!$omp target map (to: foo_ptr, bar_ptr, baz_ptr) map (from: x)
x = foo_ptr () + bar_ptr () + baz_ptr ()
!$omp end target
stop x - expected
end program

54
libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 Normal file
View file

@ -0,0 +1,54 @@
! { dg-do run }
! { dg-xfail-run-if "Requires libgomp bug fix pending review" { offload_device } }
module m
contains
integer function foo ()
!$omp declare target to (foo) indirect
foo = 5
end function
integer function bar ()
!$omp declare target to (bar) indirect
bar = 8
end function
integer function baz ()
!$omp declare target to (baz) indirect
baz = 11
end function
end module
program main
use m
implicit none
type fp
procedure (foo), pointer, nopass :: f => null ()
end type
integer, parameter :: N = 256
integer :: i, x = 0, expected = 0;
type (fp) :: fn_ptr (N)
do i = 1, N
select case (mod (i, 3))
case (0)
fn_ptr (i)%f => foo
case (1)
fn_ptr (i)%f => bar
case (2)
fn_ptr (i)%f => baz
end select
expected = expected + fn_ptr (i)%f ()
end do
!$omp target teams distribute parallel do &
!$omp & reduction(+: x) map (to: fn_ptr) map (tofrom: x)
do i = 1, N
x = x + fn_ptr (i)%f ()
end do
!$omp end target teams distribute parallel do
stop x - expected
end program

35
libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 Normal file
View file

@ -0,0 +1,35 @@
! { dg-do run }
! Check that indirect calls work on procedures passed in via a dummy argument
module m
integer, parameter :: offset = 123
contains
function bar(x)
!$omp declare target enter (bar) indirect
integer :: bar
integer, intent(in) :: x
bar = x + offset
end function
function foo(f, x)
integer :: foo
procedure(bar) :: f
integer, intent(in) :: x
!$omp target map (to: x) map (from: foo)
foo = f(x)
!$omp end target
end function
end module
program main
use m
implicit none
integer :: a = 321
integer :: b
b = foo(bar, a)
stop b - (a + offset)
end program