Fortran: Replace getting of coarray data with accessor-based version. [PR107635]

Getting coarray data from remote images was slow, inefficient and did
not work for object files that where not compiled with coarray support
for derived types with allocatable/pointer components.  The old approach
emulated accessing data through a whole structure ref, which was error
prone for corner cases.  Furthermore was did it have a runtime
complexity of O(N), where N is the number of allocatable/pointer
components and descriptors involved.  Each of those needed communication
twice.  The new approach creates a routine for each access into a
coarray object putting all required operations there.  Looking a
tree-dump one will see those small routines.  But this time it is just
compiled fortran with all the knowledge of the compiler of bounds and so
on.  New paradigms will be available out of the box.  Furthermore is the
complexity of the communication reduced to be O(1).  E.g. the mpi
implementation sends one message for the parameters of the access and
one message back with the results without caring about the number of
allocatable/pointer/descriptor components in the access.

Identification of access routines is done be adding them to a hash map,
where the hash is the same on all images.  Translating the hash to an
index, which is the same on all images again, allows for fast calls of
the access routines.  Resolving the hash to an index is cached at
runtime, preventing additional hash map lookups.  A hashmap was use
because not all processor OS combinations may use the same address for
the access routine.

gcc/fortran/ChangeLog:

	PR fortran/107635

	* gfortran.h (gfc_add_caf_accessor): New function.
	* gfortran.texi: Document new API routines.
	* resolve.cc (get_arrayspec_from_expr): Synthesize the arrayspec
	resulting from an expression, i.e. not only the rank, but also
	the bounds.
	(remove_coarray_from_derived_type): Remove coarray ref from a
	derived type to access it in access routine.
	(convert_coarray_class_to_derived_type): Same but for classes.
	The result is a derived type.
	(split_expr_at_caf_ref): Split an expression at the coarray
	reference to move the reference after the coarray ref into the
	access routine.
	(check_add_new_component): Helper to add variables as
	components to derived type transfered to the access routine.
	(create_get_parameter_type): Create the derived type to transfer
	addressing data to the access routine.
	(create_get_callback): Create the access routine.
	(add_caf_get_intrinsic): Use access routine instead of old
	caf_get.
	* trans-decl.cc (gfc_build_builtin_function_decls): Register new
	API routines.
	(gfc_create_module_variable): Use renamed flag.
	(gfc_emit_parameter_debug_info):
	(struct caf_accessor): Linked list of hash-access routine pairs.
	(gfc_add_caf_accessor): Add a hash-access routine pair to above
	linked list.
	(create_caf_accessor_register): Add all registered hash-access
	routine pairs to the current caf_init.
	(generate_coarray_init): Use routine above.
	(gfc_generate_module_vars): Use renamed flag.
	(generate_local_decl): Same.
	(gfc_generate_function_code): Same.
	(gfc_process_block_locals): Same.
	* trans-intrinsic.cc (conv_shape_to_cst): Build the product of a
	shape.
	(gfc_conv_intrinsic_caf_get): Create call to access routine.
	(conv_caf_send): Adapt to caf_get using less arguments.
	(gfc_conv_intrinsic_function): Same.
	* trans.cc (gfc_trans_force_lval): Helper to ensure that an
	expression can be used as an lvalue-ref.
	* trans.h (gfc_trans_force_lval): See above.

libgfortran/ChangeLog:

	* caf/libcaf.h (_gfortran_caf_register_accessor): New function
	to register access routines at runtime.
	(_gfortran_caf_register_accessors_finish): New function to
	finish registration of access routine and sort hash map.
	(_gfortran_caf_get_remote_function_index): New function to
	convert an hash to an index.
	(_gfortran_caf_get_by_ct): New function to get data from a
	remote image using the access routine given by an index.
	* caf/single.c (struct accessor_hash_t): Hashmap type.
	(_gfortran_caf_send): Fixed formatting.
	(_gfortran_caf_register_accessor): Register a hash accessor
	routine.
	(hash_compare): Compare two hashes for sort() and bsearch().
	(_gfortran_caf_register_accessors_finish): Sort the hashmap to
	allow bsearch()'s quick lookup.
	(_gfortran_caf_get_remote_function_index): Map a hash to an
	index.
	(_gfortran_caf_get_by_ct): Get data from a remote image using
	the index provided by get_remote_function_index().

