https://gcc.gnu.org/g:84d93bc97a3610446c4e19fa84d5a10f8b668358
commit r17-4677-g84d93bc97a3610446c4e19fa84d5a10f8b668358 Author: Tobias Burnus <[email protected]> Date: Sat Sep 26 10:57:31 2026 +0200 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: * libgomp.texi (Impl.Status): Mark 'omp groupprivate' as partially supported. * testsuite/libgomp.fortran/groupprivate-1.f90: New test. * testsuite/libgomp.fortran/groupprivate-2.f90: New test. Diff: --- gcc/c-family/c-attribs.cc | 2 + gcc/config/nvptx/nvptx.cc | 3 +- gcc/fortran/f95-lang.cc | 2 + gcc/fortran/trans-common.cc | 9 +- gcc/fortran/trans-decl.cc | 13 +-- gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 | 15 +-- gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 | 14 +-- gcc/varpool.cc | 27 ++++++ libgomp/libgomp.texi | 3 +- .../testsuite/libgomp.fortran/groupprivate-1.f90 | 100 ++++++++++++++++++++ .../testsuite/libgomp.fortran/groupprivate-2.f90 | 102 +++++++++++++++++++++ 11 files changed, 260 insertions(+), 30 deletions(-) diff --git a/gcc/c-family/c-attribs.cc b/gcc/c-family/c-attribs.cc index 0e2e17cc0bec..1e6e21005d39 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 fb76e7813507..39ea6e6f923d 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 bfc2651c0767..10d18fe5a221 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 5458237a002c..2674ef374e18 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 dc17b658d10e..2b7ef12c1a82 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 1d9f5492d6af..80bf6c61023d 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 a980c1fa0bd6..278b9b513439 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 b62fba999968..d30bd248e182 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/libgomp.texi b/libgomp/libgomp.texi index 4a1069833082..7f34a36e38b7 100644 --- a/libgomp/libgomp.texi +++ b/libgomp/libgomp.texi @@ -533,7 +533,8 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab @item @code{delete} as delete-modifier not as map type @tab N @tab @item For Fortran, the @code{automap} modifier to the @code{enter} clause of @code{declare_target} @tab N @tab -@item @code{groupprivate} directive @tab N @tab +@item @code{groupprivate} directive @tab P @tab + Only Fortran with @code{device_type(nohost)} with only nvptx GPUs @item @code{local} clause to @code{declare_target} directive @tab N @tab @item @code{part_size} allocator trait for @code{interleaved} allocator partitions @tab N @tab diff --git a/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 b/libgomp/testsuite/libgomp.fortran/groupprivate-1.f90 new file mode 100644 index 000000000000..27156aae1f86 --- /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 000000000000..f52c1d095ff6 --- /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
