On 9/19/26 6:46 AM, Mikael Morin wrote:
Le 15/09/2026 à 17:53, Jerry D a écrit :
See attached patch 2 of 3.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR127347] caf_shmem: do not wait for
stopped images
When an image terminated normally, the other images kept counting it
in their team barriers and blocked forever in the next SYNC ALL. A
stopped image now marks itself and drops out of the barriers of all
teams it is a member of, and images waiting in a barrier re-evaluate
the number of participating images each time they wake up. The
supervisor wakes the images waiting in the initial team's barrier when
it reaps a terminated image.
SYNC IMAGES indexed its synchronization table with the team's image
count as the row stride. That count shrinks once an image has
stopped, although the table is allocated for all images. Use the
total number of images.
Assisted-by: Claude Opus 5
PR libfortran/127347
libgfortran/ChangeLog:
* caf/shmem.c (mark_stopped): New function.
(_gfortran_caf_stop_numeric, _gfortran_caf_stop_str): Call it.
* caf/shmem/counter_barrier.c (counter_barrier_wait_recheck): New
function.
(counter_barrier_wait): Use it.
* caf/shmem/counter_barrier.h (counter_barrier_recheck): New type.
(counter_barrier_wait_recheck): Declare.
* caf/shmem/supervisor.c (ensure_shmem_initialization): Record the
initial team's barrier.
(supervisor_main_loop): Wake the images waiting in it when an image
terminated.
* caf/shmem/supervisor.h (supervisor): Add initial_team_barrier.
* caf/shmem/sync.c (sync_table): Use the total number of images as
the row stride.
(sync_all): Use sync_team.
(sync_team): Re-evaluate the participating images on wake up.
* caf/shmem/teams_mgmt.c (update_teams_images_locked): New
function, split out of ...
(update_teams_images): ... this.
* caf/shmem/teams_mgmt.h (update_teams_images_locked): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/stop_sync_1.f90: New test.
* gfortran.dg/coarray/sync_images_stopped_1.f90: New test.
---
---
.../gfortran.dg/coarray/stop_sync_1.f90 | 17 +++++++++++++
.../coarray/sync_images_stopped_1.f90 | 16 +++++++++++++
libgfortran/caf/shmem.c | 24 +++++++++++++++++++
libgfortran/caf/shmem/counter_barrier.c | 19 +++++++++++++--
libgfortran/caf/shmem/counter_barrier.h | 11 +++++++++
libgfortran/caf/shmem/supervisor.c | 15 ++++++++++++
libgfortran/caf/shmem/supervisor.h | 3 +++
libgfortran/caf/shmem/sync.c | 19 +++++++++------
libgfortran/caf/shmem/teams_mgmt.c | 12 ++++++++--
libgfortran/caf/shmem/teams_mgmt.h | 5 ++++
10 files changed, 130 insertions(+), 11 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_1.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90 b/gcc/
testsuite/gfortran.dg/coarray/stop_sync_1.f90
new file mode 100644
index 00000000000..cb41610aaf9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90
@@ -0,0 +1,17 @@
+! { dg-do run }
+!
+! A normal STOP on one image must not block the surviving images in the
+! SYNC ALL statements that follow.
+
+program stop_sync_1
+ implicit none
+ integer :: i, st
+
+ sync all
+ if (num_images () > 1 .and. this_image () == num_images ()) stop
+
+ do i = 1, 5
+ st = 0
+ sync all (stat=st)
+ end do
+end program stop_sync_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_1.f90 b/
gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_1.f90
new file mode 100644
index 00000000000..eecfc70f877
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_images_stopped_1.f90
@@ -0,0 +1,16 @@
+! { dg-do run }
+!
+! SYNC IMAGES (*) has to keep working after an image terminated normally.
+
+program sync_images_stopped_1
+ implicit none
+ integer :: i, st
+
+ sync all
+ if (num_images () > 1 .and. this_image () == num_images ()) stop
+
+ do i = 1, 5
+ st = 0
+ sync images (*, stat=st)
+ end do
+end program sync_images_stopped_1
I'm not sure about the two testcases. Aren't they invalid?
No. Under F2023 11.7.11 ¶5–6 (page 226), SYNC ALL or SYNC IMAGES with STAT=
and a stopped image assigns STAT_STOPPED_IMAGE and has the effect of SYNC
MEMORY. Without STAT= it would be error termination, which is why both tests use it.
(Looking at my draft copy here)
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index c6735146a2e..5c92c13d328 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -570,6 +570,28 @@ _gfortran_caf_sync_images (int count, int images[], int
*stat, char *errmsg,
extern void _gfortran_report_exception (void);
+/* Tell the supervisor that this image terminated normally and wake the images
+ waiting in a team barrier, so that they can drop this image from their
+ barrier count. */
+
+static void
+mark_stopped (void)
+{
+ if (!this_image.supervisor || this_image.image_num < 0)
+ return;
+
+ if (this_image.supervisor->images[this_image.image_num].status == IMAGE_OK)
+ {
+ this_image.supervisor->images[this_image.image_num].status
+ = IMAGE_SUCCESS;
+ atomic_fetch_add (&this_image.supervisor->finished_images, 1);
+ }
+
+ /* Drop this image from the barriers of the teams it is a member of. */
+ for (caf_shmem_team_t t = caf_current_team; t; t = t->parent)
+ update_teams_images (t);
Can we use counter_barrier_add (t->...image_count, -1) instead, so that the
function update_teams_images can be removed?
Not by itself. update_teams_images already exists on master; the patch only
splits it. Five CHECK_TEAM_INTEGRITY call sites use it to recount a team from
the image statuses whenever the cached num_term_images differs from the global
counts. A plain -1 in mark_stopped would be subtracted a second time by the next
recount.
+}
+
/* Tell the supervisor that this image error stopped, so that it can terminate
all other images. */
@@ -589,6 +611,7 @@ _gfortran_caf_stop_numeric (int stop_code, bool quiet)
_gfortran_report_exception ();
fprintf (stderr, "STOP %d\n", stop_code);
}
+ mark_stopped ();
exit (stop_code);
}
@@ -603,6 +626,7 @@ _gfortran_caf_stop_str (const char *string, size_t len,
bool quiet)
fputc (*(string++), stderr);
fputs ("\n", stderr);
}
+ mark_stopped ();
exit (0);
}
That part looks good overall.
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index 76ae0e53ccf..3d03cd67152 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -94,12 +94,14 @@ sync_table (sync_t *si, int *images, int size)
command is completed.
*/
volatile int *table = si->table;
+ /* The table is allocated for all images, so the row stride is the
total
+ number of images and not the (shrinking) number of images in a
team. */
+ const size_t img_c = local->total_num_images;
int i;
lock_table (si);
if (size > 0)
{
- const size_t img_c =
caf_current_team->u.image_info->image_map_size;
for (i = 0; i < size; ++i)
{
++table[images[i] + img_c * this_image.image_num];
@@ -121,20 +123,20 @@ sync_table (sync_t *si, int *images, int size)
else
{
int *map = caf_current_team->u.image_info->image_map;
- size = caf_current_team->u.image_info->image_count.count;
+ size = caf_current_team->u.image_info->image_map_size;
for (i = 0; i < size; ++i)
{
if (this_image.supervisor->images[map[i]].status != IMAGE_OK)
continue;
- ++table[map[i] + size * this_image.image_num];
+ ++table[map[i] + img_c * this_image.image_num];
caf_shmem_cond_signal (&si->triggers[map[i]]);
}
for (;;)
{
for (i = 0; i < size; ++i)
if (this_image.supervisor->images[map[i]].status == IMAGE_OK
- && table[map[i] + size * this_image.image_num]
- > table[this_image.image_num + map[i] * size])
+ && table[map[i] + img_c * this_image.image_num]
+ > table[this_image.image_num + img_c * map[i]])
break;
if (i == size)
break;
That part looks good as well.
It seems the if and else cases could use some refactoring after this.
And then there is the rest, which I quite don't understand, so I'll have to come
back to it later.
Generally speaking, getting multithreading right is hard with all the risks of
deadlocks and race conditions. But here the patch adds callbacks to the party,
that are passed from function to function; it's a nightmare.
diff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/
counter_barrier.c
index 1993b1ebeea..0e583eecb98 100644
--- a/libgfortran/caf/shmem/counter_barrier.c
+++ b/libgfortran/caf/shmem/counter_barrier.c
@@ -55,11 +55,16 @@ counter_barrier_init (counter_barrier *b, int val)
}
void
-counter_barrier_wait (counter_barrier *b)
+counter_barrier_wait_recheck (counter_barrier *b,
+ counter_barrier_recheck recheck, void *data)
{
int wait_group_beginning;
lock_counter_barrier (b);
+ /* Re-check before blocking, so that a terminating image that adjusted the
+ count before this image took the lock is not waited for. */
+ if (recheck)
+ recheck (data);
wait_group_beginning = b->curr_wait_group;
if ((--b->wait_count) <= 0)
@@ -67,7 +72,11 @@ counter_barrier_wait (counter_barrier *b)
else
{
while (b->wait_count > 0 && b->curr_wait_group == wait_group_beginning)
- caf_shmem_cond_wait (&b->cond, &b->mutex);
+ {
+ caf_shmem_cond_wait (&b->cond, &b->mutex);
+ if (recheck)
+ recheck (data);
+ }
}
if (b->wait_count <= 0)
I don't understand the need for this "recheck" callback, and the repeated
wakeups to recheck.
You make a good point. So I am going to take a different approach to avoid using
callbacks. So, this patch and probably 3 of 3 are going to change. Hold off on
reviewing any further. I will have v2 patches going.
Thanks,
Good feedback.
Jerry
--- snip ---