gcc/testsuite/ChangeLog:

	* gfortran.dg/coarray_atomic_5.f90: Adapted to look for
	get_by_ct.
	* gfortran.dg/coarray_lib_comm_1.f90: Same.
	* gfortran.dg/coarray_stat_function.f90: Same.

1 files changed, 203 insertions, 201 deletions

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index 41a1739..66da97b 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -42,6 +42,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"	/* For CAF array alias analysis.  */
 #include "attribs.h"
 #include "realmpfr.h"
+#include "constructor.h"
 
 /* Only for gfc_trans_assign and gfc_trans_pointer_assign.  */
 
@@ -1667,31 +1668,59 @@ conv_expr_ref_to_caf_ref (stmtblock_t *block, gfc_expr *expr)
 			      : NULL_TREE;
 }
 
+static tree
+conv_shape_to_cst (gfc_expr *e)
+{
+  tree tmp = NULL;
+  for (int d = 0; d < e->rank; ++d)
+    {
+      if (!tmp)
+	tmp = gfc_conv_mpz_to_tree (e->shape[d], gfc_size_kind);
+      else
+	tmp = fold_build2 (MULT_EXPR, TREE_TYPE (tmp), tmp,
+			   gfc_conv_mpz_to_tree (e->shape[d], gfc_size_kind));
+    }
+  return fold_convert (size_type_node, tmp);
+}
+
 /* Get data from a remote coarray.  */
 
 static void
-gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
-			    tree may_require_tmp, bool may_realloc,
-			    symbol_attribute *caf_attr)
+gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs,
+			    bool may_realloc, symbol_attribute *caf_attr)
 {
+  static int call_cnt = 0;
   gfc_expr *array_expr, *tmp_stat;
   gfc_se argse;
-  tree caf_decl, token, offset, image_index, tmp;
-  tree res_var, dst_var, type, kind, vec, stat;
-  tree caf_reference;
+  tree caf_decl, token, image_index, tmp, res_var, type, stat, dest_size,
+    dest_data, opt_dest_desc, rget_index_tree, rget_data_tree, rget_data_size,
+    opt_src_desc, opt_src_charlen, opt_dest_charlen;
   symbol_attribute caf_attr_store;
+  gfc_namespace *ns;
+  gfc_expr *rget_hash = expr->value.function.actual->next->expr,
+	   *rget_fn_expr = expr->value.function.actual->next->next->expr;
+  gfc_symbol *gdata_sym
+    = rget_fn_expr->symtree->n.sym->formal->next->next->next->sym;
+  gfc_expr rget_data, rget_data_init, rget_index;
+  char *name;
+  gfc_symtree *data_st, *index_st;
+  gfc_constructor *con;
+  stmtblock_t blk;
 
   gcc_assert (flag_coarray == GFC_FCOARRAY_LIB);
 
   if (se->ss && se->ss->info->useflags)
     {
-       /* Access the previously obtained result.  */
-       gfc_conv_tmp_array_ref (se);
-       return;
+      /* Access the previously obtained result.  */
+      gfc_conv_tmp_array_ref (se);
+      return;
     }
 
-  /* If lhs is set, the CAF_GET intrinsic has already been stripped.  */
-  array_expr = (lhs == NULL_TREE) ? expr->value.function.actual->expr : expr;
+  array_expr = expr->value.function.actual->expr;
+  ns = array_expr->expr_type == EXPR_VARIABLE
+	   && !array_expr->symtree->n.sym->attr.associate_var
+	 ? array_expr->symtree->n.sym->ns
+	 : gfc_current_ns;
   type = gfc_typenode_for_spec (&array_expr->ts);
 
   if (caf_attr == NULL)
@@ -1701,9 +1730,7 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
     }
 
   res_var = lhs;
