libcaf.h: Add new action types for (de-)registration of allocatable components in derived...

libgfortran/ChangeLog:

2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>

	* caf/libcaf.h: Add new action types for (de-)registration of
	allocatable components in derived type coarrays.  Add _caf_is_present
	prototype.
	* caf/single.c (_gfortran_caf_register): Add support for registration
	only and allocation of already registered allocatable components in
	derived type coarrays.
	(_gfortran_caf_deregister): Add mode to deallocate but not deregister
	an allocatable component in a derived type coarray.
	(_gfortran_caf_is_present): New function.  Query whether an
	allocatable component in a derived type coarray on a remote image is
	allocated.


gcc/testsuite/ChangeLog:

2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>

	* gfortran.dg/coarray/alloc_comp_1.f90: Fix tree-dump scans to adhere
	to the changed interfaces.
	* gfortran.dg/coarray_alloc_comp_1.f08: Likewise.
	* gfortran.dg/coarray_allocate_7.f08: Likewise.
	* gfortran.dg/coarray_lib_alloc_1.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_2.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_3.f90: Likewise.
	* gfortran.dg/coarray_lib_comm_1.f90: Likewise.
	* gfortran.dg/coarray_lib_alloc_4.f90: New test.

gcc/fortran/ChangeLog:

2016-11-30  Andre Vehreschild  <vehre@gcc.gnu.org>

	* check.c (gfc_check_allocated): By pass the caf_get call and check on
	the array.
	* gfortran.h: Add optional flag to gfc_caf_attr.
	* gfortran.texi: Document new enum values and _caf_is_present function.
	* primary.c (caf_variable_attr): Add optional flag to indicate that the
	expression is reffing a component.
	(gfc_caf_attr): Likewise.
	* trans-array.c (gfc_array_deallocate): Handle deallocation mode for
	coarray deregistration.
	(gfc_trans_dealloc_allocated): Likewise.
	(duplicate_allocatable): Use constants instead of
        creating custom constant tree node of zero or one.  Use gfc_add_modify
        convenience function.
	(duplicate_allocatable_coarray): This function is similar to
	duplicate_allocatable but tailored to handle coarrays.
	(caf_enabled): Check whether in-derived-type coarray processing is
	enabled.
	(caf_in_coarray): Check that in-derived-type coarray processing is
	enabled and currently in a derived-typed coarray.
	(gfc_caf_is_dealloc_only): Return true, when deallocate only is
	desired for components in derived typed coarrays.
	(structure_alloc_comps): A mode for handling coarrays, that is no
	longer encode in the purpose.  This makes the use cases of the
	routine more flexible without repeating.  Allocatable components in
	derived type coarrays are now registered only when nullifying an
	object and allocated before copying data into them.
	(gfc_nullify_alloc_comp): Use the caf_mode of structure_alloc_comps
	now.
	(gfc_deallocate_alloc_comp): Likewise.
	(gfc_deallocate_alloc_comp_no_caf): Likewise.
	(gfc_reassign_alloc_comp_caf): Likewise.
	(gfc_copy_alloc_comp): Likewise.
	(gfc_copy_only_alloc_comp): Likewise.
	(gfc_alloc_allocatable_for_assignment): Make use to the cheaper way of
	reallocating a coarray without deregistering and reregistering it.
	(gfc_trans_deferred_array): Initialize the coarray token correctly for
	deferred variables and tear them down on exit.
	* trans-array.h: Change some prototypes to add the coarray (de-)
	registration modes.  Add prototype for checking if deallocate only is
	selected for components in derived typed coarrays.
	* trans-decl.c (gfc_build_builtin_function_decls): Generate the
	declarations for the changed/new caf-lib routines.
	(gfc_trans_deferred_vars): Ensure deferred variables are (de-)
	registered correctly on procedure entry/exit.
	(generate_coarray_sym_init): Use constants.
	* trans-expr.c (gfc_conv_procedure_call): Propagate coarray allocation
	modes accordingly.
	(gfc_trans_alloc_subarray_assign): Likewise.
	(gfc_trans_subcomponent_assign): Likewise.
	(gfc_trans_structure_assign): Generate code to register the components
	of a derived type coarray prior to initialization.
	(gfc_conv_structure): Set flag that the structure is in a coarray.
	(gfc_trans_scalar_assign): Add flag to indicate being in a coarray and
	set the structure_alloc_comps modes correctly.
	(gfc_trans_assignment_1): Figure being in a coarray expression.
	* trans-intrinsic.c (gfc_conv_intrinsic_caf_get): Adapt to new
	structure_alloc_comps interface.
	(conv_caf_send): Use the old API as long as possible.
	(trans_caf_is_present): Generate code to check whether an allocatable
	component in a derived typed coarray is allocated on a remote image.
	(caf_this_image_ref): Return true, when only reffing this image.
	(gfc_conv_allocated): Convert allocated queries on allocatable
	components to the library API.
	(conv_intrinsic_move_alloc): Adapt to new interface of
	structure_alloc_comps.
	* trans-openmp.c (gfc_walk_alloc_comps): Likewise.
	(gfc_omp_clause_assign_op): Likewise.
	(gfc_omp_clause_dtor): Likewise.
	* trans-stmt.c (gfc_trans_deallocate): Figure which mode to use when
	deallocating allocatable components in derived type coarras.
	* trans.c (gfc_allocate_using_lib): Renamed to
	gfc_allcate_using_caf_lib.
	(gfc_allocate_allocatable): Set the registration mode/type of caf-
	register calls adapting to all the possible allocatable objects.
	(gfc_deallocate_with_status): Add deregistration mode for allocatable
	components in derived type coarrays.
	(gfc_deallocate_scalar_with_status): Likewise.
	* trans.h (enum gfc_coarray_type): Renamed to gfc_coarray_regtype to
	avoid collision with gfc_coarray_deregtype.

