diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 75693cc4a60..267c81e3076 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-07-07 Tobias Burnus + + * trans.c (gfc_allocate_with_status): Call _gfortran_caf_register + with NULL arguments for (new) stat=/errmsg= arguments. + 2011-07-06 Daniel Carrera * trans-array.c (gfc_array_allocate): Rename allocatable_array to diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 683e3f1e48b..4043df287f1 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/ChangeLog b/libgfortran/ChangeLog index 442c032f477..b7114e9dbae 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2011-07-07 Tobias Burnus + + * 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. + 2011-07-05 Thomas Koenig * runtime/memory.c (internal_malloc_size): If size is zero, diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h index 4177985536d..4fe09e4c8a0 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 /* For int32_t. */ #include /* 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 83f39f6f88c..4e3a7eb359c 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) @@ -104,9 +111,18 @@ _gfortran_caf_register (ptrdiff_t size, caf_register_t type, 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 53927977d52..603a910aeb3 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 /* For fputs and fprintf. */ #include /* For exit and malloc. */ +#include /* 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));