-  dst_var = lhs;
 
-  vec = null_pointer_node;
   tmp_stat = gfc_find_stat_co (expr);
 
   if (tmp_stat)
@@ -1718,198 +1745,172 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   else
     stat = null_pointer_node;
 
-  /* Only use the new get_by_ref () where it is necessary.  I.e., when the lhs
-     is reallocatable or the right-hand side has allocatable components.  */
-  if (caf_attr->alloc_comp || caf_attr->pointer_comp || may_realloc)
-    {
-      /* Get using caf_get_by_ref.  */
-      caf_reference = conv_expr_ref_to_caf_ref (&se->pre, array_expr);
-
-      if (caf_reference != NULL_TREE)
-	{
-	  if (lhs == NULL_TREE)
-	    {
-	      if (array_expr->ts.type == BT_CHARACTER)
-		gfc_init_se (&argse, NULL);
-	      if (array_expr->rank == 0)
-		{
-		  symbol_attribute attr;
-		  gfc_clear_attr (&attr);
-		  if (array_expr->ts.type == BT_CHARACTER)
-		    {
-		      res_var = gfc_conv_string_tmp (se,
-						     build_pointer_type (type),
-					     array_expr->ts.u.cl->backend_decl);
-		      argse.string_length = array_expr->ts.u.cl->backend_decl;
-		    }
-		  else
-		    res_var = gfc_create_var (type, "caf_res");
-		  dst_var = gfc_conv_scalar_to_descriptor (se, res_var, attr);
-		  dst_var = gfc_build_addr_expr (NULL_TREE, dst_var);
-		}
-	      else
-		{
-		  /* Create temporary.  */
-		  if (array_expr->ts.type == BT_CHARACTER)
-		    gfc_conv_expr_descriptor (&argse, array_expr);
-		  may_realloc = gfc_trans_create_temp_array (&se->pre,
-							     &se->post,
-							     se->ss, type,
-							     NULL_TREE, false,
-							     false, false,
-							     &array_expr->where)
-		      == NULL_TREE;
-		  res_var = se->ss->info->data.array.descriptor;
-		  dst_var = gfc_build_addr_expr (NULL_TREE, res_var);
-		  if (may_realloc)
-		    {
-		      tmp = gfc_conv_descriptor_data_get (res_var);
-		      tmp = gfc_deallocate_with_status (tmp, NULL_TREE,
-							NULL_TREE, NULL_TREE,
-							NULL_TREE, true,
-							NULL,
-						     GFC_CAF_COARRAY_NOCOARRAY);
-		      gfc_add_expr_to_block (&se->post, tmp);
-		    }
-		}
-	    }
-
-	  kind = build_int_cst (integer_type_node, expr->ts.kind);
-	  if (lhs_kind == NULL_TREE)
-	    lhs_kind = kind;
-
-	  caf_decl = gfc_get_tree_for_caf_expr (array_expr);
-	  if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
-	    caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
-	  image_index = gfc_caf_get_image_index (&se->pre, array_expr,
-						 caf_decl);
-	  gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL,
-				    array_expr);
-
-	  /* No overlap possible as we have generated a temporary.  */
-	  if (lhs == NULL_TREE)
-	    may_require_tmp = boolean_false_node;
-
-	  /* It guarantees memory consistency within the same segment.  */
-	  tmp = gfc_build_string_const (strlen ("memory") + 1, "memory");
-	  tmp = build5_loc (input_location, ASM_EXPR, void_type_node,
-			    gfc_build_string_const (1, ""), NULL_TREE,
-			    NULL_TREE, tree_cons (NULL_TREE, tmp, NULL_TREE),
-			    NULL_TREE);
-	  ASM_VOLATILE_P (tmp) = 1;
-	  gfc_add_expr_to_block (&se->pre, tmp);
+  memset (&rget_data, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&rget_data.ts);
+  rget_data.expr_type = EXPR_VARIABLE;
+  name = xasprintf ("__caf_rget_data_%d", call_cnt);
+  gcc_assert (!gfc_get_sym_tree (name, ns, &data_st, false));
+  name = xasprintf ("__caf_rget_index_%d", call_cnt);
+  ++call_cnt;
+  gcc_assert (!gfc_get_sym_tree (name, ns, &index_st, false));
+  free (name);
+  data_st->n.sym->attr.flavor = FL_VARIABLE;
+  data_st->n.sym->ts = gdata_sym->ts;
+  rget_data.symtree = data_st;
+  gfc_set_sym_referenced (rget_data.symtree->n.sym);
+  rget_data.ts = data_st->n.sym->ts;
+  gfc_commit_symbol (data_st->n.sym);
+
+  memset (&rget_data_init, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&rget_data_init.ts);
+  rget_data_init.expr_type = EXPR_STRUCTURE;
+  rget_data_init.ts = rget_data.ts;
+  for (gfc_component *comp = rget_data.ts.u.derived->components; comp;
+       comp = comp->next)
+    {
+      con = gfc_constructor_get ();
+      con->expr = comp->initializer;
+      comp->initializer = NULL;
+      gfc_constructor_append (&rget_data_init.value.constructor, con);
+    }
+
+  index_st->n.sym->attr.flavor = FL_VARIABLE;
+  index_st->n.sym->attr.save = SAVE_EXPLICIT;
+  index_st->n.sym->value
+    = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
+			     &gfc_current_locus);
+  mpz_init_set_si (index_st->n.sym->value->value.integer, -1);
+  index_st->n.sym->ts.type = BT_INTEGER;
+  index_st->n.sym->ts.kind = gfc_default_integer_kind;
+  gfc_set_sym_referenced (index_st->n.sym);
+  memset (&rget_index, 0, sizeof (gfc_expr));
+  gfc_clear_ts (&rget_index.ts);
+  rget_index.expr_type = EXPR_VARIABLE;
+  rget_index.symtree = index_st;
+  rget_index.ts = index_st->n.sym->ts;
+  gfc_commit_symbol (index_st->n.sym);
 
