On 9/23/26 1:41 PM, Mikael Morin wrote:
Le 22/09/2026 à 14:30, Jerry D a écrit :
The attached patch is version 2 of 2 of 3.
(Patch 1 of 3 was approved previously and is unchanged.)
This responds to Mikael's comment about using callbacks. Callbacks are
eliminated in this version.
Regression tested on x86_64.
OK for mainline?
Regards,
Jerry
---
libgfortran: [PR127347] caf_shmem: do not wait for
terminated images
When an image terminated normally or with FAIL IMAGE, the other images
kept counting it in their team barriers and blocked forever in the next
SYNC ALL. An image executing STOP or FAIL IMAGE now drops out of the
barriers of every team it is a member of before it exits. Lowering the
count wakes the images already waiting once it reaches zero.
An image that terminates without STOP or FAIL IMAGE, e.g. by a signal,
cannot do so. It now initiates error termination of all images, as for
ERROR STOP, instead of being marked failed. Only the fork based
supervisor does so.
I'm not sure it is correct.
Failed state is defined as (F2023 5.3.6: Image execution states):
> An image that has ceased participating in program execution but has
> not initiated termination is a failed image.
Killed images match this definition. And the definition also kind of implicitly
means that the other images continue their execution.
I'm starting to understand what was the reason for the callback in the original
patch. The supervisor has no access to the images' teams data, so that the call
to leave_teams that is done in the STOP case can't be done by the supervisor in
the signal case. Is that correct?
Yes, that is exactly it. The supervisor is a separate process and
only has supervisor->images[]. caf_current_team and caf_teams_formed
are per-image lists in the image's own memory, so it cannot walk the
teams an image belonged to, and it cannot lower their barrier counts.
I also agree with your reading of F2023 5.3.6: a killed image is a
failed image and the remaining images are meant to keep running, so
terminating all of them is a deviation. I have split that part out of
2/3 into a separate patch (attached separately, not for commit yet) so
that the rest can go in. Its commit message now states the deviation
explicitly. Without it, images waiting in a team barrier for a killed
image still block, as they do today.
Maybe we can store a copy of caf_current_team->u.image_info and
caf_teams_formed->u.image_info in supervisor's image_tracker, so that a call to
leave_teams or similar can be done from the supervisor.
A pointer to the parent would also be necessary in shmem_image_info.
Unfortunately it's not very nice to have every image updating rapidly the
current team of their image info stored in shared memory, to support something
as rare as a signal. I have nothing better to propose so far.
Agreed, that would be a lot of traffic for a rare event. How about
turning it around and registering teams instead of images? A team's
shmem_image_info already lives in shared memory and is created exactly
once, by the first image reaching alloc_get_memory_by_id_created in
FORM TEAM. If that image also appended the team to a list in shared
memory, the supervisor could walk the list when it reaps an image,
and, under each team's barrier lock, recompute the count from the
image statuses and broadcast -- the same thing update_teams_images
does now, just done by the supervisor. A team is only ever added,
so no per-statement updates are needed, and images that are not in the
team are unaffected because their count does not change. END TEAM
would leave the entry in place.
I have not implemented this yet; if you think it is the right
direction I will do that instead of the signal patch.
One thing to note in the new 2/3: the supervisor.c hunk is not just
dropped, it is replaced. mark_stopped now records IMAGE_SUCCESS
before exit, but a STOP with a non-zero stop code exits non-zero, and
the supervisor marked every such image as failed, overwriting that and
counting it twice. So the status the image recorded is now kept, the
same way it already is for an image exiting with zero. That hunk is
new since your review.
One nit:
Please mention that the number of finished or failed images has to be updated
beforehand for the function to have any effect.
void check_health (int *, char *, size_t);
#define HEALTH_CHECK(stat, errmsg, errlen) check_health (stat, errmsg, errlen)
OK for the non-signal part (all but supervisor.c and signal_sync_1.f90), with
the nit above addressed.
The doc nit is addressed: leave_teams now says the number of finished
or failed images has to be updated before the call for it to have any
effect.
The attached patch is now v3 of the 2/3. The signal part I will submit seprately
later
3/3 is attached as v3 as well. The only change from the posted v2 is
the leave_teams comment, which now keeps the sentence added in 2/3
instead of replacing it; without that the two patches conflict.
Retested on x86_64 with 2, 3 and 8 images, no hangs and no new
failures.
OK?
Regards,
Jerry
---
libgfortran: [PR127347] caf_shmem: do not wait for
terminated images
When an image terminated normally or with FAIL IMAGE, the other images
kept counting it in their team barriers and blocked forever in the next
SYNC ALL. An image executing STOP or FAIL IMAGE now drops out of the
barriers of every team it is a member of before it exits. Lowering the
count wakes the images already waiting once it reaches zero.
An image executing STOP with a non-zero stop code records that it
stopped and then exits with that code. The supervisor marked every
image exiting with a non-zero code as failed, so keep the status the
image recorded, as is done for an image exiting with zero.
SYNC IMAGES indexed its synchronization table with the team's image
count as the row stride. That count shrinks once an image has
terminated, although the table is allocated for all images. Use the
total number of images, and handle an image list and * alike.
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.
(_gfortran_caf_fail_image): Call leave_teams.
* caf/shmem/supervisor.c (supervisor_main_loop): Keep the status an
image recorded for itself.
* caf/shmem/sync.c (sync_table): Use the total number of images as
the row stride. Handle an image list and all images alike.
* caf/shmem/teams_mgmt.c (leave_teams): New function.
* caf/shmem/teams_mgmt.h (leave_teams): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/fail_image_sync_1.f90: New test.
* gfortran.dg/coarray/stop_sync_1.f90: New test.
* gfortran.dg/coarray/sync_images_stopped_1.f90: New test.
---
From 3694522926dfd359e0828f9dd290d8dcb35703f4 Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Wed, 23 Sep 2026 13:46:40 -0700
Subject: [PATCH v3 2/3] libgfortran: [PR127347] caf_shmem: do not wait for
terminated images
When an image terminated normally or with FAIL IMAGE, the other images
kept counting it in their team barriers and blocked forever in the next
SYNC ALL. An image executing STOP or FAIL IMAGE now drops out of the
barriers of every team it is a member of before it exits. Lowering the
count wakes the images already waiting once it reaches zero.
An image executing STOP with a non-zero stop code records that it
stopped and then exits with that code. The supervisor marked every
image exiting with a non-zero code as failed, so keep the status the
image recorded, as is done for an image exiting with zero.
SYNC IMAGES indexed its synchronization table with the team's image
count as the row stride. That count shrinks once an image has
terminated, although the table is allocated for all images. Use the
total number of images, and handle an image list and * alike.
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.
(_gfortran_caf_fail_image): Call leave_teams.
* caf/shmem/supervisor.c (supervisor_main_loop): Keep the status an
image recorded for itself.
* caf/shmem/sync.c (sync_table): Use the total number of images as
the row stride. Handle an image list and all images alike.
* caf/shmem/teams_mgmt.c (leave_teams): New function.
* caf/shmem/teams_mgmt.h (leave_teams): Declare.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/fail_image_sync_1.f90: New test.
* gfortran.dg/coarray/stop_sync_1.f90: New test.
* gfortran.dg/coarray/sync_images_stopped_1.f90: New test.
---
.../gfortran.dg/coarray/fail_image_sync_1.f90 | 19 ++++++
.../gfortran.dg/coarray/stop_sync_1.f90 | 17 +++++
.../coarray/sync_images_stopped_1.f90 | 16 +++++
libgfortran/caf/shmem.c | 21 +++++++
libgfortran/caf/shmem/supervisor.c | 9 ++-
libgfortran/caf/shmem/sync.c | 63 +++++++------------
libgfortran/caf/shmem/teams_mgmt.c | 9 +++
libgfortran/caf/shmem/teams_mgmt.h | 6 ++
8 files changed, 118 insertions(+), 42 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/fail_image_sync_1.f90
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/fail_image_sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/fail_image_sync_1.f90
new file mode 100644
index 00000000000..87b2abbcb95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/fail_image_sync_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+!
+! FAIL IMAGE on one image must not block the remaining images in SYNC ALL.
+! They synchronize among themselves and get STAT_FAILED_IMAGE.
+
+program fail_image_sync_1
+ use iso_fortran_env, only: STAT_FAILED_IMAGE
+ implicit none
+ integer :: i, st
+
+ sync all
+ if (num_images () > 1 .and. this_image () == num_images ()) fail image
+
+ do i = 1, 5
+ st = 0
+ sync all (stat=st)
+ end do
+ if (num_images () > 1 .and. st /= STAT_FAILED_IMAGE) stop 1
+end program fail_image_sync_1
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
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index c6735146a2e..89fad8a8f4b 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -570,6 +570,24 @@ _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 drop it from
+ the barriers of its teams. */
+
+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);
+ }
+ leave_teams ();
+}
+
/* Tell the supervisor that this image error stopped, so that it can terminate
all other images. */
@@ -589,6 +607,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 +622,7 @@ _gfortran_caf_stop_str (const char *string, size_t len, bool quiet)
fputc (*(string++), stderr);
fputs ("\n", stderr);
}
+ mark_stopped ();
exit (0);
}
@@ -630,6 +650,7 @@ _gfortran_caf_fail_image (void)
fputs ("IMAGE FAILED!\n", stderr);
this_image.supervisor->images[this_image.image_num].status = IMAGE_FAILED;
atomic_fetch_add (&this_image.supervisor->failed_images, 1);
+ leave_teams ();
exit (0);
}
diff --git a/libgfortran/caf/shmem/supervisor.c b/libgfortran/caf/shmem/supervisor.c
index ff4a592b6f2..d63b58e3647 100644
--- a/libgfortran/caf/shmem/supervisor.c
+++ b/libgfortran/caf/shmem/supervisor.c
@@ -478,8 +478,13 @@ supervisor_main_loop (int *argc __attribute__ ((unused)),
WTERMSIG (chstatus), finished_pid);
continue;
}
- m->images[j].status = IMAGE_FAILED;
- atomic_fetch_add (&m->failed_images, 1);
+ /* Only set the status, when it has not been set by the image
+ already, e.g. by a STOP with a non-zero stop code. */
+ if (m->images[j].status == IMAGE_OK)
+ {
+ m->images[j].status = IMAGE_FAILED;
+ atomic_fetch_add (&m->failed_images, 1);
+ }
if (*exit_code < WTERMSIG (chstatus))
*exit_code = WTERMSIG (chstatus);
else if (*exit_code == 0)
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index 76ae0e53ccf..f1d5bedbc8e 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -94,53 +94,36 @@ 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;
+ if (size <= 0)
+ {
+ images = caf_current_team->u.image_info->image_map;
+ size = caf_current_team->u.image_info->image_map_size;
+ }
+
lock_table (si);
- if (size > 0)
+ for (i = 0; i < size; ++i)
{
- 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];
- caf_shmem_cond_signal (&si->triggers[images[i]]);
- }
- for (;;)
- {
- for (i = 0; i < size; ++i)
- if (this_image.supervisor->images[images[i]].status == IMAGE_OK
- && table[images[i] + this_image.image_num * img_c]
- > table[this_image.image_num + images[i] * img_c])
- break;
- if (i == size)
- break;
- caf_shmem_cond_wait (&si->triggers[this_image.image_num],
- &si->cis->sync_images_table_lock);
- }
+ if (this_image.supervisor->images[images[i]].status != IMAGE_OK)
+ continue;
+ ++table[images[i] + img_c * this_image.image_num];
+ caf_shmem_cond_signal (&si->triggers[images[i]]);
}
- else
+ for (;;)
{
- int *map = caf_current_team->u.image_info->image_map;
- size = caf_current_team->u.image_info->image_count.count;
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];
- 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])
- break;
- if (i == size)
- break;
- caf_shmem_cond_wait (&si->triggers[this_image.image_num],
- &si->cis->sync_images_table_lock);
- }
+ if (this_image.supervisor->images[images[i]].status == IMAGE_OK
+ && table[images[i] + img_c * this_image.image_num]
+ > table[this_image.image_num + img_c * images[i]])
+ break;
+ if (i == size)
+ break;
+ caf_shmem_cond_wait (&si->triggers[this_image.image_num],
+ &si->cis->sync_images_table_lock);
}
unlock_table (si);
}
diff --git a/libgfortran/caf/shmem/teams_mgmt.c b/libgfortran/caf/shmem/teams_mgmt.c
index c4a821d5f00..02f37f28590 100644
--- a/libgfortran/caf/shmem/teams_mgmt.c
+++ b/libgfortran/caf/shmem/teams_mgmt.c
@@ -55,6 +55,15 @@ update_teams_images (caf_shmem_team_t team)
caf_shmem_mutex_unlock (&team->u.image_info->image_count.mutex);
}
+void
+leave_teams (void)
+{
+ for (caf_shmem_team_t t = caf_current_team; t; t = t->parent)
+ update_teams_images (t);
+ for (caf_shmem_team_t t = caf_teams_formed; t; t = t->parent)
+ update_teams_images (t);
+}
+
void
check_health (int *stat, char *errmsg, size_t errmsg_len)
{
diff --git a/libgfortran/caf/shmem/teams_mgmt.h b/libgfortran/caf/shmem/teams_mgmt.h
index f9da4511128..8478281f5d2 100644
--- a/libgfortran/caf/shmem/teams_mgmt.h
+++ b/libgfortran/caf/shmem/teams_mgmt.h
@@ -86,6 +86,12 @@ extern caf_shmem_team_t caf_teams_formed;
void update_teams_images (caf_shmem_team_t);
+/* 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. */
+
+void leave_teams (void);
+
void check_health (int *, char *, size_t);
#define HEALTH_CHECK(stat, errmsg, errlen) check_health (stat, errmsg, errlen)
--
2.55.0
From 309c84e115d0b6467e4630334d504f17a7b5090b Mon Sep 17 00:00:00 2001
From: Jerry DeLisle <[email protected]>
Date: Sat, 19 Sep 2026 12:24:04 -0700
Subject: [PATCH v3 3/3] libgfortran: [PR127347] caf_shmem: fix STAT= for
stopped images
Image control statements and collective subroutines did not follow
F2023 when an image of the team had stopped.
SYNC ALL and SYNC TEAM with a stopped image still synchronized the
remaining images, although F2023 11.7.11 gives them the effect of SYNC
MEMORY, so a conforming program could deadlock. A stopping image now
marks the barriers of its teams as aborting: SYNC ALL and SYNC TEAM no
longer wait in them, and a round they already wait in is aborted.
Images waiting in END TEAM, CHANGE TEAM or at program end take part in
the next round instead.
Collective subroutines blocked forever. They now report
STAT_STOPPED_IMAGE, or STAT_FAILED_IMAGE, when the current team
contains a terminated image (F2023 16.6), and a collective already
running gives up with an error instead of blocking.
STAT= was classified with the program-wide counts of stopped and
failed images, so an image that stopped in one team made SYNC ALL in a
sibling team report STAT_STOPPED_IMAGE. It is now classified over the
images involved in the statement, and SYNC TEAM reports them at all.
Not addressed: END TEAM does not set STAT=.
Assisted-by: Claude Opus 5
PR libfortran/127347
libgfortran/ChangeLog:
* caf/shmem.c (_gfortran_caf_sync_all, _gfortran_caf_sync_team):
Have the effect of SYNC MEMORY with a stopped image. Check the
images of the team synchronized.
(_gfortran_caf_sync_images): Check the images synchronized. Fix
the format of the duplicate image error.
(mark_stopped, _gfortran_caf_fail_image): Tell leave_teams whether
the image stopped.
(_gfortran_caf_co_broadcast, _gfortran_caf_co_sum)
(_gfortran_caf_co_min, _gfortran_caf_co_max)
(_gfortran_caf_co_reduce): Report terminated images of the team.
* caf/shmem/collective_subroutine.c (collsub_sync): Give up when an
image of the team terminated.
* caf/shmem/counter_barrier.c (counter_barrier_init): Initialize the
new fields.
(next_round, wait_round): New functions.
(counter_barrier_wait): Use wait_round. Take part in the next round
when a round is aborted.
(counter_barrier_wait_abortable, counter_barrier_abort_locked): New
functions.
* caf/shmem/counter_barrier.h (counter_barrier): Make
curr_wait_group a round number. Add aborted_round,
abortable_arrivals and aborting.
(counter_barrier_wait_abortable, counter_barrier_abort_locked):
Declare.
* caf/shmem/sync.c (sync_all): Return whether the images were
synchronized.
(sync_team_unless_stopped): New function.
* caf/shmem/sync.h (sync_all): Adjust.
(sync_team_unless_stopped): Declare.
* caf/shmem/teams_mgmt.c (count_images, team_terminated_images)
(update_teams_images_locked, leave_team): New functions.
(update_teams_images): Use update_teams_images_locked.
(leave_teams): Add stopped argument. Use leave_team.
(check_health): Classify the given images. Return the stat value.
* caf/shmem/teams_mgmt.h (leave_teams, check_health): Adjust.
(TEAM_HEALTH_CHECK): New macro.
(HEALTH_CHECK): Use it.
gcc/testsuite/ChangeLog:
* gfortran.dg/coarray/stop_sync_1.f90: Check STAT=.
* gfortran.dg/coarray/collective_stopped_1.f90: New test.
* gfortran.dg/coarray/stop_end_team_1.f90: New test.
* gfortran.dg/coarray/stop_sync_team_1.f90: New test.
* gfortran.dg/coarray/sync_memory_stopped_1.f90: New test.
---
.../coarray/collective_stopped_1.f90 | 33 +++++
.../gfortran.dg/coarray/stop_end_team_1.f90 | 28 ++++
.../gfortran.dg/coarray/stop_sync_1.f90 | 4 +-
.../gfortran.dg/coarray/stop_sync_team_1.f90 | 32 +++++
.../coarray/sync_memory_stopped_1.f90 | 25 ++++
libgfortran/caf/shmem.c | 35 ++++-
libgfortran/caf/shmem/collective_subroutine.c | 10 +-
libgfortran/caf/shmem/counter_barrier.c | 81 ++++++++---
libgfortran/caf/shmem/counter_barrier.h | 25 +++-
libgfortran/caf/shmem/sync.c | 10 +-
libgfortran/caf/shmem/sync.h | 9 +-
libgfortran/caf/shmem/teams_mgmt.c | 126 +++++++++++++-----
libgfortran/caf/shmem/teams_mgmt.h | 23 +++-
13 files changed, 369 insertions(+), 72 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/collective_stopped_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
create mode 100644 gcc/testsuite/gfortran.dg/coarray/sync_memory_stopped_1.f90
diff --git a/gcc/testsuite/gfortran.dg/coarray/collective_stopped_1.f90 b/gcc/testsuite/gfortran.dg/coarray/collective_stopped_1.f90
new file mode 100644
index 00000000000..b1eae226279
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/collective_stopped_1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+!
+! A collective subroutine has to report an image that terminated normally
+! through stat= instead of blocking forever.
+
+program collective_stopped_1
+ use iso_fortran_env, only : stat_stopped_image
+ implicit none
+ integer :: st, val
+
+ sync all
+ if (num_images () > 1 .and. this_image () == num_images ()) stop
+
+ st = 0
+ sync all (stat=st)
+
+ val = this_image ()
+ st = 0
+ call co_sum (val, stat=st)
+ if (num_images () > 1) then
+ if (st /= stat_stopped_image) error stop "co_sum missed the stopped image"
+ else
+ if (st /= 0) error stop "co_sum failed"
+ end if
+
+ st = 0
+ call co_broadcast (val, 1, stat=st)
+ if (num_images () > 1) then
+ if (st /= stat_stopped_image) error stop "co_broadcast missed the stopped image"
+ else
+ if (st /= 0) error stop "co_broadcast failed"
+ end if
+end program collective_stopped_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
new file mode 100644
index 00000000000..79e7d246f57
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_end_team_1.f90
@@ -0,0 +1,28 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+!
+! In a team with a stopped image, SYNC ALL (STAT=) on some images must not
+! pair with END TEAM on the others.
+
+program stop_end_team_1
+ use iso_fortran_env, only : team_type, stat_stopped_image
+ implicit none
+ type(team_type) :: t
+ integer :: me, st, k
+
+ me = 2 - mod (this_image (), 2)
+ form team (me, t)
+ change team (t)
+ sync all
+ if (me == 1 .and. num_images () > 1 .and. this_image () == num_images ()) stop
+ if (me == 1 .and. mod (this_image (), 2) == 0) then
+ do k = 1, 3
+ sync all (stat=st)
+ if (st /= 0 .and. st /= stat_stopped_image) error stop 1
+ end do
+ end if
+ end team
+ st = -1
+ sync all (stat=st)
+ if (num_images () > 2 .and. st /= stat_stopped_image) error stop 2
+end program stop_end_team_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90 b/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90
index cb41610aaf9..ee2d8426ba4 100644
--- a/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_sync_1.f90
@@ -1,9 +1,10 @@
! { dg-do run }
!
! A normal STOP on one image must not block the surviving images in the
-! SYNC ALL statements that follow.
+! SYNC ALL statements that follow, which report STAT_STOPPED_IMAGE.
program stop_sync_1
+ use iso_fortran_env, only : stat_stopped_image
implicit none
integer :: i, st
@@ -14,4 +15,5 @@ program stop_sync_1
st = 0
sync all (stat=st)
end do
+ if (num_images () > 1 .and. st /= stat_stopped_image) error stop 1
end program stop_sync_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90 b/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
new file mode 100644
index 00000000000..9eba00e7b10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/stop_sync_team_1.f90
@@ -0,0 +1,32 @@
+! { dg-do run }
+! { dg-skip-if "CHANGE TEAM needs a coarray library" { *-*-* } { "-fcoarray=single" } { "" } }
+!
+! An image stopping in one team is a stopped image for SYNC ALL and SYNC
+! TEAM in that team only, not in its sibling team.
+
+program stop_sync_team_1
+ use iso_fortran_env, only : team_type, stat_stopped_image
+ implicit none
+ type(team_type) :: t
+ integer :: i, st, me
+
+ if (num_images () < 4) stop
+ me = 2 - mod (this_image (), 2)
+ form team (me, t)
+ change team (t)
+ sync all
+ if (me == 1 .and. this_image () == num_images ()) stop
+
+ do i = 1, 5
+ st = -1
+ sync all (stat=st)
+ if (me == 2 .and. st /= 0) error stop 1
+ end do
+ if (me == 1 .and. st /= stat_stopped_image) error stop 2
+
+ st = -1
+ sync team (get_team (), stat=st)
+ if (me == 2 .and. st /= 0) error stop 3
+ if (me == 1 .and. st /= stat_stopped_image) error stop 4
+ end team
+end program stop_sync_team_1
diff --git a/gcc/testsuite/gfortran.dg/coarray/sync_memory_stopped_1.f90 b/gcc/testsuite/gfortran.dg/coarray/sync_memory_stopped_1.f90
new file mode 100644
index 00000000000..dd400fd5911
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/sync_memory_stopped_1.f90
@@ -0,0 +1,25 @@
+! { dg-do run }
+!
+! SYNC ALL (STAT=) with a stopped image in the team has the effect of
+! SYNC MEMORY: it must not wait for the other images (F2023 11.7.11).
+
+program sync_memory_stopped_1
+ use iso_fortran_env, only : stat_stopped_image
+ implicit none
+ integer :: s
+
+ if (num_images () < 3) stop
+ sync all
+ if (this_image () == 3) stop
+ do while (image_status (3) /= stat_stopped_image)
+ end do
+ s = -1
+ if (this_image () == 1) then
+ sync all (stat=s)
+ sync images (2)
+ else if (this_image () == 2) then
+ sync images (1)
+ sync all (stat=s)
+ end if
+ if (this_image () <= 2 .and. s /= stat_stopped_image) error stop 1
+end program sync_memory_stopped_1
diff --git a/libgfortran/caf/shmem.c b/libgfortran/caf/shmem.c
index 89fad8a8f4b..00d851ab539 100644
--- a/libgfortran/caf/shmem.c
+++ b/libgfortran/caf/shmem.c
@@ -483,7 +483,9 @@ _gfortran_caf_sync_all (int *stat, char *errmsg, size_t errmsg_len)
__asm__ __volatile__ ("":::"memory");
HEALTH_CHECK (stat, errmsg, errmsg_len);
CHECK_TEAM_INTEGRITY (caf_current_team);
- sync_all ();
+ /* With a stopped image, SYNC ALL only has the effect of SYNC MEMORY. */
+ if (!sync_all ())
+ HEALTH_CHECK (stat, errmsg, errmsg_len);
}
@@ -543,7 +545,7 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
if (mapped_images[c] == mapped_images[i])
{
caf_internal_error ("SYNC IMAGES: Duplicate image %d in "
- "images at position %d and &d.",
+ "images at position %d and %d.",
stat, errmsg, errmsg_len, images[c],
i + 1, c + 1);
/* There is no official error code for this, but 3 is what
@@ -565,7 +567,10 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
__asm__ __volatile__ ("" ::: "memory");
sync_table (&local->si, mapped_images, count);
- HEALTH_CHECK (stat, errmsg, errmsg_len);
+ if (count > 0)
+ check_health (mapped_images, count, stat, errmsg, errmsg_len);
+ else
+ HEALTH_CHECK (stat, errmsg, errmsg_len);
}
extern void _gfortran_report_exception (void);
@@ -585,7 +590,7 @@ mark_stopped (void)
= IMAGE_SUCCESS;
atomic_fetch_add (&this_image.supervisor->finished_images, 1);
}
- leave_teams ();
+ leave_teams (true);
}
/* Tell the supervisor that this image error stopped, so that it can terminate
@@ -650,7 +655,7 @@ _gfortran_caf_fail_image (void)
fputs ("IMAGE FAILED!\n", stderr);
this_image.supervisor->images[this_image.image_num].status = IMAGE_FAILED;
atomic_fetch_add (&this_image.supervisor->failed_images, 1);
- leave_teams ();
+ leave_teams (false);
exit (0);
}
@@ -847,6 +852,9 @@ _gfortran_caf_co_broadcast (gfc_descriptor_t *desc, int source_image, int *stat,
if (stat)
*stat = 0;
+ if (HEALTH_CHECK (stat, errmsg, errmsg_len))
+ return;
+
if (!check_map_team (&mapped_index, &this_image_index, source_image, NULL,
NULL, stat))
return;
@@ -942,6 +950,9 @@ _gfortran_caf_co_sum (gfc_descriptor_t *desc, int result_image, int *stat,
if (stat)
*stat = 0;
+ if (HEALTH_CHECK (stat, errmsg, errmsg_len))
+ return;
+
/* If result_image == 0 then allreduce is wanted, i.e. mapped_index = -1. */
if (result_image
&& !check_map_team (&mapped_index, &this_image_index, result_image, NULL,
@@ -964,6 +975,9 @@ _gfortran_caf_co_min (gfc_descriptor_t *desc, int result_image, int *stat,
if (stat)
*stat = 0;
+
+ if (HEALTH_CHECK (stat, errmsg, errmsg_len))
+ return;
/* If result_image == 0 then allreduce is wanted, i.e. mapped_index = -1. */
if (result_image
&& !check_map_team (&mapped_index, &this_image_index, result_image, NULL,
@@ -986,6 +1000,9 @@ _gfortran_caf_co_max (gfc_descriptor_t *desc, int result_image, int *stat,
if (stat)
*stat = 0;
+
+ if (HEALTH_CHECK (stat, errmsg, errmsg_len))
+ return;
/* If result_image == 0 then allreduce is wanted, i.e. mapped_index = -1. */
if (result_image
&& !check_map_team (&mapped_index, &this_image_index, result_image, NULL,
@@ -1008,6 +1025,9 @@ _gfortran_caf_co_reduce (gfc_descriptor_t *desc, void *(*opr) (void *, void *),
if (stat)
*stat = 0;
+ if (HEALTH_CHECK (stat, errmsg, errmsg_len))
+ return;
+
/* If result_image == 0 then allreduce is wanted, i.e. mapped_index = -1. */
if (result_image
&& !check_map_team (&mapped_index, &this_image_index, result_image, NULL,
@@ -1936,7 +1956,10 @@ _gfortran_caf_sync_team (caf_team_t team, int *stat, char *errmsg,
return;
}
- sync_team (team_to_sync);
+ 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))
+ TEAM_HEALTH_CHECK (team_to_sync, stat, errmsg, errmsg_len);
}
int
diff --git a/libgfortran/caf/shmem/collective_subroutine.c b/libgfortran/caf/shmem/collective_subroutine.c
index 01389b18b0a..f97789cab1c 100644
--- a/libgfortran/caf/shmem/collective_subroutine.c
+++ b/libgfortran/caf/shmem/collective_subroutine.c
@@ -22,6 +22,7 @@ a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
+#include "../caf_error.h"
#include "collective_subroutine.h"
#include "supervisor.h"
#include "teams_mgmt.h"
@@ -219,12 +220,17 @@ get_collsub_buf (size_t size)
}
/* This function syncs all images with one another. It will only return once
- all images have called it. */
+ all images have called it. The reduction is laid out over a fixed set of
+ images, so it cannot be completed once an image of the team terminated. */
static void
collsub_sync (void)
{
- counter_barrier_wait (&caf_current_team->u.image_info->collsub.barrier);
+ counter_barrier *barrier = &caf_current_team->u.image_info->collsub.barrier;
+
+ if (!counter_barrier_wait_abortable (barrier))
+ caf_runtime_error ("Image terminated while executing a collective "
+ "subroutine");
}
typedef void *(*red_op) (void *, void *);
diff --git a/libgfortran/caf/shmem/counter_barrier.c b/libgfortran/caf/shmem/counter_barrier.c
index 1993b1ebeea..8598d79d69d 100644
--- a/libgfortran/caf/shmem/counter_barrier.c
+++ b/libgfortran/caf/shmem/counter_barrier.c
@@ -48,35 +48,80 @@ unlock_counter_barrier (counter_barrier *b)
void
counter_barrier_init (counter_barrier *b, int val)
{
- *b = (counter_barrier) {CAF_SHMEM_MUTEX_INITIALIZER,
- CAF_SHMEM_COND_INITIALIZER, val, 0, val};
+ *b = (counter_barrier) {.mutex = CAF_SHMEM_MUTEX_INITIALIZER,
+ .cond = CAF_SHMEM_COND_INITIALIZER,
+ .wait_count = val,
+ .curr_wait_group = 1,
+ .aborted_round = 0,
+ .abortable_arrivals = 0,
+ .aborting = false,
+ .count = val};
initialize_shared_condition (&b->cond, val);
initialize_shared_mutex (&b->mutex);
}
+/* Start the next round of the barrier and wake the images waiting in the
+ current one. */
+
+static void
+next_round (counter_barrier *b, bool abort)
+{
+ if (abort)
+ b->aborted_round = b->curr_wait_group;
+ ++b->curr_wait_group;
+ b->wait_count = b->count;
+ b->abortable_arrivals = 0;
+ caf_shmem_cond_broadcast (&b->cond);
+}
+
+/* Take part in the current round of the barrier, with its lock held. Returns
+ false, when the round was aborted. */
+
+static bool
+wait_round (counter_barrier *b, bool abortable)
+{
+ const uint64_t round = b->curr_wait_group;
+
+ if (abortable)
+ ++b->abortable_arrivals;
+ --b->wait_count;
+ while (b->wait_count > 0 && b->curr_wait_group == round)
+ caf_shmem_cond_wait (&b->cond, &b->mutex);
+
+ /* The last image to arrive, or to be woken after the count dropped, ends
+ the round. */
+ if (b->curr_wait_group == round)
+ next_round (b, false);
+
+ return b->aborted_round != round;
+}
+
void
counter_barrier_wait (counter_barrier *b)
{
- int wait_group_beginning;
-
lock_counter_barrier (b);
- wait_group_beginning = b->curr_wait_group;
-
- if ((--b->wait_count) <= 0)
- caf_shmem_cond_broadcast (&b->cond);
- else
- {
- while (b->wait_count > 0 && b->curr_wait_group == wait_group_beginning)
- caf_shmem_cond_wait (&b->cond, &b->mutex);
- }
+ while (!wait_round (b, false))
+ ;
+ unlock_counter_barrier (b);
+}
- if (b->wait_count <= 0)
- {
- b->curr_wait_group = !wait_group_beginning;
- b->wait_count = b->count;
- }
+bool
+counter_barrier_wait_abortable (counter_barrier *b)
+{
+ bool completed;
+ lock_counter_barrier (b);
+ completed = !b->aborting && wait_round (b, true);
unlock_counter_barrier (b);
+ return completed;
+}
+
+void
+counter_barrier_abort_locked (counter_barrier *b)
+{
+ b->aborting = true;
+ if (b->abortable_arrivals)
+ next_round (b, true);
}
static inline void
diff --git a/libgfortran/caf/shmem/counter_barrier.h b/libgfortran/caf/shmem/counter_barrier.h
index 7d7c724ae06..7b6d3d88e71 100644
--- a/libgfortran/caf/shmem/counter_barrier.h
+++ b/libgfortran/caf/shmem/counter_barrier.h
@@ -27,6 +27,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "thread_support.h"
+#include <stdbool.h>
+#include <stdint.h>
+
/* Usable as counter barrier and as waitable counter.
This "class" allows to sync all images acting as a barrier. For this the
counter_barrier is to be initialized by the number of images and then later
@@ -44,7 +47,14 @@ typedef struct
caf_shmem_mutex mutex;
caf_shmem_condvar cond;
volatile int wait_count;
- volatile int curr_wait_group;
+ /* The number of the current round of the barrier, and of the last round
+ that was aborted. */
+ volatile uint64_t curr_wait_group;
+ volatile uint64_t aborted_round;
+ /* The number of abortable arrivals in the current round. */
+ volatile int abortable_arrivals;
+ /* Set once abortable arrivals are no longer to be synchronized. */
+ volatile bool aborting;
volatile int count;
} counter_barrier;
@@ -73,8 +83,19 @@ void counter_barrier_init_add (counter_barrier *, int);
int counter_barrier_get_count (counter_barrier *);
-/* Wait for the count in the barrier drop to or below 0. */
+/* Wait for the count in the barrier drop to or below 0. When the round is
+ aborted, take part in the next one. */
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. */
+
+bool counter_barrier_wait_abortable (counter_barrier *);
+
+/* Abort the current round when it has an abortable arrival, and every later
+ abortable arrival. The barrier's lock has to be held. */
+
+void counter_barrier_abort_locked (counter_barrier *);
+
#endif
diff --git a/libgfortran/caf/shmem/sync.c b/libgfortran/caf/shmem/sync.c
index f1d5bedbc8e..511a8525424 100644
--- a/libgfortran/caf/shmem/sync.c
+++ b/libgfortran/caf/shmem/sync.c
@@ -128,10 +128,10 @@ sync_table (sync_t *si, int *images, int size)
unlock_table (si);
}
-void
+bool
sync_all (void)
{
- counter_barrier_wait (&caf_current_team->u.image_info->image_count);
+ return sync_team_unless_stopped (caf_current_team);
}
void
@@ -140,6 +140,12 @@ sync_team (caf_shmem_team_t team)
counter_barrier_wait (&team->u.image_info->image_count);
}
+bool
+sync_team_unless_stopped (caf_shmem_team_t team)
+{
+ return counter_barrier_wait_abortable (&team->u.image_info->image_count);
+}
+
void
lock_event (sync_t *si)
{
diff --git a/libgfortran/caf/shmem/sync.h b/libgfortran/caf/shmem/sync.h
index 6f8b28d378a..0aa596c9eff 100644
--- a/libgfortran/caf/shmem/sync.h
+++ b/libgfortran/caf/shmem/sync.h
@@ -51,7 +51,10 @@ void sync_init (sync_t *, shared_memory);
void sync_init_supervisor (sync_t *, alloc *);
-void sync_all (void);
+/* Synchronize the images of the current team. Returns false without
+ synchronizing when a stopped image is a member of the team. */
+
+bool sync_all (void);
/* Prototype for circular dependency break. */
@@ -60,6 +63,10 @@ typedef struct caf_shmem_team *caf_shmem_team_t;
void sync_team (caf_shmem_team_t team);
+/* Like sync_all for TEAM. */
+
+bool sync_team_unless_stopped (caf_shmem_team_t team);
+
void sync_table (sync_t *, int *, int);
void lock_alloc_lock (sync_t *);
diff --git a/libgfortran/caf/shmem/teams_mgmt.c b/libgfortran/caf/shmem/teams_mgmt.c
index 02f37f28590..d90ece310ba 100644
--- a/libgfortran/caf/shmem/teams_mgmt.c
+++ b/libgfortran/caf/shmem/teams_mgmt.c
@@ -28,65 +28,119 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
caf_shmem_team_t caf_current_team = NULL, caf_initial_team;
caf_shmem_team_t caf_teams_formed = NULL;
-void
-update_teams_images (caf_shmem_team_t team)
+/* Count the images among the COUNT images in MAP that have status STATUS. */
+
+static int
+count_images (const int *map, int count, image_status status)
+{
+ int i, n = 0;
+
+ for (i = 0; i < count; ++i)
+ if (this_image.supervisor->images[map[i]].status == status)
+ ++n;
+
+ return n;
+}
+
+/* Get the number of images of TEAM that have terminated. */
+
+static int
+team_terminated_images (caf_shmem_team_t team)
+{
+ const int sz = team->u.image_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)
+ ++term;
+
+ return term;
+}
+
+static void
+update_teams_images_locked (caf_shmem_team_t team)
{
- caf_shmem_mutex_lock (&team->u.image_info->image_count.mutex);
if (team->u.image_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 sz = team->u.image_info->image_map_size;
- int i, good = 0;
-
- for (i = 0; i < sz; ++i)
- if (this_image.supervisor->images[team->u.image_info->image_map[i]]
- .status
- == IMAGE_OK)
- ++good;
- team->u.image_info->num_term_images = sz - good;
+ team->u.image_info->num_term_images = team_terminated_images (team);
counter_barrier_add_locked (&team->u.image_info->image_count,
old_num
- team->u.image_info->num_term_images);
}
+}
+
+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);
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)
+{
+ counter_barrier *b = &team->u.image_info->image_count;
+ counter_barrier *cb = &team->u.image_info->collsub.barrier;
+
+ caf_shmem_mutex_lock (&b->mutex);
+ update_teams_images_locked (team);
+ if (stopped)
+ counter_barrier_abort_locked (b);
+ caf_shmem_mutex_unlock (&b->mutex);
+
+ caf_shmem_mutex_lock (&cb->mutex);
+ counter_barrier_abort_locked (cb);
+ caf_shmem_mutex_unlock (&cb->mutex);
+}
+
void
-leave_teams (void)
+leave_teams (bool stopped)
{
for (caf_shmem_team_t t = caf_current_team; t; t = t->parent)
- update_teams_images (t);
+ leave_team (t, stopped);
for (caf_shmem_team_t t = caf_teams_formed; t; t = t->parent)
- update_teams_images (t);
+ leave_team (t, stopped);
}
-void
-check_health (int *stat, char *errmsg, size_t errmsg_len)
+int
+check_health (const int *map, int count, int *stat, char *errmsg,
+ size_t errmsg_len)
{
- if (this_image.supervisor->finished_images
- || this_image.supervisor->failed_images)
+ int stopped = 0, failed = 0;
+
+ if (this_image.supervisor->finished_images)
+ stopped = count_images (map, count, IMAGE_SUCCESS);
+ if (this_image.supervisor->failed_images)
+ failed = count_images (map, count, IMAGE_FAILED);
+
+ if (stopped)
{
- if (this_image.supervisor->finished_images)
- {
- caf_internal_error ("Stopped images present (currently %d)", stat,
- errmsg, errmsg_len,
- this_image.supervisor->finished_images);
- if (stat)
- *stat = CAF_STAT_STOPPED_IMAGE;
- }
- else if (this_image.supervisor->failed_images)
- {
- caf_internal_error ("Failed images present (currently %d)", stat,
- errmsg, errmsg_len,
- this_image.supervisor->failed_images);
- if (stat)
- *stat = CAF_STAT_FAILED_IMAGE;
- }
+ caf_internal_error ("Stopped images present (currently %d)", stat,
+ errmsg, errmsg_len, stopped);
+ if (stat)
+ *stat = CAF_STAT_STOPPED_IMAGE;
+ return CAF_STAT_STOPPED_IMAGE;
}
- else if (stat)
+
+ if (failed)
+ {
+ caf_internal_error ("Failed images present (currently %d)", stat,
+ errmsg, errmsg_len, failed);
+ if (stat)
+ *stat = CAF_STAT_FAILED_IMAGE;
+ return CAF_STAT_FAILED_IMAGE;
+ }
+
+ if (stat)
*stat = 0;
+ return 0;
}
diff --git a/libgfortran/caf/shmem/teams_mgmt.h b/libgfortran/caf/shmem/teams_mgmt.h
index 8478281f5d2..3b0c3b6aa22 100644
--- a/libgfortran/caf/shmem/teams_mgmt.h
+++ b/libgfortran/caf/shmem/teams_mgmt.h
@@ -88,12 +88,27 @@ void update_teams_images (caf_shmem_team_t);
/* 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. */
+ before the call for it to have any effect. When STOPPED, image control
+ statements and collective subroutines no longer synchronize with the other
+ images of these teams. Otherwise only collective subroutines do not. */
-void leave_teams (void);
+void leave_teams (bool stopped);
-void check_health (int *, char *, size_t);
+/* Set STAT for the stopped or failed images among the COUNT images in MAP.
+ Returns the stat value. */
-#define HEALTH_CHECK(stat, errmsg, errlen) check_health (stat, errmsg, errlen)
+int check_health (const int *map, int count, int *stat, char *errmsg,
+ size_t errmsg_len);
+
+/* Perform the health check on the specified team. */
+
+#define TEAM_HEALTH_CHECK(team, stat, errmsg, errlen) \
+ check_health ((team)->u.image_info->image_map, \
+ (team)->u.image_info->image_map_size, stat, errmsg, errlen)
+
+/* Perform the health check on the current team. */
+
+#define HEALTH_CHECK(stat, errmsg, errlen) \
+ TEAM_HEALTH_CHECK (caf_current_team, stat, errmsg, errlen)
#endif
--
2.55.0
