From 0b03498a33ea6f7374c8a322445fa3ee2716e52a Mon Sep 17 00:00:00 2001 From: Gilles Gouaillardet Date: Fri, 29 Aug 2025 14:01:58 +0900 Subject: [PATCH] mpi: exchange an index instead of MPI_Win A requirement is that all the ranks of a given MPI window share the same id (so it can be passed to an other rank). There is no such thing mandated by the MPI standard, this is absolutely not the case with Open MPI (and its derivatives) and though it seems to work with MPICH (and its derivatives) this is not something guaranted by the implementation. A reliable mechanism must be implemented for this to work with any MPI library. This patch is a proof of concept that introduces two subroutines: - `MPI_Win CAF_idx2win(int idx)` - `int CAF_win2idx(MPI_Win win)` that do the conversion between a MPI_Win opaque handler and and index that meet the Coarrays requirements. These subroutines are implemented with `MPI_Win_f2c()` and `MPI_Win_c2f()`. THIS IS NOT A CORRECT IMPLEMENTATIONi since the MPI Standard offer no guarantee that the Fortran ID meet the requirements for Coarrays. OpenCoarrays have been lucky so far with MPICH, and it may be equally lucky with Open MPI too, but that CANNOT be taken for granted. Refs #793 Signed-off-by: Gilles Gouaillardet --- src/runtime-libraries/mpi/CMakeLists.txt | 5 ----- src/runtime-libraries/mpi/mpi_caf.c | 27 ++++++++++++++++-------- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/src/runtime-libraries/mpi/CMakeLists.txt b/src/runtime-libraries/mpi/CMakeLists.txt index b97f305c..c74b5277 100644 --- a/src/runtime-libraries/mpi/CMakeLists.txt +++ b/src/runtime-libraries/mpi/CMakeLists.txt @@ -146,11 +146,6 @@ set(HOST_NAME ${HOST_NAME} PARENT_SCOPE) execute_process(COMMAND ${MPIEXEC_EXECUTABLE} --version OUTPUT_VARIABLE mpi_version_out) if (mpi_version_out MATCHES "[Oo]pen[ -][Mm][Pp][Ii]") - if ( gfortran_compiler AND ( NOT CMAKE_Fortran_COMPILER_VERSION VERSION_LESS 14.0.0 ) ) - # OpenMPI uses addresses for windows instead of identical ids on all images for the same token. - # Therefore we can't use it (yet; and probably never). - message( FATAL_ERROR "OpenMPI is incompatible with gfortran's coarray implementation from gfortran version 15 on. Please use a different MPI implementation!") - endif () message( STATUS "OpenMPI detected") set_property(GLOBAL PROPERTY openmpi true) # Write out a host file because OMPI's mpiexec is dumb diff --git a/src/runtime-libraries/mpi/mpi_caf.c b/src/runtime-libraries/mpi/mpi_caf.c index 8de5ad84..216230e3 100644 --- a/src/runtime-libraries/mpi/mpi_caf.c +++ b/src/runtime-libraries/mpi/mpi_caf.c @@ -65,6 +65,14 @@ static char *caf_ref_type_str[] = { "CAF_REF_STATIC_ARRAY", }; +static inline MPI_Win CAF_idx2win(int idx) { + return MPI_Win_f2c(idx); +} + +static inline int CAF_win2idx(MPI_Win win) { + return MPI_Win_c2f(win); +} + #ifndef EXTRA_DEBUG_OUTPUT #define dprint(...) #define chk_err(...) @@ -310,7 +318,7 @@ typedef struct int flags; size_t transfer_size; size_t opt_charlen; - MPI_Win win; + int win; int dest_image; int dest_tag; int accessor_index; @@ -942,7 +950,7 @@ handle_transfer_message(ct_msg_t *msg, void *baseptr) { int flag; dprint("ct: self handling message of size %zd.\n", send_size); - ierr = MPI_Win_get_attr(send_msg->win, MPI_WIN_BASE, &baseptr, &flag); + ierr = MPI_Win_get_attr(CAF_idx2win(send_msg->win), MPI_WIN_BASE, &baseptr, &flag); chk_err(ierr); handle_send_message(send_msg, baseptr); } @@ -970,9 +978,10 @@ handle_incoming_message(MPI_Status *status_in, MPI_Message *msg_han, dprint("ct: Received request of size %d (sizeof(ct_msg) = %zd).\n", cnt, sizeof(ct_msg_t)); - if (msg->win != MPI_WIN_NULL) + MPI_Win win = CAF_idx2win(msg->win); + if (win != MPI_WIN_NULL) { - ierr = MPI_Win_get_attr(msg->win, MPI_WIN_BASE, &baseptr, &flag); + ierr = MPI_Win_get_attr(win, MPI_WIN_BASE, &baseptr, &flag); chk_err(ierr); } else @@ -5600,7 +5609,7 @@ PREFIX(get_from_remote)(caf_token_t token, const gfc_descriptor_t *opt_src_desc, msg->cmd = remote_command_get; msg->transfer_size = dst_size; msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); + msg->win = CAF_win2idx(*TOKEN(token)); msg->dest_image = mpi_this_image; msg->dest_tag = CAF_CT_TAG + 1; msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; @@ -5786,7 +5795,7 @@ PREFIX(is_present_on_remote)(caf_token_t token, const int image_index, msg->cmd = remote_command_present; msg->transfer_size = 1; msg->opt_charlen = 0; - msg->win = *TOKEN(token); + msg->win = CAF_win2idx(*TOKEN(token)); msg->dest_image = mpi_this_image; msg->dest_tag = CAF_CT_TAG + 1; msg->dest_opt_charlen = 0; @@ -6001,7 +6010,7 @@ PREFIX(send_to_remote)(caf_token_t token, gfc_descriptor_t *opt_dst_desc, msg->cmd = remote_command_send; msg->transfer_size = src_size; msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - msg->win = *TOKEN(token); + msg->win = CAF_win2idx(*TOKEN(token)); msg->dest_image = mpi_this_image; msg->dest_tag = CAF_CT_TAG + 1; msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; @@ -6264,7 +6273,7 @@ PREFIX(transfer_between_remotes)( full_msg->cmd = remote_command_transfer; full_msg->transfer_size = src_size; full_msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - full_msg->win = *TOKEN(src_token); + full_msg->win = CAF_win2idx(*TOKEN(src_token)); full_msg->dest_image = dst_remote_image; full_msg->dest_tag = CAF_CT_TAG; full_msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1; @@ -6280,7 +6289,7 @@ PREFIX(transfer_between_remotes)( dst_msg->cmd = remote_command_send; dst_msg->transfer_size = src_size; dst_msg->opt_charlen = opt_src_charlen ? *opt_src_charlen : 0; - dst_msg->win = *TOKEN(dst_token); + dst_msg->win = CAF_win2idx(*TOKEN(dst_token)); dst_msg->dest_image = mpi_this_image; dst_msg->dest_tag = CAF_CT_TAG + 1; dst_msg->dest_opt_charlen = opt_dst_charlen ? *opt_dst_charlen : 1;