-	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get_by_ref,
-				     10, token, image_index, dst_var,
-				     caf_reference, lhs_kind, kind,
-				     may_require_tmp,
-				     may_realloc ? boolean_true_node :
-						   boolean_false_node,
-				     stat, build_int_cst (integer_type_node,
-							  array_expr->ts.type));
+  gfc_init_se (&argse, NULL);
+  gfc_conv_expr (&argse, &rget_index);
+  gfc_add_block_to_block (&se->pre, &argse.pre);
+  rget_index_tree = argse.expr;
 
-	  gfc_add_expr_to_block (&se->pre, tmp);
+  gfc_init_se (&argse, NULL);
+  gfc_conv_expr (&argse, rget_hash);
 
-	  if (se->ss)
-	    gfc_advance_se_ss_chain (se);
+  gfc_init_block (&blk);
+  tmp = build_call_expr (gfor_fndecl_caf_get_remote_function_index, 1,
+			 argse.expr);
 
-	  se->expr = res_var;
-	  if (array_expr->ts.type == BT_CHARACTER)
-	    se->string_length = argse.string_length;
+  gfc_add_modify (&blk, rget_index_tree, tmp);
+  gfc_add_expr_to_block (
+    &se->pre,
+    build3 (COND_EXPR, void_type_node,
+	    gfc_likely (build2 (EQ_EXPR, logical_type_node, rget_index_tree,
+				build_int_cst (integer_type_node, -1)),
+			PRED_FIRST_MATCH),
+	    gfc_finish_block (&blk), NULL_TREE));
 
-	  return;
-	}
+  if (rget_data.ts.u.derived->components)
+    {
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr (&argse, &rget_data);
+      rget_data_tree = argse.expr;
+      gfc_add_expr_to_block (&se->pre,
+			     gfc_trans_structure_assign (rget_data_tree,
+							 &rget_data_init, true,
+							 false));
+      gfc_constructor_free (rget_data_init.value.constructor);
+      rget_data_size = TREE_TYPE (rget_data_tree)->type_common.size_unit;
+      rget_data_tree = gfc_build_addr_expr (pvoid_type_node, rget_data_tree);
+    }
+  else
+    {
+      rget_data_tree = build_zero_cst (pvoid_type_node);
+      rget_data_size = build_zero_cst (size_type_node);
     }
 
