diff mbox

[Fortran-CAF,committed] Add array sending support for coarrays

Message ID 533DB5A6.90402@net-b.de
State New
Headers show

Commit Message

Tobias Burnus April 3, 2014, 7:25 p.m. UTC 
This patch handles assigning to coarray array (sections) from local 
arrays for array RHS and for scalar RHS. I have lightly tested it with 
libcaf_single.

On the library side, I added a minimal implementation for libcaf_single, 
which handles only rank==1 arrays, but which otherwise seems to work.

With that patch, the most common cases for sending should be handled. 
Missing features for sending to remote issues: character strings are not 
handled, type conversion (i.e. assigning a real to an integer or 
similar), allocatable/pointer components of coarrays, and array vector 
sections are still not handled. - And, of course, reading from remote 
coarrays ("get", "pull") is not supported.

Build on x86-64-gnu-linux - and committed to the branch as Rev. 209060

Tobias

PS: Minimal test case to be run with "gfortran -fdump-tree-original 
-fcoarray=single -lcaf_single":

integer :: foo(5)[*]
integer :: bar(5)

bar = [1,2,3,4,5]
foo(:)[1] = bar
print *, foo
foo(:)[1] = 45
print *, foo
end
diff mbox

Patch

 gcc/fortran/ChangeLog.fortran-caf |    9 +++++
 gcc/fortran/trans-decl.c          |   15 +++++++-
 gcc/fortran/trans-intrinsic.c     |   34 +++++++++++++------
 gcc/fortran/trans.h               |    2 +
 libgfortran/ChangeLog.fortran-caf |   13 +++++++
 libgfortran/caf/libcaf.h          |   34 +++++++++++++++++++
 libgfortran/caf/single.c          |   67 ++++++++++++++++++++++++++++++++++++++
 7 files changed, 163 insertions(+), 11 deletions(-)

Index: libgfortran/ChangeLog.fortran-caf
===================================================================
--- libgfortran/ChangeLog.fortran-caf	(Revision 208931)
+++ libgfortran/ChangeLog.fortran-caf	(Arbeitskopie)
@@ -1,3 +1,16 @@ 
+2014-04-03  Tobias Burnus  <burnus@net-b.de>
+
+	* caf/libcaf.h (descriptor_dimension, gfc_descriptor_t): New
+	structs.
+	(GFC_MAX_DIMENSIONS, GFC_DTYPE_RANK_MASK, GFC_DTYPE_TYPE_SHIFT,
+	GFC_DTYPE_TYPE_MASK, GFC_DTYPE_SIZE_SHIFT, GFC_DESCRIPTOR_RANK,
+	GFC_DESCRIPTOR_TYPE, GFC_DESCRIPTOR_SIZE): New defines.
+	(_gfortran_caf_send_desc, _gfortran_caf_send_desc_scalar): New
+	prototypes.
+	* caf/single.c (_gfortran_caf_send_desc,
+	_gfortran_caf_send_desc_scalar): New functions, supporting
+	rank == 1 only.
+
 2014-03-14  Tobias Burnus  <burnus@net-b.de>
 
 	* caf/libcaf.h (caf_token_t): New typedef.
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h	(Revision 208931)
+++ libgfortran/caf/libcaf.h	(Arbeitskopie)
@@ -58,6 +58,38 @@  caf_register_t;
 
 typedef void* caf_token_t;
 
