Fortran: Add transfer_between_remotes [PR107635]
Add the last missing coarray data manipulation routine using remote accessors. gcc/fortran/ChangeLog: PR fortran/107635 * coarray.cc (rewrite_caf_send): Rewrite to transfer_between_remotes when both sides of the assignment have a coarray. (coindexed_code_callback): Prevent duplicate rewrite. * gfortran.texi: Add documentation for transfer_between_remotes. * intrinsic.cc (add_subroutines): Add intrinsic symbol for caf_sendget to allow easy rewrite to transfer_between_remotes. * trans-decl.cc (gfc_build_builtin_function_decls): Add prototype for transfer_between_remotes. * trans-intrinsic.cc (conv_caf_vector_subscript_elem): Mark as deprecated. (conv_caf_vector_subscript): Same. (compute_component_offset): Same. (conv_expr_ref_to_caf_ref): Same. (conv_stat_and_team): Extract stat and team from expr. (gfc_conv_intrinsic_caf_get): Use conv_stat_and_team. (conv_caf_send_to_remote): Same. (has_ref_after_cafref): Mark as deprecated. (conv_caf_sendget): Translate to transfer_between_remotes. * trans.h: Add prototype for transfer_between_remotes. libgfortran/ChangeLog: * caf/libcaf.h: Add prototype for transfer_between_remotes. * caf/single.c: Implement transfer_between_remotes. gcc/testsuite/ChangeLog: * gfortran.dg/coarray_lib_comm_1.f90: Fix up scan_trees.
This commit is contained in:
Andre Vehreschild
parent
69eb02682b
commit
8bf0ee8d62
9 changed files with 1478 additions and 1033 deletions
|
|
@ -1351,12 +1351,6 @@ rewrite_caf_send (gfc_code *c)
|
|||
&& arg->next->next && arg->next->next->expr->expr_type == EXPR_VARIABLE)
|
||||
return;
|
||||
|
||||
if (gfc_is_coindexed (rhs))
|
||||
{
|
||||
c->resolved_isym->id = GFC_ISYM_CAF_SENDGET;
|
||||
return;
|
||||
}
|
||||
|
||||
send_to_remote_expr = create_send_callback (lhs, rhs);
|
||||
send_to_remote_hash_expr = gfc_get_expr ();
|
||||
send_to_remote_hash_expr->expr_type = EXPR_CONSTANT;
|
||||
|
|
@ -1372,6 +1366,28 @@ rewrite_caf_send (gfc_code *c)
|
|||
arg = arg->next;
|
||||
arg->expr = send_to_remote_expr;
|
||||
gfc_add_caf_accessor (send_to_remote_hash_expr, send_to_remote_expr);
|
||||
|
||||
if (gfc_is_coindexed (rhs))
|
||||
{
|
||||
gfc_expr *get_from_remote_expr, *get_from_remote_hash_expr;
|
||||
|
||||
c->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SENDGET);
|
||||
get_from_remote_expr = create_get_callback (rhs);
|
||||
get_from_remote_hash_expr = gfc_get_expr ();
|
||||
get_from_remote_hash_expr->expr_type = EXPR_CONSTANT;
|
||||
get_from_remote_hash_expr->ts.type = BT_INTEGER;
|
||||
get_from_remote_hash_expr->ts.kind = gfc_default_integer_kind;
|
||||
get_from_remote_hash_expr->where = rhs->where;
|
||||
mpz_init_set_ui (get_from_remote_hash_expr->value.integer,
|
||||
gfc_hash_value (get_from_remote_expr->symtree->n.sym));
|
||||
arg->next = gfc_get_actual_arglist ();
|
||||
arg = arg->next;
|
||||
arg->expr = get_from_remote_hash_expr;
|
||||
arg->next = gfc_get_actual_arglist ();
|
||||
arg = arg->next;
|
||||
arg->expr = get_from_remote_expr;
|
||||
gfc_add_caf_accessor (get_from_remote_hash_expr, get_from_remote_expr);
|
||||
}
|
||||
}
|
||||
|
||||
static int
|
||||
|
|
@ -1451,7 +1467,9 @@ coindexed_code_callback (gfc_code **c, int *walk_subtrees,
|
|||
*walk_subtrees = 0;
|
||||
break;
|
||||
case GFC_ISYM_CAF_SENDGET:
|
||||
// rewrite_caf_sendget (*c);
|
||||
/* Seldomly this routine is called again with the symbol already
|
||||
changed to CAF_SENDGET. Do not process the subtree again. The
|
||||
rewrite has already been done by rewrite_caf_send (). */
|
||||
*walk_subtrees = 0;
|
||||
break;
|
||||
case GFC_ISYM_ATOMIC_ADD:
|
||||
|
|
|
|||
|
|
@ -4214,6 +4214,7 @@ future implementation of teams. It is about to change without further notice.
|
|||
* _gfortran_caf_get_from_remote:: Getting data from a remote image using a remote side accessor
|
||||
* _gfortran_caf_is_present_on_remote:: Check that a coarray or a part of it is allocated on the remote image
|
||||
* _gfortran_caf_send_to_remote:: Send data to a remote image using a remote side accessor to store it
|
||||
* _gfortran_caf_transfer_between_remotes:: Initiate data transfer between to remote images
|
||||
* _gfortran_caf_sendget_by_ref:: Sending data between remote images using enhanced references
|
||||
* _gfortran_caf_lock:: Locking a lock variable
|
||||
* _gfortran_caf_unlock:: Unlocking a lock variable
|
||||
|
|
@ -5153,6 +5154,111 @@ The implementation has to take care that it handles this case, e.g. using
|
|||
@end table
|
||||
|
||||
|
||||
@node _gfortran_caf_transfer_between_remotes
|
||||
@subsection @code{_gfortran_caf_transfer_between_remotes} --- Initiate data transfer between to remote images
|
||||
@cindex Coarray, _gfortran_caf_transfer_between_remotes
|
||||
|
||||
@table @asis
|
||||
@item @emph{Description}:
|
||||
Initiates a transfer of data from one remote image to another remote image.
|
||||
The call modifies the memory of the receiving remote image given by
|
||||
@code{dst_image_index}. The @code{src_image_index}'s memory is not modified.
|
||||
The call returns when the transfer has commenced.
|
||||
|
||||
@item @emph{Syntax}:
|
||||
@code{void _gfortran_caf_transfer_between_remotes (caf_token_t dst_token,
|
||||
gfc_descriptor_t *opt_dst_desc, size_t *opt_dst_charlen,
|
||||
const int dst_image_index, const int dst_access_index, void *dst_add_data,
|
||||
const size_t dst_add_data_size, caf_token_t src_token,
|
||||
const gfc_descriptor_t *opt_src_desc, const size_t *opt_src_charlen,
|
||||
const int src_image_index, const int src_access_index, void *src_add_data,
|
||||
const size_t src_add_data_size, const size_t src_size,
|
||||
const bool scalar_transfer, int *dst_stat, int *src_stat, caf_team_t *dst_team,
|
||||
int *dst_team_number, caf_team_t *src_team, int *src_team_number)
|
||||
}
|
||||
|
||||
@item @emph{Arguments}:
|
||||
@multitable @columnfractions .15 .70
|
||||
@item @var{dst_token} @tab intent(in) An opaque pointer identifying the coarray
|
||||
on the receiving image.
|
||||
@item @var{opt_dst_desc} @tab intent(inout) A pointer to the descriptor when
|
||||
the object identified by @var{dst_token} is an array with a descriptor. The
|
||||
parameter needs to be set to @code{NULL}, when @var{dst_token} identifies a
|
||||
scalar or is an array without a descriptor.
|
||||
@item @var{opt_dst_charlen} @tab intent(in) When the object to modify on the
|
||||
receiving image is a char array with deferred length, then this parameter needs
|
||||
to be set to point to its length. Else the parameter needs to be set to
|
||||
@code{NULL}.
|
||||
@item @var{dst_image_index} @tab intent(in) The ID of the receiving/destination
|
||||
remote image; must be a positive number. @code{this_image ()} is valid.
|
||||
@item @var{dst_access_index} @tab intent(in) The index of the accessor to
|
||||
execute on the receiving image as returned by
|
||||
@code{_gfortran_caf_get_remote_function_index ()}.
|
||||
@item @var{dst_add_data} @tab intent(inout) Additional data needed in the
|
||||
accessor on the receiving side. I.e., when an array reference uses a local
|
||||
variable @var{v}, it is transported in this structure and all references in the
|
||||
accessor are rewritten to access the member. The data in the structure of
|
||||
@var{dst_add_data} may be changed by the accessor, but these changes are lost to
|
||||
the calling Fortran program.
|
||||
@item @var{dst_add_data_size} @tab intent(in) The size of the
|
||||
@var{dst_add_data} structure.
|
||||
@item @var{src_token} @tab intent(in) An opaque pointer identifying the coarray
|
||||
on the sending image.
|
||||
@item @var{opt_src_desc} @tab intent(inout) A pointer to the descriptor when
|
||||
the object identified by @var{src_token} is an array with a descriptor. The
|
||||
parameter needs to be set to @code{NULL}, when @var{src_token} identifies a
|
||||
scalar or is an array without a descriptor.
|
||||
@item @var{opt_src_charlen} @tab intent(in) When the object to get from the
|
||||
source image is a char array with deferred length, then this parameter needs
|
||||
to be set to point to its length. Else the parameter needs to be set to
|
||||
@code{NULL}.
|
||||
@item @var{src_image_index} @tab intent(in) The ID of the sending/source
|
||||
remote image; must be a positive number. @code{this_image ()} is valid.
|
||||
@item @var{src_access_index} @tab intent(in) The index of the accessor to
|
||||
execute on the sending image as returned by
|
||||
@code{_gfortran_caf_get_remote_function_index ()}.
|
||||
@item @var{src_add_data} @tab intent(inout) Additional data needed in the
|
||||
accessor on the sending side. I.e., when an array reference uses a local
|
||||
variable @var{v}, it is transported in this structure and all references in the
|
||||
accessor are rewritten to access the member. The data in the structure of
|
||||
@var{src_add_data} may be changed by the accessor, but these changes are lost to
|
||||
the calling Fortran program.
|
||||
@item @var{src_add_data_size} @tab intent(in) The size of the
|
||||
@var{src_add_data} structure.
|
||||
@item @var{src_size} @tab intent(in) The size of data expected to be transferred
|
||||
between the images. If the data type to get is a string or string array,
|
||||
then this needs to be set to the byte size of each character, i.e. @code{4} for
|
||||
a @code{CHARACTER (KIND=4)} string. The length of the string is then given
|
||||
in @code{opt_src_charlen} and @code{opt_dst_charlen} (also for string arrays).
|
||||
@item @var{scalar_transfer} @tab intent(in) Is set to true when the data to be
|
||||
transfered between the two images is not an array with a descriptor.
|
||||
@item @var{dst_stat} @tab intent(out) When non-@code{NULL} give the result of
|
||||
the operation on the receiving side, i.e., zero on success and non-zero on
|
||||
error. When @code{NULL} and an error occurs, then an error message is printed
|
||||
and the program is terminated.
|
||||
@item @var{src_stat} @tab intent(out) When non-@code{NULL} give the result of
|
||||
the operation on the sending side, i.e., zero on success and non-zero on error.
|
||||
When @code{NULL} and an error occurs, then an error message is printed and the
|
||||
program is terminated.
|
||||
@item @var{dst_team} @tab intent(in) The opaque team handle as returned by
|
||||
@code{FORM TEAM}. Unused at the moment.
|
||||
@item @var{dst_team_number} @tab intent(in) The number of the team this access
|
||||
is to be part of. Unused at the moment.
|
||||
@item @var{src_team} @tab intent(in) The opaque team handle as returned by
|
||||
@code{FORM TEAM}. Unused at the moment.
|
||||
@item @var{src_team_number} @tab intent(in) The number of the team this access
|
||||
is to be part of. Unused at the moment.
|
||||
@end multitable
|
||||
|
||||
@item @emph{NOTES}
|
||||
It is permitted to have both @code{dst_image_index} and @code{src_image_index}
|
||||
equal the current image; the memory to send the data to and the memory to read
|
||||
for the data may (partially) overlap. The implementation has to take care that
|
||||
it handles this case, e.g. using @code{memmove} which handles (partially)
|
||||
overlapping memory.
|
||||
@end table
|
||||
|
||||
|
||||
@node _gfortran_caf_sendget_by_ref
|
||||
@subsection @code{_gfortran_caf_sendget_by_ref} --- Sending data between remote images using enhanced references on both sides
|
||||
@cindex Coarray, _gfortran_caf_sendget_by_ref
|
||||
|
|
|
|||
|
|
@ -3898,6 +3898,10 @@ add_subroutines (void)
|
|||
"y", BT_REAL, dr, REQUIRED, INTENT_IN);
|
||||
make_from_module();
|
||||
|
||||
add_sym_2s (GFC_PREFIX ("caf_sendget"), GFC_ISYM_CAF_SENDGET, CLASS_IMPURE,
|
||||
BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL, "x", BT_REAL, dr,
|
||||
REQUIRED, INTENT_OUT, "y", BT_REAL, dr, REQUIRED, INTENT_IN);
|
||||
make_from_module ();
|
||||
|
||||
/* More G77 compatibility garbage. */
|
||||
add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
|
||||
|
|
|
|||
|
|
@ -149,6 +149,7 @@ tree gfor_fndecl_caf_register_accessors_finish;
|
|||
tree gfor_fndecl_caf_get_remote_function_index;
|
||||
tree gfor_fndecl_caf_get_from_remote;
|
||||
tree gfor_fndecl_caf_send_to_remote;
|
||||
tree gfor_fndecl_caf_transfer_between_remotes;
|
||||
|
||||
tree gfor_fndecl_caf_sync_all;
|
||||
tree gfor_fndecl_caf_sync_memory;
|
||||
|
|
@ -4144,9 +4145,19 @@ gfc_build_builtin_function_decls (void)
|
|||
pvoid_type_node, size_type_node, pint_type, pvoid_type_node,
|
||||
pint_type);
|
||||
|
||||
gfor_fndecl_caf_transfer_between_remotes
|
||||
= gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX ("caf_transfer_between_remotes")),
|
||||
". r r r r r r r r r r r r r r r r w w r r ", void_type_node, 20,
|
||||
pvoid_type_node, pvoid_type_node, psize_type, integer_type_node,
|
||||
integer_type_node, pvoid_type_node, size_type_node, pvoid_type_node,
|
||||
pvoid_type_node, psize_type, integer_type_node, integer_type_node,
|
||||
pvoid_type_node, size_type_node, size_type_node, boolean_type_node,
|
||||
pint_type, pint_type, pvoid_type_node, pint_type);
|
||||
|
||||
gfor_fndecl_caf_sync_all = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("caf_sync_all")), ". w w . ", void_type_node,
|
||||
3, pint_type, pchar_type_node, size_type_node);
|
||||
get_identifier (PREFIX ("caf_sync_all")), ". w w . ", void_type_node, 3,
|
||||
pint_type, pchar_type_node, size_type_node);
|
||||
|
||||
gfor_fndecl_caf_sync_memory = gfc_build_library_function_decl_with_spec (
|
||||
get_identifier (PREFIX("caf_sync_memory")), ". w w . ", void_type_node,
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
|
|
@ -897,6 +897,7 @@ extern GTY(()) tree gfor_fndecl_caf_register_accessors_finish;
|
|||
extern GTY(()) tree gfor_fndecl_caf_get_remote_function_index;
|
||||
extern GTY(()) tree gfor_fndecl_caf_get_from_remote;
|
||||
extern GTY(()) tree gfor_fndecl_caf_send_to_remote;
|
||||
extern GTY(()) tree gfor_fndecl_caf_transfer_between_remotes;
|
||||
|
||||
extern GTY(()) tree gfor_fndecl_caf_sync_all;
|
||||
extern GTY(()) tree gfor_fndecl_caf_sync_memory;
|
||||
|
|
|
|||
|
|
@ -39,5 +39,7 @@ if (any (A-B /= 0)) STOP 4
|
|||
end
|
||||
|
||||
! { dg-final { scan-tree-dump-times "_gfortran_caf_get_from_remote" 4 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "_gfortran_caf_sendget \\\(caf_token.\[0-9\]+, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, caf_token.\[0-9\]+, \\\(integer\\\(kind=\[48\]\\\)\\\) parm.\[0-9\]+.data - \\\(integer\\\(kind=\[48\]\\\)\\\) a, 1, &parm.\[0-9\]+, 0B, 4, 4, 1, 0B\\\);" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "_gfortran_caf_transfer_between_remotes" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-not "_gfortran_caf_transfer_get" "original" } }
|
||||
! { dg-final { scan-tree-dump-not "_gfortran_caf_transfer_send" "original" } }
|
||||
|
||||
|
|
|
|||
|
|
@ -261,6 +261,18 @@ void _gfortran_caf_send_to_remote (
|
|||
void *add_data, const size_t add_data_size, int *stat, caf_team_t *team,
|
||||
int *team_number);
|
||||
|
||||
void _gfortran_caf_transfer_between_remotes (
|
||||
caf_token_t dst_token, gfc_descriptor_t *opt_dst_desc,
|
||||
size_t *opt_dst_charlen, const int dst_image_index,
|
||||
const int dst_access_index, void *dst_add_data,
|
||||
const size_t dst_add_data_size, caf_token_t src_token,
|
||||
const gfc_descriptor_t *opt_src_desc, const size_t *opt_src_charlen,
|
||||
const int src_image_index, const int src_access_index, void *src_add_data,
|
||||
const size_t src_add_data_size, const size_t src_size,
|
||||
const bool scalar_transfer, int *dst_stat, int *src_stat,
|
||||
caf_team_t *dst_team, int *dst_team_number, caf_team_t *src_team,
|
||||
int *src_team_number);
|
||||
|
||||
void _gfortran_caf_atomic_define (caf_token_t, size_t, int, void *, int *,
|
||||
int, int);
|
||||
void _gfortran_caf_atomic_ref (caf_token_t, size_t, int, void *, int *,
|
||||
|
|
|
|||
|
|
@ -3023,6 +3023,75 @@ _gfortran_caf_send_to_remote (
|
|||
opt_src_charlen);
|
||||
}
|
||||
|
||||
void
|
||||
_gfortran_caf_transfer_between_remotes (
|
||||
caf_token_t dst_token, gfc_descriptor_t *opt_dst_desc,
|
||||
size_t *opt_dst_charlen, const int dst_image_index,
|
||||
const int dst_access_index, void *dst_add_data,
|
||||
const size_t dst_add_data_size __attribute__ ((unused)),
|
||||
caf_token_t src_token, const gfc_descriptor_t *opt_src_desc,
|
||||
const size_t *opt_src_charlen, const int src_image_index,
|
||||
const int src_access_index, void *src_add_data,
|
||||
const size_t src_add_data_size __attribute__ ((unused)),
|
||||
const size_t src_size, const bool scalar_transfer, int *dst_stat,
|
||||
int *src_stat, caf_team_t *dst_team __attribute__ ((unused)),
|
||||
int *dst_team_number __attribute__ ((unused)),
|
||||
caf_team_t *src_team __attribute__ ((unused)),
|
||||
int *src_team_number __attribute__ ((unused)))
|
||||
{
|
||||
caf_single_token_t src_single_token = TOKEN (src_token),
|
||||
dst_single_token = TOKEN (dst_token);
|
||||
void *src_ptr
|
||||
= opt_src_desc ? (void *) opt_src_desc : src_single_token->memptr;
|
||||
int32_t free_buffer;
|
||||
void *dst_ptr
|
||||
= opt_dst_desc ? (void *) opt_dst_desc : dst_single_token->memptr;
|
||||
void *transfer_ptr, *buffer;
|
||||
GFC_FULL_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) *transfer_desc = NULL;
|
||||
struct caf_single_token cb_token;
|
||||
cb_token.memptr = src_add_data;
|
||||
cb_token.desc = NULL;
|
||||
cb_token.owning_memory = false;
|
||||
|
||||
if (src_stat)
|
||||
*src_stat = 0;
|
||||
|
||||
if (!scalar_transfer)
|
||||
{
|
||||
const size_t desc_size = sizeof (*transfer_desc);
|
||||
transfer_desc = alloca (desc_size);
|
||||
memset (transfer_desc, 0, desc_size);
|
||||
transfer_ptr = transfer_desc;
|
||||
}
|
||||
else if (opt_dst_charlen)
|
||||
transfer_ptr = alloca (*opt_dst_charlen * src_size);
|
||||
else
|
||||
{
|
||||
buffer = NULL;
|
||||
transfer_ptr = &buffer;
|
||||
}
|
||||
|
||||
accessor_hash_table[src_access_index].u.getter (
|
||||
src_add_data, &src_image_index, transfer_ptr, &free_buffer, src_ptr,
|
||||
&cb_token, 0, opt_dst_charlen, opt_src_charlen);
|
||||
|
||||
if (dst_stat)
|
||||
*dst_stat = 0;
|
||||
|
||||
if (scalar_transfer)
|
||||
transfer_ptr = *(void **) transfer_ptr;
|
||||
|
||||
cb_token.memptr = dst_add_data;
|
||||
accessor_hash_table[dst_access_index].u.receiver (dst_add_data,
|
||||
&dst_image_index, dst_ptr,
|
||||
transfer_ptr, &cb_token, 0,
|
||||
opt_dst_charlen,
|
||||
opt_src_charlen);
|
||||
|
||||
if (free_buffer)
|
||||
free (transfer_desc ? transfer_desc->base_addr : transfer_ptr);
|
||||
}
|
||||
|
||||
void
|
||||
_gfortran_caf_atomic_define (caf_token_t token, size_t offset,
|
||||
int image_index __attribute__ ((unused)),
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue