Patchwork [Fortran] Add stat=/errmsg= support to _gfortran_caf_register

login
register
mail settings
Submitter Tobias Burnus
Date July 7, 2011, 5:35 a.m.
Message ID <4E15458B.8050901@net-b.de>
Download mbox | patch
Permalink /patch/103610/
State New
Headers show

Comments

Tobias Burnus - July 7, 2011, 5:35 a.m.
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
Mikael Morin - July 7, 2011, 11:35 a.m.
On Thursday 07 July 2011 07:35:07 Tobias Burnus wrote:
> 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
> @@ -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);
> +  
Trailing blanks
> +  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)
>      {
This will return the same error (memory allocation failure) as in the case 
just above. Is this expected or should it have an error of its own?

> +	  char *msg;
> +          if (caf_is_finalized)
Space indentation
> +	    msg = "Failed to allocate coarray - stopped images";


Also I'm wondering whether it would be pertinent to share the error handling 
between single.c (one error) and mpi.c (2 or 3 errors) as the codes are very 
close (with an interface such as handle_error (int *stat, char *errmsg, int 
errmsg_len, char *actual_error)).


> Build and regtested on x86-64-linux.
> OK for the trunk?
The above is nitpicking, and I leave the final decision to you and Daniel, so 
the patch is basically OK with the two indentation nits fixed.

Mikael
Tobias Burnus - July 7, 2011, 12:48 p.m.
On 07/07/2011 01:35 PM, Mikael Morin wrote:
>>     if (type == CAF_REGTYPE_COARRAY_STATIC)
>>       {
> This will return the same error (memory allocation failure) as in the case
> just above. Is this expected or should it have an error of its own?

I think it is OK in either case. CAF_REFTYPE_COARRAY_STATIC is an 
automatic allocation for static coarrays, e.g.
    REAL, SAVE :: my_coarray(1000,1000,10)[*]
is allocated at startup (via a constructor) while the other case is for 
allocatable coarrays of the form
    REAL, ALLOCATABLE :: my_alloc_coarray(:, :, :)[:]
    ALLOCATE (my_alloc_coarray(1000,1000,10)[*])

I admit that it is might be not obvious to the user that there is an 
explicit allocate in the first case. However, one allocates memory in 
either case and, thus, one could leave the message as is. In particular, 
I would assume that on most systems, the size of static coarrays is 
small enough that the message does not trigger.
However, if you think that the message could be clearer, I could also 
change it.

>> +	    msg = "Failed to allocate coarray - stopped images";
>
> Also I'm wondering whether it would be pertinent to share the error handling
> between single.c (one error) and mpi.c (2 or 3 errors) as the codes are very
> close (with an interface such as handle_error (int *stat, char *errmsg, int
> errmsg_len, char *actual_error)).

The question is where to handle it; in principle, single.c and mpi.c are 
completely separate files - and both might be compiled by the 
user/system administrator, contrary to the rest of GCC. Well, single.c 
is actually automatically compiled as static library and installed as 
libcaf_single.a. The MPI version is never compiled automatically.

Thus, anyone who wants to use gfortran with coarrays (based on mpi.c), 
has to do:
a) Fetch libcaf.h and mpi.c
b) Compile mpi.c, e.g., using mpicc -g -O2 -c mpi.c
c) Link the such generated mpi.o  (or libcaf_mpi.a) to the Fortran program.

As the user/sysadmin as to do the compiliation himself, I would like to 
make it as easy as possible. The current idea is to have just a single C 
file plus a header file and no further dependency. Other communication 
backends could be added by simply creating a new file and implementing 
the library calls.

Thus, I do not see how one could best share single.c and mpi.c error 
messages. But if you have a good idea, I am open to change the current 
implementation.

(See also http://gcc.gnu.org/wiki/CoarrayLib )

>> Build and regtested on x86-64-linux.
>> OK for the trunk?
> The above is nitpicking, and I leave the final decision to you and Daniel, so
> the patch is basically OK with the two indentation nits fixed.

I have now committed the patch with only the nits fixed (Rev.175966). 
But given that the coarray support - especially with regards to the 
library - is still in a flux, we can still change everything, including 
the ABI of the library and the file organization. I am sure that not all 
design decisions are optimal.

Thanks for the review!

Tobias
Janne Blomqvist - July 8, 2011, 8:14 p.m.
On Thu, Jul 7, 2011 at 15:48, Tobias Burnus <burnus@net-b.de> wrote:
> I have now committed the patch with only the nits fixed (Rev.175966). But
> given that the coarray support - especially with regards to the library - is
> still in a flux, we can still change everything, including the ABI of the
> library and the file organization. I am sure that not all design decisions
> are optimal.

One minor thing is that one should use gfc_charlen_type_node
(frontend) and gfc_charlen_type (library) for string lengths instead
of int. (Currently gfc_charlen_type is a typedef for int, but if this
is at some point changed to size_t, as has been discussed, then it's
easier if one needs only to change a few places.)

Patch

2011-07-06  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  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.

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