TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fortran: Fix form team in caf_shmem [PR124071]

Browse Source 
Form team w/o new_index= tried to compute the new_index assuming that
images are scattered onto to teams. I.e. the distribution is:

Image index: 1 2 3 4 5 6
New team no: 1 2 1 2 1 2 , i.e. scattered

But this algorithm failed, when the images were linearly distributed
into the new teams, like in:

Image index: 1 2 3 4 5 6
New team no: 1 1 1 2 2 2

The new approach is to look up a free index in the new team, when the
computed one is already taken.  Because F2018, 11.6.9, §4 states the
new index is processor dependent, it feels safe to do it this way.

	PR fortran/124071

libgfortran/ChangeLog:

	* caf/shmem.c (_gfortran_caf_form_team): Take free index, when
	computed one is already taken.

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray/form_team_1.f90: New test.
This commit is contained in:
Andre Vehreschild
2026-02-12 11:13:25 +01:00
committed by Jerry DeLisle
parent 136940891b
commit a1b67de3a4
2 changed files with 53 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/testsuite/gfortran.dg/coarray/form_team_1.f90 Normal file
View File

@@ -0,0 +1,18 @@
!{ dg-do run }
program main
use, intrinsic :: iso_fortran_env, only: team_type
implicit none
type(team_type) :: team
integer :: slice_size, team_no
if (num_images() >= 3) then
slice_size = num_images() / 3
team_no = this_image() / slice_size + 1
form team (team_no, team)
sync all
end if
end program

45
libgfortran/caf/shmem.c
View File

@@ -1768,26 +1768,51 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
}
else
{
int im;
int exp = -1;
int im, cnt;
int exp;
__atomic_fetch_add (&t->u.image_info->image_map_size, 1,
__ATOMIC_SEQ_CST);
sync_team (caf_current_team);
im = caf_current_team->index * t->u.image_info->image_map_size
cnt = t->u.image_info->image_map_size;
/* Try to map the source team's images linearly into the domain of the
new team. This works for scattered teams distributions. I.e. when a
set of images is distritubed in this way:
Image no: 1 2 3 4 5 6
New team: 1 2 1 2 1 2
but not for:
Image no: 1 2 3 4 5 6
New team: 1 1 1 2 2 2
*/
im = caf_current_team->index * cnt
/ caf_current_team->u.image_info->image_count.count;
/* Map our old index into the domain of the new team's size. */
if (__atomic_compare_exchange_n (&t->u.image_info->image_map[im], &exp,
this_image.image_num, false,
__ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST))
t->index = im;
else
do
{
caf_internal_error (cannot_assign_index, stat, errmsg, errmsg_len);
return;
/* (Re-)set exp. */
exp = -1;
if (__atomic_compare_exchange_n (&t->u.image_info->image_map[im],
&exp, this_image.image_num, false,
__ATOMIC_SEQ_CST, __ATOMIC_SEQ_CST))
{
t->index = im;
goto form_team_finish;
}
/* Find a free new_index in the newly formed team for this image.
There no longer is any order to the teams. */
++im;
if (im >= t->u.image_info->image_map_size)
im = 0;
--cnt;
}
while (cnt > 0);
caf_internal_error (cannot_assign_index, stat, errmsg, errmsg_len);
return;
}
form_team_finish:
sync_team (caf_current_team);
caf_teams_formed = t;