On 9/29/26 1:14 AM, Mikael Morin wrote:
Le 28/09/2026 à 22:30, Jerry D a écrit :
I have been out on travel this weekend. I am curious why the email is marked
SPAM? I will look at your comments tomorro.
Yes, sorry about it, I forgot to remove the SPAM marker. There is obviously a
spam filter before I receive the message; it selects its messages more or less
randomly, and it marks them with a tag in the subject rather than with a
dedicated attribute. Yes, it's more a nuisance than an help, but it's out of my
control.
Attached is v2 of the patch. I had claude run fuzz tests on this which generated
about 900 variations. Doing this identified another small adjustment needed to
avoid some timing issues under heavy loads in the counter_barrier.c code.
Regression tested on x86_64.
Ok for mainline?
Regards,
Jerry
---
libgfortran: [PR127347] caf_shmem: drop images killed by a
signal from teams
An image that terminates without STOP or FAIL IMAGE, e.g. when it is
killed by a signal, cannot drop itself from the barriers of its teams,
so the other images blocked forever in their next image control
statement. Only the supervisor notices such an image, and it has no
access to the teams the image was a member of.
Every team now registers itself with the supervisor when it is formed,
which happens once per team, so that the supervisor can walk the teams
and do for a killed image what the image itself does for a STOP.
Entries are pushed onto the list without a lock, so that an image
killed while registering a team cannot block the supervisor.
An image killed this way stays a failed image (F2023 5.3.6): the other
images of its teams carry on and report it through STAT=.
Reporting it needs SYNC ALL and SYNC TEAM to check the images of the
team after synchronizing. They only did so when they had not
synchronized, which is the case for a stopped image; with a failed
image the active images are synchronized (F2023 11.7.11) and the only
other check ran before the barrier, so an image failing while the
others already waited in the statement left STAT= zero.
Assisted-by: Claude Opus 5.5
PR libfortran/127347
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_init): Synchronize without the checks
of the SYNC ALL statement.
(_gfortran_caf_sync_all, _gfortran_caf_sync_team): Report the images
of the team that terminated before the images synchronized.
(_gfortran_caf_form_team): Register the team.
* caf/shmem/collective_subroutine.c (collsub_sync): Adjust.
* caf/shmem/counter_barrier.c (counter_barrier_init): Initialize the
new fields.
(counter_barrier_add_locked): Count the images removed from the
barrier.
(next_round): Take that count as the round ends.
(wait_round, counter_barrier_wait_abortable): Report it for the round
the image took part in.
* caf/shmem/counter_barrier.h (counter_barrier): Add terminated,
round_terminated and round_terminated_round.
(counter_barrier_wait_abortable): Adjust.
* caf/shmem/supervisor.c (ensure_shmem_initialization): Initialize
the list of teams. Register the initial team.
(supervisor_main_loop): Drop an image that terminated without
leaving its teams from them.
* caf/shmem/supervisor.h (supervisor): Add teams.
* caf/shmem/sync.c (sync_all, sync_team_unless_stopped): Report the
images that terminated.
* caf/shmem/sync.h (sync_all, sync_team_unless_stopped): Adjust.
* caf/shmem/teams_mgmt.c (team_terminated_images)
(update_teams_images_locked, leave_team): Take the team's image
info.
(register_team, update_registered_teams): New functions.
* caf/shmem/teams_mgmt.h (shmem_image_info): Add next_team.
(register_team, update_registered_teams): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/signal_sync_1.f90: New test.
* gfortran.dg/coarray/signal_team_1.f90: New test.
* gfortran.dg/coarray/sync_failed_stat_1.f90: New test.
---
From a1024e03a7f5b1ac7ebecf21453377c91ef51654 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Thu, 24 Sep 2026 12:57:23 -0700
Subject: [PATCH] libgfortran: [PR127347] caf_shmem: drop images killed by a
signal from teams
An image that terminates without STOP or FAIL IMAGE, e.g. when it is
killed by a signal, cannot drop itself from the barriers of its teams,
so the other images blocked forever in their next image control
statement. Only the supervisor notices such an image, and it has no
access to the teams the image was a member of.
Every team now registers itself with the supervisor when it is formed,
which happens once per team, so that the supervisor can walk the teams
and do for a killed image what the image itself does for a STOP.
Entries are pushed onto the list without a lock, so that an image
killed while registering a team cannot block the supervisor.
An image killed this way stays a failed image (F2023 5.3.6): the other
images of its teams carry on and report it through STAT=.
Reporting it needs SYNC ALL and SYNC TEAM to check the images of the
team after synchronizing. They only did so when they had not
synchronized, which is the case for a stopped image; with a failed
image the active images are synchronized (F2023 11.7.11) and the only
other check ran before the barrier, so an image failing while the
others already waited in the statement left STAT= zero.
Assisted-by: Claude Opus 5.5
PR libfortran/127347
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_init): Synchronize without the checks
of the SYNC ALL statement.
(_gfortran_caf_sync_all, _gfortran_caf_sync_team): Report the images
of the team that terminated before the images synchronized.
(_gfortran_caf_form_team): Register the team.
* caf/shmem/collective_subroutine.c (collsub_sync): Adjust.
* caf/shmem/counter_barrier.c (counter_barrier_init): Initialize the
new fields.
(counter_barrier_add_locked): Count the images removed from the
barrier.
(next_round): Take that count as the round ends.
(wait_round, counter_barrier_wait_abortable): Report it for the round
the image took part in.
* caf/shmem/counter_barrier.h (counter_barrier): Add terminated,
round_terminated and round_terminated_round.
(counter_barrier_wait_abortable): Adjust.
* caf/shmem/supervisor.c (ensure_shmem_initialization): Initialize
the list of teams. Register the initial team.
(supervisor_main_loop): Drop an image that terminated without
leaving its teams from them.
* caf/shmem/supervisor.h (supervisor): Add teams.
* caf/shmem/sync.c (sync_all, sync_team_unless_stopped): Report the
images that terminated.
* caf/shmem/sync.h (sync_all, sync_team_unless_stopped): Adjust.
* caf/shmem/teams_mgmt.c (team_terminated_images)
(update_teams_images_locked, leave_team): Take the team's image
info.
(register_team, update_registered_teams): New functions.
* caf/shmem/teams_mgmt.h (shmem_image_info): Add next_team.
(register_team, update_registered_teams): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/signal_sync_1.f90: New test.
* gfortran.dg/coarray/signal_team_1.f90: New test.
* gfortran.dg/coarray/sync_failed_stat_1.f90: New test.
---
.../gfortran.dg/coarray/signal_sync_1.f90 | 22 ++++++
.../gfortran.dg/coarray/signal_team_1.f90 | 26 +++++++
.../coarray/sync_failed_stat_1.f90 | 30 +++++++
libgfortran/caf/shmem.c | 30 +++++--
libgfortran/caf/shmem/collective_subroutine.c | 2 +-
libgfortran/caf/shmem/counter_barrier.c | 24 +++++-
libgfortran/caf/shmem/counter_barrier.h | 11 ++-
libgfortran/caf/shmem/supervisor.c | 5 ++
libgfortran/caf/shmem/supervisor.h | 4 +
libgfortran/caf/shmem/sync.c | 9 ++-
libgfortran/caf/shmem/sync.h | 8 +-
libgfortran/caf/shmem/teams_mgmt.c | 78 ++++++++++++++-----
libgfortran/caf/shmem/teams_mgmt.h | 13 ++++
13 files changed, 219 insertions(+), 43 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/signal_sync_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/sync_failed_stat_1.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/signal_sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/signal_sync_1.f90
new file mode 100644
index 00000000000..416cee6d8e6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/signal_sync_1.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-shouldfail "an image is killed by a signal" }
+!
+! An image killed by a signal is a failed image (F2023 5.3.6). The other
+! images have to continue and report it, instead of blocking in the SYNC ALL
+! below until the test times out.
+
+program signal_sync_1
+ use iso_fortran_env, only : stat_failed_image
+ implicit none
+ integer :: i, st
+
+ sync all
+ if (this_image () == num_images ()) call abort ()
+
+ do i = 1, 100
+ st = 0
+ sync all (stat=st)
+ if (st == stat_failed_image) exit
+ end do
+ if (num_images () > 1 .and. st /= stat_failed_image) error stop "not reported"
+end program signal_sync_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
new file mode 100644
index 00000000000..958801a7fda
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/signal_team_1.f90
@@ -0,0 +1,26 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+! { dg-shouldfail "an image is killed by a signal" }
+!
+! An image killed by a signal while its team is the current one must not
+! block the remaining images of that team.
+
+program signal_team_1
+ use iso_fortran_env, only : team_type, stat_failed_image
+ implicit none
+ type(team_type) :: t
+ integer :: i, st
+
+ form team (merge (1, 2, mod (this_image (), 2) == 1), t)
+ change team (t)
+ sync all
+ if (this_image () == num_images ()) call abort ()
+
+ do i = 1, 100
+ st = 0
+ sync all (stat=st)
+ if (st == stat_failed_image) exit
+ end do
+ if (num_images () > 1 .and. st /= stat_failed_image) error stop "not reported"
+ end team
+end program signal_team_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_failed_stat_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_failed_stat_1.f90
new file mode 100644
index 00000000000..d6f2d785999
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_failed_stat_1.f90
@@ -0,0 +1,30 @@
+! { dg-do run }
+!
+! SYNC ALL synchronizes the active images of a team that contains a failed
+! image and has to report it through stat= (F2023 11.7.11), also when the
+! image fails while the others already wait in the statement.
+
+program sync_failed_stat_1
+ use iso_fortran_env, only : stat_failed_image
+ implicit none
+ integer :: st
+
+ if (num_images () < 2) stop
+ if (this_image () == 1) then
+ call spin ()
+ fail image
+ end if
+
+ st = 0
+ sync all (stat=st)
+ if (st /= stat_failed_image) stop 1
+contains
+ subroutine spin ()
+ integer :: c
+ integer(kind=8) :: v
+ v = 2
+ do c = 1, 20000000
+ v = mod (v * 2, 199679_8)
+ end do
+ end subroutine
+end program sync_failed_stat_1
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index aacb1fd6f86..fe1e5e29384 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -87,8 +87,10 @@ _gfortran_caf_init (int *argc, char ***argv)
if (shared_memory_get_env ())
{
- /* This is the initialization of a worker. */
- _gfortran_caf_sync_all (NULL, NULL, 0);
+ /* This is the initialization of a worker. Synchronize without the
+ checks of the SYNC ALL statement: an image terminating right after
+ this barrier is not an error condition here. */
+ sync_all (NULL);
return;
}
@@ -480,12 +482,18 @@ _gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
void
_gfortran_caf_sync_all (int *stat, char *errmsg, size_t errmsg_len)
{
+ int terminated;
+
__asm__ __volatile__ ("":::"memory");
- HEALTH_CHECK (stat, errmsg, errmsg_len);
CHECK_TEAM_INTEGRITY (caf_current_team);
- /* With a stopped image, SYNC ALL only has the effect of SYNC MEMORY. */
- if (!sync_all ())
+ /* With a stopped image this only has the effect of SYNC MEMORY, with a
+ failed image the active images are synchronized; both are reported
+ (F2023 11.7.11). An image terminating after the images synchronized
+ was not involved in the statement. */
+ if (!sync_all (&terminated) || terminated)
HEALTH_CHECK (stat, errmsg, errmsg_len);
+ else if (stat)
+ *stat = 0;
}
@@ -1802,6 +1810,7 @@ _gfortran_caf_form_team (int team_no, caf_team_t *team, int *new_index,
t->u.image_info->image_map_size = 0;
t->u.image_info->num_term_images = 0;
t->u.image_info->lastmemid = tmemid;
+ register_team (t);
/* Initialize a freshly created image_map with -1. */
for (int i = 0; i < caf_current_team->u.image_info->image_count.count;
++i)
@@ -1941,6 +1950,7 @@ _gfortran_caf_sync_team (caf_team_t team, int *stat, char *errmsg,
{
caf_shmem_team_t team_to_sync = (caf_shmem_team_t) team;
caf_shmem_team_t active_team = caf_current_team;
+ int terminated;
if (stat)
*stat = 0;
@@ -1962,10 +1972,14 @@ _gfortran_caf_sync_team (caf_team_t team, int *stat, char *errmsg,
return;
}
- TEAM_HEALTH_CHECK (team_to_sync, stat, errmsg, errmsg_len);
- /* With a stopped image, SYNC TEAM only has the effect of SYNC MEMORY. */
- if (!sync_team_unless_stopped (team_to_sync))
+ /* With a stopped image this only has the effect of SYNC MEMORY, with a
+ failed image the active images are synchronized; both are reported
+ (F2023 11.7.11). An image terminating after the images synchronized
+ was not involved in the statement. */
+ if (!sync_team_unless_stopped (team_to_sync, &terminated) || terminated)
TEAM_HEALTH_CHECK (team_to_sync, stat, errmsg, errmsg_len);
+ else if (stat)
+ *stat = 0;
}
int
diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c
index 911c54acbee..fbbe93e80f2 100644
--- a/libgfortran/caf/shmem/collective_subroutine.c
+++ b/libgfortran/caf/shmem/collective_subroutine.c
@@ -228,7 +228,7 @@ collsub_sync (void)
{
counter_barrier *barrier = &caf_current_team->u.image_info->collsub.barrier;
- return counter_barrier_wait_abortable (barrier);
+ return counter_barrier_wait_abortable (barrier, NULL);
}
typedef void *(*red_op) (void *, void *);
diff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/counter_barrier.c
index 8598d79d69d..43e80289d23 100644
--- a/libgfortran/caf/shmem/counter_barrier.c
+++ b/libgfortran/caf/shmem/counter_barrier.c
@@ -55,6 +55,9 @@ counter_barrier_init (counter_barrier *b, int val)
.aborted_round = 0,
.abortable_arrivals = 0,
.aborting = false,
+ .terminated = 0,
+ .round_terminated = 0,
+ .round_terminated_round = 0,
.count = val};
initialize_shared_condition (&b->cond, val);
initialize_shared_mutex (&b->mutex);
@@ -66,6 +69,10 @@ counter_barrier_init (counter_barrier *b, int val)
static void
next_round (counter_barrier *b, bool abort)
{
+ /* Take the images removed so far as the ones that were involved in the
+ round; an image removed later did not take part in it. */
+ b->round_terminated = b->terminated;
+ b->round_terminated_round = b->curr_wait_group;
if (abort)
b->aborted_round = b->curr_wait_group;
++b->curr_wait_group;
@@ -78,9 +85,10 @@ next_round (counter_barrier *b, bool abort)
false, when the round was aborted. */
static bool
-wait_round (counter_barrier *b, bool abortable)
+wait_round (counter_barrier *b, bool abortable, int *terminated)
{
const uint64_t round = b->curr_wait_group;
+ const int at_arrival = b->terminated;
if (abortable)
++b->abortable_arrivals;
@@ -93,6 +101,12 @@ wait_round (counter_barrier *b, bool abortable)
if (b->curr_wait_group == round)
next_round (b, false);
+ if (terminated)
+ /* A later round may have taken its own snapshot in the meantime; the
+ images removed before this one arrived are known to be involved. */
+ *terminated = b->round_terminated_round == round ? b->round_terminated
+ : at_arrival;
+
return b->aborted_round != round;
}
@@ -100,18 +114,18 @@ void
counter_barrier_wait (counter_barrier *b)
{
lock_counter_barrier (b);
- while (!wait_round (b, false))
+ while (!wait_round (b, false, NULL))
;
unlock_counter_barrier (b);
}
bool
-counter_barrier_wait_abortable (counter_barrier *b)
+counter_barrier_wait_abortable (counter_barrier *b, int *terminated)
{
bool completed;
lock_counter_barrier (b);
- completed = !b->aborting && wait_round (b, true);
+ completed = !b->aborting && wait_round (b, true, terminated);
unlock_counter_barrier (b);
return completed;
}
@@ -136,6 +150,8 @@ int
counter_barrier_add_locked (counter_barrier *c, int val)
{
int ret;
+ if (val < 0)
+ c->terminated -= val;
ret = (c->count += val);
change_internal_barrier_count (c, val);
diff --git a/libgfortran/caf/shmem/counter_barrier.h b/libgfortran/caf/shmem/counter_barrier.h
index 7b6d3d88e71..33ea342cd9b 100644
--- a/libgfortran/caf/shmem/counter_barrier.h
+++ b/libgfortran/caf/shmem/counter_barrier.h
@@ -55,6 +55,11 @@ typedef struct
volatile int abortable_arrivals;
/* Set once abortable arrivals are no longer to be synchronized. */
volatile bool aborting;
+ /* The number of images that have been removed from the barrier, and that
+ number as it was when the round ROUND_TERMINATED_ROUND ended. */
+ volatile int terminated;
+ volatile int round_terminated;
+ volatile uint64_t round_terminated_round;
volatile int count;
} counter_barrier;
@@ -89,9 +94,11 @@ int counter_barrier_get_count (counter_barrier *);
void counter_barrier_wait (counter_barrier *);
/* Like counter_barrier_wait, but return false without waiting when the
- barrier is aborting, or when the round is aborted. */
+ barrier is aborting, or when the round is aborted. TERMINATED, when
+ given, receives the number of images that had been removed from the
+ barrier when the round ended; images removed later are not counted. */
-bool counter_barrier_wait_abortable (counter_barrier *);
+bool counter_barrier_wait_abortable (counter_barrier *, int *terminated);
/* Abort the current round when it has an abortable arrival, and every later
abortable arrival. The barrier's lock has to be held. */
diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c
index d63b58e3647..246f98aab63 100644
--- a/libgfortran/caf/shmem/supervisor.c
+++ b/libgfortran/caf/shmem/supervisor.c
@@ -242,6 +242,7 @@ ensure_shmem_initialization (void)
caf_initial_team->u.image_info->lastmemid = 0;
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);
}
allocator_unlock (&local->ai.alloc);
sync_init (&local->si, &local->sm);
@@ -253,6 +254,7 @@ ensure_shmem_initialization (void)
thread_support_init_supervisor ();
counter_barrier_init (&this_image.supervisor->num_active_images,
local->total_num_images);
+ this_image.supervisor->teams = SHMPTR_NULL;
alloc_init_supervisor (&local->ai, &local->sm);
sync_init_supervisor (&local->si, &local->ai);
}
@@ -484,6 +486,9 @@ supervisor_main_loop (int *argc __attribute__ ((unused)),
{
m->images[j].status = IMAGE_FAILED;
atomic_fetch_add (&m->failed_images, 1);
+ /* The image did not leave the barriers of its teams, so do
+ it for it. */
+ update_registered_teams ();
}
if (*exit_code < WTERMSIG (chstatus))
*exit_code = WTERMSIG (chstatus);
diff --git a/libgfortran/caf/shmem/supervisor.h b/libgfortran/caf/shmem/supervisor.h
index a956092e263..ea122de12b2 100644
--- a/libgfortran/caf/shmem/supervisor.h
+++ b/libgfortran/caf/shmem/supervisor.h
@@ -62,6 +62,10 @@ typedef struct supervisor
atomic_int failed_images;
atomic_int finished_images;
counter_barrier num_active_images;
+ /* The teams formed so far, linked through their next_team, so that the
+ supervisor can reach the barriers of an image that terminated without
+ leaving them. Pushed to without a lock. */
+ shared_mem_ptr teams;
caf_shmem_mutex image_tracker_lock;
#ifdef WIN32
size_t global_used_handles;
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index 511a8525424..9deb31f0871 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -129,9 +129,9 @@ sync_table (sync_t *si, int *images, int size)
}
bool
-sync_all (void)
+sync_all (int *terminated)
{
- return sync_team_unless_stopped (caf_current_team);
+ return sync_team_unless_stopped (caf_current_team, terminated);
}
void
@@ -141,9 +141,10 @@ sync_team (caf_shmem_team_t team)
}
bool
-sync_team_unless_stopped (caf_shmem_team_t team)
+sync_team_unless_stopped (caf_shmem_team_t team, int *terminated)
{
- return counter_barrier_wait_abortable (&team->u.image_info->image_count);
+ return counter_barrier_wait_abortable (&team->u.image_info->image_count,
+ terminated);
}
void
diff --git a/libgfortran/caf/shmem/sync.h b/libgfortran/caf/shmem/sync.h
index 0aa596c9eff..d7b96992840 100644
--- a/libgfortran/caf/shmem/sync.h
+++ b/libgfortran/caf/shmem/sync.h
@@ -52,9 +52,11 @@ void sync_init (sync_t *, shared_memory);
void sync_init_supervisor (sync_t *, alloc *);
/* Synchronize the images of the current team. Returns false without
- synchronizing when a stopped image is a member of the team. */
+ synchronizing when a stopped image is a member of the team. TERMINATED,
+ when given, receives the number of images of the team that had terminated
+ when the images synchronized. */
-bool sync_all (void);
+bool sync_all (int *terminated);
/* Prototype for circular dependency break. */
@@ -65,7 +67,7 @@ void sync_team (caf_shmem_team_t team);
/* Like sync_all for TEAM. */
-bool sync_team_unless_stopped (caf_shmem_team_t team);
+bool sync_team_unless_stopped (caf_shmem_team_t team, int *terminated);
void sync_table (sync_t *, int *, int);
diff --git a/libgfortran/caf/shmem/teams_mgmt.c b/libgfortran/caf/shmem/teams_mgmt.c
index d90ece310ba..9e04ee9da10 100644
--- a/libgfortran/caf/shmem/teams_mgmt.c
+++ b/libgfortran/caf/shmem/teams_mgmt.c
@@ -42,36 +42,34 @@ count_images (const int *map, int count, image_status status)
return n;
}
-/* Get the number of images of TEAM that have terminated. */
+/* Get the number of images of the team INFO belongs to that have
+ terminated. */
static int
-team_terminated_images (caf_shmem_team_t team)
+team_terminated_images (struct shmem_image_info *info)
{
- const int sz = team->u.image_info->image_map_size;
+ const int sz = info->image_map_size;
int i, term = 0;
for (i = 0; i < sz; ++i)
- if (this_image.supervisor->images[team->u.image_info->image_map[i]].status
- != IMAGE_OK)
+ if (this_image.supervisor->images[info->image_map[i]].status != IMAGE_OK)
++term;
return term;
}
static void
-update_teams_images_locked (caf_shmem_team_t team)
+update_teams_images_locked (struct shmem_image_info *info)
{
- if (team->u.image_info->num_term_images
- != this_image.supervisor->finished_images
- + this_image.supervisor->failed_images)
+ if (info->num_term_images != this_image.supervisor->finished_images
+ + this_image.supervisor->failed_images)
{
- const int old_num = team->u.image_info->num_term_images;
+ const int old_num = info->num_term_images;
- team->u.image_info->num_term_images = team_terminated_images (team);
+ info->num_term_images = team_terminated_images (info);
- counter_barrier_add_locked (&team->u.image_info->image_count,
- old_num
- - team->u.image_info->num_term_images);
+ counter_barrier_add_locked (&info->image_count,
+ old_num - info->num_term_images);
}
}
@@ -79,20 +77,20 @@ void
update_teams_images (caf_shmem_team_t team)
{
caf_shmem_mutex_lock (&team->u.image_info->image_count.mutex);
- update_teams_images_locked (team);
+ update_teams_images_locked (team->u.image_info);
caf_shmem_mutex_unlock (&team->u.image_info->image_count.mutex);
}
/* Drop this image from the barriers of TEAM. */
static void
-leave_team (caf_shmem_team_t team, bool stopped)
+leave_team (struct shmem_image_info *info, bool stopped)
{
- counter_barrier *b = &team->u.image_info->image_count;
- counter_barrier *cb = &team->u.image_info->collsub.barrier;
+ counter_barrier *b = &info->image_count;
+ counter_barrier *cb = &info->collsub.barrier;
caf_shmem_mutex_lock (&b->mutex);
- update_teams_images_locked (team);
+ update_teams_images_locked (info);
if (stopped)
counter_barrier_abort_locked (b);
caf_shmem_mutex_unlock (&b->mutex);
@@ -106,9 +104,47 @@ void
leave_teams (bool stopped)
{
for (caf_shmem_team_t t = caf_current_team; t; t = t->parent)
- leave_team (t, stopped);
+ leave_team (t->u.image_info, stopped);
for (caf_shmem_team_t t = caf_teams_formed; t; t = t->parent)
- leave_team (t, stopped);
+ leave_team (t->u.image_info, stopped);
+}
+
+void
+register_team (caf_shmem_team_t team)
+{
+ struct shmem_image_info *info = team->u.image_info;
+ const shared_mem_ptr self = AS_SHMPTR ((void *) info, local->sm);
+ ptrdiff_t head;
+
+ /* Push without taking a lock, so that an image killed in the middle of it
+ cannot block the supervisor. */
+ head = __atomic_load_n (&this_image.supervisor->teams.offset,
+ __ATOMIC_ACQUIRE);
+ do
+ info->next_team.offset = head;
+ while (!__atomic_compare_exchange_n (&this_image.supervisor->teams.offset,
+ &head, self.offset, false,
+ __ATOMIC_RELEASE, __ATOMIC_ACQUIRE));
+}
+
+void
+update_registered_teams (void)
+{
+ ptrdiff_t off = __atomic_load_n (&this_image.supervisor->teams.offset,
+ __ATOMIC_ACQUIRE);
+
+ while (off != SHMPTR_NULL.offset)
+ {
+ struct shmem_image_info *info
+ = SHMPTR_AS (struct shmem_image_info *, ((shared_mem_ptr) {off}),
+ &local->sm);
+
+ /* A terminated image is dropped from the count, so that the others can
+ complete their barriers, but a collective over a fixed set of images
+ can no longer be completed. */
+ leave_team (info, false);
+ off = __atomic_load_n (&info->next_team.offset, __ATOMIC_ACQUIRE);
+ }
}
int
diff --git a/libgfortran/caf/shmem/teams_mgmt.h b/libgfortran/caf/shmem/teams_mgmt.h
index 3b0c3b6aa22..b87fc6f87d1 100644
--- a/libgfortran/caf/shmem/teams_mgmt.h
+++ b/libgfortran/caf/shmem/teams_mgmt.h
@@ -62,6 +62,8 @@ struct caf_shmem_team
this is checked against the global number and the image_count and
image_map is updated. */
int num_term_images;
+ /* The next team in the supervisor's list of teams. */
+ shared_mem_ptr next_team;
memid lastmemid;
int image_map[];
} *image_info;
@@ -86,6 +88,17 @@ extern caf_shmem_team_t caf_teams_formed;
void update_teams_images (caf_shmem_team_t);
+/* Make TEAM known to the supervisor. To be called once per team, by the
+ image that created it. */
+
+void register_team (caf_shmem_team_t);
+
+/* Drop the images that terminated from the barriers of every team known to
+ the supervisor. For the supervisor, which has no access to the teams an
+ image was a member of. */
+
+void update_registered_teams (void);
+
/* Drop this image, which terminated, from the barriers of all teams it is a
member of. The number of finished or failed images has to be updated
before the call for it to have any effect. When STOPPED, image control
--
2.55.0