From-SVN: r243021

2 files changed, 135 insertions, 8 deletions

diff --git a/libgfortran/caf/libcaf.h b/libgfortran/caf/libcaf.h
index aad0f621795..1bb5176a6c1 100644
--- a/libgfortran/caf/libcaf.h
+++ b/libgfortran/caf/libcaf.h
@@ -50,7 +50,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #define STAT_STOPPED_IMAGE 	6000
 #endif
 
-/* Describes what type of array we are registerring. Keep in sync with
+/* 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,
@@ -59,10 +59,20 @@ typedef enum caf_register_t {
   CAF_REGTYPE_LOCK_ALLOC,
   CAF_REGTYPE_CRITICAL,
   CAF_REGTYPE_EVENT_STATIC,
-  CAF_REGTYPE_EVENT_ALLOC
+  CAF_REGTYPE_EVENT_ALLOC,
+  CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY,
+  CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY
 }
 caf_register_t;
 
+/* Describes the action to take on _caf_deregister.  Keep in sync with
+   gcc/fortran/trans.h.  */
+typedef enum caf_deregister_t {
+  CAF_DEREGTYPE_COARRAY_DEREGISTER,
+  CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY
+}
+caf_deregister_t;
+
 typedef void* caf_token_t;
 typedef gfc_array_void gfc_descriptor_t;
 
@@ -174,7 +184,8 @@ int _gfortran_caf_num_images (int, int);
 
 void _gfortran_caf_register (size_t, caf_register_t, caf_token_t *,
 			     gfc_descriptor_t *, int *, char *, int);
-void _gfortran_caf_deregister (caf_token_t *, int *, char *, int);
+void _gfortran_caf_deregister (caf_token_t *, caf_deregister_t, int *, char *,
+			       int);
 
 void _gfortran_caf_sync_all (int *, char *, int);
 void _gfortran_caf_sync_memory (int *, char *, int);
@@ -232,4 +243,6 @@ void _gfortran_caf_event_post (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_wait (caf_token_t, size_t, int, int *, char *, int);
 void _gfortran_caf_event_query (caf_token_t, size_t, int, int *, int *);
 
+int _gfortran_caf_is_present (caf_token_t, int, caf_reference_t *);
+
 #endif  /* LIBCAF_H  */
diff --git a/libgfortran/caf/single.c b/libgfortran/caf/single.c
index 00b71208473..5e2932ca007 100644
--- a/libgfortran/caf/single.c
+++ b/libgfortran/caf/single.c
@@ -144,11 +144,17 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
       || type == CAF_REGTYPE_CRITICAL || type == CAF_REGTYPE_EVENT_STATIC
       || type == CAF_REGTYPE_EVENT_ALLOC)
     local = calloc (size, sizeof (bool));
+  else if (type == CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)
+    local = NULL;
   else
     local = malloc (size);
-  *token = malloc (sizeof (struct caf_single_token));
 