-  gfc_init_se (&argse, NULL);
   if (array_expr->rank == 0)
     {
-      symbol_attribute attr;
-
-      gfc_clear_attr (&attr);
-      gfc_conv_expr (&argse, array_expr);
-
-      if (lhs == NULL_TREE)
+      res_var = gfc_create_var (type, "caf_res");
+      if (array_expr->ts.type == BT_CHARACTER)
 	{
-	  gfc_clear_attr (&attr);
-	  if (array_expr->ts.type == BT_CHARACTER)
-	    res_var = gfc_conv_string_tmp (se, build_pointer_type (type),
-					   argse.string_length);
-	  else
-	    res_var = gfc_create_var (type, "caf_res");
-	  dst_var = gfc_conv_scalar_to_descriptor (&argse, res_var, attr);
-	  dst_var = gfc_build_addr_expr (NULL_TREE, dst_var);
+	  gfc_conv_string_length (array_expr->ts.u.cl, array_expr, &se->pre);
+	  argse.string_length = array_expr->ts.u.cl->backend_decl;
+	  opt_src_charlen = gfc_build_addr_expr (
+	    NULL_TREE, gfc_trans_force_lval (&se->pre, argse.string_length));
+	  dest_size = build_int_cstu (size_type_node, array_expr->ts.kind);
+	}
+      else
+	{
+	  dest_size = res_var->typed.type->type_common.size_unit;
+	  opt_src_charlen
+	    = build_zero_cst (build_pointer_type (size_type_node));
 	}
-      argse.expr = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr);
-      argse.expr = gfc_build_addr_expr (NULL_TREE, argse.expr);
+      dest_data
+	= gfc_evaluate_now (gfc_build_addr_expr (NULL_TREE, res_var), &se->pre);
+      res_var = build_fold_indirect_ref (dest_data);
+      dest_data = gfc_build_addr_expr (pvoid_type_node, dest_data);
+      opt_dest_desc = build_zero_cst (pvoid_type_node);
     }
   else
     {
-      /* If has_vector, pass descriptor for whole array and the
-         vector bounds separately.  */
-      gfc_array_ref *ar, ar2;
-      bool has_vector = false;
-
-      if (gfc_is_coindexed (expr) && gfc_has_vector_subscript (expr))
+      /* Create temporary.  */
+      may_realloc = gfc_trans_create_temp_array (&se->pre, &se->post, se->ss,
+						 type, NULL_TREE, false, false,
+						 false, &array_expr->where)
+		    == NULL_TREE;
+      res_var = se->ss->info->data.array.descriptor;
+      if (array_expr->ts.type == BT_CHARACTER)
 	{
-          has_vector = true;
-          ar = gfc_find_array_ref (expr);
-	  ar2 = *ar;
-	  memset (ar, '\0', sizeof (*ar));
-	  ar->as = ar2.as;
-	  ar->type = AR_FULL;
-	}
-      // TODO: Check whether argse.want_coarray = 1 can help with the below.
-      gfc_conv_expr_descriptor (&argse, array_expr);
-      /* Using gfc_conv_expr_descriptor, we only get the descriptor, but that
-	 has the wrong type if component references are done.  */
-      gfc_add_modify (&argse.pre, gfc_conv_descriptor_dtype (argse.expr),
-		      gfc_get_dtype_rank_type (has_vector ? ar2.dimen
-							  : array_expr->rank,
-					       type));
-      if (has_vector)
-	{
-	  vec = conv_caf_vector_subscript (&argse.pre, argse.expr, &ar2);
-	  *ar = ar2;
+	  argse.string_length = array_expr->ts.u.cl->backend_decl;
+	  opt_src_charlen = gfc_build_addr_expr (
+	    NULL_TREE, gfc_trans_force_lval (&se->pre, argse.string_length));
+	  dest_size = build_int_cstu (size_type_node, array_expr->ts.kind);
 	}
-
-      if (lhs == NULL_TREE)
+      else
 	{
-	  /* Create temporary.  */
-	  for (int n = 0; n < se->ss->loop->dimen; n++)
-	    if (se->loop->to[n] == NULL_TREE)
-	      {
-		se->loop->from[n] = gfc_conv_descriptor_lbound_get (argse.expr,
-							       gfc_rank_cst[n]);
-		se->loop->to[n] = gfc_conv_descriptor_ubound_get (argse.expr,
-							       gfc_rank_cst[n]);
-	      }
-	  gfc_trans_create_temp_array (&argse.pre, &argse.post, se->ss, type,
-				       NULL_TREE, false, true, false,
-				       &array_expr->where);
-	  res_var = se->ss->info->data.array.descriptor;
-	  dst_var = gfc_build_addr_expr (NULL_TREE, res_var);
-	}
-      argse.expr = gfc_build_addr_expr (NULL_TREE, argse.expr);
-    }
-
-  kind = build_int_cst (integer_type_node, expr->ts.kind);
-  if (lhs_kind == NULL_TREE)
-    lhs_kind = kind;
-
-  gfc_add_block_to_block (&se->pre, &argse.pre);
-  gfc_add_block_to_block (&se->post, &argse.post);
-
+	  opt_src_charlen
+	    = build_zero_cst (build_pointer_type (size_type_node));
+	  dest_size = fold_build2 (
+	    MULT_EXPR, size_type_node,
+	    fold_convert (size_type_node,
+			  array_expr->shape
+			    ? conv_shape_to_cst (array_expr)
+			    : gfc_conv_descriptor_size (res_var,
+							array_expr->rank)),
+	    fold_convert (size_type_node,
+			  gfc_conv_descriptor_span_get (res_var)));
+	}
+      opt_dest_desc = res_var;
+      dest_data = gfc_conv_descriptor_data_get (res_var);
+      opt_dest_desc = gfc_build_addr_expr (NULL_TREE, opt_dest_desc);
+      if (may_realloc)
+	{
+	  tmp = gfc_conv_descriptor_data_get (res_var);
+	  tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,
+					    NULL_TREE, NULL_TREE, true, NULL,
+					    GFC_CAF_COARRAY_NOCOARRAY);
+	  gfc_add_expr_to_block (&se->post, tmp);
+	}
+      dest_data
+	= gfc_build_addr_expr (NULL_TREE,
+			       gfc_trans_force_lval (&se->pre, dest_data));
+    }
+
+  opt_dest_charlen = opt_src_charlen;
   caf_decl = gfc_get_tree_for_caf_expr (array_expr);
