git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mpi.c (runtime_error): New function. 

2011-07-09  Tobias Burnus  <burnus@net-b.de>
            Daniel Carrera  <dcarrera@gmail.com>

        * caf/mpi.c (runtime_error): New function.
        (_gfortran_caf_register): Use it.
        (_gfortran_caf_sync_all): Use it, add STAT_STOPPED_IMAGE
        as possible status value.
        (_gfortran_caf_sync_images): Ditto.


Co-Authored-By: Daniel Carrera <dcarrera@gmail.com>

From-SVN: r176080
This commit is contained in:
Tobias Burnus 2011-07-09 16:29:50 +02:00 committed by Tobias Burnus
parent 677aad9c92
commit 41de45c6a0
2 changed files with 83 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
libgfortran/ChangeLog
View File

@ -1,3 +1,12 @@
2011-07-09 Tobias Burnus <burnus@net-b.de>
Daniel Carrera <dcarrera@gmail.com>
* caf/mpi.c (runtime_error): New function.
(_gfortran_caf_register): Use it.
(_gfortran_caf_sync_all): Use it, add STAT_STOPPED_IMAGE
as possible status value.
(_gfortran_caf_sync_images): Ditto.
2011-07-07 Tobias Burnus <burnus@net-b.de> 2011-07-07 Tobias Burnus <burnus@net-b.de>
* libcaf.h (__attribute__, unlikely, likely): New macros. * libcaf.h (__attribute__, unlikely, likely): New macros.

120
libgfortran/caf/mpi.c
View File

@ -28,6 +28,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> /* For memcpy. */ #include <string.h> /* For memcpy. */
#include <stdarg.h> /* For variadic arguments. */
#include <mpi.h> #include <mpi.h>
@ -46,6 +47,25 @@ static int caf_is_finalized;
caf_static_t *caf_static_list = NULL; caf_static_t *caf_static_list = NULL;
static void
caf_runtime_error (int error, const char *message, ...)
{
va_list ap;
fprintf (stderr, "Fortran runtime error on image %d: ", caf_this_image);
va_start (ap, message);
fprintf (stderr, message, ap);
va_end (ap);
fprintf (stderr, "\n");
/* FIXME: Shutdown the Fortran RTL to flush the buffer. PR 43849. */
/* FIXME: Do some more effort than just MPI_ABORT. */
MPI_Abort (MPI_COMM_WORLD, error);
/* Should be unreachable, but to make sure also call exit. */
exit (2);
}
/* Initialize coarray program. This routine assumes that no other /* Initialize coarray program. This routine assumes that no other
MPI initialization happened before; otherwise MPI_Initialized MPI initialization happened before; otherwise MPI_Initialized
had to be used. As the MPI library might modify the command-line had to be used. As the MPI library might modify the command-line
@ -138,34 +158,31 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token,
return local; return local;
error: error:
if (stat) {
{ char *msg;
*stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1;
if (errmsg_len > 0) if (caf_is_finalized)
{ msg = "Failed to allocate coarray - there are stopped images";
char *msg; else
if (caf_is_finalized) msg = "Failed to allocate coarray";
msg = "Failed to allocate coarray - stopped images";
else if (stat)
msg = "Failed to allocate coarray"; {
int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len *stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1;
: (int) strlen (msg); if (errmsg_len > 0)
memcpy (errmsg, msg, len); {
if (errmsg_len > len) int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
memset (&errmsg[len], ' ', errmsg_len-len); : (int) strlen (msg);
} memcpy (errmsg, msg, len);
return NULL; if (errmsg_len > len)
} memset (&errmsg[len], ' ', errmsg_len-len);
else }
{ }
if (caf_is_finalized) else
fprintf (stderr, "ERROR: Image %d is stopped, failed to allocate " caf_runtime_error (caf_is_finalized ? STAT_STOPPED_IMAGE : 1, msg);
"coarray", caf_this_image); }
else
fprintf (stderr, "ERROR: Failed to allocate coarray on image %d\n", return NULL;
caf_this_image);
error_stop (1);
}
} }
@ -179,28 +196,34 @@ _gfortran_caf_deregister (void **token __attribute__ ((unused)))
void void
_gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len) _gfortran_caf_sync_all (int *stat, char *errmsg, int errmsg_len)
{ {
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ int ierr;
int ierr = MPI_Barrier (MPI_COMM_WORLD);
if (unlikely (caf_is_finalized))
ierr = STAT_STOPPED_IMAGE;
else
ierr = MPI_Barrier (MPI_COMM_WORLD);
if (stat) if (stat)
*stat = ierr; *stat = ierr;
if (ierr) if (ierr)
{ {
const char msg[] = "SYNC ALL failed"; char *msg;
if (caf_is_finalized)
msg = "SYNC ALL failed - there are stopped images";
else
msg = "SYNC ALL failed";
if (errmsg_len > 0) if (errmsg_len > 0)
{ {
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg); : (int) strlen (msg);
memcpy (errmsg, msg, len); memcpy (errmsg, msg, len);
if (errmsg_len > len) if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len); memset (&errmsg[len], ' ', errmsg_len-len);
} }
else else
{ caf_runtime_error (caf_is_finalized ? STAT_STOPPED_IMAGE : ierr, msg);
fprintf (stderr, "SYNC ALL failed\n");
error_stop (ierr);
}
} }
} }
@ -243,27 +266,32 @@ _gfortran_caf_sync_images (int count, int images[], int *stat, char *errmsg,
} }
/* Handle SYNC IMAGES(*). */ /* Handle SYNC IMAGES(*). */
/* TODO: Is ierr correct? When should STAT_STOPPED_IMAGE be used? */ if (unlikely(caf_is_finalized))
ierr = MPI_Barrier (MPI_COMM_WORLD); ierr = STAT_STOPPED_IMAGE;
else
ierr = MPI_Barrier (MPI_COMM_WORLD);
if (stat) if (stat)
*stat = ierr; *stat = ierr;
if (ierr) if (ierr)
{ {
const char msg[] = "SYNC IMAGES failed"; char *msg;
if (caf_is_finalized)
msg = "SYNC IMAGES failed - there are stopped images";
else
msg = "SYNC IMAGES failed";
if (errmsg_len > 0) if (errmsg_len > 0)
{ {
int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
: (int) sizeof (msg); : (int) strlen (msg);
memcpy (errmsg, msg, len); memcpy (errmsg, msg, len);
if (errmsg_len > len) if (errmsg_len > len)
memset (&errmsg[len], ' ', errmsg_len-len); memset (&errmsg[len], ' ', errmsg_len-len);
} }
else else
{ caf_runtime_error (caf_is_finalized ? STAT_STOPPED_IMAGE : ierr, msg);
fprintf (stderr, "SYNC IMAGES failed\n");
error_stop (ierr);
}
} }
} }