trans.c (gfc_allocate_with_status): Call _gfortran_caf_register with NULL 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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 75693cc4a6090946397f2af682ec42338ae21034..267c81e3076b74add8edb5ab8d76a2de1d2b9b5d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 683e3f1e48bb7773b53f0e56e0248379635fde55..4043df287f1d8edaae575a99984c5faf95c4a7ab 100644 (file)
--- 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 442c032f47720996253298f4568f64dc81ae2384..b7114e9dbae32c24f1e090f120a5ee6b55c5bac7 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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,

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index 4177985536dc7e36c41f9f23565b6a510e056edd..4fe09e4c8a0d4571359ccd0554919253749597c7 100644 (file)
--- 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 83f39f6f88c802af65b18dd7d89b6670ada41a6e..4e3a7eb359ca9b309fab6e9b3108d00e9c69e900 100644 (file)
--- 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 53927977d52515b06200c8e42acc7e7db1dd4fd8..603a910aeb3c102e592464008977ce0c71dcba0c 100644 (file)
--- 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));