This patch cleans up the ABI mess, I created at some point.
The initial version of _gfortran_caf_register didn't handle stat/errmsg
as one could leave it to the front end: The the returned memory is NULL,
it's an error. However, as Nick pointed out, for stat= one can also
return STAT_STOPPED_IMAGE. In order to handle this, one needs an
additional argument.
That's what was done - albeit incompletely: The documentation was
updated, cf. http://gcc.gnu.org/wiki/CoarrayLib#Registering_coarrays, as
was the front end (cf. function declaration and call in trans-decl.c);
however, the library itself (single.c and mpi.c) was not accepting the
new arguments.
The attached patch solves this: It updates the just (by Daniel) added
trans.c call and implements the new arguments in the library.
TODO: In trans.c (for the ALLOCATE statement), I currently pass NULL
pointers for stat and errormsg argument. Hence, the ABI is fixed, but
the error diagnostic is not yet standard conform. However, I think one
can defer this to another patch. I added a note in my BUG file to make
sure it won't get forgotten. Cf.
http://users.physik.fu-berlin.de/~tburnus/coarray/BUGS.txt
Build and regtested on x86-64-linux.
OK for the trunk?
(Daniel Carrera, I would be happy if you could also have a look at the
patch.)
Tobias
2011-07-06 Tobias Burnus <bur...@net-b.de>
* trans.c (gfc_allocate_with_status): Call _gfortran_caf_register
with NULL arguments for (new) stat=/errmsg= arguments.
2011-07-06 Tobias Burnus <bur...@net-b.de>
* libcaf.h (__attribute__, unlikely, likely): New macros.
(caf_register_t): Update comment.
(_gfortran_caf_register): Add stat, errmsg, errmsg_len arguments.
* single.c (_gfortran_caf_register): Ditto; add error diagnostics.
* mpi.c (_gfortran_caf_register): Ditto.
(caf_is_finalized): New global variable.
(_gfortran_caf_finalize): Use it.
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 683e3f1..4043df2 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -622,13 +622,16 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status,
gfc_add_modify (&alloc_block, res,
fold_convert (prvoid_type_node,
build_call_expr_loc (input_location,
- gfor_fndecl_caf_register, 3,
+ gfor_fndecl_caf_register, 6,
fold_build2_loc (input_location,
MAX_EXPR, size_type_node, size,
build_int_cst (size_type_node, 1)),
build_int_cst (integer_type_node,
GFC_CAF_COARRAY_ALLOC),
- null_pointer_node))); /* Token */
+ null_pointer_node, /* token */
+ null_pointer_node, /* stat */
+ null_pointer_node, /* errmsg, errmsg_len */
+ build_int_cst (integer_type_node, 0))));
}
else
{
diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 4177985..4fe09e4 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -30,6 +30,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <stdint.h> /* For int32_t. */
#include <stddef.h> /* For ptrdiff_t. */
+#ifndef __GNUC__
+#define __attribute__(x)
+#define likely(x) (x)
+#define unlikely(x) (x)
+#else
+#define likely(x) __builtin_expect(!!(x), 1)
+#define unlikely(x) __builtin_expect(!!(x), 0)
+#endif
/* Definitions of the Fortran 2008 standard; need to kept in sync with
ISO_FORTRAN_ENV, cf. libgfortran.h. */
@@ -38,7 +46,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#define STAT_LOCKED_OTHER_IMAGE 2
#define STAT_STOPPED_IMAGE 3
-/* Describes what type of array we are registerring. */
+/* Describes what type of array we are registerring. Keep in sync with
+ gcc/fortran/trans.h. */
typedef enum caf_register_t {
CAF_REGTYPE_COARRAY_STATIC,
CAF_REGTYPE_COARRAY_ALLOC,
@@ -58,7 +67,8 @@ caf_static_t;
void _gfortran_caf_init (int *, char ***, int *, int *);
void _gfortran_caf_finalize (void);
-void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void **);
+void * _gfortran_caf_register (ptrdiff_t, caf_register_t, void **, int *,
+ char *, int);
int _gfortran_caf_deregister (void **);
diff --git a/libgfortran/caf/mpi.c b/libgfortran/caf/mpi.c
index 83f39f6..2d4af6b 100644
--- a/libgfortran/caf/mpi.c
+++ b/libgfortran/caf/mpi.c
@@ -41,6 +41,7 @@ static void error_stop (int error) __attribute__ ((noreturn));
static int caf_mpi_initialized;
static int caf_this_image;
static int caf_num_images;
+static int caf_is_finalized;
caf_static_t *caf_static_list = NULL;
@@ -87,14 +88,20 @@ _gfortran_caf_finalize (void)
if (!caf_mpi_initialized)
MPI_Finalize ();
+
+ caf_is_finalized = 1;
}
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type,
- void **token)
+_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token,
+ int *stat, char *errmsg, int errmsg_len)
{
void *local;
+ int err;
+
+ if (unlikely (caf_is_finalized))
+ goto error;
/* Start MPI if not already started. */
if (caf_num_images == 0)
@@ -103,10 +110,19 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type,
/* Token contains only a list of pointers. */
local = malloc (size);
token = malloc (sizeof (void*) * caf_num_images);
+
+ if (unlikely (local == NULL || token == NULL))
+ goto error;
/* token[img-1] is the address of the token in image "img". */
- MPI_Allgather (&local, sizeof (void*), MPI_BYTE,
- token, sizeof (void*), MPI_BYTE, MPI_COMM_WORLD);
+ err = MPI_Allgather (&local, sizeof (void*), MPI_BYTE, token,
+ sizeof (void*), MPI_BYTE, MPI_COMM_WORLD);
+ if (unlikely (err))
+ {
+ free (local);
+ free (token);
+ goto error;
+ }
if (type == CAF_REGTYPE_COARRAY_STATIC)
{
@@ -115,7 +131,41 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type,
tmp->token = token;
caf_static_list = tmp;
}
+
+ if (stat)
+ *stat = 0;
+
return local;
+
+error:
+ if (stat)
+ {
+ *stat = caf_is_finalized ? STAT_STOPPED_IMAGE : 1;
+ if (errmsg_len > 0)
+ {
+ char *msg;
+ if (caf_is_finalized)
+ msg = "Failed to allocate coarray - stopped images";
+ else
+ msg = "Failed to allocate coarray";
+ int len = ((int) strlen (msg) > errmsg_len) ? errmsg_len
+ : (int) strlen (msg);
+ memcpy (errmsg, msg, len);
+ if (errmsg_len > len)
+ memset (&errmsg[len], ' ', errmsg_len-len);
+ }
+ return NULL;
+ }
+ else
+ {
+ if (caf_is_finalized)
+ fprintf (stderr, "ERROR: Image %d is stopped, failed to allocate "
+ "coarray", caf_this_image);
+ else
+ fprintf (stderr, "ERROR: Failed to allocate coarray on image %d\n",
+ caf_this_image);
+ error_stop (1);
+ }
}
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 5392797..603a910 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -27,6 +27,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "libcaf.h"
#include <stdio.h> /* For fputs and fprintf. */
#include <stdlib.h> /* For exit and malloc. */
+#include <string.h> /* For memcpy and memset. */
/* Define GFC_CAF_CHECK to enable run-time checking. */
/* #define GFC_CAF_CHECK 1 */
@@ -61,8 +62,8 @@ _gfortran_caf_finalize (void)
void *
-_gfortran_caf_register (ptrdiff_t size, caf_register_t type,
- void **token)
+_gfortran_caf_register (ptrdiff_t size, caf_register_t type, void **token,
+ int *stat, char *errmsg, int errmsg_len)
{
void *local;
@@ -70,6 +71,32 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type,
token = malloc (sizeof (void*) * 1);
token[0] = local;
+ if (unlikely (local == NULL || token == NULL))
+ {
+ if (stat)
+ {
+ *stat = 1;
+ if (errmsg_len > 0)
+ {
+ const char msg[] = "Failed to allocate coarray";
+ int len = ((int) sizeof (msg) > errmsg_len) ? errmsg_len
+ : (int) sizeof (msg);
+ memcpy (errmsg, msg, len);
+ if (errmsg_len > len)
+ memset (&errmsg[len], ' ', errmsg_len-len);
+ }
+ return NULL;
+ }
+ else
+ {
+ fprintf (stderr, "ERROR: Failed to allocate coarray");
+ exit (1);
+ }
+ }
+
+ if (stat)
+ *stat = 0;
+
if (type == CAF_REGTYPE_COARRAY_STATIC)
{
caf_static_t *tmp = malloc (sizeof (caf_static_t));