+
+/* GNU Fortran's array descriptor.  Keep in sync with libgfortran.h.  */
+
+typedef struct descriptor_dimension
+{
+  ptrdiff_t _stride;
+  ptrdiff_t lower_bound;
+  ptrdiff_t _ubound;
+}
+descriptor_dimension;
+
+typedef struct gfc_descriptor_t {
+  void *base_addr;
+  size_t offset;
+  ptrdiff_t dtype;
+  descriptor_dimension dim[];
+} gfc_descriptor_t;
+
+
+#define GFC_MAX_DIMENSIONS 7
+
+#define GFC_DTYPE_RANK_MASK 0x07
+#define GFC_DTYPE_TYPE_SHIFT 3
+#define GFC_DTYPE_TYPE_MASK 0x38
+#define GFC_DTYPE_SIZE_SHIFT 6
+#define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
+#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
+                                   >> GFC_DTYPE_TYPE_SHIFT)
+#define GFC_DESCRIPTOR_SIZE(desc) ((desc)->dtype >> GFC_DTYPE_SIZE_SHIFT)
+
+
+
 /* Linked list of static coarrays registered.  */
 typedef struct caf_static_t {
   caf_token_t token;
@@ -77,6 +109,8 @@  void *_gfortran_caf_register (size_t, caf_register
 void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
 
 void _gfortran_send (caf_token_t, size_t, int, void *, size_t, bool);
+void _gfortran_send_desc (caf_token_t, size_t, int, gfc_descriptor_t*, gfc_descriptor_t*, bool);
+void _gfortran_send_desc_scalar (caf_token_t, size_t, int, gfc_descriptor_t*, void*, bool);
 
 void _gfortran_caf_sync_all (int *, char *, int);
 void _gfortran_caf_sync_images (int, int[], int *, char *, int);
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c	(Revision 208931)
+++ libgfortran/caf/single.c	(Arbeitskopie)
@@ -149,6 +149,7 @@  _gfortran_caf_deregister (caf_token_t *token, int
     *stat = 0;
 }
 
+/* Send scalar (or contiguous) data from buffer to a remote image.  */
 
 void
 _gfortran_caf_send (caf_token_t token, size_t offset,
@@ -161,7 +162,73 @@  _gfortran_caf_send (caf_token_t token, size_t offs
 }
 
 
+/* Send array data from src to dest on a remote image.  */
+
 void
+_gfortran_caf_send_desc (caf_token_t token, size_t offset,
+			 int image_id __attribute__ ((unused)),
+			 gfc_descriptor_t *dest, gfc_descriptor_t *src,
+			 bool asyn __attribute__ ((unused)))
+{
+  fprintf (stderr, "COARRAY ERROR: Array communication "
+	   "[_gfortran_caf_send_desc] not yet implemented for rank /= 0");
+  exit (EXIT_FAILURE);
+  size_t i, j;
+  size_t size = GFC_DESCRIPTOR_SIZE (dest);
+  int rank = GFC_DESCRIPTOR_RANK (dest);
+
+  if (rank != 1)
+    {
+      fprintf (stderr, "COARRAY ERROR: Array communication "
+	       "[_gfortran_caf_send_desc] not yet implemented for rank /= 0");
+      exit (EXIT_FAILURE);
+    }
+
+  for (j = dest->dim[0].lower_bound - dest->offset,
+       i = src->dim[0].lower_bound - src->offset;
+       j <= dest->dim[0]._ubound - dest->offset
+       && i <= src->dim[0]._ubound - src->offset;
+       j += dest->dim[0]._stride,
+       i += src->dim[0]._stride)
+    {
+      void *dst = (void *)((char *) TOKEN(token) + offset + j*size);
+      void *sr = (void *)((char *)src->base_addr + j*size);
+      memmove (dst, sr, size);
+    }
+}
+
+
+/* Send scalar data from src to array dest on a remote image.  */
+
+void
+_gfortran_caf_send_desc_scalar (caf_token_t token, size_t offset,
+				int image_id __attribute__ ((unused)),
+				gfc_descriptor_t *dest, void *buffer,
+				bool asyn __attribute__ ((unused)))
+{
+  size_t j;
+  size_t size = GFC_DESCRIPTOR_SIZE (dest);
+  int rank = GFC_DESCRIPTOR_RANK (dest);
+
+  if (rank != 1)
+    {
+      fprintf (stderr, "COARRAY ERROR: Array communication "
+	       "[_gfortran_caf_send_desc_scalar] not yet implemented for "
+	       "rank /= 0");
+      exit (EXIT_FAILURE);
+    }
+
+  for (j = dest->dim[0].lower_bound - dest->offset;
+       j <= dest->dim[0]._ubound - dest->offset;
+       j += dest->dim[0]._stride)
+    {
+      void *dst = (void *)((char *) TOKEN(token) + offset + j*size);
+      memmove (dst, buffer, size);
+    }
+}
+
+
+void
 _gfortran_caf_sync_all (int *stat,
 			char *errmsg __attribute__ ((unused)),
 			int errmsg_len __attribute__ ((unused)))
Index: gcc/fortran/ChangeLog.fortran-caf
===================================================================
--- gcc/fortran/ChangeLog.fortran-caf	(Revision 208931)
+++ gcc/fortran/ChangeLog.fortran-caf	(Arbeitskopie)
@@ -1,3 +1,12 @@ 
+2014-04-03  Tobias Burnus  <burnus@net-b.de>
+
+	* trans.h (gfor_fndecl_caf_send_desc,
+	gfor_fndecl_caf_send_desc_scalar): Declare variables.
+	* trans-decl.c (gfor_fndecl_caf_send_desc,
+	gfor_fndecl_caf_send_desc_scalar): Define them.
+	(gfc_build_builtin_function_decls): Initialize them.
+	* trans-intrinsic.c (conv_caf_send): Handle arrays.
+
 2014-03-28  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-intrinsic.c (conv_caf_send): Fix offset calculation.
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c	(Revision 208931)
+++ gcc/fortran/trans-decl.c	(Arbeitskopie)
@@ -126,6 +126,8 @@  tree gfor_fndecl_caf_num_images;
 tree gfor_fndecl_caf_register;
 tree gfor_fndecl_caf_deregister;
 tree gfor_fndecl_caf_send;
+tree gfor_fndecl_caf_send_desc;
+tree gfor_fndecl_caf_send_desc_scalar;
 tree gfor_fndecl_caf_critical;
 tree gfor_fndecl_caf_end_critical;
 tree gfor_fndecl_caf_sync_all;
@@ -3264,9 +3266,20 @@  gfc_build_builtin_function_decls (void)
 
       gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("caf_send")), "R..R..", void_type_node, 6,
-        ppvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
 	size_type_node, boolean_type_node);
 
+      gfor_fndecl_caf_send_desc = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_send_desc")), "R..RR.", void_type_node, 6,
+        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, boolean_type_node);
+
+      gfor_fndecl_caf_send_desc_scalar
+	= gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("caf_send_desc_scalar")), "R..RR..", void_type_node, 6,
+        pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+	pvoid_type_node, boolean_type_node);
+
       gfor_fndecl_caf_critical = gfc_build_library_function_decl (
 	get_identifier (PREFIX("caf_critical")), void_type_node, 0);
 
