trans.c (gfc_allocate_with_status): Call _gfortran_caf_register with NULL arguments for (new) stat=/errmsg= arguments.

2011-07-07  Tobias Burnus  <burnus@net-b.de>

        * trans.c (gfc_allocate_with_status): Call _gfortran_caf_register
        with NULL arguments for (new) stat=/errmsg= arguments.

2011-07-07  Tobias Burnus  <burnus@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.

From-SVN: r175966
This commit is contained in:
Tobias Burnus 2011-07-07 14:46:18 +02:00 committed by Tobias Burnus
parent 3c3ab6c5e1
commit 4054bc52d6
6 changed files with 115 additions and 10 deletions

View File

@ -1,3 +1,8 @@
2011-07-07 Tobias Burnus <burnus@net-b.de>
* trans.c (gfc_allocate_with_status): Call _gfortran_caf_register
with NULL arguments for (new) stat=/errmsg= arguments.
2011-07-06 Daniel Carrera <dcarrera@gmail.com>
* trans-array.c (gfc_array_allocate): Rename allocatable_array to

View File

@ -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
{

View File

@ -1,3 +1,13 @@
2011-07-07 Tobias Burnus <burnus@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.
2011-07-05 Thomas Koenig <tkoenig@gcc.gnu.org>
* runtime/memory.c (internal_malloc_size): If size is zero,

View File

@ -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 **);

View File

@ -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);
}
}

View File

@ -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));