Skip to content

Commit

Permalink
Sending data to this_image() lead doing a memmove even when
Browse files Browse the repository at this point in the history
that was unsuitable, because size, rank, type, a.s.o. did not
match. This patch directs all data sends to the convert
routine, which does scalar to array and type/kind conversion
correctly.
  • Loading branch information
vehre committed Oct 2, 2024
1 parent 5f09984 commit 6017b71
Show file tree
Hide file tree
Showing 2 changed files with 17 additions and 12 deletions.
27 changes: 16 additions & 11 deletions src/runtime-libraries/mpi/mpi_caf.c
Original file line number Diff line number Diff line change
Expand Up @@ -2026,25 +2026,30 @@ copy_char_to_self(void *src, int src_type, int src_size, int src_kind,

static void
copy_to_self(gfc_descriptor_t *src, int src_kind,
gfc_descriptor_t *dest, int dst_kind, size_t size, int *stat)
gfc_descriptor_t *dst, int dst_kind, size_t elem_size, int *stat)
{
const int src_size = GFC_DESCRIPTOR_SIZE(src),
dst_size = GFC_DESCRIPTOR_SIZE(dst);
const int src_type = GFC_DESCRIPTOR_TYPE(src),
dst_type = GFC_DESCRIPTOR_TYPE(dst);
const int src_rank = GFC_DESCRIPTOR_RANK(src),
dst_rank = GFC_DESCRIPTOR_RANK(dst);
#ifdef GFC_CAF_CHECK
if (GFC_DESCRIPTOR_TYPE(dest) == BT_CHARACTER
|| GFC_DESCRIPTOR_TYPE(src) == BT_CHARACTER)
if (dst_type == BT_CHARACTER || src_type == BT_CHARACTER)
caf_runtime_error("internal error: copy_to_self() for char types called.");
#endif
/* The address of dest passed by the compiler points on the right
* memory location. No offset summation is needed. */
if (dst_kind == src_kind)
memmove(dest->base_addr, src->base_addr, size * GFC_DESCRIPTOR_SIZE(dest));
* memory location. No offset summation is needed. Use the convert with
* strides when src is a scalar. */
if (dst_kind == src_kind && dst_size == src_size && dst_type == src_type
&& src_rank == dst_rank)
memmove(dst->base_addr, src->base_addr, elem_size * dst_size);
else
/* When the rank is 0 then a scalar is copied to a vector and the stride
* is zero. */
convert_with_strides(dest->base_addr, GFC_DESCRIPTOR_TYPE(dest), dst_kind,
GFC_DESCRIPTOR_SIZE(dest), src->base_addr,
GFC_DESCRIPTOR_TYPE(src), src_kind,
(GFC_DESCRIPTOR_RANK(src) > 0)
? GFC_DESCRIPTOR_SIZE(src) : 0, size, stat);
convert_with_strides(dst->base_addr, dst_type, dst_kind,
dst_size, src->base_addr, src_type, src_kind,
src_rank > 0 ? src_size : 0, elem_size, stat);
}

/* token: The token of the array to be written to.
Expand Down
2 changes: 1 addition & 1 deletion src/tests/unit/send-get/send_convert_nums.f90
Original file line number Diff line number Diff line change
Expand Up @@ -364,7 +364,7 @@ program send_convert_nums
& call print_and_register( 'send strided int kind=1 to kind=1 self failed.')

co_int_k4 = -1
co_int_k4(::2)[1] = int_k4
co_int_k4(::2)[1] = int_k4(1:3)
print *, co_int_k4
if (any(co_int_k4 /= [int_k4(1), -1, int_k4(2), -1, int_k4(3)])) &
call print_and_register( 'send strided int kind=4 to kind=4 self failed.')
Expand Down

0 comments on commit 6017b71

Please sign in to comment.