-  if (POINTER_TYPE_P (TREE_TYPE (caf_decl)))
+  if (TREE_CODE (TREE_TYPE (caf_decl)) == REFERENCE_TYPE)
     caf_decl = build_fold_indirect_ref_loc (input_location, caf_decl);
-  image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
-  gfc_get_caf_token_offset (se, &token, &offset, caf_decl, argse.expr,
-			    array_expr);
 
-  /* No overlap possible as we have generated a temporary.  */
-  if (lhs == NULL_TREE)
-    may_require_tmp = boolean_false_node;
+  if (!TYPE_LANG_SPECIFIC (TREE_TYPE (caf_decl))->rank
+      || GFC_ARRAY_TYPE_P (TREE_TYPE (caf_decl)))
+    opt_src_desc = build_zero_cst (pvoid_type_node);
+  else
+    opt_src_desc = gfc_build_addr_expr (pvoid_type_node, caf_decl);
+
+  image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
+  gfc_get_caf_token_offset (se, &token, NULL, caf_decl, NULL, array_expr);
 
   /* It guarantees memory consistency within the same segment.  */
   tmp = gfc_build_string_const (strlen ("memory") + 1, "memory");
@@ -1919,9 +1920,12 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   ASM_VOLATILE_P (tmp) = 1;
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 10,
-			     token, offset, image_index, argse.expr, vec,
-			     dst_var, kind, lhs_kind, may_require_tmp, stat);
+  tmp = build_call_expr_loc (
+    input_location, gfor_fndecl_caf_get_by_ct, 15, token, opt_src_desc,
+    opt_src_charlen, image_index, dest_size, dest_data, opt_dest_charlen,
+    opt_dest_desc, constant_boolean_node (may_realloc, boolean_type_node),
+    rget_index_tree, rget_data_tree, rget_data_size, stat, null_pointer_node,
+    null_pointer_node);
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
@@ -1931,6 +1935,8 @@ gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
   se->expr = res_var;
   if (array_expr->ts.type == BT_CHARACTER)
     se->string_length = argse.string_length;
