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:
parent
3c3ab6c5e1
commit
4054bc52d6
@ -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
|
||||
|
@ -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
|
||||
{
|
||||
|
@ -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,
|
||||
|
@ -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 **);
|
||||
|
||||
|
||||
|
@ -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);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
@ -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));
|
||||
|
Loading…
Reference in New Issue
Block a user