-  if (unlikely (local == NULL || *token == NULL))
+  if (type != CAF_REGTYPE_COARRAY_ALLOC_ALLOCATE_ONLY)
+    *token = malloc (sizeof (struct caf_single_token));
+
+  if (unlikely (*token == NULL
+		|| (local == NULL
+		    && type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY)))
     {
       /* Freeing the memory conditionally seems pointless, but
 	 caf_internal_error () may return, when a stat is given and then the
@@ -163,7 +169,7 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 
   single_token = TOKEN (*token);
   single_token->memptr = local;
-  single_token->owning_memory = true;
+  single_token->owning_memory = type != CAF_REGTYPE_COARRAY_ALLOC_REGISTER_ONLY;
   single_token->desc = GFC_DESCRIPTOR_RANK (data) > 0 ? data : NULL;
 
 
@@ -184,7 +190,7 @@ _gfortran_caf_register (size_t size, caf_register_t type, caf_token_t *token,
 
 
 void
-_gfortran_caf_deregister (caf_token_t *token, int *stat,
+_gfortran_caf_deregister (caf_token_t *token, caf_deregister_t type, int *stat,
 			  char *errmsg __attribute__ ((unused)),
 			  int errmsg_len __attribute__ ((unused)))
 {
@@ -193,7 +199,16 @@ _gfortran_caf_deregister (caf_token_t *token, int *stat,
   if (single_token->owning_memory && single_token->memptr)
     free (single_token->memptr);
 
-  free (TOKEN (*token));
+  if (type != CAF_DEREGTYPE_COARRAY_DEALLOCATE_ONLY)
+    {
+      free (TOKEN (*token));
+      *token = NULL;
+    }
+  else
+    {
+      single_token->memptr = NULL;
+      single_token->owning_memory = false;
+    }
 
   if (stat)
     *stat = 0;
@@ -2882,3 +2897,102 @@ _gfortran_caf_unlock (caf_token_t token, size_t index,
     }
   _gfortran_caf_error_stop_str (msg, (int32_t) strlen (msg));
 }
+
+int
+_gfortran_caf_is_present (caf_token_t token,
+			  int image_index __attribute__ ((unused)),
+			  caf_reference_t *refs)
+{
+  const char arraddressingnotallowed[] = "libcaf_single::caf_is_present(): "
+				   "only scalar indexes allowed.\n";
+  const char unknownreftype[] = "libcaf_single::caf_get_by_ref(): "
+				"unknown reference type.\n";
+  const char unknownarrreftype[] = "libcaf_single::caf_get_by_ref(): "
+				   "unknown array reference type.\n";
+  size_t i;
+  caf_single_token_t single_token = TOKEN (token);
+  void *memptr = single_token->memptr;
+  gfc_descriptor_t *src = single_token->desc;
+  caf_reference_t *riter = refs;
+
+  while (riter)
+    {
+      switch (riter->type)
+	{
+	case CAF_REF_COMPONENT:
+	  if (riter->u.c.caf_token_offset)
+	    {
+	      single_token = *(caf_single_token_t*)
+					 (memptr + riter->u.c.caf_token_offset);
+	      memptr = single_token->memptr;
+	      src = single_token->desc;
+	    }
+	  else
+	    {
+	      memptr += riter->u.c.offset;
+	      src = (gfc_descriptor_t *)memptr;
+	    }
+	  break;
+	case CAF_REF_ARRAY:
+	  for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+	    {
+	      switch (riter->u.a.mode[i])
+		{
+		case CAF_ARR_REF_SINGLE:
+		  memptr += (riter->u.a.dim[i].s.start
+			     - GFC_DIMENSION_LBOUND (src->dim[i]))
+		      * GFC_DIMENSION_STRIDE (src->dim[i])
+		      * riter->item_size;
+		  break;
+		case CAF_ARR_REF_FULL:
+		  /* A full array ref is allowed on the last reference only.  */
+		  if (riter->next == NULL)
+		    break;
+		  /* else fall through reporting an error.  */
+		case CAF_ARR_REF_VECTOR:
+		case CAF_ARR_REF_RANGE:
+		case CAF_ARR_REF_OPEN_END:
+		case CAF_ARR_REF_OPEN_START:
+		  caf_internal_error (arraddressingnotallowed, 0, NULL, 0);
+		  return 0;
+		default:
+		  caf_internal_error (unknownarrreftype, 0, NULL, 0);
+		  return 0;
+		}
+	    }
+	  break;
+	case CAF_REF_STATIC_ARRAY:
+	  for (i = 0; riter->u.a.mode[i] != CAF_ARR_REF_NONE; ++i)
+	    {
+	      switch (riter->u.a.mode[i])
+		{
+		case CAF_ARR_REF_SINGLE:
+		  memptr += riter->u.a.dim[i].s.start
+		      * riter->u.a.dim[i].s.stride
+		      * riter->item_size;
+		  break;
+		case CAF_ARR_REF_FULL:
+		  /* A full array ref is allowed on the last reference only.  */
+		  if (riter->next == NULL)
+		    break;
+		  /* else fall through reporting an error.  */
+		case CAF_ARR_REF_VECTOR:
+		case CAF_ARR_REF_RANGE:
+		case CAF_ARR_REF_OPEN_END:
+		case CAF_ARR_REF_OPEN_START:
+		  caf_internal_error (arraddressingnotallowed, 0, NULL, 0);
+		  return 0;
+		default:
+		  caf_internal_error (unknownarrreftype, 0, NULL, 0);
+		  return 0;
+		}
+	    }
+	  break;
+	default:
+	  caf_internal_error (unknownreftype, 0, NULL, 0);
+	  return 0;
+	}
+      riter = riter->next;
+    }
+  return memptr != NULL;
+}