+2014-08-31 Tobias Burnus <burnus@net-b.de>
+
+ * trans-decl.c (gfc_build_builtin_function_decls): Add
+ may_require_tmp dummy argument.
+ * trans-intrinsic.c (gfc_conv_intrinsic_caf_get,
+ conv_caf_send): Handle may_require_tmp argument.
+ (gfc_conv_intrinsic_function): Update call.
+ * gfortran.texi (_gfortran_caf_send, _gfortran_caf_get,
+ _gfortran_caf_sendget): Update interface description.
+
2014-08-30 Tobias Burnus <burnus@net-b.de>
* trans.h (gfc_caf_get_image_index,
@item @emph{Syntax}:
@code{void _gfortran_caf_send (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
-gfc_descriptor_t *src, int dst_kind, int src_kind)}
+gfc_descriptor_t *src, int dst_kind, int src_kind, bool may_require_tmp)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
transferred to the remote image
@item @var{dst_kind} @tab Kind of the destination argument
@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false it is known at compile
+time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
+or partially) such that walking @var{src} and @var{dest} in element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
@end multitable
@item @emph{NOTES}
It is permitted to have image_id equal the current image; the memory of the
send-to and the send-from might (partially) overlap in that case. The
-implementation has to take care that it handles this case. Note that the
-assignment of a scalar to an array is permitted. In addition, the library has
-to handle numeric-type conversion and for strings, padding and different
-character kinds.
+implementation has to take care that it handles this case, e.g. using
+@code{memmove} which handles (partially) overlapping memory. If
+@var{may_require_tmp} is true, the library might additionally create a
+temporary variable, unless additional checks show that this is not required
+(e.g. because walking backward is possible or because both arrays are
+contiguous and @code{memmove} takes care of overlap issues).
+
+Note that the assignment of a scalar to an array is permitted. In addition,
+the library has to handle numeric-type conversion and for strings, padding
+and different character kinds.
@end table
@item @emph{Syntax}:
@code{void _gfortran_caf_get_desc (caf_token_t token, size_t offset,
int image_index, gfc_descriptor_t *src, caf_vector_t *src_vector,
-gfc_descriptor_t *dest, int src_kind, int dst_kind)}
+gfc_descriptor_t *dest, int src_kind, int dst_kind, bool may_require_tmp)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
triplet of the dest argument.
@item @var{dst_kind} @tab Kind of the destination argument
@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false it is known at compile
+time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
+or partially) such that walking @var{src} and @var{dest} in element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
@end multitable
@item @emph{NOTES}
It is permitted to have image_id equal the current image; the memory of the
send-to and the send-from might (partially) overlap in that case. The
-implementation has to take care that it handles this case. Note that the
-library has to handle numeric-type conversion and for strings, padding
-and different character kinds.
+implementation has to take care that it handles this case, e.g. using
+@code{memmove} which handles (partially) overlapping memory. If
+@var{may_require_tmp} is true, the library might additionally create a
+temporary variable, unless additional checks show that this is not required
+(e.g. because walking backward is possible or because both arrays are
+contiguous and @code{memmove} takes care of overlap issues).
+
+Note that the library has to handle numeric-type conversion and for strings,
+padding and different character kinds.
@end table
@code{void _gfortran_caf_sendget (caf_token_t dst_token, size_t dst_offset,
int dst_image_index, gfc_descriptor_t *dest, caf_vector_t *dst_vector,
caf_token_t src_token, size_t src_offset, int src_image_index,
-gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind)}
+gfc_descriptor_t *src, caf_vector_t *src_vector, int dst_kind, int src_kind,
+bool may_require_tmp)}
@item @emph{Arguments}:
@multitable @columnfractions .15 .70
shifted compared to the base address of the destination coarray.
@item @var{dst_image_index} @tab The ID of the destination remote image; must
be a positive number.
-@item @var{dst_dest} @tab intent(in) Array descriptor for the destination
+@item @var{dest} @tab intent(in) Array descriptor for the destination
remote image for the bounds and the size. The base_addr shall not be accessed.
@item @var{dst_vector} @tab intent(int) If not NULL, it contains the vector
subscript of the destination array; the values are relative to the dimension
compared to the base address of the source coarray.
@item @var{src_image_index} @tab The ID of the source remote image; must be a
positive number.
-@item @var{src_dest} @tab intent(in) Array descriptor of the local array to be
+@item @var{src} @tab intent(in) Array descriptor of the local array to be
transferred to the remote image.
@item @var{src_vector} @tab intent(in) Array descriptor of the local array to
be transferred to the remote image
@item @var{dst_kind} @tab Kind of the destination argument
@item @var{src_kind} @tab Kind of the source argument
+@item @var{may_require_tmp} @tab The variable is false it is known at compile
+time that the @var{dest} and @var{src} either cannot overlap or overlap (fully
+or partially) such that walking @var{src} and @var{dest} in element wise
+element order (honoring the stride value) will not lead to wrong results.
+Otherwise, the value is true.
@end multitable
@item @emph{NOTES}
-It is permitted to have image_id equal the current image; the memory of the
-send-to and the send-from might (partially) overlap in that case. The
-implementation has to take care that it handles this case. Note that the
-assignment of a scalar to an array is permitted. In addition, the library has
-to handle numeric-type conversion and for strings, padding and different
-character kinds.
+It is permitted to have image_ids equal; the memory of the send-to and the
+send-from might (partially) overlap in that case. The implementation has to
+take care that it handles this case, e.g. using @code{memmove} which handles
+(partially) overlapping memory. If @var{may_require_tmp} is true, the library
+might additionally create a temporary variable, unless additional checks show
+that this is not required (e.g. because walking backward is possible or because
+both arrays are contiguous and @code{memmove} takes care of overlap issues).
+
+Note that the assignment of a scalar to an array is permitted. In addition,
+the library has to handle numeric-type conversion and for strings, padding and
+different character kinds.
@end table
ppvoid_type_node, pint_type, pchar_type_node, integer_type_node);
gfor_fndecl_caf_get = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 8,
+ get_identifier (PREFIX("caf_get")), ".R.RRRW", void_type_node, 9,
pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
- pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node);
+ pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
+ boolean_type_node);
gfor_fndecl_caf_send = gfc_build_library_function_decl_with_spec (
- get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 8,
+ get_identifier (PREFIX("caf_send")), ".R.RRRR", void_type_node, 9,
pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
- pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node);
+ pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
+ boolean_type_node);
gfor_fndecl_caf_sendget = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_sendget")), ".R.RRRR.RRR", void_type_node,
- 12, pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
+ 13, pvoid_type_node, size_type_node, integer_type_node, pvoid_type_node,
pvoid_type_node, pvoid_type_node, size_type_node, integer_type_node,
- pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node);
+ pvoid_type_node, pvoid_type_node, integer_type_node, integer_type_node,
+ boolean_type_node);
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
get_identifier (PREFIX("caf_sync_all")), ".WW", void_type_node,
#include "trans-const.h"
#include "trans-types.h"
#include "trans-array.h"
+#include "dependency.h" /* For CAF array alias analysis. */
/* Only for gfc_trans_assign and gfc_trans_pointer_assign. */
#include "trans-stmt.h"
#include "tree-nested.h"
/* Get data from a remote coarray. */
static void
-gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind)
+gfc_conv_intrinsic_caf_get (gfc_se *se, gfc_expr *expr, tree lhs, tree lhs_kind,
+ tree may_require_tmp)
{
gfc_expr *array_expr;
gfc_se argse;
image_index = gfc_caf_get_image_index (&se->pre, array_expr, caf_decl);
gfc_get_caf_token_offset (&token, &offset, caf_decl, argse.expr, array_expr);
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 8,
+ /* No overlap possible as we have generated a temporary. */
+ if (lhs == NULL_TREE)
+ may_require_tmp = boolean_false_node;
+
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_get, 9,
token, offset, image_index, argse.expr, vec,
- dst_var, kind, lhs_kind);
+ dst_var, kind, lhs_kind, may_require_tmp);
gfc_add_expr_to_block (&se->pre, tmp);
if (se->ss)
gfc_se lhs_se, rhs_se;
stmtblock_t block;
tree caf_decl, token, offset, image_index, tmp, lhs_kind, rhs_kind;
+ tree may_require_tmp;
tree lhs_type = NULL_TREE;
tree vec = null_pointer_node, rhs_vec = null_pointer_node;
lhs_expr = code->ext.actual->expr;
rhs_expr = code->ext.actual->next->expr;
+ may_require_tmp = gfc_check_dependency (lhs_expr, rhs_expr, false) == 0
+ ? boolean_false_node : boolean_true_node;
gfc_init_block (&block);
/* LHS. */
{
gcc_assert (gfc_is_coindexed (rhs_expr));
gfc_init_se (&rhs_se, NULL);
- gfc_conv_intrinsic_caf_get (&rhs_se, rhs_expr, lhs_se.expr, lhs_kind);
+ gfc_conv_intrinsic_caf_get (&rhs_se, rhs_expr, lhs_se.expr, lhs_kind,
+ may_require_tmp);
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);
rhs_kind = build_int_cst (integer_type_node, rhs_expr->ts.kind);
if (!gfc_is_coindexed (rhs_expr))
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 8, token,
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_send, 9, token,
offset, image_index, lhs_se.expr, vec,
- rhs_se.expr, lhs_kind, rhs_kind);
+ rhs_se.expr, lhs_kind, rhs_kind, may_require_tmp);
else
{
tree rhs_token, rhs_offset, rhs_image_index;
rhs_image_index = gfc_caf_get_image_index (&block, rhs_expr, caf_decl);
gfc_get_caf_token_offset (&rhs_token, &rhs_offset, caf_decl, rhs_se.expr,
rhs_expr);
- tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, 12,
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_sendget, 13,
token, offset, image_index, lhs_se.expr, vec,
rhs_token, rhs_offset, rhs_image_index,
- rhs_se.expr, rhs_vec, lhs_kind, rhs_kind);
+ rhs_se.expr, rhs_vec, lhs_kind, rhs_kind,
+ may_require_tmp);
}
gfc_add_expr_to_block (&block, tmp);
gfc_add_block_to_block (&block, &lhs_se.post);
break;
case GFC_ISYM_CAF_GET:
- gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE);
+ gfc_conv_intrinsic_caf_get (se, expr, NULL_TREE, NULL_TREE, NULL_TREE);
break;
case GFC_ISYM_CMPLX:
+2014-08-31 Tobias Burnus <burnus@net-b.de>
+
+ * gfortran.dg/coarray_lib_comm_1.f90: New.
+
2014-08-30 Andrew Pinski <apinski@cavium.com>
* gcc.c-torture/execute/20140828-1.c: New testcase.
--- /dev/null
+! { dg-do run }
+! { dg-options "-fdump-tree-original -fcoarray=lib -lcaf_single" }
+!
+! Some dependency-analysis check for coarray communication
+!
+integer, target, save :: A(10)[*]
+integer, pointer :: P(:)
+integer, save :: B(10)[*]
+
+A = [1,2,3,4,5,6,7,8,9,10]
+B = [1,2,3,4,5,6,7,8,9,10]
+A(10:2:-1) = A(9:1:-1)[1] ! 0
+B(10:2:-1) = B(9:1:-1)
+if (any (A-B /= 0)) call abort
+
+A = [1,2,3,4,5,6,7,8,9,10]
+B = [1,2,3,4,5,6,7,8,9,10]
+A(9:1:-1) = A(10:2:-1)[1] ! 1
+B(9:1:-1) = B(10:2:-1)
+if (any (A-B /= 0)) call abort
+
+A = [1,2,3,4,5,6,7,8,9,10]
+B = [1,2,3,4,5,6,7,8,9,10]
+allocate(P(10))
+P(:) = A(:)[1] ! 1
+if (any (A-B /= 0)) call abort
+
+A = [1,2,3,4,5,6,7,8,9,10]
+B = [1,2,3,4,5,6,7,8,9,10]
+allocate(P(10))
+P(:) = B(:)[1] ! 0
+
+A = [1,2,3,4,5,6,7,8,9,10]
+B = [1,2,3,4,5,6,7,8,9,10]
+A(1:5)[1] = A(3:7)[1] ! 1
+B(1:5) = B(3:7)
+if (any (A-B /= 0)) call abort
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 0\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &parm.\[0-9\]+, 4, 4, 1\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 1\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_get \\\(caf_token.1, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) b, 1, &parm.\[0-9\]+, 0B, &p, 4, 4, 0\\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.0, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 0\\\);" 1 "original" } }
+
+! { dg-final { cleanup-tree-dump "original" } }
+2014-08-31 Tobias Burnus <burnus@net-b.de>
+
+ * caf/libcaf.h (_gfortran_caf_send, _gfortran_caf_get,
+ _gfortran_caf_sendget): Update prototype.
+ * caf/single.c (_gfortran_caf_send, _gfortran_caf_get,
+ _gfortran_caf_sendget): Handle may_require_tmp.
+
2014-08-20 Steven G. Kargl <kargl@gcc.gnu.org>
PR libgfortran/62188
int, int);
void _gfortran_caf_get (caf_token_t, size_t, int, gfc_descriptor_t *,
- caf_vector_t *, gfc_descriptor_t *, int, int);
+ caf_vector_t *, gfc_descriptor_t *, int, int, bool);
void _gfortran_caf_send (caf_token_t, size_t, int, gfc_descriptor_t *,
- caf_vector_t *, gfc_descriptor_t *, int, int);
+ caf_vector_t *, gfc_descriptor_t *, int, int, bool);
void _gfortran_caf_sendget (caf_token_t, size_t, int, gfc_descriptor_t *,
caf_vector_t *, caf_token_t, size_t, int,
- gfc_descriptor_t *, caf_vector_t *, int, int);
+ gfc_descriptor_t *, caf_vector_t *, int, int, bool);
void _gfortran_caf_atomic_define (caf_token_t, size_t, int, void *, int *,
int, int);
int image_index __attribute__ ((unused)),
gfc_descriptor_t *src,
caf_vector_t *src_vector __attribute__ ((unused)),
- gfc_descriptor_t *dest, int src_kind, int dst_kind)
+ gfc_descriptor_t *dest, int src_kind, int dst_kind,
+ bool may_require_tmp)
{
/* FIXME: Handle vector subscripts. */
size_t i, k, size;
if (size == 0)
return;
+ if (may_require_tmp)
+ {
+ ptrdiff_t array_offset_sr, array_offset_dst;
+ void *tmp = malloc (size*src_size);
+
+ array_offset_dst = 0;
+ for (i = 0; i < size; i++)
+ {
+ ptrdiff_t array_offset_sr = 0;
+ ptrdiff_t stride = 1;
+ ptrdiff_t 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) * src->dim[rank-1]._stride;
+ void *sr = (void *)((char *) TOKEN (token) + offset
+ + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
+ memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size);
+ array_offset_dst += src_size;
+ }
+
+ array_offset_sr = 0;
+ 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;
+ void *dst = dest->base_addr
+ + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest);
+ void *sr = tmp + array_offset_sr;
+
+ if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+ && dst_kind == src_kind)
+ {
+ memmove (dst, sr, dst_size > src_size ? src_size : dst_size);
+ if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER
+ && dst_size > src_size)
+ {
+ if (dst_kind == 1)
+ memset ((void*)(char*) dst + src_size, ' ',
+ dst_size-src_size);
+ else /* dst_kind == 4. */
+ for (k = src_size/4; k < dst_size/4; k++)
+ ((int32_t*) dst)[k] = (int32_t) ' ';
+ }
+ }
+ else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+ assign_char1_from_char4 (dst_size, src_size, dst, sr);
+ else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+ assign_char4_from_char1 (dst_size, src_size, dst, sr);
+ else
+ convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
+ sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+ array_offset_sr += src_size;
+ }
+
+ free (tmp);
+ return;
+ }
+
for (i = 0; i < size; i++)
{
ptrdiff_t array_offset_dst = 0;
int image_index __attribute__ ((unused)),
gfc_descriptor_t *dest,
caf_vector_t *dst_vector __attribute__ ((unused)),
- gfc_descriptor_t *src, int dst_kind, int src_kind)
+ gfc_descriptor_t *src, int dst_kind, int src_kind,
+ bool may_require_tmp)
{
/* FIXME: Handle vector subscripts. */
size_t i, k, size;
if (size == 0)
return;
+ if (may_require_tmp)
+ {
+ ptrdiff_t array_offset_sr, array_offset_dst;
+ void *tmp;
+
+ if (GFC_DESCRIPTOR_RANK (src) == 0)
+ {
+ tmp = malloc (src_size);
+ memcpy (tmp, GFC_DESCRIPTOR_DATA (src), src_size);
+ }
+ else
+ {
+ tmp = malloc (size*src_size);
+ array_offset_dst = 0;
+ for (i = 0; i < size; i++)
+ {
+ ptrdiff_t array_offset_sr = 0;
+ ptrdiff_t stride = 1;
+ ptrdiff_t 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) * src->dim[rank-1]._stride;
+ void *sr = (void *) ((char *) src->base_addr
+ + array_offset_sr*GFC_DESCRIPTOR_SIZE (src));
+ memcpy ((void *) ((char *) tmp + array_offset_dst), sr, src_size);
+ array_offset_dst += src_size;
+ }
+ }
+
+ array_offset_sr = 0;
+ 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;
+ void *dst = (void *)((char *) TOKEN (token) + offset
+ + array_offset_dst*GFC_DESCRIPTOR_SIZE (dest));
+ void *sr = tmp + array_offset_sr;
+ if (GFC_DESCRIPTOR_TYPE (dest) == GFC_DESCRIPTOR_TYPE (src)
+ && dst_kind == src_kind)
+ {
+ memmove (dst, sr,
+ dst_size > src_size ? src_size : dst_size);
+ if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER
+ && dst_size > src_size)
+ {
+ if (dst_kind == 1)
+ memset ((void*)(char*) dst + src_size, ' ',
+ dst_size-src_size);
+ else /* dst_kind == 4. */
+ for (k = src_size/4; k < dst_size/4; k++)
+ ((int32_t*) dst)[k] = (int32_t) ' ';
+ }
+ }
+ else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER && dst_kind == 1)
+ assign_char1_from_char4 (dst_size, src_size, dst, sr);
+ else if (GFC_DESCRIPTOR_TYPE (dest) == BT_CHARACTER)
+ assign_char4_from_char1 (dst_size, src_size, dst, sr);
+ else
+ convert_type (dst, GFC_DESCRIPTOR_TYPE (dest), dst_kind,
+ sr, GFC_DESCRIPTOR_TYPE (src), src_kind);
+ if (GFC_DESCRIPTOR_RANK (src))
+ array_offset_sr += src_size;
+ }
+ free (tmp);
+ return;
+ }
+
for (i = 0; i < size; i++)
{
ptrdiff_t array_offset_dst = 0;
int src_image_index __attribute__ ((unused)),
gfc_descriptor_t *src,
caf_vector_t *src_vector __attribute__ ((unused)),
- int dst_kind, int src_kind)
+ int dst_kind, int src_kind, bool may_require_tmp)
{
/* FIXME: Handle vector subscript of 'src_vector'. */
/* For a single image, src->base_addr should be the same as src_token + offset
void *src_base = GFC_DESCRIPTOR_DATA (src);
GFC_DESCRIPTOR_DATA (src) = (void *) ((char *) TOKEN (src_token) + src_offset);
_gfortran_caf_send (dst_token, dst_offset, dst_image_index, dest, dst_vector,
- src, dst_kind, src_kind);
+ src, dst_kind, src_kind, may_require_tmp);
GFC_DESCRIPTOR_DATA (src) = src_base;
}
projects / thirdparty / gcc.git / commitdiff