Index: gcc/fortran/trans-intrinsic.c
===================================================================
--- gcc/fortran/trans-intrinsic.c	(Revision 208931)
+++ gcc/fortran/trans-intrinsic.c	(Arbeitskopie)
@@ -7867,8 +7867,8 @@  conv_caf_send (gfc_code *code) {
   gfc_expr *lhs_expr, *rhs_expr, *async_expr;
   gfc_se lhs_se, rhs_se, async_se;
   stmtblock_t block;
-  tree caf_decl, token, offset, image_index, tmp;
- 
+  tree caf_decl, token, offset, image_index, tmp, size;
+
   gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
 
   lhs_expr = code->ext.actual->expr; 
@@ -7878,11 +7878,9 @@  conv_caf_send (gfc_code *code) {
 
   /* LHS: The coarray.  */
 
+  gfc_init_se (&lhs_se, NULL);
   if (lhs_expr->rank)
-    gfc_fatal_error ("Remote coarray access at %L for array sections not yet "
-		     " implemented", &lhs_expr->where);
-
-  gfc_init_se (&lhs_se, NULL);
+    lhs_se.descriptor_only = 1;
   gfc_conv_expr_reference (&lhs_se, lhs_expr);
 
   caf_decl = gfc_get_tree_for_caf_expr (lhs_expr);
@@ -7948,6 +7946,8 @@  conv_caf_send (gfc_code *code) {
   /* RHS - a noncoarray.  */
 
   gfc_init_se (&rhs_se, NULL);
+  if (rhs_expr->rank)
+    rhs_se.descriptor_only = 1;
   rhs_se.want_pointer = 1;
   gfc_conv_expr_reference (&rhs_se, rhs_expr);
   gfc_add_block_to_block (&block, &rhs_se.pre);
@@ -7955,10 +7955,24 @@  conv_caf_send (gfc_code *code) {
   gfc_init_se (&async_se, NULL);
   gfc_conv_expr (&async_se, async_expr);
 
-  tree size = size_in_bytes (TREE_TYPE (TREE_TYPE (rhs_se.expr)));
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 6,
-			     token, offset, image_index, rhs_se.expr, size,
-			     fold_convert (boolean_type_node, async_se.expr));
+  if (rhs_expr->rank)
+    size = size_in_bytes (gfc_get_element_type (TREE_TYPE (rhs_se.expr)));
+  else
+    size = size_in_bytes (TREE_TYPE (TREE_TYPE (rhs_se.expr)));
+  if (lhs_expr->rank && rhs_expr->rank)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send_desc, 6,
+			       token, offset, image_index, lhs_se.expr,
+			       rhs_se.expr, 
+			       fold_convert (boolean_type_node, async_se.expr));
+  else if (lhs_expr->rank)
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send_desc_scalar,
+			       6, token, offset, image_index, lhs_se.expr,
+			       rhs_se.expr,
+			       fold_convert (boolean_type_node, async_se.expr));
+  else
+    tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 6,
+			       token, offset, image_index, rhs_se.expr, size,
+			       fold_convert (boolean_type_node, async_se.expr));
   gfc_add_expr_to_block (&block, tmp);
   gfc_add_block_to_block (&block, &rhs_se.post);
   return gfc_finish_block (&block);
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h	(Revision 208931)
+++ gcc/fortran/trans.h	(Arbeitskopie)
@@ -701,6 +701,8 @@  extern GTY(()) tree gfor_fndecl_caf_num_images;
 extern GTY(()) tree gfor_fndecl_caf_register;
 extern GTY(()) tree gfor_fndecl_caf_deregister;
 extern GTY(()) tree gfor_fndecl_caf_send;
+extern GTY(()) tree gfor_fndecl_caf_send_desc;
+extern GTY(()) tree gfor_fndecl_caf_send_desc_scalar;
 extern GTY(()) tree gfor_fndecl_caf_critical;
 extern GTY(()) tree gfor_fndecl_caf_end_critical;
 extern GTY(()) tree gfor_fndecl_caf_sync_all;