https://gcc.gnu.org/g:89058eb24376fe0d25ed586fab86b691672eb45d
commit r17-5300-g89058eb24376fe0d25ed586fab86b691672eb45d Author: Jerry DeLisle <[email protected]> Date: Mon Oct 5 11:14:03 2026 -0700 libgfortran: [PR127738] caf_shmem: give every team its own id The id of a team's shared data was computed from the team number and a count of FORM TEAM statements per image, which collided between teams and differed between the images of a team. Each team now takes its id from a counter in the supervisor, looked up per FORM TEAM statement of the parent team, and the ids of its coarrays are derived from it. Assisted-by: Claude Opus 5.5 PR libfortran/127738 libgfortran/ChangeLog: * caf/shmem.c (new_team_id): New function. (_gfortran_caf_form_team): Use it. Count the FORM TEAM statements of the current team. (_gfortran_caf_change_team): Derive the coarray ids from the team's id. * caf/shmem/supervisor.c (ensure_shmem_initialization): Initialize the id of the initial team and the next team id. * caf/shmem/supervisor.h (struct supervisor): Add next_team_id. * caf/shmem/teams_mgmt.h (struct caf_shmem_team): Add teams_formed. (struct shmem_image_info): Replace lastmemid by id. Add new_teams and new_teams_gen. gcc/testsuite/ChangeLog: * gfortran.dg/coarray/form_team_ids_1.f90: New test. Diff: --- .../gfortran.dg/coarray/form_team_ids_1.f90 | 32 +++++++++ libgfortran/caf/shmem.c | 78 ++++++++++++++++------ libgfortran/caf/shmem/supervisor.c | 31 ++++++--- libgfortran/caf/shmem/supervisor.h | 2 + libgfortran/caf/shmem/teams_mgmt.h | 9 ++- 5 files changed, 119 insertions(+), 33 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90 b/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90 new file mode 100644 index 000000000000..b542ed35f72e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/form_team_ids_1.f90 @@ -0,0 +1,32 @@ +! { dg-do run } +! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } } +! PR 127738 +! +! Each team formed gets its own shared data: team 2 and then team 1 formed +! from the same team, and a team formed after only some of its images formed +! a team inside a child team. + +program form_team_ids_1 + use iso_fortran_env, only : team_type + implicit none + type(team_type) :: t1, t2, inner, t3 + integer :: me, n + + me = this_image () + n = num_images () + form team (2, t1) + form team (1, t2, new_index = n + 1 - me) + change team (t2) + if (team_number () /= 1 .or. num_images () /= n) error stop 1 + if (this_image () /= n + 1 - me) error stop 2 + end team + + form team (mod (me - 1, 2) + 1, t1) + change team (t1) + if (team_number () == 1) form team (1, inner) + end team + form team (1, t3) + change team (t3) + if (num_images () /= n) error stop 3 + end team +end program form_team_ids_1 diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c index 4e5a816bf17f..90d069c72158 100644 --- a/libgfortran/caf/shmem.c +++ b/libgfortran/caf/shmem.c @@ -1716,6 +1716,50 @@ _gfortran_caf_random_init (bool repeatable, bool image_distinct) } } +/* The id of team TEAM_NO formed by the current FORM TEAM statement of the + current team. All images forming that team get the same id, which no + other team has. To be called with the allocator lock held, after counting + the statement. Returns 0 when the shared memory is exhausted. */ + +static memid +new_team_id (int team_no) +{ + struct shmem_image_info *info = caf_current_team->u.image_info; + struct new_team_id + { + int team_no; + memid id; + } *table; + int i; + + if (SHMPTR_IS_NULL (info->new_teams)) + { + info->new_teams + = allocator_shared_malloc (&local->ai.alloc, info->image_map_size + * sizeof (*table)); + if (SHMPTR_IS_NULL (info->new_teams)) + return 0; + info->new_teams_gen = 0; + } + table = SHMPTR_AS (struct new_team_id *, info->new_teams, &local->sm); + /* The first image of a new FORM TEAM statement clears the ids of the + previous one; the images all passed its final barrier. */ + if (info->new_teams_gen != caf_current_team->teams_formed) + { + for (i = 0; i < info->image_map_size; ++i) + table[i].team_no = 0; + info->new_teams_gen = caf_current_team->teams_formed; + } + for (i = 0; i < info->image_map_size && table[i].team_no != 0; ++i) + if (table[i].team_no == team_no) + return table[i].id; + /* Each image forms one team, so the table has room for all of them. */ + assert (i < info->image_map_size); + table[i].team_no = team_no; + table[i].id = this_image.supervisor->next_team_id++; + return table[i].id; +} + void _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index, int *stat, char *errmsg, size_t errmsg_len) @@ -1729,14 +1773,10 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index, = "The NEW_INDEX of FORM TEAMs has to be unique."; const char cannot_assign_index[] = "Can not assign new image index in FORM TEAM."; - static int image_size_shift = -1; - static int teams_count = 0; caf_shmem_team_t t; bool created; - memid tmemid; + memid id; - if (image_size_shift < 0) - image_size_shift = (int) round (log2 (local->total_num_images)); if (stat) *stat = 0; @@ -1764,23 +1804,21 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index, t = *((caf_shmem_team_t *) team); allocator_lock (&local->ai.alloc); - if (caf_current_team->team_no == -1) - tmemid = team_no + teams_count; - else - tmemid = (caf_current_team->u.image_info->lastmemid << image_size_shift) - + team_no + teams_count; - ++teams_count; + ++caf_current_team->teams_formed; + id = new_team_id (team_no); *t = (struct caf_shmem_team) { caf_teams_formed, team_no, -1, 0, NULL, - {alloc_get_memory_by_id_created ( - &local->ai, - sizeof (struct shmem_image_info) - + caf_current_team->u.image_info->image_map_size * sizeof (int), - -tmemid, &created)}}; + {id ? alloc_get_memory_by_id_created ( + &local->ai, + sizeof (struct shmem_image_info) + + caf_current_team->u.image_info->image_map_size * sizeof (int), + -id, &created) + : NULL}, + 0}; if (unlikely (t->u.image_info == NULL)) { allocator_unlock (&local->ai.alloc); @@ -1799,7 +1837,8 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index, t->u.image_info->team_id = team_no; t->u.image_info->image_map_size = 0; t->u.image_info->num_term_images = 0; - t->u.image_info->lastmemid = tmemid; + t->u.image_info->id = id; + t->u.image_info->new_teams = SHMPTR_NULL; register_team (t); /* Initialize a freshly created image_map with -1. */ for (int i = 0; i < caf_current_team->u.image_info->image_map_size; ++i) @@ -1899,10 +1938,7 @@ _gfortran_caf_change_team (caf_team_t team, int *stat, t->parent = caf_current_team; t->parent_teams_last_active_memid = next_memid; - next_memid = (t->u.image_info->team_parent_id != -1 - ? (((memid) t->u.image_info->team_parent_id) << 48) - : 0) - | (((memid) t->u.image_info->team_id) << 32) | 1; + next_memid = (t->u.image_info->id << 32) | 1; caf_current_team = t; sync_team (caf_current_team); } diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c index 8ef9a00429f4..2e8f70c509f1 100644 --- a/libgfortran/caf/shmem/supervisor.c +++ b/libgfortran/caf/shmem/supervisor.c @@ -217,16 +217,23 @@ ensure_shmem_initialization (void) caf_initial_team = caf_current_team = (caf_shmem_team_t) calloc (1, sizeof (struct caf_shmem_team)); allocator_lock (&local->ai.alloc); - *caf_initial_team = (struct caf_shmem_team) { - NULL, - -1, - this_image.image_num, - 0, - NULL, - {alloc_get_memory_by_id_created (&local->ai, - local->total_num_images * sizeof (int) - + sizeof (struct shmem_image_info), - next_memid++, &created)}}; + + *caf_initial_team = (struct caf_shmem_team) + { + NULL, + -1, + this_image.image_num, + 0, + NULL, + { + alloc_get_memory_by_id_created (&local->ai, + local->total_num_images * sizeof (int) + + sizeof (struct shmem_image_info), + next_memid++, + &created) + } + }; + if (caf_initial_team->u.image_info == NULL) caf_runtime_error ("Shared memory exhausted; increase " "GFORTRAN_SHARED_MEMORY_SIZE"); @@ -242,7 +249,8 @@ ensure_shmem_initialization (void) caf_initial_team->u.image_info->image_map_size = local->total_num_images; caf_initial_team->u.image_info->num_term_images = 0; - caf_initial_team->u.image_info->lastmemid = 0; + caf_initial_team->u.image_info->id = 0; + caf_initial_team->u.image_info->new_teams = SHMPTR_NULL; for (int i = 0; i < local->total_num_images; ++i) caf_initial_team->u.image_info->image_map[i] = i; register_team (caf_initial_team); @@ -258,6 +266,7 @@ ensure_shmem_initialization (void) counter_barrier_init (&this_image.supervisor->num_active_images, local->total_num_images); this_image.supervisor->teams = SHMPTR_NULL; + this_image.supervisor->next_team_id = 1; alloc_init_supervisor (&local->ai, &local->sm); sync_init_supervisor (&local->si, &local->ai); } diff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h index ea122de12b25..e63a3ea5abd5 100644 --- a/libgfortran/caf/shmem/supervisor.h +++ b/libgfortran/caf/shmem/supervisor.h @@ -66,6 +66,8 @@ typedef struct supervisor supervisor can reach the barriers of an image that terminated without leaving them. Pushed to without a lock. */ shared_mem_ptr teams; + /* The id of the next team formed; guarded by the allocator lock. */ + memid next_team_id; caf_shmem_mutex image_tracker_lock; #ifdef WIN32 size_t global_used_handles; diff --git a/libgfortran/caf/shmem/teams_mgmt.h b/libgfortran/caf/shmem/teams_mgmt.h index b87fc6f87d12..000d843f8c32 100644 --- a/libgfortran/caf/shmem/teams_mgmt.h +++ b/libgfortran/caf/shmem/teams_mgmt.h @@ -64,10 +64,17 @@ struct caf_shmem_team int num_term_images; /* The next team in the supervisor's list of teams. */ shared_mem_ptr next_team; - memid lastmemid; + /* The id of the team, unique among all teams formed. */ + memid id; + /* The ids given to the teams formed from this one by the FORM TEAM + statement with number NEW_TEAMS_GEN, see new_team_id. */ + shared_mem_ptr new_teams; + int new_teams_gen; int image_map[]; } *image_info; } u; + /* The number of FORM TEAM statements executed with this team current. */ + int teams_formed; }; typedef struct caf_shmem_team *caf_shmem_team_t;