+
+  return;
 }
 
 static bool
@@ -1995,8 +2001,9 @@ conv_caf_send (gfc_code *code) {
 	  gfc_clear_attr (&attr);
 	  gfc_conv_expr (&lhs_se, lhs_expr);
 	  lhs_type = TREE_TYPE (lhs_se.expr);
-	  lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr,
-						       attr);
+	  if (lhs_is_coindexed)
+	    lhs_se.expr = gfc_conv_scalar_to_descriptor (&lhs_se, lhs_se.expr,
+							 attr);
 	  lhs_se.expr = gfc_build_addr_expr (NULL_TREE, lhs_se.expr);
 	}
     }
@@ -2174,17 +2181,13 @@ conv_caf_send (gfc_code *code) {
 	lhs_may_realloc = lhs_may_realloc
 	    && gfc_full_array_ref_p (lhs_expr->ref, NULL);
       gfc_add_block_to_block (&block, &lhs_se.pre);
-      gfc_conv_intrinsic_caf_get (&rhs_se, rhs_expr, lhs_se.expr, lhs_kind,
-				  may_require_tmp, lhs_may_realloc,
-				  &rhs_caf_attr);
+      gfc_conv_intrinsic_caf_get (&rhs_se, code->ext.actual->next->expr,
+				  lhs_se.expr, lhs_may_realloc, &rhs_caf_attr);
       gfc_add_block_to_block (&block, &rhs_se.pre);
       gfc_add_block_to_block (&block, &rhs_se.post);
       gfc_add_block_to_block (&block, &lhs_se.post);
       return gfc_finish_block (&block);
     }
-  else if (rhs_expr->expr_type == EXPR_FUNCTION
-	   && rhs_expr->value.function.isym->id == GFC_ISYM_CAF_GET)
-    rhs_expr = rhs_expr->value.function.actual->expr;
 
   gfc_add_block_to_block (&block, &lhs_se.pre);
 
@@ -2301,8 +2304,8 @@ conv_caf_send (gfc_code *code) {
 	{
 	  tree reference, dst_realloc;
 	  reference = conv_expr_ref_to_caf_ref (&block, lhs_expr);
-	  dst_realloc = lhs_caf_attr.allocatable ? boolean_true_node
-					     : boolean_false_node;
+	  dst_realloc
+	    = lhs_caf_attr.allocatable ? boolean_true_node : boolean_false_node;
 	  tmp = build_call_expr_loc (input_location,
 				     gfor_fndecl_caf_send_by_ref,
 				     10, token, image_index, rhs_se.expr,
@@ -2310,7 +2313,7 @@ conv_caf_send (gfc_code *code) {
 				     may_require_tmp, dst_realloc, src_stat,
 				     build_int_cst (integer_type_node,
 						    lhs_expr->ts.type));
-	  }
+	}
       else
 	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 11,
 				   token, offset, image_index, lhs_se.expr, vec,
@@ -11290,8 +11293,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
       break;
 
     case GFC_ISYM_CAF_GET:
-      gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE,
-				  false, NULL);
+      gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, false, NULL);
       break;
 
     case GFC_ISYM_CMPLX: