This patch depends on the nearly ready and mostly approved patch
[PATCH, OpenMP, v2] Implement local clause for declare target
https://gcc.gnu.org/pipermail/gcc-patches/2026-September/731712.html
Similar to CUDA language's __SHARED__ attribute that turns static variables
into variables that are only shared with threads (workers) on the same
streaming processor, OpenMP's 'omp groupprivate' also makes the variable
only shared within the same contention group (also known as 'team').
This patch enabled OpenMP's groupprivate support for Fortran but
only for offloading to Nvidia GPUs.
@Thomas: Is the nvptx change OK?
Any other comments, remarks, concerns?
Tobias
PS: For C/C++, parser support is missing, likewise LDS implementation
support for GCN; both is expected to become available. I currently do
not see us supporting groupprivate on the host for static variables.
Note: There is also 'dyn_groupprivate' which is related but quite
differently handled (spec wise and implementation wise).
OpenMP: ME, nvptx, Fortran: enable 'omp groupprivate' for nvptx offload
OpenMP's groupprivate variables are static variables that are have a copy
per team - which matches Nvidia's 'shared' variables. This commit enables
the support for offload to nvptx devices, only. Hence, a sorry is printed
unless device_type(nohost) is used - and likewise when attempting to use
them with GCN devices.
Note: As currently the variable is still output to the host-side assembler
code, accessing it from the host is still possible, but unless there is
only a single variable for all teams!
gcc/c-family/ChangeLog:
* c-attribs.cc (c_common_gnu_attributes): Add "omp groupprivate".
gcc/ChangeLog:
* config/nvptx/nvptx.cc (nvptx_encode_section_info): Handle
'omp groupprivate'.
* varpool.cc (varpool_node::get_create): Print sorry for
'omp groupprivate' variables except for device_type(nohost) and
no offloading or nvptx offloading.
gcc/fortran/ChangeLog:
* f95-lang.cc (gfc_gnu_attributes): Add "omp groupprivate".
* trans-common.cc (build_common_decl): Enable 'omp groupprivate'.
* trans-decl.cc (add_attributes_to_decl): Likewise.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/groupprivate-1.f90: Update sorry output.
* gfortran.dg/gomp/groupprivate-4.f90: Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/groupprivate-1.f90: New test.
* testsuite/libgomp.fortran/groupprivate-2.f90: New test.
diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc
index 3c0e780669b..d6258080313 100644
--- a/gcc/c-family/c-attribs.cc
+++ b/gcc/c-family/c-attribs.cc
@@ -619,6 +619,8 @@ const struct attribute_spec c_common_gnu_attributes[] =
handle_omp_declare_target_attribute, NULL },
{ "omp declare target nohost", 0, 0, true, false, false, false,
handle_omp_declare_target_attribute, NULL },
+ { "omp groupprivate", 0, 0, true, false, false, false,
+ handle_omp_declare_target_attribute, NULL },
{ "non overlapping", 0, 0, true, false, false, false,
handle_non_overlapping_attribute, NULL },
{ "alloc_align", 1, 1, false, true, true, false,
diff --git a/gcc/config/nvptx/nvptx.cc b/gcc/config/nvptx/nvptx.cc
index fb76e781350..39ea6e6f923 100644
--- a/gcc/config/nvptx/nvptx.cc
+++ b/gcc/config/nvptx/nvptx.cc
@@ -484,7 +484,8 @@ nvptx_encode_section_info (tree decl, rtx rtl, int first)
if (VAR_P (decl))
{
- if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl)))
+ if (lookup_attribute ("shared", DECL_ATTRIBUTES (decl))
+ || lookup_attribute ("omp groupprivate", DECL_ATTRIBUTES (decl)))
{
area = DATA_AREA_SHARED;
if (DECL_INITIAL (decl))
diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index bfc2651c076..10d18fe5a22 100644
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -100,6 +100,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 },
+ { "omp groupprivate", 0, 0, true, false, false, false,
+ gfc_handle_omp_declare_target_attribute, NULL },
};
static const scoped_attribute_specs gfc_gnu_attribute_table =
diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc
index 5458237a002..2674ef374e1 100644
--- a/gcc/fortran/trans-common.cc
+++ b/gcc/fortran/trans-common.cc
@@ -467,6 +467,9 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
gfc_set_decl_location (decl, &com->where);
+ if (com->omp_groupprivate)
+ DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp groupprivate"),
+ NULL_TREE, DECL_ATTRIBUTES (decl));
tree arg_list = NULL_TREE;
if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET)
{
@@ -488,12 +491,6 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
arg_list = tree_cons (NULL_TREE, get_identifier (arg_str), arg_list);
}
- /* Also check trans-decl.cc when updating/removing the following;
- also update f95.c's gfc_gnu_attributes. */
- if (com->omp_groupprivate)
- gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, used by common "
- "block %</%s/%> declared at %L", com->name, &com->where);
-
if (com->omp_declare_target_link)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target link"),
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index dc17b658d10..2b7ef12c1a8 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1582,12 +1582,13 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym)
clauses = c;
}
- /* FIXME: 'declare_target_link' permits both any and host, but
- will fail if one sets OMP_CLAUSE_DEVICE_TYPE_KIND. */
+ if (sym_attr.omp_groupprivate)
+ list = tree_cons (get_identifier ("omp groupprivate"), NULL_TREE, list);
+
tree arg_list = NULL_TREE;
if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
&& !sym_attr.omp_declare_target_link
- && !sym_attr.omp_declare_target_indirect /* implies 'any' */)
+ && !sym_attr.omp_declare_target_indirect)
{
const char *arg_str = NULL;
switch (sym_attr.omp_device_type)
@@ -1607,12 +1608,6 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym)
arg_list = tree_cons (NULL_TREE, get_identifier (arg_str), arg_list);
}
- /* Also check trans-common.cc when updating/removing the following;
- also update f95.c's gfc_gnu_attributes. */
- if (sym_attr.omp_groupprivate)
- gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, "
- "used by %qs declared at %L", sym->name, &sym->declared_at);
-
bool has_declare = true;
if (flag_openmp)
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90
index 1d9f5492d6a..80bf6c61023 100644
--- a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90
@@ -2,13 +2,14 @@ module m
implicit none
integer :: ii
integer :: x, y(20), z, v, u, k
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'x' declared at .1." "" { target *-*-* } .-1 }
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'y' declared at .1." "" { target *-*-* } .-2 }
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'z' declared at .1." "" { target *-*-* } .-3 }
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'v' declared at .1." "" { target *-*-* } .-4 }
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'u' declared at .1." "" { target *-*-* } .-5 }
-! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'k' declared at .1." "" { target *-*-* } .-6 }
-!
+ ! { dg-message "sorry, unimplemented: 'k' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-1 }
+ ! { dg-message "sorry, unimplemented: 'u' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-2 }
+ ! { dg-message "sorry, unimplemented: 'x' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-3 }
+ ! { dg-message "sorry, unimplemented: 'y' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-4 }
+ ! { dg-message "sorry, unimplemented: 'z' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" "" { target *-*-* } .-5 }
+
+ ! { dg-prune-output "sorry, unimplemented: 'v' with 'omp groupprivate' on devices other than" }
+
!$omp groupprivate(x, z) device_Type( any )
!$omp declare target local(x) device_type ( any )
!$omp declare target enter( ii) ,local(y), device_type ( host )
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90
index a980c1fa0bd..278b9b51343 100644
--- a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90
@@ -4,12 +4,14 @@ module m
integer :: x, y(20), z, v, u, k
common /b_ii/ ii
- common /b_x/ x ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_x/' declared at .1." }
- common /b_y/ y ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_y/' declared at .1." }
- common /b_z/ z ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_z/' declared at .1." }
- common /b_v/ v ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_v/' declared at .1." }
- common /b_u/ u ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_u/' declared at .1." }
- common /b_k/ k ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_k/' declared at .1." }
+ common /b_x/ x ! { dg-message "sorry, unimplemented: 'b_x' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" }
+ common /b_y/ y ! { dg-message "sorry, unimplemented: 'b_y' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" }
+ common /b_z/ z ! { dg-message "sorry, unimplemented: 'b_z' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" }
+ common /b_v/ v
+ common /b_u/ u ! { dg-message "sorry, unimplemented: 'b_u' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" }
+ common /b_k/ k ! { dg-message "sorry, unimplemented: 'b_k' with 'omp groupprivate' on the host; try 'device_type\\(nohost\\)'" }
+
+ ! { dg-prune-output "sorry, unimplemented: 'b_v' with 'omp groupprivate' on devices other than" }
!$omp groupprivate(/b_x/, /b_z/) device_Type( any )
!$omp declare target local(/b_x/) device_type ( any )
diff --git a/gcc/varpool.cc b/gcc/varpool.cc
index b62fba99996..f858352940a 100644
--- a/gcc/varpool.cc
+++ b/gcc/varpool.cc
@@ -156,6 +156,33 @@ varpool_node::get_create (tree decl)
DECL_ATTRIBUTES (decl))))
{
node->offloadable = 1;
+ if (lookup_attribute ("omp groupprivate", DECL_ATTRIBUTES (decl)))
+ {
+ if (!value_member (get_identifier ("device_type(nohost)"),
+ TREE_VALUE (attr))
+ && !lookup_attribute ("omp declare target nohost",
+ DECL_ATTRIBUTES (decl)))
+ /* FIXME: value_member is Fortran, nohost attribute is C/C++. */
+ sorry_at (DECL_SOURCE_LOCATION (decl),
+ "%qD with %<omp groupprivate%> on the host; "
+ "try %<device_type(nohost)%>", decl);
+ else
+ for (const char *c = getenv ("OFFLOAD_TARGET_NAMES"); c;)
+ {
+ if (startswith (c, "nvptx")) /* Supported. */
+ {
+ if ((c = strchr (c, ':')))
+ c++;
+ }
+ else
+ {
+ sorry_at (DECL_SOURCE_LOCATION (decl),
+ "%qD with %<omp groupprivate%> on devices other "
+ "than nvptx; try %<-foffload=nvptx-none%>", decl);
+ break;
+ }
+ }
+ }
if (ENABLE_OFFLOADING && !DECL_EXTERNAL (decl))
{
g->have_offload = true;
diff --git a/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 b/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90
new file mode 100644
index 00000000000..27156aae1f8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90
@@ -0,0 +1,100 @@
+! { dg-do run { target offload_device_nvptx } }
+! { dg-additional-options "-O0 -foffload=nvptx-none" }
+!
+! FIXME: Enable testing for AMD GCN once implemented
+!
+! The following code works if
+! - either 'target teams' runs in sequence order (this seems to happen on the
+! host for 'target teams' but not for 'teams')
+! - or, when teams run concurrently, if 'cnt' and 'local_cnt' are 'groupprivate'.
+!
+! The latter is check by this testcase.
+!
+! On nvptx, such memory is called 'shared' and it turns out that the address
+! is the same for all teams. However, the value check only succeeds if it is
+! indeed shared! The produced nvptx assembly is:
+! .shared .align 4 .u32 local_cnt$1[1];
+! .visible .shared .align 4 .u32 __m_MOD_cnt[1];
+!
+module m
+ use iso_c_binding
+ use omp_lib
+ implicit none
+
+ integer :: cnt ! Note that no initializer is permitted!
+ !$omp declare target local(cnt) device_type(nohost)
+ !$omp groupprivate(cnt) device_type(nohost)
+
+contains
+
+ integer(c_ptrdiff_t) function addr()
+ addr = loc(cnt)
+ end
+
+ integer function f_global(first)
+ !$omp declare target enter(f_global) device_type(nohost)
+ logical, value, intent(in) :: first
+
+ if (first) then
+ !$omp atomic write
+ cnt = 0
+ end if
+ !$omp atomic update
+ cnt = cnt + (omp_get_team_num () + 1);
+ !$omp atomic read
+ f_global = cnt
+ end
+
+ integer function f_local(first)
+ !$omp declare target enter(f_local) device_type(nohost)
+ logical, value, intent(in) :: first
+ integer, save :: local_cnt
+ !$omp groupprivate(local_cnt) device_type(nohost)
+
+ if (first) then
+ !$omp atomic write
+ local_cnt = 5
+ end if
+ !$omp atomic update
+ local_cnt = local_cnt + 2*(omp_get_team_num () + 1);
+ !$omp atomic read
+ f_local = local_cnt
+ end
+end module m
+
+program main
+ use m
+ implicit none
+ integer :: team_global(16), team_local(16), j, num_teams
+ integer(c_ptrdiff_t) :: addrs(16)
+
+ ! !$omp teams num_teams(16)
+ !$omp target teams num_teams(16) map(from: team_global, team_local, num_teams) device_type(nohost)
+ block
+ !$omp parallel if(.false.)
+ block
+ integer :: i
+ real, volatile :: x
+ x = 3.3
+ i = f_global(.true.)
+ i = f_local(.true.)
+ addrs(1+omp_get_team_num()) = addr()
+ x = sin(x)
+ team_global(1+omp_get_team_num()) = f_global(.false.)
+ team_local(1+omp_get_team_num()) = f_local(.false.)
+ if (omp_get_team_num() == 0) &
+ num_teams = omp_get_num_teams ()
+ end block
+ end block
+
+ if (num_teams /= 16) error stop "num teams error"
+
+ do j = 1, 16
+ if (team_global(j) /= j*2 .or. team_local(j) /= 5+j*4) then
+ print '(i2,": ", 4(i6, " "), g0, " ", g0, " - ", z16)', j,&
+ team_global(j), team_local(j), j*2, 5+j*4, &
+ team_global(j)==j*2, team_local(j)==5+j*4, addrs(j)
+ error stop "invalid value"
+ end if
+ end do
+end
diff --git a/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90 b/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90
new file mode 100644
index 00000000000..f52c1d095ff
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/groupprivate-2.f90
@@ -0,0 +1,102 @@
+! { dg-do run { target offload_device_nvptx } }
+! { dg-additional-options "-O0 -foffload=nvptx-none" }
+!
+! FIXME: Enable testing for AMD GCN once implemented
+!
+! The following code works if
+! - either 'target teams' runs in sequence order (this seems to happen on the
+! host for 'target teams' but not for 'teams')
+! - or, when teams run concurrently, if 'cnt' and 'local_cnt' are 'groupprivate'.
+!
+! The latter is check by this testcase.
+!
+! On nvptx, such memory is called 'shared' and it turns out that the address
+! is the same for all teams. However, the value check only succeeds if it is
+! indeed shared! The produced nvptx assembly is:
+! .shared .align 4 .u32 local_cnt$1[1];
+! .visible .shared .align 4 .u32 __m_MOD_cnt[1];
+!
+module m
+ use iso_c_binding
+ use omp_lib
+ implicit none
+
+ integer :: cnt ! Note that no initializer is permitted!
+ common /one/ cnt
+ !$omp declare target local(/one/) device_type(nohost)
+ !$omp groupprivate(/one/) device_type(nohost)
+
+contains
+
+ integer(c_ptrdiff_t) function addr()
+ addr = loc(cnt)
+ end
+
+ integer function f_global(first)
+ !$omp declare target enter(f_global) device_type(nohost)
+ logical, value, intent(in) :: first
+
+ if (first) then
+ !$omp atomic write
+ cnt = 0
+ end if
+ !$omp atomic update
+ cnt = cnt + (omp_get_team_num () + 1);
+ !$omp atomic read
+ f_global = cnt
+ end
+
+ integer function f_local(first)
+ !$omp declare target enter(f_local) device_type(nohost)
+ logical, value, intent(in) :: first
+ integer :: local_cnt
+ common /two/ local_cnt
+ !$omp groupprivate(/two/) device_type(nohost)
+
+ if (first) then
+ !$omp atomic write
+ local_cnt = 5
+ end if
+ !$omp atomic update
+ local_cnt = local_cnt + 2*(omp_get_team_num () + 1);
+ !$omp atomic read
+ f_local = local_cnt
+ end
+end module m
+
+program main
+ use m
+ implicit none
+ integer :: team_global(16), team_local(16), j, num_teams
+ integer(c_ptrdiff_t) :: addrs(16)
+
+ ! !$omp teams num_teams(16)
+ !$omp target teams num_teams(16) map(from: team_global, team_local, num_teams) device_type(nohost)
+ block
+ !$omp parallel if(.false.)
+ block
+ integer :: i
+ real, volatile :: x
+ x = 3.3
+ i = f_global(.true.)
+ i = f_local(.true.)
+ addrs(1+omp_get_team_num()) = addr()
+ x = sin(x)
+ team_global(1+omp_get_team_num()) = f_global(.false.)
+ team_local(1+omp_get_team_num()) = f_local(.false.)
+ if (omp_get_team_num() == 0) &
+ num_teams = omp_get_num_teams ()
+ end block
+ end block
+
+ if (num_teams /= 16) error stop "num teams error"
+
+ do j = 1, 16
+ if (team_global(j) /= j*2 .or. team_local(j) /= 5+j*4) then
+ print '(i2,": ", 4(i6, " "), g0, " ", g0, " - ", z16)', j,&
+ team_global(j), team_local(j), j*2, 5+j*4, &
+ team_global(j)==j*2, team_local(j)==5+j*4, addrs(j)
+ error stop "invalid value"
+ end if
+ end do
+end
