This patch adds the support for coindexed arrays in expressions (or the
RHS of assignments) to the single-image implementation of the library.
Additionally, it adds the required function definitions to the compiler.
Missing is adding the intrinsic in resolve.c – and converting it into
code in trans-intrinsic.c. I have a draft patch for it, but I still need
to fix something and clean up the patch.
Committed to the branch as Rev. 209279
Tobias
gcc/fortran/ChangeLog.fortran-caf | 8 ++++
gcc/fortran/gfortran.h | 1
gcc/fortran/intrinsic.c | 10 ++++-
gcc/fortran/trans-decl.c | 7 +++
gcc/fortran/trans.h | 1
libgfortran/ChangeLog.fortran-caf | 5 ++
libgfortran/caf/libcaf.h | 2 +
libgfortran/caf/single.c | 69 ++++++++++++++++++++++++++++++++++++--
8 files changed, 99 insertions(+), 4 deletions(-)
Index: gcc/fortran/ChangeLog.fortran-caf
===================================================================
--- gcc/fortran/ChangeLog.fortran-caf (Revision 209226)
+++ gcc/fortran/ChangeLog.fortran-caf (Arbeitskopie)
@@ -1,3 +1,11 @@
+2014-04-10 Tobias Burnus <bur...@net-b.de>
+
+ * trans.h (gfor_fndecl_caf_remote_get_desc): Declare variables.
+ * trans-decl.c (gfor_fndecl_caf_remote_get_desc): Define it.
+ (gfc_build_builtin_function_decls_desc): Initialize it.
+ * gfortran.h (gfc_isym_id): Add GFC_ISYM_CAF_GET.
+ * intrinsic.c (add_functions): Add internal-only caf_get.
+
2014-04-08 Tobias Burnus <bur...@net-b.de>
* trans.h (gfor_fndecl_caf_remote_get): Declare variables.
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 209226)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -323,6 +323,7 @@
GFC_ISYM_CHDIR,
GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX,
+ GFC_ISYM_CAF_GET,
GFC_ISYM_CAF_SEND,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_COMPILER_OPTIONS,
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (Revision 209226)
+++ gcc/fortran/intrinsic.c (Arbeitskopie)
@@ -2994,6 +2994,14 @@
x, BT_UNKNOWN, 0, REQUIRED);
make_generic ("loc", GFC_ISYM_LOC, GFC_STD_GNU);
+
+ /* The following function is internally used for coarray libray functions.
+ "make_from_module" makes it inaccessible for external users. */
+ add_sym_2 (GFC_PREFIX ("caf_get"), GFC_ISYM_CAF_GET, CLASS_IMPURE, ACTUAL_NO,
+ BT_REAL, dr, GFC_STD_GNU, NULL, NULL, NULL,
+ x, BT_REAL, dr, REQUIRED,
+ "async", BT_LOGICAL, dl, REQUIRED);
+ make_from_module();
}
@@ -3209,7 +3217,7 @@
"fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
make_from_module();
- /* The following function is internally used for coarray libray functions.
+ /* The following subroutine is internally used for coarray libray functions.
"make_from_module" makes it inaccessible for external users. */
add_sym_3s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 209226)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -126,6 +126,7 @@
tree gfor_fndecl_caf_register;
tree gfor_fndecl_caf_deregister;
tree gfor_fndecl_caf_remote_get;
+tree gfor_fndecl_caf_remote_get_desc;
tree gfor_fndecl_caf_send;
tree gfor_fndecl_caf_send_desc;
tree gfor_fndecl_caf_send_desc_scalar;
@@ -3270,6 +3271,12 @@
pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
size_type_node, boolean_type_node);
+ gfor_fndecl_caf_remote_get_desc
+ = gfc_build_library_function_decl_with_spec (
+ get_identifier (PREFIX("caf_get_desc")), "R..RW.", 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 = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_send")), "R..R..", void_type_node, 6,
pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (Revision 209226)
+++ gcc/fortran/trans.h (Arbeitskopie)
@@ -701,6 +701,7 @@
extern GTY(()) tree gfor_fndecl_caf_register;
extern GTY(()) tree gfor_fndecl_caf_deregister;
extern GTY(()) tree gfor_fndecl_caf_remote_get;
+extern GTY(()) tree gfor_fndecl_caf_remote_get_desc;
extern GTY(()) tree gfor_fndecl_caf_send;
extern GTY(()) tree gfor_fndecl_caf_send_desc;
extern GTY(()) tree gfor_fndecl_caf_send_desc_scalar;
Index: libgfortran/ChangeLog.fortran-caf
===================================================================
--- libgfortran/ChangeLog.fortran-caf (Revision 209226)
+++ libgfortran/ChangeLog.fortran-caf (Arbeitskopie)
@@ -1,3 +1,8 @@
+2014-04-10 Tobias Burnus <bur...@net-b.de>
+
+ * caf/libcaf.h (_gfortran_caf_get_desc): New.
+ * caf/single.c (_gfortran_caf_get_desc): New.
+
2014-04-08 Tobias Burnus <bur...@net-b.de>
* caf/libcaf.h (_gfortran_caf_get): New.
Index: libgfortran/caf/libcaf.h
===================================================================
--- libgfortran/caf/libcaf.h (Revision 209226)
+++ libgfortran/caf/libcaf.h (Arbeitskopie)
@@ -109,6 +109,8 @@
void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
void _gfortran_caf_get (caf_token_t, size_t, int, void *, size_t, bool);
+void _gfortran_caf_get_desc (caf_token_t, size_t, int, gfc_descriptor_t*,
+ gfc_descriptor_t*, bool);
void _gfortran_caf_send (caf_token_t, size_t, int, void *, size_t, bool);
void _gfortran_caf_send_desc (caf_token_t, size_t, int, gfc_descriptor_t*,
Index: libgfortran/caf/single.c
===================================================================
--- libgfortran/caf/single.c (Revision 209226)
+++ libgfortran/caf/single.c (Arbeitskopie)
@@ -162,6 +162,69 @@
}
+/* Get array data from a remote src to a local dest. */
+
+void
+_gfortran_caf_get_desc (caf_token_t token, size_t offset,
+ int image_id __attribute__ ((unused)),
+ gfc_descriptor_t *src, gfc_descriptor_t *dest,
+ bool asyn __attribute__ ((unused)))
+{
+ size_t i, size;
+ int j;
+ int rank = GFC_DESCRIPTOR_RANK (dest);
+
+ size = 1;
+ for (j = 0; j < rank; j++)
+ {
+ ptrdiff_t dimextent = dest->dim[j]._ubound - dest->dim[j].lower_bound + 1;
+ if (dimextent < 0)
+ dimextent = 0;
+ size *= dimextent;
+ }
+
+ if (size == 0)
+ return;
+
+ for (i = 0; i < size; i++)
+ {
+ ptrdiff_t array_offset_dst = 0;
+ ptrdiff_t stride = 1;
+ ptrdiff_t extent = 1;
+ for (j = 0; j < rank-1; j++)
+ {
+ array_offset_dst += ((i / (extent*stride))
+ % (dest->dim[j]._ubound
+ - dest->dim[j].lower_bound + 1))
+ * dest->dim[j]._stride;
+ extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
+ stride = dest->dim[j]._stride;
+ }
+ array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
+
+ ptrdiff_t array_offset_sr = 0;
+ stride = 1;
+ extent = 1;
+ for (j = 0; j < GFC_DESCRIPTOR_RANK (src)-1; j++)
+ {
+ array_offset_sr += ((i / (extent*stride))
+ % (src->dim[j]._ubound
+ - src->dim[j].lower_bound + 1))
+ * src->dim[j]._stride;
+ extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
+ stride = src->dim[j]._stride;
+ }
+ array_offset_sr += (i / extent) * dest->dim[rank-1]._stride;
+
+ void *sr = (void *)((char *) TOKEN (token) + offset
+ + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
+ void *dst = (void *)((char *) dest->base_addr
+ + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest));
+ memmove (dst, sr, GFC_DESCRIPTOR_SIZE (dest));
+ }
+}
+
+
/* Send scalar (or contiguous) data from buffer to a remote image. */
void
@@ -211,7 +274,7 @@
- dest->dim[j].lower_bound + 1))
* dest->dim[j]._stride;
extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
+ stride = dest->dim[j]._stride;
}
array_offset_dst += (i / extent) * dest->dim[rank-1]._stride;
@@ -225,7 +288,7 @@
- src->dim[j].lower_bound + 1))
* src->dim[j]._stride;
extent = (src->dim[j]._ubound - src->dim[j].lower_bound + 1);
- stride = src->dim[j]._stride;
+ stride = src->dim[j]._stride;
}
array_offset_sr += (i / extent) * dest->dim[rank-1]._stride;
@@ -271,7 +334,7 @@
- dest->dim[j].lower_bound + 1))
* dest->dim[j]._stride;
extent = (dest->dim[j]._ubound - dest->dim[j].lower_bound + 1);
- stride = dest->dim[j]._stride;
+ stride = dest->dim[j]._stride;
}
array_offset += (i / extent) * dest->dim[rank-1]._stride;
void *dst = (void *)((char *) TOKEN (token) + offset
