From 090549885d1b83e9f7d44a625a92415d500f5912 Mon Sep 17 00:00:00 2001 From: Edgar Gabriel Date: Mon, 26 May 2025 12:29:27 -0500 Subject: [PATCH 1/8] mpi: add request_get_status_all/any/some Signed-off-by: Edgar Gabriel --- ompi/include/mpi.h.in | 18 ++++ ompi/mpi/c/Makefile.am | 3 + ompi/mpi/c/request_get_status_all.c.in | 131 +++++++++++++++++++++++ ompi/mpi/c/request_get_status_any.c.in | 132 ++++++++++++++++++++++++ ompi/mpi/c/request_get_status_some.c.in | 127 +++++++++++++++++++++++ 5 files changed, 411 insertions(+) create mode 100644 ompi/mpi/c/request_get_status_all.c.in create mode 100644 ompi/mpi/c/request_get_status_any.c.in create mode 100644 ompi/mpi/c/request_get_status_some.c.in diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index e838fe66061..1fef26c41db 100644 --- a/ompi/include/mpi.h.in +++ b/ompi/include/mpi.h.in @@ -2226,6 +2226,15 @@ OMPI_DECLSPEC MPI_Request MPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int MPI_Request_free(MPI_Request *request); OMPI_DECLSPEC int MPI_Request_get_status(MPI_Request request, int *flag, MPI_Status *status); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int MPI_Request_get_status_all(int count, MPI_Request array_of_requests[], int *flag, + MPI_Status array_of_statuses[]); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int MPI_Request_get_status_any(int count, MPI_Request array_of_requests[], int *index, + int *flag, MPI_Status *status); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int MPI_Request_get_status_some(int incount, MPI_Request array_of_requests[], int *outcount, + int array_of_indices[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int MPI_Rget(void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); @@ -3385,6 +3394,15 @@ OMPI_DECLSPEC MPI_Request PMPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int PMPI_Request_free(MPI_Request *request); OMPI_DECLSPEC int PMPI_Request_get_status(MPI_Request request, int *flag, MPI_Status *status); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int PMPI_Request_get_status_all(int count, MPI_Request array_of_requests[], int *flag, + MPI_Status array_of_statuses[]); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int PMPI_Request_get_status_any(int count, MPI_Request array_of_requests[], int *index, + int *flag, MPI_Status *status); +/* should be 'const MPI_Request array_of_requests[]' */ +OMPI_DECLSPEC int PMPI_Request_get_status_some(int incount, MPI_Request array_of_requests[], int *outcount, + int array_of_indices[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int PMPI_Rget(void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); diff --git a/ompi/mpi/c/Makefile.am b/ompi/mpi/c/Makefile.am index c8fad462772..70c080e4d2d 100644 --- a/ompi/mpi/c/Makefile.am +++ b/ompi/mpi/c/Makefile.am @@ -345,6 +345,9 @@ prototype_sources = \ request_f2c.c.in \ request_free.c.in \ request_get_status.c.in \ + request_get_status_all.c.in \ + request_get_status_any.c.in \ + request_get_status_some.c.in \ rget_accumulate.c.in \ rget.c.in \ rput.c.in \ diff --git a/ompi/mpi/c/request_get_status_all.c.in b/ompi/mpi/c/request_get_status_all.c.in new file mode 100644 index 00000000000..2d72999c223 --- /dev/null +++ b/ompi/mpi/c/request_get_status_all.c.in @@ -0,0 +1,131 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2008 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2010 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/request/grequest.h" +#include "ompi/memchecker.h" + +/* Non blocking test for the request status. Upon completion, the request will + * not be freed (unlike the test function). A subsequent call to test, wait + * or free should be executed on the request. + */ +PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_INOUT requests:count, INT_OUT flag, + STATUS_OUT statuses:count) +{ + MEMCHECKER( + int j; + for (j = 0; j< count; j++) { + memchecker_request(&requests[j]); + } + ); + + if( MPI_PARAM_CHECK ) { + int rc = MPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == requests) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, count) ) { + rc = MPI_ERR_REQUEST; + } + } + if ((NULL == flag) || (count < 0)) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == count)) { + *flag = true; + return MPI_SUCCESS; + } + + bool all_done; + bool one_done; + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + int do_it_once = 0; + recheck_request_status: +#endif + + opal_atomic_mb(); + int i; + all_done = true; + for (i = 0; i < count; i++) { + one_done = false; + if( (requests[i] == MPI_REQUEST_NULL) || (requests[i]->req_state == OMPI_REQUEST_INACTIVE) || + (requests[i]->req_complete) ) { + continue; + } + if (!one_done) { + all_done = false; + break; + } + } + + if (!all_done) { +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + if( 0 == do_it_once ) { + /* If we run the opal_progress then check the status of the + request before leaving. We will call the opal_progress only + once per call. */ + opal_progress(); + do_it_once++; + goto recheck_request_status; + } +#endif + *flag = false; + return MPI_SUCCESS; + } + + for (i = 0; i < count; i++) { + if( (requests[i] == MPI_REQUEST_NULL) || (requests[i]->req_state == OMPI_REQUEST_INACTIVE) ) { + if (MPI_STATUS_IGNORE != statuses) { + OMPI_COPY_STATUS(&statuses[i], ompi_status_empty, false); + } + } + if (requests[i]->req_complete ) { + /* If this is a generalized request, we *always* have to call + the query function to get the status (MPI-2:8.2), even if + the user passed STATUS_IGNORE. */ + if (OMPI_REQUEST_GEN == requests[i]->req_type) { + ompi_grequest_invoke_query(requests[i], &requests[i]->req_status); + } + if (MPI_STATUS_IGNORE != statuses) { + OMPI_COPY_STATUS(&statuses[i], requests[i]->req_status, false); + } + } + } + + *flag = true; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/request_get_status_any.c.in b/ompi/mpi/c/request_get_status_any.c.in new file mode 100644 index 00000000000..5c45f4ee534 --- /dev/null +++ b/ompi/mpi/c/request_get_status_any.c.in @@ -0,0 +1,132 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2008 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2010 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/request/grequest.h" +#include "ompi/memchecker.h" + +/* Non blocking test for the request status. Upon completion, the request will + * not be freed (unlike the test function). A subsequent call to test, wait + * or free should be executed on the request. + */ +PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_INOUT requests:count, INT_OUT indx, + INT_OUT flag, STATUS_OUT status) +{ + + MEMCHECKER( + int j; + for (j = 0; j< count; j++) { + memchecker_request(&requests[j]); + } + ); + + if( MPI_PARAM_CHECK ) { + int rc = MPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == requests) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, count) ) { + rc = MPI_ERR_REQUEST; + } + } + if ((NULL == flag) || (count < 0) || (NULL == indx) ) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == count)) { + *flag = true; + *indx = MPI_UNDEFINED; + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + } + return MPI_SUCCESS; + } + + bool all_inactive; + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + int do_it_once = 0; + recheck_request_status: +#endif + + opal_atomic_mb(); + all_inactive = true; + int i; + for (i = 0; i < count; i++) { + if ( (requests[i] == MPI_REQUEST_NULL) || (requests[i]->req_state == OMPI_REQUEST_INACTIVE) ) { + continue; + } + if (requests[i]->req_complete ) { + *flag = true; + *indx = i; + /* If this is a generalized request, we *always* have to call + the query function to get the status (MPI-2:8.2), even if + the user passed STATUS_IGNORE. */ + if (OMPI_REQUEST_GEN == requests[i]->req_type) { + ompi_grequest_invoke_query(requests[i], &requests[i]->req_status); + } + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, requests[i]->req_status, false); + } + return MPI_SUCCESS; + } else { + /* regular request but not complete */ + all_inactive = false; + } + } + + if (all_inactive) { + *flag = true; + *indx = MPI_UNDEFINED; + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + } + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + if( 0 == do_it_once ) { + /* If we run the opal_progress then check the status of the + request before leaving. We will call the opal_progress only + once per call. */ + opal_progress(); + do_it_once++; + goto recheck_request_status; + } +#endif + *flag = false; + *indx = MPI_UNDEFINED; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/request_get_status_some.c.in b/ompi/mpi/c/request_get_status_some.c.in new file mode 100644 index 00000000000..9a2714e8088 --- /dev/null +++ b/ompi/mpi/c/request_get_status_some.c.in @@ -0,0 +1,127 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2008 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2010 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/request/grequest.h" +#include "ompi/memchecker.h" + +/* Non blocking test for the request status. Upon completion, the request will + * not be freed (unlike the test function). A subsequent call to test, wait + * or free should be executed on the request. + */ +PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_INOUT requests:count, INT_OUT outcount, + INT_OUT indices, STATUS_OUT statuses:count) +{ + + MEMCHECKER( + int j; + for (j = 0; j< incount; j++) { + memchecker_request(&requests[j]); + } + ); + + if( MPI_PARAM_CHECK ) { + int rc = MPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == requests) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, incount) ) { + rc = MPI_ERR_REQUEST; + } + } + if ((NULL == outcount) || (incount < 0) || (NULL == indices) ) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == incount)) { + *outcount = 0; + return MPI_SUCCESS; + } + + bool all_inactive; + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + int do_it_once = 0; + recheck_request_status: +#endif + + opal_atomic_mb(); + int i; + int indx = 0; + all_inactive = true; + for (i = 0; i < incount; i++) { + if ( (requests[i] == MPI_REQUEST_NULL) || (requests[i]->req_state == OMPI_REQUEST_INACTIVE) ) { + continue; + } + all_inactive = false; + if (requests[i]->req_complete ) { + indices[indx] = i; + /* If this is a generalized request, we *always* have to call + the query function to get the status (MPI-2:8.2), even if + the user passed STATUS_IGNORE. */ + if (OMPI_REQUEST_GEN == requests[i]->req_type) { + ompi_grequest_invoke_query(requests[i], &requests[i]->req_status); + } + if (MPI_STATUS_IGNORE != statuses) { + OMPI_COPY_STATUS(&statuses[indx], requests[i]->req_status, false); + } + indx++; + } + } + + if (all_inactive) { + *outcount = MPI_UNDEFINED; + return MPI_SUCCESS; + } + + if (0 < indx) { + *outcount = indx; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + if( 0 == do_it_once ) { + /* If we run the opal_progress then check the status of the + request before leaving. We will call the opal_progress only + once per call. */ + opal_progress(); + do_it_once++; + goto recheck_request_status; + } +#endif + + *outcount = 0; + return MPI_SUCCESS; +} From 5bcd16f097367b34cb899b5fff5e27fe246e59d7 Mon Sep 17 00:00:00 2001 From: Edgar Gabriel Date: Mon, 26 May 2025 15:00:03 -0500 Subject: [PATCH 2/8] docs: add man-pages for new functions add the man pages for the newly implemented MPI_Request_get_status_all/any/some functions. Signed-off-by: Edgar Gabriel --- docs/Makefile.am | 3 ++ .../man3/MPI_Request_get_status_all.3.rst | 48 +++++++++++++++++ .../man3/MPI_Request_get_status_any.3.rst | 53 +++++++++++++++++++ .../man3/MPI_Request_get_status_some.3.rst | 52 ++++++++++++++++++ docs/man-openmpi/man3/index.rst | 3 ++ 5 files changed, 159 insertions(+) create mode 100644 docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst diff --git a/docs/Makefile.am b/docs/Makefile.am index f6993850939..98d3622dd99 100644 --- a/docs/Makefile.am +++ b/docs/Makefile.am @@ -387,6 +387,9 @@ OMPI_MAN3 = \ MPI_Request_f2c.3 \ MPI_Request_free.3 \ MPI_Request_get_status.3 \ + MPI_Request_get_status_all.3 \ + MPI_Request_get_status_any.3 \ + MPI_Request_get_status_some.3 \ MPI_Rget.3 \ MPI_Rget_accumulate.3 \ MPI_Rput.3 \ diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst new file mode 100644 index 00000000000..35f110ed811 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst @@ -0,0 +1,48 @@ +.. _mpi_request_get_status_all: + + +MPI_Request_get_status_all +========================== + +.. include_body + +:ref:`MPI_Request_get_status_all` |mdash| Access information associated with a +request without freeing the request. + +.. The following file was automatically generated +.. include:: ./bindings/mpi_request_get_status_all.rst + +INPUT PARAMETER +--------------- +* ``count``: List length (non-negative integer) +* ``array_of_requests``: Array of requests (array of handles). + +OUTPUT PARAMETERS +----------------- +* ``flag``: Boolean flag, same as from :ref:`MPI_Test` (logical). +* ``array_of_statuses``: Array of ``MPI_Status`` objects if flag is true (array of status). +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +:ref:`MPI_Request_get_status_all` sets ``flag = true`` if all +operations associated with *active* handles in the array have completed. +In this case, each status entry that corresponds to an active request +is set to the status of the corresponding operation. It +does not deallocate or deactivate the request; a subsequent call to +test, wait, or free should be executed with each of those requests. + +Each status entry that corresponds to a null or inactive handle is set +to empty. Otherwise, ``flag = false`` is returned and the values of the +status entries are undefined. + +If your application does not need to examine the *status* field, you can +save resources by using the predefined constant ``MPI_STATUS_IGNORE`` as a +special value for the ``array_of_statuses`` argument. + + +ERRORS +------ + +.. include:: ./ERRORS.rst diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst new file mode 100644 index 00000000000..f6572343b9c --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst @@ -0,0 +1,53 @@ +.. _mpi_request_get_status_any: + + +MPI_Request_get_status_any +========================== + +.. include_body + +:ref:`MPI_Request_get_status_any` |mdash| Access information associated with a +request without freeing the request. + +.. The following file was automatically generated +.. include:: ./bindings/mpi_request_get_status_any.rst + +INPUT PARAMETER +--------------- +* ``count``: List length (non-negative integer) +* ``array_of_requests``: Array of requests (array of handles). + +OUTPUT PARAMETERS +----------------- +* ``index``: Index of operation that completed (integer). +* ``flag``: Boolean flag, same as from :ref:`MPI_Test` (logical). +* ``status``: ``MPI_Status`` object if flag is true (status). +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +:ref:`MPI_Request_get_status_any` sets ``flag = true`` if either one +of the operations associated with active handles has completed. In +this case it returns in ``index`` the index of this request in the +array and the status of the operation in ``status``. It does not +deallocate or deactivate the request; a subsequent call to test, wait, +or free should be executed with that request. + +If no operation completed, it returns ``flag = false`` and a value of +``MPI_UNDEFINED`` in ``index``. ``status`` is undefined in this +scenario. + +If ``array_of_requests`` contains no active handles then the call +returns immediately with ``flag = true``, ``index = MPI_UNDEFINED``, +and an empty status. + +If your application does not need to examine the *status* field, you can +save resources by using the predefined constant ``MPI_STATUS_IGNORE`` as a +special value for the ``status`` argument. + + +ERRORS +------ + +.. include:: ./ERRORS.rst diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst new file mode 100644 index 00000000000..3c8033d3726 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst @@ -0,0 +1,52 @@ +.. _mpi_request_get_status_some: + + +MPI_Request_get_status_some +=========================== + +.. include_body + +:ref:`MPI_Request_get_status_some` |mdash| Access information associated with a +request without freeing the request. + +.. The following file was automatically generated +.. include:: ./bindings/mpi_request_get_status_some.rst + +INPUT PARAMETER +--------------- +* ``incount``: List length (non-negative integer). +* ``array_of_requests``: Array of requests (array of handles). + +OUTPUT PARAMETERS +----------------- +* ``outcount``: Number of completed requests (integer). +* ``array_of_indices``: Array of indices of operations that completed (array of integers). +* ``array_of_statuses``: Array of ``MPI_Status`` objects for operations that completed (array of status). +* ``ierror``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +:ref:`MPI_Request_get_status_some` returns in outcount the number of +requests from the list ``array_of_requests`` that have completed. The +first ``outcount`` locations of the array ``array_of_indices`` and +``array_of_statuses`` will contain the indices of the operations +within the array ``array_of_requests`` and the status of these +operations respectively. The array is indexed from zero in C and from +one in Fortran. It does not deallocate or deactivate the request; a +subsequent call to test, wait, or free should be executed with each completed +request. + +If no operation in ``array_of_requests`` is complete, it returns +``outcount = 0``. If all operations in ``array_of_requests`` are either +``MPI_REQUEST_NULL`` or inactive, ``outcount`` will be set to ``MPI_UNDEFINED``. + +If your application does not need to examine the *status* field, you can +save resources by using the predefined constant ``MPI_STATUS_IGNORE`` as a +special value for the ``array_of_statuses`` argument. + + +ERRORS +------ + +.. include:: ./ERRORS.rst diff --git a/docs/man-openmpi/man3/index.rst b/docs/man-openmpi/man3/index.rst index 8b880c33967..60f5e0b798c 100644 --- a/docs/man-openmpi/man3/index.rst +++ b/docs/man-openmpi/man3/index.rst @@ -309,6 +309,9 @@ MPI API manual pages (section 3) MPI_Request_f2c.3.rst MPI_Request_free.3.rst MPI_Request_get_status.3.rst + MPI_Request_get_status_all.3.rst + MPI_Request_get_status_any.3.rst + MPI_Request_get_status_some.3.rst MPI_Rget.3.rst MPI_Rget_accumulate.3.rst MPI_Rput.3.rst From c1423fc02944260911d51e4b26e3c5b996341ce5 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 27 May 2025 12:15:35 -0600 Subject: [PATCH 3/8] c-bindings: add support for const request args Three new functions were added to the MPI API as part of the 4.1 standard. These used an array of const MPI_Request s which the bindings code didn't support. This commit also fixes back the mpi.h prototypes to include the constants and required changes to the new template files. Signed-off-by: Howard Pritchard --- ompi/include/mpi.h.in | 12 +++++----- ompi/mpi/bindings/ompi_bindings/c_type.py | 27 +++++++++++++++++++++-- ompi/mpi/c/request_get_status_all.c.in | 4 ++-- ompi/mpi/c/request_get_status_any.c.in | 4 ++-- ompi/mpi/c/request_get_status_some.c.in | 4 ++-- 5 files changed, 37 insertions(+), 14 deletions(-) diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index 1fef26c41db..2f4b132077b 100644 --- a/ompi/include/mpi.h.in +++ b/ompi/include/mpi.h.in @@ -2227,13 +2227,13 @@ OMPI_DECLSPEC int MPI_Request_free(MPI_Request *request); OMPI_DECLSPEC int MPI_Request_get_status(MPI_Request request, int *flag, MPI_Status *status); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int MPI_Request_get_status_all(int count, MPI_Request array_of_requests[], int *flag, +OMPI_DECLSPEC int MPI_Request_get_status_all(int count, const MPI_Request array_of_requests[], int *flag, MPI_Status array_of_statuses[]); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int MPI_Request_get_status_any(int count, MPI_Request array_of_requests[], int *index, +OMPI_DECLSPEC int MPI_Request_get_status_any(int count, const MPI_Request array_of_requests[], int *index, int *flag, MPI_Status *status); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int MPI_Request_get_status_some(int incount, MPI_Request array_of_requests[], int *outcount, +OMPI_DECLSPEC int MPI_Request_get_status_some(int incount, const MPI_Request array_of_requests[], int *outcount, int array_of_indices[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int MPI_Rget(void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, @@ -3395,13 +3395,13 @@ OMPI_DECLSPEC int PMPI_Request_free(MPI_Request *request); OMPI_DECLSPEC int PMPI_Request_get_status(MPI_Request request, int *flag, MPI_Status *status); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int PMPI_Request_get_status_all(int count, MPI_Request array_of_requests[], int *flag, +OMPI_DECLSPEC int PMPI_Request_get_status_all(int count, const MPI_Request array_of_requests[], int *flag, MPI_Status array_of_statuses[]); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int PMPI_Request_get_status_any(int count, MPI_Request array_of_requests[], int *index, +OMPI_DECLSPEC int PMPI_Request_get_status_any(int count, const MPI_Request array_of_requests[], int *index, int *flag, MPI_Status *status); /* should be 'const MPI_Request array_of_requests[]' */ -OMPI_DECLSPEC int PMPI_Request_get_status_some(int incount, MPI_Request array_of_requests[], int *outcount, +OMPI_DECLSPEC int PMPI_Request_get_status_some(int incount, const MPI_Request array_of_requests[], int *outcount, int array_of_indices[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int PMPI_Rget(void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, diff --git a/ompi/mpi/bindings/ompi_bindings/c_type.py b/ompi/mpi/bindings/ompi_bindings/c_type.py index 532dfb88e37..510c606bea3 100644 --- a/ompi/mpi/bindings/ompi_bindings/c_type.py +++ b/ompi/mpi/bindings/ompi_bindings/c_type.py @@ -556,6 +556,31 @@ def type_text(self, enable_count=False): def argument(self): return f'(MPI_Request) {self.name}' +@Type.add_type('REQUEST_CONST', abi_type=['ompi']) +class TypeConstRequest(TypeRequest): + + def type_text(self, enable_count=False): + return f'const MPI_Request *' + + def parameter(self, enable_count=False, **kwargs): + if self.count_param is None: + return f'const MPI_Request {self.name}' + else: + return f'const MPI_Request {self.name}[]' + +# +# TODO ABI NEEDS WORK +# +@Type.add_type('REQUEST_CONST', abi_type=['standard']) +class TypeConstRequestStandard(TypeRequestStandard): + + def type_text(self, enable_count=False): + name = self.mangle_name('MPI_Request') + return f'const {name}' + + @property + def argument(self): + return f'(MPI_Request) {self.name}' @Type.add_type('REQUEST_INOUT', abi_type=['ompi']) class TypeRequestInOut(Type): @@ -563,7 +588,6 @@ class TypeRequestInOut(Type): def type_text(self, enable_count=False): return 'MPI_Request *' - @Type.add_type('REQUEST_INOUT', abi_type=['standard']) class TypeRequestInOutStandard(Type): @@ -593,7 +617,6 @@ def parameter(self, enable_count=False, **kwargs): else: return f'{type_name} {self.name}[]' - @Type.add_type('STATUS', abi_type=['ompi']) class TypeStatus(Type): diff --git a/ompi/mpi/c/request_get_status_all.c.in b/ompi/mpi/c/request_get_status_all.c.in index 2d72999c223..ef1c36af355 100644 --- a/ompi/mpi/c/request_get_status_all.c.in +++ b/ompi/mpi/c/request_get_status_all.c.in @@ -37,7 +37,7 @@ * not be freed (unlike the test function). A subsequent call to test, wait * or free should be executed on the request. */ -PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_INOUT requests:count, INT_OUT flag, +PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_CONST requests:count, INT_OUT flag, STATUS_OUT statuses:count) { MEMCHECKER( @@ -54,7 +54,7 @@ PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_INOUT requests:c if (NULL == requests) { rc = MPI_ERR_REQUEST; } else { - if(!ompi_request_check_same_instance(requests, count) ) { + if(!ompi_request_check_same_instance((MPI_Request *)requests, count) ) { rc = MPI_ERR_REQUEST; } } diff --git a/ompi/mpi/c/request_get_status_any.c.in b/ompi/mpi/c/request_get_status_any.c.in index 5c45f4ee534..25613bcef36 100644 --- a/ompi/mpi/c/request_get_status_any.c.in +++ b/ompi/mpi/c/request_get_status_any.c.in @@ -37,7 +37,7 @@ * not be freed (unlike the test function). A subsequent call to test, wait * or free should be executed on the request. */ -PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_INOUT requests:count, INT_OUT indx, +PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_CONST requests:count, INT_OUT indx, INT_OUT flag, STATUS_OUT status) { @@ -55,7 +55,7 @@ PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_INOUT requests:c if (NULL == requests) { rc = MPI_ERR_REQUEST; } else { - if(!ompi_request_check_same_instance(requests, count) ) { + if(!ompi_request_check_same_instance((MPI_Request *)requests, count) ) { rc = MPI_ERR_REQUEST; } } diff --git a/ompi/mpi/c/request_get_status_some.c.in b/ompi/mpi/c/request_get_status_some.c.in index 9a2714e8088..b7f524773dd 100644 --- a/ompi/mpi/c/request_get_status_some.c.in +++ b/ompi/mpi/c/request_get_status_some.c.in @@ -37,7 +37,7 @@ * not be freed (unlike the test function). A subsequent call to test, wait * or free should be executed on the request. */ -PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_INOUT requests:count, INT_OUT outcount, +PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_CONST requests:count, INT_OUT outcount, INT_OUT indices, STATUS_OUT statuses:count) { @@ -55,7 +55,7 @@ PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_INOUT request if (NULL == requests) { rc = MPI_ERR_REQUEST; } else { - if(!ompi_request_check_same_instance(requests, incount) ) { + if(!ompi_request_check_same_instance((MPI_Request *)requests, incount) ) { rc = MPI_ERR_REQUEST; } } From 1c0d10cb8b76c80e87787e3a61a0025ca482ee18 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Sun, 15 Jun 2025 08:59:29 -0600 Subject: [PATCH 4/8] request_get_status variants: add f08 interfaces also switch MPI_Request_get_status to use new method for generating f08 bindings. Update fortran bindings interfaces generation code. f90/f77 interfaces will be added as another commit. Signed-off-by: Howard Pritchard --- ompi/mpi/bindings/ompi_bindings/fortran.py | 9 +- .../bindings/ompi_bindings/fortran_type.py | 660 +++++++++++++++++- ompi/mpi/bindings/ompi_bindings/util.py | 8 +- ompi/mpi/fortran/use-mpi-f08/Makefile.am | 1 - .../use-mpi-f08/Makefile.prototype_files | 4 + .../use-mpi-f08/mod/mpi-f08-interfaces.h.in | 11 - .../fortran/use-mpi-f08/mod/mpi-f08-rename.h | 2 - .../use-mpi-f08/request_get_status.c.in | 45 ++ .../use-mpi-f08/request_get_status_all.c.in | 67 ++ .../use-mpi-f08/request_get_status_any.c.in | 76 ++ .../use-mpi-f08/request_get_status_f08.F90 | 35 - .../use-mpi-f08/request_get_status_some.c.in | 86 +++ ompi/mpi/fortran/use-mpi-f08/testany.c.in | 2 +- ompi/mpi/fortran/use-mpi-f08/waitall.c.in | 2 +- 14 files changed, 929 insertions(+), 79 deletions(-) create mode 100644 ompi/mpi/fortran/use-mpi-f08/request_get_status.c.in create mode 100644 ompi/mpi/fortran/use-mpi-f08/request_get_status_all.c.in create mode 100644 ompi/mpi/fortran/use-mpi-f08/request_get_status_any.c.in delete mode 100644 ompi/mpi/fortran/use-mpi-f08/request_get_status_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/request_get_status_some.c.in diff --git a/ompi/mpi/bindings/ompi_bindings/fortran.py b/ompi/mpi/bindings/ompi_bindings/fortran.py index 42d185d4fba..79ad0cdbaae 100644 --- a/ompi/mpi/bindings/ompi_bindings/fortran.py +++ b/ompi/mpi/bindings/ompi_bindings/fortran.py @@ -151,6 +151,11 @@ def print_f_source(self): self._print_fortran_interface() self.dump() + # Output in pre C function call methods + + for param in self.parameters: + self.dump_lines(param.pre_c_call()) + # Call into the C function call_start = f' call {self.c_func_name}(' params = [param.argument() for param in self.parameters] @@ -184,7 +189,8 @@ def print_c_source(self): replacements={'INNER_CALL': self.inner_call, 'COUNT_TYPE': count_type, 'COUNT_FINT_TYPE': count_fint_type, - 'DISP_TYPE': disp_type}) + 'DISP_TYPE': disp_type, + 'LOGICAL_TYPE': 'int'}) def print_interface(self): """Output just the Fortran interface for this binding.""" @@ -234,6 +240,7 @@ def print_c_source_header(out): out.dump('#include "ompi/file/file.h"') out.dump('#include "ompi/errhandler/errhandler.h"') out.dump('#include "ompi/datatype/ompi_datatype.h"') + out.dump('#include "ompi/attribute/attribute.h"') out.dump('#include "ompi/mca/coll/base/coll_base_util.h"') out.dump('#include "ts.h"') out.dump('#include "bigcount.h"') diff --git a/ompi/mpi/bindings/ompi_bindings/fortran_type.py b/ompi/mpi/bindings/ompi_bindings/fortran_type.py index 0e7d9486d1a..17141993340 100644 --- a/ompi/mpi/bindings/ompi_bindings/fortran_type.py +++ b/ompi/mpi/bindings/ompi_bindings/fortran_type.py @@ -1,4 +1,4 @@ -# Copyright (c) 2024 Triad National Security, LLC. All rights +# Copyright (c) 2024-2025 Triad National Security, LLC. All rights # reserved. # # $COPYRIGHT$ @@ -95,6 +95,10 @@ def post(self): """Return post-processing code to be run after the call.""" return '' + def pre_c_call(self): + """Return pre-processing code to be run before the call the c interface.""" + return '' + @abstractmethod def c_parameter(self): """Return the parameter expression to be used in the C function.""" @@ -265,23 +269,20 @@ def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('DATATYPE_OUT') -class DatatypeTypeOut(FortranType): +class DatatypeTypeOut(DatatypeType): def declare(self): return f'TYPE(MPI_Datatype), INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Datatype')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' - +@FortranType.add('DATATYPE_INOUT') +class DatatypeTypeInOut(DatatypeType): + def declare(self): + return f'TYPE(MPI_Datatype), INTENT(INOUT) :: {self.name}' + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' @FortranType.add('DATATYPE_ARRAY') class DatatypeArrayType(FortranType): @@ -303,11 +304,29 @@ def declare(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('INT_OUT') +class IntOutType(FortranType): + def declare(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('INT_INOUT') +class IntOutType(FortranType): + def declare(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' @FortranType.add('RANK') class RankType(IntType): pass +@FortranType.add('RANK_OUT') +class RankType(IntOutType): + pass @FortranType.add('TAG') class TagType(IntType): @@ -320,6 +339,61 @@ def declare(self): return f'INTEGER, INTENT(OUT) :: {self.name}' +@FortranType.add('LOGICAL') +class LogicalType(IntType): + """Logical type. + + NOTE: Since the logical type causes difficulties when passed to C code, + this code uses a temporary integer in Fortran to pass to the C code. The + logical type is set based on C's true/false rules prior. + """ + + def declare(self): + return f'LOGICAL, INTENT(IN) :: {self.name}' + + def declare_tmp(self): + return f'INTEGER :: {self.tmp_name} = 0' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return self.tmp_name + + def pre_c_call(self): + return f'{self.tmp_name} = merge(1,0,{self.name})' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('LOGICAL_ARRAY') +class LogicalArrayType(IntType): + """Logical array type. + + NOTE: Since the logical type causes difficulties when passed to C code, + this code uses a temporary integer array in Fortran to pass to the C code. The + logical type is set based on C's true/false rules prior using fortran merge intrinsic + procedure. + """ + + def declare(self): + return f'LOGICAL, INTENT(IN) :: {self.name}({self.count_param})' + + def declare_tmp(self): + return f'INTEGER :: {self.tmp_name}({self.count_param})' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}({self.count_param})' + + def argument(self): + return self.tmp_name + + def pre_c_call(self): + return f'{self.tmp_name} = merge(1,0,{self.name})' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + @FortranType.add('LOGICAL_OUT') class LogicalOutType(IntType): """Logical type. @@ -347,7 +421,34 @@ def post(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('LOGICAL_ARRAY_OUT') +class LogicalArrayType(IntType): + """Logical array type. + + NOTE: Since the logical type causes difficulties when passed to C code, + this code uses a temporary integer array in Fortran to pass to the C code. The + logical type is set based on C's true/false rules prior using fortran merge intrinsic + procedure. + """ + + def declare(self): + return f'LOGICAL, INTENT(OUT) :: {self.name}({self.count_param})' + + def declare_tmp(self): + return f'INTEGER :: {self.tmp_name}({self.count_param})' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}({self.count_param})' + + def argument(self): + return self.tmp_name + def pre_c_call(self): + return f'{self.tmp_name} = merge(1,0,{self.name})' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + @FortranType.add('COMM') class CommType(FortranType): def declare(self): @@ -365,7 +466,106 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('COMM_OUT') +class CommOutType(FortranType): + def declare(self): + return f'TYPE(MPI_Comm), INTENT(OUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Comm')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('COMM_INOUT') +class CommInOutType(FortranType): + def declare(self): + return f'TYPE(MPI_Comm), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + def use(self): + return [('mpi_f08_types', 'MPI_Comm')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('GROUP') +class GroupType(FortranType): + def declare(self): + return f'TYPE(MPI_Group), INTENT(IN) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Group')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('GROUP_OUT') +class GroupOutType(GroupType): + def declare(self): + return f'TYPE(MPI_Group), INTENT(OUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + +@FortranType.add('GROUP_INOUT') +class GroupInOutType(GroupType): + def declare(self): + return f'TYPE(MPI_Group), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' + +@FortranType.add('SESSION') +class SessionType(FortranType): + def declare(self): + return f'TYPE(MPI_Session), INTENT(IN) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Session')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('SESSION_OUT') +class SessionOutType(SessionType): + def declare(self): + return f'TYPE(MPI_Session), INTENT(OUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + +@FortranType.add('SESSION_INOUT') +class SessionInOutType(SessionType): + def declare(self): + return f'TYPE(MPI_Session), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' + @FortranType.add('STATUS') class StatusType(FortranType): def declare(self): @@ -379,20 +579,42 @@ def c_parameter(self): @FortranType.add('STATUS_OUT') -class StatusOutType(FortranType): +class StatusOutType(StatusType): def declare(self): return f'TYPE(MPI_Status), INTENT(OUT) :: {self.name}' - def use(self): - return [('mpi_f08_types', 'MPI_Status')] + def c_parameter(self): + # TODO: Is this correct? (I've listed it as TYPE(MPI_Status) in the binding) + return f'MPI_Fint *{self.name}' + +@FortranType.add('STATUS_INOUT') +class StatusInOutType(StatusType): + def declare(self): + return f'TYPE(MPI_Status), INTENT(INOUT) :: {self.name}' def c_parameter(self): # TODO: Is this correct? (I've listed it as TYPE(MPI_Status) in the binding) return f'MPI_Fint *{self.name}' +@FortranType.add('REQUEST') +class RequestType(FortranType): + def declare(self): + return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Request')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' @FortranType.add('REQUEST_OUT') -class RequestType(FortranType): +class RequestTypeOut(FortranType): def declare(self): return f'TYPE(MPI_Request), INTENT(OUT) :: {self.name}' @@ -408,9 +630,17 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('REQUEST_INOUT') +class RequestTypeInOut(RequestType): + def declare(self): + return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' -@FortranType.add('REQUEST_ARRAY') -class RequestArrayType(FortranType): + +@FortranType.add('REQUEST_ARRAY_INOUT') +class RequestArrayTypeInOut(FortranType): def declare(self): return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}({self.count_param})' @@ -426,6 +656,23 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('REQUEST_ARRAY') +class RequestArrayType(FortranType): + def declare(self): + return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}({self.count_param})' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}({self.count_param})' + + def argument(self): + return f'{self.name}(:)%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Request')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + @FortranType.add('STATUS_ARRAY') class StatusArrayType(FortranType): @@ -444,19 +691,46 @@ class IntArray(FortranType): """Integer array as used for MPI_*v() variable length functions.""" def declare(self): - return f'INTEGER, INTENT(IN) :: {self.name}(*)' + size = '*' if self.count_param == None else self.count_param + return f'INTEGER, INTENT(IN) :: {self.name}({size})' + + def use(self): + if self.count_param == 'MPI_STATUS_SIZE': + return [('mpi_f08_types', 'MPI_STATUS_SIZE')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('INT_ARRAY_OUT') +class IntArrayOut(IntArray): + """Integer out array as used for MPI_*v() variable length functions.""" + + def declare(self): + size = '*' if self.count_param == None else self.count_param + return f'INTEGER, INTENT(OUT) :: {self.name}({size})' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' +@FortranType.add('INT_ARRAY_INOUT') +class IntArrayInOut(IntArray): + """Integer out array as used for MPI_*v() variable length functions.""" + + def declare(self): + size = '*' if self.count_param == None else self.count_param + return f'INTEGER, INTENT(INOUT) :: {self.name}({size})' + @FortranType.add('COUNT_ARRAY') class CountArray(IntArray): """Array of MPI_Count or int.""" def declare(self): kind = '(KIND=MPI_COUNT_KIND)' if self.bigcount else '' - return f'INTEGER{kind}, INTENT(IN) :: {self.name}(*)' + size = '*' if self.count_param == None else self.count_param +# print("size " + size + "count_param" + str(self.count_param)) + return f'INTEGER{kind}, INTENT(IN) :: {self.name}({size})' def use(self): if self.bigcount: @@ -473,7 +747,8 @@ class CountArray(IntArray): def declare(self): kind = '(KIND=MPI_COUNT_KIND)' if self.bigcount else '(KIND=MPI_ADDRESS_KIND)' - return f'INTEGER{kind}, INTENT(IN) :: {self.name}(*)' + size = '*' if self.count_param == None else self.count_param + return f'INTEGER{kind}, INTENT(IN) :: {self.name}({size})' def use(self): if self.bigcount: @@ -581,7 +856,8 @@ class AintArrayType(FortranType): def declare(self): # TODO: Should there be a separate ASYNC version here, when the OMPI_ASYNCHRONOUS attr is required? - return f'INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) OMPI_ASYNCHRONOUS :: {self.name}(*)' + size = '*' if self.count_param == None else self.count_param + return f'INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) OMPI_ASYNCHRONOUS :: {self.name}({size})' def use(self): return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] @@ -631,7 +907,8 @@ class DispArray(IntArray): def declare(self): kind = '(KIND=MPI_ADDRESS_KIND)' if self.bigcount else '' - return f'INTEGER{kind}, INTENT(IN) :: {self.name}(*)' + size = '*' if self.count_param == None else self.count_param + return f'INTEGER{kind}, INTENT(IN) :: {self.name}({size})' def use(self): if self.bigcount: @@ -650,13 +927,25 @@ class Op(FortranType): def declare(self): return f'TYPE(MPI_Op), INTENT(IN) :: {self.name}' + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + def use(self): return [('mpi_f08_types', 'MPI_Op')] + def argument(self): + return f'{self.name}%MPI_VAL' + def c_parameter(self): return f'MPI_Fint *{self.name}' - +@FortranType.add('OP_INOUT') +class OpInOut(Op): + """MPI_Op INOUT type.""" + + def declare(self): + return f'TYPE(MPI_Op), INTENT(INOUT) :: {self.name}' + @FortranType.add('WIN') class Win(FortranType): """MPI_Win type.""" @@ -664,9 +953,15 @@ class Win(FortranType): def declare(self): return f'TYPE(MPI_Win), INTENT(IN) :: {self.name}' + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + def use(self): return [('mpi_f08_types', 'MPI_Win')] + def argument(self): + return f'{self.name}%MPI_VAL' + def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -689,6 +984,15 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('WIN_INOUT') +class WinInOut(Win): + """MPI_Win inout type.""" + + def declare(self): + return f'TYPE(MPI_Win), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' @FortranType.add('FILE') class File(FortranType): @@ -703,6 +1007,13 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('FILE_OUT') +class FileOut(File): + """MPI_File OUT type.""" + + def declare(self): + return f'TYPE(MPI_File), INTENT(OUT) :: {self.name}' + @FortranType.add('INFO') class Info(FortranType): """MPI_Info type.""" @@ -716,6 +1027,26 @@ def use(self): def c_parameter(self): return f'MPI_Fint *{self.name}' +@FortranType.add('INFO_OUT') +class InfoOut(FortranType): + """MPI_Info out type.""" + + def declare(self): + return f'TYPE(MPI_Info), INTENT(OUT) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Info')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('INFO_INOUT') +class InfoInOut(InfoOut): + """MPI_Info inout type.""" + + def declare(self): + return f'TYPE(MPI_Info), INTENT(INOUT) :: {self.name}' + @FortranType.add('OFFSET') class Offset(FortranType): """MPI_Offset type.""" @@ -729,6 +1060,13 @@ def use(self): def c_parameter(self): return f'MPI_Offset *{self.name}' +@FortranType.add('OFFSET_OUT') +class OffsetOut(Offset): + """MPI_Offset OUT type.""" + + def declare(self): + return f'INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: {self.name}' + @FortranType.add('CHAR_ARRAY') class CharArray(FortranType): @@ -738,24 +1076,294 @@ def declare(self): return f'CHARACTER(LEN=*), INTENT(IN) :: {self.name}' def use(self): - return [('iso_c_binding', 'c_char')] + return [('iso_c_binding', 'c_char'), ('iso_c_binding', 'c_null_char')] def declare_cbinding_fortran(self): return f'CHARACTER(KIND=C_CHAR), INTENT(IN) :: {self.name}(*)' + def argument(self): + return f'{self.name}//c_null_char' + + def c_parameter(self): + return f'char *{self.name}' + +@FortranType.add('CHAR_ARRAY_OUT') +class CharArrayOut(FortranType): + """Fortran CHAR OUT type.""" + + def declare(self): + size = '*' if self.count_param == None else self.count_param + return f'CHARACTER(LEN={size}), INTENT(OUT) :: {self.name}' + + def use(self): +# print("self COUNT count_param" + str(self.count_param)) + if self.count_param == 'MPI_MAX_OBJECT_NAME': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_MAX_OBJECT_NAME')] + elif self.count_param == 'MPI_MAX_PORT_NAME': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_MAX_PORT_NAME')] + elif self.count_param == 'MPI_MAX_ERROR_STRING': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_MAX_ERROR_STRING')] + elif self.count_param == 'MPI_MAX_PROCESSOR_NAME': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_MAX_PROCESSOR_NAME')] + elif self.count_param == 'MPI_MAX_LIBRARY_VERSION_STRING': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_MAX_LIBRARY_VERSION_STRING')] + elif self.count_param == 'MPI_STATUS_SIZE': + return [('iso_c_binding', 'c_char'), ('mpi_f08_types', 'MPI_STATUS_SIZE')] + else: + return [('iso_c_binding', 'c_char')] + + def declare_cbinding_fortran(self): + return f'CHARACTER(KIND=C_CHAR), INTENT(OUT) :: {self.name}(*)' + def c_parameter(self): return f'char *{self.name}' +@FortranType.add('MESSAGE_OUT') +class MessageOut(FortranType): + """MPI_Message OUT type.""" + + def declare(self): + return f'TYPE(MPI_Message), INTENT(OUT) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Message')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + @FortranType.add('MESSAGE_INOUT') -class MessageInOut(FortranType): +class MessageInOut(MessageOut): """MPI_Message INOUT type.""" def declare(self): return f'TYPE(MPI_Message), INTENT(INOUT) :: {self.name}' + +@FortranType.add('ERRHANDLER') +class ErrhandlerType(FortranType): + def declare(self): + return f'TYPE(MPI_Errhandler), INTENT(IN) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + def use(self): - return [('mpi_f08_types', 'MPI_Message')] + return [('mpi_f08_types', 'MPI_Errhandler')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' +@FortranType.add('ERRHANDLER_OUT') +class ErrhandlerOutType(FortranType): + def declare(self): + return f'TYPE(MPI_Errhandler), INTENT(OUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_types', 'MPI_Errhandler')] + def c_parameter(self): return f'MPI_Fint *{self.name}' + +@FortranType.add('ERRHANDLER_INOUT') +class ErrhandlerOutType(ErrhandlerOutType): + def declare(self): + return f'TYPE(MPI_Errhandler), INTENT(INOUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {self.name}' + +@FortranType.add('COMM_ERRHANDLER_FN') +class CommErrhandlerFnType(FortranType): + def declare(self): + return f'PROCEDURE(MPI_Comm_copy_errhandler_function) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def argument(self): + return f'{self.name}%MPI_VAL' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def declare_tmp(self): + return f'type(c_funptr) :: {self.tmp_name}' + + def c_parameter(self): + return f'type(c_funptr) :: {self.tmp_name}' + + def pre_c_call(self): + return f'{self.tmp_name} = c_funloc({self.name})' + +@FortranType.add('COMM_COPY_ATTR_FN') +class CommCopyAttrFnType(FortranType): + def declare(self): + return f'PROCEDURE(MPI_Comm_copy_attr_function) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'type(c_funptr) :: {self.name}' + + def argument(self): + return f'{self.tmp_name}' + + def declare_tmp(self): + return f'type(c_funptr)::{self.tmp_name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def c_parameter(self): + return f'ompi_aint_copy_attr_function {self.name}' + + def pre_c_call(self): + return f'{self.tmp_name} = c_funloc({self.name})' + +@FortranType.add('TYPE_COPY_ATTR_FN') +class TypeCopyAttrFnType(CommCopyAttrFnType): + def declare(self): + return f'PROCEDURE(MPI_Type_copy_attr_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Type_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + +@FortranType.add('WIN_COPY_ATTR_FN') +class WinCopyAttrFnType(CommCopyAttrFnType): + def declare(self): + return f'PROCEDURE(MPI_Win_copy_attr_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + +@FortranType.add('COMM_DELETE_ATTR_FN') +class CommDeleteAttrFnType(FortranType): + def declare(self): + return f'PROCEDURE(MPI_Comm_delete_attr_function) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'type(c_funptr) :: {self.name}' + + def argument(self): + return f'{self.tmp_name}' + + def declare_tmp(self): + return f'type(c_funptr) :: {self.tmp_name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def c_parameter(self): + return f'ompi_aint_delete_attr_function {self.name}' + + def pre_c_call(self): + return f'{self.tmp_name} = c_funloc({self.name})' + +@FortranType.add('TYPE_DELETE_ATTR_FN') +class TypeDeleteAttrFnType(CommDeleteAttrFnType): + def declare(self): + return f'PROCEDURE(MPI_Type_delete_attr_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Type_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + +@FortranType.add('WIN_DELETE_ATTR_FN') +class WinDeleteAttrFnType(CommDeleteAttrFnType): + def declare(self): + return f'PROCEDURE(MPI_Win_delete_attr_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + +@FortranType.add('COMM_ERRHANDLER_FN') +class CommErrhandlerFnType(FortranType): + def declare(self): + return f'PROCEDURE(MPI_Comm_errhandler_function) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'type(c_funptr) :: {self.name}' + + def argument(self): + return f'{self.tmp_name}' + + def declare_tmp(self): + return f'type(c_funptr) :: {self.tmp_name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def c_parameter(self): + return f'ompi_errhandler_fortran_handler_fn_t {self.name}' + + def pre_c_call(self): + return f'{self.tmp_name} = c_funloc({self.name})' + + +@FortranType.add('FILE_ERRHANDLER_FN') +class FileErrhandlerFnType(CommErrhandlerFnType): + def declare(self): + return f'PROCEDURE(MPI_File_errhandler_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_File_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + +@FortranType.add('SESSION_ERRHANDLER_FN') +class SessionErrhandlerFnType(CommErrhandlerFnType): + def declare(self): + return f'PROCEDURE(MPI_Session_errhandler_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Session_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + +@FortranType.add('WIN_ERRHANDLER_FN') +class WinErrhandlerFnType(CommErrhandlerFnType): + def declare(self): + return f'PROCEDURE(MPI_Win_errhandler_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + +@FortranType.add('DATAREP_CONVERSION_FN') +class DataRepConversionFnType(FortranType): + def declare(self): + return f'PROCEDURE(MPI_Datarep_conversion_function) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'type(c_funptr) :: {self.name}' + + def argument(self): + return f'{self.tmp_name}' + + def declare_tmp(self): + return f'type(c_funptr) :: {self.tmp_name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_conversion_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def c_parameter(self): + return f'ompi_mpi2_fortran_datarep_conversion_fn_t {self.name}' + + def pre_c_call(self): + return f'{self.tmp_name} = c_funloc({self.name})' + +@FortranType.add('DATAREP_EXTENT_FN') +class DataRepExtentFnType(DataRepConversionFnType): + def declare(self): + return f'PROCEDURE(MPI_Datarep_extent_function) :: {self.name}' + + def use(self): + return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_extent_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + + def c_parameter(self): + return f'ompi_mpi2_fortran_datarep_extent_fn_t {self.name}' diff --git a/ompi/mpi/bindings/ompi_bindings/util.py b/ompi/mpi/bindings/ompi_bindings/util.py index 68d03eaa563..da454f7e967 100644 --- a/ompi/mpi/bindings/ompi_bindings/util.py +++ b/ompi/mpi/bindings/ompi_bindings/util.py @@ -83,7 +83,13 @@ def break_param_lines_fortran(start, params, end): This is often necessary to avoid going over the max line length of 132 characters. """ - assert len(params) > 1, 'expected more than one parameter' + assert len(params) > 0, 'expected at least one parameter' +# +# handle special case of just one parameter and return +# + if len(params) == 1: + result_lines = [f'{start}{params[0]}{end}'] + return result_lines indent = len(start) * ' ' lines = [f'{start}{params[0]},'] for param in params[1:-1]: diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 5211dcd267e..d0ffeee44ee 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -279,7 +279,6 @@ mpi_api_files = \ query_thread_f08.F90 \ register_datarep_f08.F90 \ request_free_f08.F90 \ - request_get_status_f08.F90 \ session_call_errhandler_f08.F90\ session_create_errhandler_f08.F90\ session_get_errhandler_f08.F90\ diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files index 3eca1162ae0..0c6e755ce85 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files @@ -128,6 +128,10 @@ prototype_files = \ reduce_scatter_init_ts.c.in \ reduce_scatter_ts.c.in \ reduce_ts.c.in \ + request_get_status.c.in \ + request_get_status_all.c.in \ + request_get_status_any.c.in \ + request_get_status_some.c.in \ rget_accumulate_ts.c.in \ rget_ts.c.in \ rput_ts.c.in \ diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in index 9b462537a25..cf738294432 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in @@ -102,17 +102,6 @@ subroutine MPI_Request_free_f08(request,ierror) end subroutine MPI_Request_free_f08 end interface MPI_Request_free -interface MPI_Request_get_status -subroutine MPI_Request_get_status_f08(request,flag,status,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - TYPE(MPI_Request), INTENT(IN) :: request - LOGICAL, INTENT(OUT) :: flag - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Request_get_status_f08 -end interface MPI_Request_get_status - interface MPI_Session_call_errhandler subroutine MPI_Session_call_errhandler_f08(session,errorcode,ierror) use :: mpi_f08_types, only : MPI_Session diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h index ea8370f4b54..f77e423efb4 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h @@ -562,8 +562,6 @@ #define MPI_Register_datarep PMPI_Register_datarep #define MPI_Request_free_f08 PMPI_Request_free_f08 #define MPI_Request_free PMPI_Request_free -#define MPI_Request_get_status_f08 PMPI_Request_get_status_f08 -#define MPI_Request_get_status PMPI_Request_get_status #define MPI_Rget_accumulate_f08 PMPI_Rget_accumulate_f08 #define MPI_Rget_accumulate PMPI_Rget_accumulate #define MPI_Rget_f08 PMPI_Rget_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/request_get_status.c.in b/ompi/mpi/fortran/use-mpi-f08/request_get_status.c.in new file mode 100644 index 00000000000..c765e8837cb --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/request_get_status.c.in @@ -0,0 +1,45 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2005 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID request_get_status(REQUEST request, LOGICAL_OUT flag, + STATUS_OUT status) +{ + int c_ierr; + MPI_Status c_status; + MPI_Request c_req = PMPI_Request_f2c( *request ); + int c_flag = 0; + + /* This seems silly, but someone will do it */ + + if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + c_ierr = MPI_SUCCESS; + } else { + c_ierr = @INNER_CALL@(c_req, + &c_flag, + &c_status); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if(MPI_SUCCESS == c_ierr) { + PMPI_Status_c2f( &c_status, status ); + *flag = OMPI_INT_2_FINT(c_flag); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/request_get_status_all.c.in b/ompi/mpi/fortran/use-mpi-f08/request_get_status_all.c.in new file mode 100644 index 00000000000..11e93265d5c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/request_get_status_all.c.in @@ -0,0 +1,67 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024-2025 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID request_get_status_all(INT count, REQUEST_ARRAY array_of_requests:count, + LOGICAL_OUT flag, STATUS_ARRAY array_of_statuses) +{ + MPI_Request *c_req; + MPI_Status *c_status; + int i, c_ierr, c_flag; + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * + (sizeof(MPI_Request) + sizeof(MPI_Status))); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*count)); + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), c_req, &c_flag, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *flag = OMPI_INT_2_FINT(c_flag); + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + array_of_requests[i] = c_req[i]->req_f_to_c_index; + if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) && + !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) { + PMPI_Status_c2f( &c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]); + } + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/request_get_status_any.c.in b/ompi/mpi/fortran/use-mpi-f08/request_get_status_any.c.in new file mode 100644 index 00000000000..8fdd62581d5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/request_get_status_any.c.in @@ -0,0 +1,76 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID request_get_status_any(INT count, REQUEST_ARRAY array_of_requests:count, + INT_OUT indx, LOGICAL_OUT flag, STATUS status) +{ + MPI_Request *c_req; + MPI_Status c_status; + int i, c_ierr; + int c_indx; + int c_flag; + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *indx = OMPI_INT_2_FINT(MPI_UNDEFINED); + PMPI_Status_c2f(&ompi_status_empty, status); + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request)); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), c_req, + &c_indx, + &c_flag, + &c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + + *indx = OMPI_INT_2_FINT(c_indx); + *flag = OMPI_INT_2_FINT(c_flag); + + /* Increment index by one for fortran conventions */ + + OMPI_SINGLE_INT_2_FINT(indx); + if (MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(indx))) { + array_of_requests[OMPI_INT_2_FINT(*indx)] = + c_req[OMPI_INT_2_FINT(*indx)]->req_f_to_c_index; + ++(*indx); + } + if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/request_get_status_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/request_get_status_f08.F90 deleted file mode 100644 index 193419f2b26..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/request_get_status_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2013 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2019-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Request_get_status_f08(request,flag,status,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - TYPE(MPI_Request), INTENT(IN) :: request - LOGICAL, INTENT(OUT) :: flag - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - ! See note in mpi-f-interfaces-bind.h for why we include an - ! interface here and call a PMPI_* subroutine below. - interface - subroutine PMPI_Request_get_status(request, flag, status, ierror) - use :: mpi_f08_types, only : MPI_Status - integer, intent(in) :: request - logical, intent(out) :: flag - type(MPI_Status), intent(out) :: status - integer, intent(out) :: ierror - end subroutine PMPI_Request_get_status - end interface - - call PMPI_Request_get_status(request%MPI_VAL,flag,status,c_ierror) - if (present(ierror)) ierror = c_ierror -end subroutine MPI_Request_get_status_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/request_get_status_some.c.in b/ompi/mpi/fortran/use-mpi-f08/request_get_status_some.c.in new file mode 100644 index 00000000000..2910c0878f6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/request_get_status_some.c.in @@ -0,0 +1,86 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID request_get_status_some(INT incount, REQUEST_ARRAY array_of_requests:incount, + INT_OUT outcount, INT_ARRAY_OUT array_of_indices, + STATUS_ARRAY array_of_statuses) +{ + int c_ierr; + MPI_Request *c_req; + MPI_Status *c_status; + int i; + int c_outcount; + int *tmp_array_of_indices = NULL; + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*incount))) { + *outcount = OMPI_INT_2_FINT(MPI_UNDEFINED); + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*incount) * + (sizeof(MPI_Request) + sizeof(MPI_Status))); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*incount)); + + for (i = 0; i < OMPI_FINT_2_INT(*incount); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(array_of_indices, tmp_array_of_indices, *incount); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*incount), c_req, + &c_outcount, + tmp_array_of_indices, + c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *outcount = OMPI_INT_2_FINT(c_outcount); + OMPI_FORTRAN_BIGCOUNT_ARRAY_COPYOUT(array_of_indices, tmp_array_of_indices, *incount); + + /* Increment indexes by one for fortran conventions */ + + if (MPI_UNDEFINED != OMPI_FINT_2_INT(*outcount)) { + for (i = 0; i < OMPI_FINT_2_INT(*outcount); ++i) { + array_of_requests[OMPI_INT_2_FINT(array_of_indices[i])] = + c_req[OMPI_INT_2_FINT(array_of_indices[i])]->req_f_to_c_index; + ++array_of_indices[i]; + } + } + if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses)) { + for (i = 0; i < OMPI_FINT_2_INT(*incount); ++i) { + if (!OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) { + PMPI_Status_c2f(&c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]); + } + } + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/testany.c.in b/ompi/mpi/fortran/use-mpi-f08/testany.c.in index 7ae3bcb343b..3ca6be546d4 100644 --- a/ompi/mpi/fortran/use-mpi-f08/testany.c.in +++ b/ompi/mpi/fortran/use-mpi-f08/testany.c.in @@ -21,7 +21,7 @@ * $HEADER$ */ -PROTOTYPE VOID testany(INT count, REQUEST_ARRAY array_of_requests:count, INT indx, +PROTOTYPE VOID testany(INT count, REQUEST_ARRAY_INOUT array_of_requests:count, INT indx, LOGICAL_OUT flag, STATUS_OUT status) { MPI_Request *c_req; diff --git a/ompi/mpi/fortran/use-mpi-f08/waitall.c.in b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in index 38cd9389722..835f49427fa 100644 --- a/ompi/mpi/fortran/use-mpi-f08/waitall.c.in +++ b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in @@ -21,7 +21,7 @@ * $HEADER$ */ -PROTOTYPE VOID waitall(INT count, REQUEST_ARRAY array_of_requests:count, +PROTOTYPE VOID waitall(INT count, REQUEST_ARRAY_INOUT array_of_requests:count, STATUS_ARRAY array_of_statuses) { MPI_Request *c_req; From 5121f575452563022385c8ad0d0628d91acdec5b Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 17 Jun 2025 19:46:14 -0600 Subject: [PATCH 5/8] use-mpi-ignore: start using binding infrastructure for new fortran methods starting with MPI_Request_get_status_(any/all/some) plus switch MPI_Request_get_status to use the binding infrastructure as well. Signed-off-by: Howard Pritchard --- .gitignore | 2 + ompi/mpi/bindings/bindings.py | 6 +- ompi/mpi/bindings/ompi_bindings/fortran.py | 67 +- .../bindings/ompi_bindings/fortran_type.py | 616 ++++++++++++------ ompi/mpi/bindings/ompi_bindings/util.py | 14 +- ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am | 1 + .../fortran/use-mpi-ignore-tkr/Makefile.am | 31 +- .../Makefile.prototype_files | 9 + .../mpi-ignore-tkr-interfaces.h.in | 13 - .../use-mpi-ignore-tkr/mpi-ignore-tkr.F90 | 1 + .../pmpi-ignore-tkr-interfaces.h | 1 - 11 files changed, 537 insertions(+), 224 deletions(-) create mode 100644 ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files diff --git a/.gitignore b/.gitignore index dfa2e7c86d0..4e71ce71bce 100644 --- a/.gitignore +++ b/.gitignore @@ -539,3 +539,5 @@ ompi/mpi/c/*_generated*.c ompi/mpi/fortran/use-mpi-f08/*_generated.F90 ompi/mpi/fortran/use-mpi-f08/base/*_generated.c ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-generated.h +ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces-generated.h +ompi/mpi/fortran/use-mpi-ignore-tkr/*_generated.F90 diff --git a/ompi/mpi/bindings/bindings.py b/ompi/mpi/bindings/bindings.py index 951d651a74d..a101bfbfd85 100644 --- a/ompi/mpi/bindings/bindings.py +++ b/ompi/mpi/bindings/bindings.py @@ -37,12 +37,16 @@ def main(): subparsers_fortran = parser_fortran.add_subparsers() parser_code = subparsers_fortran.add_parser('code', help='generate binding code') parser_code.set_defaults(handler=lambda args, out: fortran.generate_code(args, out)) - parser_code.add_argument('--lang', choices=('fortran', 'c'), + parser_code.add_argument('--lang', choices=('fortran', 'c', 'f90'), help='language to generate (only for code subparser)') + parser_code.add_argument('--fort-std', choices=('f90', 'f08'), + help='fortran standard to use for fortran module generation') # Handler for generating the Fortran interface files parser_interface = subparsers_fortran.add_parser('interface', help='generate Fortran interface specifications') parser_interface.set_defaults(handler=lambda args, out: fortran.generate_interface(args, out)) + parser_interface.add_argument('--fort-std', choices=('f90', 'f08'), + help='fortran standard to use for fortran module generation') # The prototype files argument must come last and be specified for both subparsers for f_subparser in [parser_code, parser_interface]: f_subparser.add_argument('--prototype-files', nargs='+', help='prototype files to generate code for') diff --git a/ompi/mpi/bindings/ompi_bindings/fortran.py b/ompi/mpi/bindings/ompi_bindings/fortran.py index 79ad0cdbaae..5e4256eacab 100644 --- a/ompi/mpi/bindings/ompi_bindings/fortran.py +++ b/ompi/mpi/bindings/ompi_bindings/fortran.py @@ -25,17 +25,19 @@ class FortranBinding: """Class for generating the binding for a single function.""" - def __init__(self, prototype, out, template=None, bigcount=False, needs_ts=False): + def __init__(self, prototype, out, template=None, bigcount=False, needs_ts=False, gen_f90=False): # Generate bigcount interface version self.bigcount = bigcount self.fn_name = template.prototype.name self.out = out self.template = template self.needs_ts = needs_ts + self.gen_f90 = gen_f90 self.parameters = [] for param in self.template.prototype.params: self.parameters.append(param.construct(fn_name=self.fn_name, - bigcount=bigcount)) + bigcount=bigcount, + gen_f90=gen_f90)) def dump(self, *pargs, **kwargs): """Write to the output file.""" @@ -74,6 +76,19 @@ def _use_stmts(self): stmts.append(f'use :: {mod}, only: {names}') return stmts + def _include_stmts(self): + """Return a list of required includes needed.""" + includes = [] + names = [] + for param in self.parameters: + name = param.include() + if name != '': + if name in names: + continue + includes.append(f'include \'{name}\'') + names.append(f'{name}') + return includes + def _print_fortran_interface(self): """Output the C subroutine binding for the Fortran code.""" name = self.c_func_name @@ -92,6 +107,9 @@ def _print_fortran_interface(self): for stmt in use_stmts: self.dump(f' {stmt}') self.dump(' implicit none') + include_stmts = self._include_stmts() + for stmt in include_stmts: + self.dump(f' {stmt}') for param in self.parameters: self.dump(f' {param.declare_cbinding_fortran()}') self.dump(f' INTEGER, INTENT(OUT) :: {consts.FORTRAN_ERROR_NAME}') @@ -108,17 +126,24 @@ def _print_fortran_header(self, is_interface=False): for stmt in use_stmts: self.dump(f' {stmt}') self.dump(' implicit none') + # Include statements + include_stmts = self._include_stmts() + for stmt in include_stmts: + self.dump(f' {stmt}') # Parameters/dummy variable declarations for param in self.parameters: if is_interface: self.dump_lines(param.interface_predeclare()) self.dump_lines(param.declare()) # Add the integer error manually - self.dump(f' INTEGER, OPTIONAL, INTENT(OUT) :: {consts.FORTRAN_ERROR_NAME}') + if self.gen_f90 == True: + self.dump(f' INTEGER, INTENT(OUT) :: {consts.FORTRAN_ERROR_NAME}') + else: + self.dump(f' INTEGER, OPTIONAL, INTENT(OUT) :: {consts.FORTRAN_ERROR_NAME}') def _print_fortran_subroutine(self): """Output the Fortran subroutine line.""" - sub_name = util.fortran_f08_name(self.fn_name, bigcount=self.bigcount, needs_ts=self.needs_ts) + sub_name = util.fortran_name(self.fn_name, bigcount=self.bigcount, gen_f90=self.gen_f90, needs_ts=self.needs_ts) params = [param.name for param in self.parameters] params.append(consts.FORTRAN_ERROR_NAME) lines = util.break_param_lines_fortran(f'subroutine {sub_name}(', params, ')') @@ -127,7 +152,7 @@ def _print_fortran_subroutine(self): def _print_fortran_subroutine_end(self): """Output the Fortran end subroutine line.""" - sub_name = util.fortran_f08_name(self.fn_name, bigcount=self.bigcount, needs_ts=self.needs_ts) + sub_name = util.fortran_name(self.fn_name, bigcount=self.bigcount, gen_f90=self.gen_f90, needs_ts=self.needs_ts) self.dump(f'end subroutine {sub_name}') def dump_lines(self, line_text): @@ -210,18 +235,20 @@ def print_profiling_rename_macros(templates, out, args): Previously hardcoded in mpi-f08-rename.h. """ + gen_f90 = True if args.fort_std == 'f90' else False out.dump('#if OMPI_BUILD_MPI_PROFILING') for template in templates: has_buffers = util.prototype_has_buffers(template.prototype) needs_ts = has_buffers and args.generate_ts_suffix - name = util.fortran_f08_name(template.prototype.name, needs_ts=needs_ts) + name = util.fortran_name(template.prototype.name, gen_f90=gen_f90, needs_ts=needs_ts) out.dump(f'#define {name} P{name}') # Check for bigcount version if util.prototype_has_bigcount(template.prototype): - bigcount_name = util.fortran_f08_name(template.prototype.name, bigcount=True, needs_ts=needs_ts) + bigcount_name = util.fortran_name(template.prototype.name, bigcount=True, needs_ts=needs_ts) out.dump(f'#define {bigcount_name} P{bigcount_name}') - name = util.fortran_f08_generic_interface_name(template.prototype.name) - out.dump(f'#define {name} P{name}') + if gen_f90 == False: + name = util.fortran_f08_generic_interface_name(template.prototype.name) + out.dump(f'#define {name} P{name}') out.dump('#endif /* OMPI_BUILD_MPI_PROFILING */') @@ -246,9 +273,9 @@ def print_c_source_header(out): out.dump('#include "bigcount.h"') -def print_binding(prototype, lang, out, bigcount=False, template=None, needs_ts=False): +def print_binding(prototype, lang, out, bigcount=False, template=None, needs_ts=False, gen_f90=False): """Print the binding with or without bigcount.""" - binding = FortranBinding(prototype, out=out, bigcount=bigcount, template=template, needs_ts=needs_ts) + binding = FortranBinding(prototype, out=out, bigcount=bigcount, template=template, needs_ts=needs_ts, gen_f90=gen_f90) if lang == 'fortran': binding.print_f_source() else: @@ -267,6 +294,11 @@ def generate_code(args, out): """Generate binding code based on arguments.""" templates = load_function_templates(args.prototype_files) + if args.fort_std == 'f08' or args.fort_std == None: + gen_f90 = False + else: + gen_f90 = True + if args.lang == 'fortran': print_f_source_header(out) out.dump() @@ -279,8 +311,8 @@ def generate_code(args, out): out.dump() has_buffers = util.prototype_has_buffers(template.prototype) needs_ts = has_buffers and args.generate_ts_suffix - print_binding(template.prototype, args.lang, out, template=template, needs_ts=needs_ts) - if util.prototype_has_bigcount(template.prototype): + print_binding(template.prototype, args.lang, out, template=template, needs_ts=needs_ts, gen_f90=gen_f90) + if util.prototype_has_bigcount(template.prototype) and gen_f90 == False: out.dump() print_binding(template.prototype, args.lang, bigcount=True, out=out, template=template, needs_ts=needs_ts) @@ -292,14 +324,19 @@ def generate_interface(args, out): templates = load_function_templates(args.prototype_files) print_profiling_rename_macros(templates, out, args) + if args.fort_std == 'f08' or args.fort_std == None: + gen_f90 = False + else: + gen_f90 = True + for template in templates: ext_name = util.ext_api_func_name(template.prototype.name) out.dump(f'interface {ext_name}') has_buffers = util.prototype_has_buffers(template.prototype) needs_ts = has_buffers and args.generate_ts_suffix - binding = FortranBinding(template.prototype, template=template, needs_ts=needs_ts, out=out) + binding = FortranBinding(template.prototype, template=template, needs_ts=needs_ts, gen_f90=gen_f90, out=out) binding.print_interface() - if util.prototype_has_bigcount(template.prototype): + if util.prototype_has_bigcount(template.prototype) and gen_f90 == False: out.dump() binding_c = FortranBinding(template.prototype, out=out, template=template, needs_ts=needs_ts, bigcount=True) diff --git a/ompi/mpi/bindings/ompi_bindings/fortran_type.py b/ompi/mpi/bindings/ompi_bindings/fortran_type.py index 17141993340..11b9a790b74 100644 --- a/ompi/mpi/bindings/ompi_bindings/fortran_type.py +++ b/ompi/mpi/bindings/ompi_bindings/fortran_type.py @@ -19,12 +19,13 @@ class FortranType(ABC): - def __init__(self, name, fn_name, bigcount=False, count_param=None, **kwargs): + def __init__(self, name, fn_name, bigcount=False, count_param=None, gen_f90=False, **kwargs): self.name = name self.fn_name = fn_name # Generate the bigcount interface version? self.bigcount = bigcount self.count_param = count_param + self.gen_f90 = gen_f90 self.used_counters = 0 TYPES = {} @@ -91,6 +92,10 @@ def use(self): """Return list of (module, name) for a Fortran use-statement.""" return [] + def include(self): + """Return an include file name needed for a Fortran datatype.""" + return '' + def post(self): """Return post-processing code to be run after the call.""" return '' @@ -200,14 +205,23 @@ def declare(self): return f'INTEGER, INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_COUNT_KIND')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return f"mpif-config.h" def c_parameter(self): type_ = 'MPI_Count' if self.bigcount else 'MPI_Fint' return f'{type_} *{self.name}' @FortranType.add('COUNT_INOUT') -class CountTypeInOut(FortranType): +class CountTypeInOut(CountType): """COUNT type with INOUT INTENT""" def declare(self): if self.bigcount: @@ -215,15 +229,8 @@ def declare(self): else: return f'INTEGER, INTENT(INOUT) :: {self.name}' - def use(self): - return [('mpi_f08_types', 'MPI_COUNT_KIND')] - - def c_parameter(self): - type_ = 'MPI_Count' if self.bigcount else 'MPI_Fint' - return f'{type_} *{self.name}' - @FortranType.add('COUNT_OUT') -class CountTypeInOut(FortranType): +class CountTypeInOut(CountType): """COUNT type with OUT INTENT""" def declare(self): if self.bigcount: @@ -231,13 +238,6 @@ def declare(self): else: return f'INTEGER, INTENT(OUT) :: {self.name}' - def use(self): - return [('mpi_f08_types', 'MPI_COUNT_KIND')] - - def c_parameter(self): - type_ = 'MPI_Count' if self.bigcount else 'MPI_Fint' - return f'{type_} *{self.name}' - @FortranType.add('PARTITIONED_COUNT') class PartitionedCountType(FortranType): @@ -245,7 +245,10 @@ def declare(self): return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_COUNT_KIND')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [] def c_parameter(self): return f'MPI_Count *{self.name}' @@ -254,16 +257,25 @@ def c_parameter(self): @FortranType.add('DATATYPE') class DatatypeType(FortranType): def declare(self): - return f'TYPE(MPI_Datatype), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Datatype), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Datatype')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Datatype')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -271,7 +283,10 @@ def c_parameter(self): @FortranType.add('DATATYPE_OUT') class DatatypeTypeOut(DatatypeType): def declare(self): - return f'TYPE(MPI_Datatype), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Datatype), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' @@ -279,7 +294,10 @@ def declare_cbinding_fortran(self): @FortranType.add('DATATYPE_INOUT') class DatatypeTypeInOut(DatatypeType): def declare(self): - return f'TYPE(MPI_Datatype), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Datatype), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' @@ -287,10 +305,16 @@ def declare_cbinding_fortran(self): @FortranType.add('DATATYPE_ARRAY') class DatatypeArrayType(FortranType): def declare(self): - return f'TYPE(MPI_Datatype), INTENT(IN) :: {self.name}(*)' + if self.gen_f90 == False: + return f'TYPE(MPI_Datatype), INTENT(IN) :: {self.name}(*)' + else: + return f'INTEGER, INTENT(IN) :: {self.name}(*)' def use(self): - return [('mpi_f08_types', 'MPI_Datatype')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Datatype')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -452,7 +476,10 @@ def c_parameter(self): @FortranType.add('COMM') class CommType(FortranType): def declare(self): - return f'TYPE(MPI_Comm), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Comm), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' @@ -461,49 +488,44 @@ def argument(self): return f'{self.name}%MPI_VAL' def use(self): - return [('mpi_f08_types', 'MPI_Comm')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Comm')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('COMM_OUT') -class CommOutType(FortranType): +class CommOutType(CommType): def declare(self): - return f'TYPE(MPI_Comm), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Comm), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Comm')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' @FortranType.add('COMM_INOUT') -class CommInOutType(FortranType): +class CommInOutType(CommType): def declare(self): - return f'TYPE(MPI_Comm), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Comm), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Comm')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' - @FortranType.add('GROUP') class GroupType(FortranType): def declare(self): - return f'TYPE(MPI_Group), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Group), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' @@ -512,7 +534,10 @@ def argument(self): return f'{self.name}%MPI_VAL' def use(self): - return [('mpi_f08_types', 'MPI_Group')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Group')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -520,7 +545,10 @@ def c_parameter(self): @FortranType.add('GROUP_OUT') class GroupOutType(GroupType): def declare(self): - return f'TYPE(MPI_Group), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Group), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' @@ -528,7 +556,10 @@ def declare_cbinding_fortran(self): @FortranType.add('GROUP_INOUT') class GroupInOutType(GroupType): def declare(self): - return f'TYPE(MPI_Group), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Group), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' @@ -536,7 +567,10 @@ def declare_cbinding_fortran(self): @FortranType.add('SESSION') class SessionType(FortranType): def declare(self): - return f'TYPE(MPI_Session), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Session), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' @@ -545,7 +579,10 @@ def argument(self): return f'{self.name}%MPI_VAL' def use(self): - return [('mpi_f08_types', 'MPI_Session')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Session')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -553,7 +590,10 @@ def c_parameter(self): @FortranType.add('SESSION_OUT') class SessionOutType(SessionType): def declare(self): - return f'TYPE(MPI_Session), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Session), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' @@ -561,7 +601,10 @@ def declare_cbinding_fortran(self): @FortranType.add('SESSION_INOUT') class SessionInOutType(SessionType): def declare(self): - return f'TYPE(MPI_Session), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Session), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' @@ -569,10 +612,22 @@ def declare_cbinding_fortran(self): @FortranType.add('STATUS') class StatusType(FortranType): def declare(self): - return f'TYPE(MPI_Status) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Status) :: {self.name}' + else: + return f'INTEGER :: {self.name}(MPI_STATUS_SIZE)' def use(self): - return [('mpi_f08_types', 'MPI_Status')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Status')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return f"mpif-config.h" def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -581,7 +636,10 @@ def c_parameter(self): @FortranType.add('STATUS_OUT') class StatusOutType(StatusType): def declare(self): - return f'TYPE(MPI_Status), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Status), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}(MPI_STATUS_SIZE)' def c_parameter(self): # TODO: Is this correct? (I've listed it as TYPE(MPI_Status) in the binding) @@ -590,7 +648,10 @@ def c_parameter(self): @FortranType.add('STATUS_INOUT') class StatusInOutType(StatusType): def declare(self): - return f'TYPE(MPI_Status), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Status), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}(MPI_STATUS_SIZE)' def c_parameter(self): # TODO: Is this correct? (I've listed it as TYPE(MPI_Status) in the binding) @@ -599,37 +660,40 @@ def c_parameter(self): @FortranType.add('REQUEST') class RequestType(FortranType): def declare(self): - return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Request')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Request')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('REQUEST_OUT') -class RequestTypeOut(FortranType): +class RequestTypeOut(RequestType): def declare(self): - return f'TYPE(MPI_Request), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Request), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Request')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' - @FortranType.add('REQUEST_INOUT') class RequestTypeInOut(RequestType): def declare(self): @@ -639,53 +703,72 @@ def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' -@FortranType.add('REQUEST_ARRAY_INOUT') -class RequestArrayTypeInOut(FortranType): +@FortranType.add('REQUEST_ARRAY') +class RequestArrayType(FortranType): def declare(self): - return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}({self.count_param})' + if self.gen_f90 == False: + return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}({self.count_param})' + else: + return f'INTEGER, INTENT(IN) :: {self.name}(*)' def declare_cbinding_fortran(self): - return f'INTEGER, INTENT(INOUT) :: {self.name}({self.count_param})' - + if self.gen_f90 == False: + return f'INTEGER, INTENT(IN) :: {self.name}({self.count_param})' + else: + return f'INTEGER, INTENT(IN) :: {self.name}(*)' + def argument(self): - return f'{self.name}(:)%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}(:)%MPI_VAL' + else: + return f'{self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Request')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Request')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' -@FortranType.add('REQUEST_ARRAY') -class RequestArrayType(FortranType): +@FortranType.add('REQUEST_ARRAY_INOUT') +class RequestArrayTypeInOut(RequestArrayType): def declare(self): - return f'TYPE(MPI_Request), INTENT(IN) :: {self.name}({self.count_param})' - - def declare_cbinding_fortran(self): - return f'INTEGER, INTENT(IN) :: {self.name}({self.count_param})' - - def argument(self): - return f'{self.name}(:)%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Request')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}({self.count_param})' + else: + return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}(*)' + def declare_cbinding_fortran(self): + if self.gen_f90 == False: + return f'INTEGER, INTENT(INOUT) :: {self.name}({self.count_param})' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}(*)' @FortranType.add('STATUS_ARRAY') class StatusArrayType(FortranType): def declare(self): - return f'TYPE(MPI_Status), INTENT(OUT) :: {self.name}(*)' + if self.gen_f90 == False: + return f'TYPE(MPI_Status), INTENT(OUT) :: {self.name}(*)' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}(MPI_STATUS_SIZE,*)' def use(self): - return [('mpi_f08_types', 'MPI_Status')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Status')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return f"mpif-config.h" def c_parameter(self): return f'MPI_Fint *{self.name}' - @FortranType.add('INT_ARRAY') class IntArray(FortranType): """Integer array as used for MPI_*v() variable length functions.""" @@ -756,6 +839,12 @@ def use(self): else: return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + def include(self): + if self.gen_f90 == False: + return '' + else: + return f"mpif-config.h" + def c_parameter(self): count_type = 'MPI_Count' if self.bigcount else 'MPI_Aint' return f'{count_type} *{self.name}' @@ -770,25 +859,28 @@ def declare(self): return f'INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return "mpif-config.h" def c_parameter(self): return f'MPI_Aint *{self.name}' @FortranType.add('AINT_OUT') -class AintOut(FortranType): +class AintOut(Aint): """MPI_Aint out type.""" def declare(self): return f'INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: {self.name}' - def use(self): - return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] - - def c_parameter(self): - return f'MPI_Aint *{self.name}' - @FortranType.add('AINT_COUNT') class AintCountTypeIn(FortranType): @@ -803,7 +895,16 @@ def use(self): if self.bigcount: return [('mpi_f08_types', 'MPI_COUNT_KIND')] else: - return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return "mpif-config.h" def c_parameter(self): type_ = 'MPI_Count' if self.bigcount else 'MPI_Aint' @@ -925,16 +1026,25 @@ class Op(FortranType): """MPI_Op type.""" def declare(self): - return f'TYPE(MPI_Op), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Op), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Op')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Op')] + else: + return [] def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -944,52 +1054,61 @@ class OpInOut(Op): """MPI_Op INOUT type.""" def declare(self): - return f'TYPE(MPI_Op), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Op), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' @FortranType.add('WIN') class Win(FortranType): """MPI_Win type.""" def declare(self): - return f'TYPE(MPI_Win), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Win), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Win')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Win')] + else: + return [] def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('WIN_OUT') -class WinOut(FortranType): +class WinOut(Win): """MPI_Win out type.""" def declare(self): - return f'TYPE(MPI_Win), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Win), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Win')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' - @FortranType.add('WIN_INOUT') class WinInOut(Win): """MPI_Win inout type.""" def declare(self): - return f'TYPE(MPI_Win), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Win), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' @@ -999,10 +1118,16 @@ class File(FortranType): """MPI_File type.""" def declare(self): - return f'TYPE(MPI_File), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_File), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_File')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_File')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -1012,40 +1137,52 @@ class FileOut(File): """MPI_File OUT type.""" def declare(self): - return f'TYPE(MPI_File), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_File), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' @FortranType.add('INFO') class Info(FortranType): """MPI_Info type.""" def declare(self): - return f'TYPE(MPI_Info), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Info), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Info')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Info')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('INFO_OUT') -class InfoOut(FortranType): +class InfoOut(Info): """MPI_Info out type.""" def declare(self): - return f'TYPE(MPI_Info), INTENT(OUT) :: {self.name}' - - def use(self): - return [('mpi_f08_types', 'MPI_Info')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Info), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' @FortranType.add('INFO_INOUT') -class InfoInOut(InfoOut): +class InfoInOut(Info): """MPI_Info inout type.""" def declare(self): - return f'TYPE(MPI_Info), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Info), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' @FortranType.add('OFFSET') class Offset(FortranType): @@ -1055,7 +1192,16 @@ def declare(self): return f'INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_OFFSET_KIND')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_OFFSET_KIND')] + else: + return [] + + def include(self): + if self.gen_f90 == False: + return '' + else: + return "mpif-config.h" def c_parameter(self): return f'MPI_Offset *{self.name}' @@ -1124,10 +1270,16 @@ class MessageOut(FortranType): """MPI_Message OUT type.""" def declare(self): - return f'TYPE(MPI_Message), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Message), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Message')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Message')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @@ -1138,47 +1290,56 @@ class MessageInOut(MessageOut): """MPI_Message INOUT type.""" def declare(self): - return f'TYPE(MPI_Message), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Message), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' @FortranType.add('ERRHANDLER') class ErrhandlerType(FortranType): def declare(self): - return f'TYPE(MPI_Errhandler), INTENT(IN) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Errhandler), INTENT(IN) :: {self.name}' + else: + return f'INTEGER, INTENT(IN) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def use(self): - return [('mpi_f08_types', 'MPI_Errhandler')] + if self.gen_f90 == False: + return [('mpi_f08_types', 'MPI_Errhandler')] + else: + return [] def c_parameter(self): return f'MPI_Fint *{self.name}' @FortranType.add('ERRHANDLER_OUT') -class ErrhandlerOutType(FortranType): +class ErrhandlerOutType(ErrhandlerType): def declare(self): - return f'TYPE(MPI_Errhandler), INTENT(OUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Errhandler), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER, INTENT(OUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(OUT) :: {self.name}' - def argument(self): - return f'{self.name}%MPI_VAL' - - def use(self): - return [('mpi_f08_types', 'MPI_Errhandler')] - - def c_parameter(self): - return f'MPI_Fint *{self.name}' - @FortranType.add('ERRHANDLER_INOUT') class ErrhandlerOutType(ErrhandlerOutType): def declare(self): - return f'TYPE(MPI_Errhandler), INTENT(INOUT) :: {self.name}' + if self.gen_f90 == False: + return f'TYPE(MPI_Errhandler), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER, INTENT(INOUT) :: {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(INOUT) :: {self.name}' @@ -1186,16 +1347,25 @@ def declare_cbinding_fortran(self): @FortranType.add('COMM_ERRHANDLER_FN') class CommErrhandlerFnType(FortranType): def declare(self): - return f'PROCEDURE(MPI_Comm_copy_errhandler_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Comm_copy_errhandler_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def declare_cbinding_fortran(self): return f'INTEGER, INTENT(IN) :: {self.name}' def argument(self): - return f'{self.name}%MPI_VAL' + if self.gen_f90 == False: + return f'{self.name}%MPI_VAL' + else: + return f'{self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def declare_tmp(self): return f'type(c_funptr) :: {self.tmp_name}' @@ -1209,7 +1379,10 @@ def pre_c_call(self): @FortranType.add('COMM_COPY_ATTR_FN') class CommCopyAttrFnType(FortranType): def declare(self): - return f'PROCEDURE(MPI_Comm_copy_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Comm_copy_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def declare_cbinding_fortran(self): return f'type(c_funptr) :: {self.name}' @@ -1221,7 +1394,10 @@ def declare_tmp(self): return f'type(c_funptr)::{self.tmp_name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def c_parameter(self): return f'ompi_aint_copy_attr_function {self.name}' @@ -1232,23 +1408,38 @@ def pre_c_call(self): @FortranType.add('TYPE_COPY_ATTR_FN') class TypeCopyAttrFnType(CommCopyAttrFnType): def declare(self): - return f'PROCEDURE(MPI_Type_copy_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Type_copy_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Type_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Type_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('WIN_COPY_ATTR_FN') class WinCopyAttrFnType(CommCopyAttrFnType): def declare(self): - return f'PROCEDURE(MPI_Win_copy_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Win_copy_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Win_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_copy_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('COMM_DELETE_ATTR_FN') class CommDeleteAttrFnType(FortranType): def declare(self): - return f'PROCEDURE(MPI_Comm_delete_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Comm_delete_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def declare_cbinding_fortran(self): return f'type(c_funptr) :: {self.name}' @@ -1260,7 +1451,10 @@ def declare_tmp(self): return f'type(c_funptr) :: {self.tmp_name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def c_parameter(self): return f'ompi_aint_delete_attr_function {self.name}' @@ -1271,24 +1465,39 @@ def pre_c_call(self): @FortranType.add('TYPE_DELETE_ATTR_FN') class TypeDeleteAttrFnType(CommDeleteAttrFnType): def declare(self): - return f'PROCEDURE(MPI_Type_delete_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Type_delete_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Type_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Type_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('WIN_DELETE_ATTR_FN') class WinDeleteAttrFnType(CommDeleteAttrFnType): def declare(self): - return f'PROCEDURE(MPI_Win_delete_attr_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Win_delete_attr_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Win_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_delete_attr_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('COMM_ERRHANDLER_FN') class CommErrhandlerFnType(FortranType): def declare(self): - return f'PROCEDURE(MPI_Comm_errhandler_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Comm_errhandler_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def declare_cbinding_fortran(self): return f'type(c_funptr) :: {self.name}' @@ -1300,7 +1509,10 @@ def declare_tmp(self): return f'type(c_funptr) :: {self.tmp_name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Comm_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def c_parameter(self): return f'ompi_errhandler_fortran_handler_fn_t {self.name}' @@ -1312,15 +1524,24 @@ def pre_c_call(self): @FortranType.add('FILE_ERRHANDLER_FN') class FileErrhandlerFnType(CommErrhandlerFnType): def declare(self): - return f'PROCEDURE(MPI_File_errhandler_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_File_errhandler_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_File_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_File_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('SESSION_ERRHANDLER_FN') class SessionErrhandlerFnType(CommErrhandlerFnType): def declare(self): - return f'PROCEDURE(MPI_Session_errhandler_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Session_errhandler_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): return [('mpi_f08_interfaces_callbacks', 'MPI_Session_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] @@ -1328,16 +1549,24 @@ def use(self): @FortranType.add('WIN_ERRHANDLER_FN') class WinErrhandlerFnType(CommErrhandlerFnType): def declare(self): - return f'PROCEDURE(MPI_Win_errhandler_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Win_errhandler_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Win_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] - + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Win_errhandler_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] @FortranType.add('DATAREP_CONVERSION_FN') class DataRepConversionFnType(FortranType): def declare(self): - return f'PROCEDURE(MPI_Datarep_conversion_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Datarep_conversion_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def declare_cbinding_fortran(self): return f'type(c_funptr) :: {self.name}' @@ -1349,7 +1578,10 @@ def declare_tmp(self): return f'type(c_funptr) :: {self.tmp_name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_conversion_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_conversion_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def c_parameter(self): return f'ompi_mpi2_fortran_datarep_conversion_fn_t {self.name}' @@ -1360,10 +1592,16 @@ def pre_c_call(self): @FortranType.add('DATAREP_EXTENT_FN') class DataRepExtentFnType(DataRepConversionFnType): def declare(self): - return f'PROCEDURE(MPI_Datarep_extent_function) :: {self.name}' + if self.gen_f90 == False: + return f'PROCEDURE(MPI_Datarep_extent_function) :: {self.name}' + else: + return f'EXTERNAL {self.name}' def use(self): - return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_extent_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + if self.gen_f90 == False: + return [('mpi_f08_interfaces_callbacks', 'MPI_Datarep_extent_function'), ('iso_c_binding', 'c_funloc'), ('iso_c_binding', 'c_funptr')] + else: + return [] def c_parameter(self): return f'ompi_mpi2_fortran_datarep_extent_fn_t {self.name}' diff --git a/ompi/mpi/bindings/ompi_bindings/util.py b/ompi/mpi/bindings/ompi_bindings/util.py index da454f7e967..d2a9ba1c528 100644 --- a/ompi/mpi/bindings/ompi_bindings/util.py +++ b/ompi/mpi/bindings/ompi_bindings/util.py @@ -67,11 +67,17 @@ def ext_api_func_name_profile(fn_name, bigcount=False): return f'P{ext_api_func_name(fn_name, bigcount)}' -def fortran_f08_name(fn_name, bigcount=False, needs_ts=False): +def fortran_name(fn_name, bigcount=False, needs_ts=False, gen_f90=False): """Produce the final f08 name from base_name. See section 19.2 of MPI 4.1 standard.""" - suffix = '_c' if bigcount else '' - ts = 'ts' if needs_ts else '' - return f'MPI_{fn_name.capitalize()}{suffix}_f08{ts}' + name = '' + if gen_f90 == False: + suffix = '_c' if bigcount else '' + ts = 'ts' if needs_ts else '' + name = f'MPI_{fn_name.capitalize()}{suffix}_f08{ts}' + else: + ts = '_FTS' if needs_ts else '' + name = f'MPI_{fn_name.capitalize()}{ts}' + return name def fortran_f08_generic_interface_name(fn_name): """Produce the generic interface name from the base_name.""" diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am index b636cee45ea..089fcb73efb 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am @@ -94,6 +94,7 @@ mpi-f08-interfaces-generated.h: $(template_files) fortran \ $(gen_ts) \ interface \ + --fort-std f08 \ --prototype-files $(template_files) # Delete generated file on maintainer-clean diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am index 4dd2dfc894b..f530bf3fafe 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am @@ -8,6 +8,8 @@ # Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. # Copyright (c) 2022 IBM Corporation. All rights reserved. # Copyright (c) 2025 Jeffrey M. Squyres. All rights reserved. +# Copyright (c) 2025 Triad National Security, LLC. All rights +# reserved. # $COPYRIGHT$ # # Additional copyrights may follow @@ -45,6 +47,7 @@ mpi-ignore-tkr.lo: $(top_srcdir)/ompi/mpi/fortran/base/attr-fn-int-callback-inte mpi-ignore-tkr.lo: $(top_srcdir)/ompi/mpi/fortran/base/conversion-fn-null-int-interface.h mpi-ignore-tkr.lo: mpi-ignore-tkr-interfaces.h mpi-ignore-tkr.lo: mpi-ignore-tkr-status.h +mpi-ignore-tkr.lo: mpi-ignore-tkr-interfaces-generated.h mpi-ignore-tkr.lo: pmpi-ignore-tkr-interfaces.h mpi-ignore-tkr.lo: mpi-ignore-tkr-file-interfaces.h mpi-ignore-tkr.lo: pmpi-ignore-tkr-file-interfaces.h @@ -59,7 +62,8 @@ lib@OMPI_LIBMPI_NAME@_usempi_ignore_tkr_la_SOURCES = \ mpi-ignore-tkr-status.h \ pmpi-ignore-tkr-interfaces.h \ pmpi-ignore-tkr-file-interfaces.h \ - pmpi-ignore-tkr-removed-interfaces.h + pmpi-ignore-tkr-removed-interfaces.h \ + mpi-ignore-tkr-interfaces-generated.h nodist_lib@OMPI_LIBMPI_NAME@_usempi_ignore_tkr_la_SOURCES = \ mpi-ignore-tkr-interfaces.h \ @@ -124,6 +128,30 @@ mpi-ignore-tkr-sizeof.f90: --complex4=$(OMPI_HAVE_FORTRAN_COMPLEX4) \ --complex32=$(OMPI_HAVE_FORTRAN_COMPLEX32) +# +# Generate the Fortran bindings and C wrapper functions for bindings with a +# *.in template. Eventually the template files will be moved to a +# shared location for all three fortran variants - mpif/mpi/mpi_f08. +# + +include Makefile.prototype_files +template_files =${prototype_files:%=$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/%} + +if OMPI_FORTRAN_HAVE_TS +gen_ts = --generate-ts-suffix +endif + +mpi-ignore-tkr-interfaces-generated.h: $(template_files) + $(OMPI_V_GEN) $(PYTHON) $(top_srcdir)/ompi/mpi/bindings/bindings.py \ + --builddir $(abs_top_builddir) \ + --srcdir $(abs_top_srcdir) \ + --output $(abs_builddir)/$@ \ + fortran \ + $(gen_ts) \ + interface \ + --fort-std f90 \ + --prototype-files $(template_files) + # # Clean up generated and module files # @@ -131,6 +159,7 @@ mpi-ignore-tkr-sizeof.f90: CLEANFILES += mpi-ignore-tkr-sizeof.h mpi-ignore-tkr-sizeof.f90 MOSTLYCLEANFILES = *.mod CLEANFILES += *.i90 +MAINTAINERCLEANFILES = mpi-ignore-tkr-interfaces-generated.h # Install the generated .mod files. Unfortunately, each F90 compiler # may generate different filenames, so we have to use a glob. :-( diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files new file mode 100644 index 00000000000..72dd7ea9550 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.prototype_files @@ -0,0 +1,9 @@ +# +# Shared list of prototype files to avoid listing dependencies multiple times. +# + +prototype_files = \ + request_get_status.c.in \ + request_get_status_all.c.in \ + request_get_status_any.c.in \ + request_get_status_some.c.in diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in index 6253d378bcc..45b8a22941d 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces.h.in @@ -3354,19 +3354,6 @@ end subroutine MPI_Request_free end interface -interface - -subroutine MPI_Request_get_status(request, flag, status, ierror) - include 'mpif-config.h' - integer, intent(in) :: request - logical, intent(out) :: flag - integer, dimension(MPI_STATUS_SIZE), intent(out) :: status - integer, intent(out) :: ierror -end subroutine MPI_Request_get_status - -end interface - - interface subroutine MPI_Rget(origin_addr, origin_count, origin_datatype, & diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr.F90 b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr.F90 index cb1ce70966e..c5a0ce6d941 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr.F90 +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr.F90 @@ -51,6 +51,7 @@ module mpi # include "ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h" # include "ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-file-interfaces.h" # include "ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-file-interfaces.h" +# include "ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-interfaces-generated.h" #if !defined(OMPI_ENABLE_MPI1_COMPAT) #error "Remove MPI-1 compat code" diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h b/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h index f27471b9580..d180f04addd 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/pmpi-ignore-tkr-interfaces.h @@ -228,7 +228,6 @@ #define MPI_Reduce_scatter_block_init PMPI_Reduce_scatter_block_init #define MPI_Register_datarep PMPI_Register_datarep #define MPI_Request_free PMPI_Request_free -#define MPI_Request_get_status PMPI_Request_get_status #define MPI_Rget PMPI_Rget #define MPI_Rget_accumulate PMPI_Rget_accumulate #define MPI_Rput PMPI_Rput From 7f2161857c8de60833bbdd9953dcc26ce33ae8ff Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Thu, 19 Jun 2025 13:50:19 -0600 Subject: [PATCH 6/8] request_get_status_mult: add f77 functions Signed-off-by: Howard Pritchard --- ompi/mpi/fortran/mpif-h/Makefile.am | 5 +- ompi/mpi/fortran/mpif-h/profile/Makefile.am | 3 + ompi/mpi/fortran/mpif-h/prototypes_mpi.h | 3 + .../fortran/mpif-h/request_get_status_all_f.c | 122 +++++++++++++++ .../fortran/mpif-h/request_get_status_any_f.c | 129 ++++++++++++++++ .../mpif-h/request_get_status_some_f.c | 140 ++++++++++++++++++ 6 files changed, 401 insertions(+), 1 deletion(-) create mode 100644 ompi/mpi/fortran/mpif-h/request_get_status_all_f.c create mode 100644 ompi/mpi/fortran/mpif-h/request_get_status_any_f.c create mode 100644 ompi/mpi/fortran/mpif-h/request_get_status_some_f.c diff --git a/ompi/mpi/fortran/mpif-h/Makefile.am b/ompi/mpi/fortran/mpif-h/Makefile.am index dedb62eae7f..2ea0d33bb14 100644 --- a/ompi/mpi/fortran/mpif-h/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/Makefile.am @@ -18,7 +18,7 @@ # and Technology (RIST). All rights reserved. # Copyright (c) 2016 IBM Corporation. All rights reserved. # Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -# Copyright (c) 2021-2022 Triad National Security, LLC. All rights +# Copyright (c) 2021-2025 Triad National Security, LLC. All rights # reserved. # Copyright (c) 2025 Jeffrey M. Squyres. All rights reserved. # @@ -410,6 +410,9 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \ register_datarep_f.c \ request_free_f.c \ request_get_status_f.c \ + request_get_status_all_f.c \ + request_get_status_any_f.c \ + request_get_status_some_f.c \ rsend_f.c \ rsend_init_f.c \ scan_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/profile/Makefile.am b/ompi/mpi/fortran/mpif-h/profile/Makefile.am index 4390bdd4995..11b4af4d555 100644 --- a/ompi/mpi/fortran/mpif-h/profile/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/profile/Makefile.am @@ -321,6 +321,9 @@ linked_files = \ preduce_scatter_block_init_f.c \ prequest_free_f.c \ prequest_get_status_f.c \ + prequest_get_status_all_f.c \ + prequest_get_status_any_f.c \ + prequest_get_status_some_f.c \ prsend_f.c \ prsend_init_f.c \ pscan_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h index 6573f3cbd15..db58f760e9c 100644 --- a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h +++ b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h @@ -374,6 +374,9 @@ PN2(void, MPI_Reduce_scatter_block_init, mpi_reduce_scatter_block_init, MPI_REDU PN2(void, MPI_Register_datarep, mpi_register_datarep, MPI_REGISTER_DATAREP, (char *datarep, ompi_mpi2_fortran_datarep_conversion_fn_t *read_conversion_fn, ompi_mpi2_fortran_datarep_conversion_fn_t *write_conversion_fn, ompi_mpi2_fortran_datarep_extent_fn_t *dtype_file_extent_fn, MPI_Aint *extra_state, MPI_Fint *ierr, int datarep_len)); PN2(void, MPI_Request_free, mpi_request_free, MPI_REQUEST_FREE, (MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Request_get_status, mpi_request_get_status, MPI_REQUEST_GET_STATUS, (MPI_Fint *request, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)); +PN2(void, MPI_Request_get_status_all, mpi_request_get_status_all, MPI_REQUEST_GET_STATUS_ALL, (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr)); +PN2(void, MPI_Request_get_status_any, mpi_request_get_status_any, MPI_REQUEST_GET_STATUS_ANY, (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr)); +PN2(void, MPI_Request_get_status_some, mpi_request_get_status_some, MPI_REQUEST_GET_STATUS_SOME, (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *outcount, MPI_Fint *array_of_indices, MPI_Fint *array_of_statuses, MPI_Fint *ierr)); PN2(void, MPI_Rget, mpi_rget, MPI_RGET, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Rget_accumulate, mpi_rget_accumulate, MPI_RGET_ACCUMULATE, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, char *result_addr, MPI_Fint *result_count, MPI_Fint *result_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *op, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Rput, mpi_rput, MPI_RPUT, (char *origin_addr, MPI_Fint *origin_count, MPI_Fint *origin_datatype, MPI_Fint *target_rank, MPI_Aint *target_disp, MPI_Fint *target_count, MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request, MPI_Fint *ierr)); diff --git a/ompi/mpi/fortran/mpif-h/request_get_status_all_f.c b/ompi/mpi/fortran/mpif-h/request_get_status_all_f.c new file mode 100644 index 00000000000..43ef7db0732 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/request_get_status_all_f.c @@ -0,0 +1,122 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights reserved. + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/fortran/mpif-h/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f +#pragma weak pmpi_request_get_status_all = ompi_request_get_status_all_f +#pragma weak pmpi_request_get_status_all_ = ompi_request_get_status_all_f +#pragma weak pmpi_request_get_status_all__ = ompi_request_get_status_all_f + +#pragma weak PMPI_Request_get_status_all_f = ompi_request_get_status_all_f +#pragma weak PMPI_Request_get_status_all_f08 = ompi_request_get_status_all_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_GET_STATUS_ALL, + pmpi_request_get_status_all, + pmpi_request_get_status_all_, + pmpi_request_get_status_all__, + pompi_request_get_status_all_f, + (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr), + (count, array_of_requests, flag, array_of_statuses, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REQUEST_GET_STATUS_ALL = ompi_request_get_status_all_f +#pragma weak mpi_request_get_status_all = ompi_request_get_status_all_f +#pragma weak mpi_request_get_status_all_ = ompi_request_get_status_all_f +#pragma weak mpi_request_get_status_all__ = ompi_request_get_status_all_f + +#pragma weak MPI_Request_get_status_all_f = ompi_request_get_status_all_f +#pragma weak MPI_Request_get_status_all_f08 = ompi_request_get_status_all_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS_ALL, + mpi_request_get_status_all, + mpi_request_get_status_all_, + mpi_request_get_status_all__, + ompi_request_get_status_all_f, + (MPI_Fint *count, MPI_Fint *array_of_requests, ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr), + (count, array_of_requests, flag, array_of_statuses, ierr) ) +#else +#define ompi_request_get_status_all_f pompi_request_get_status_all_f +#endif +#endif + + +static const char FUNC_NAME[] = "MPI_REQUEST_GET_STATUS_ALL"; + + +void ompi_request_get_status_all_f(MPI_Fint *count, MPI_Fint *array_of_requests, + ompi_fortran_logical_t *flag, MPI_Fint *array_of_statuses, MPI_Fint *ierr) +{ + MPI_Request *c_req; + MPI_Status *c_status; + int i, c_ierr; + OMPI_LOGICAL_NAME_DECL(flag); + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + *flag = OMPI_FORTRAN_VALUE_TRUE; + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * + (sizeof(MPI_Request) + sizeof(MPI_Status))); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*count)); + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = PMPI_Request_get_status_all(OMPI_FINT_2_INT(*count), c_req, OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag), c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_LOGICAL(flag); + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + array_of_requests[i] = c_req[i]->req_f_to_c_index; + if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) && + !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) { + PMPI_Status_c2f( &c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]); + } + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/mpif-h/request_get_status_any_f.c b/ompi/mpi/fortran/mpif-h/request_get_status_any_f.c new file mode 100644 index 00000000000..d6c0c943965 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/request_get_status_any_f.c @@ -0,0 +1,129 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights reserved. + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/fortran/mpif-h/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f +#pragma weak pmpi_request_get_status_any = ompi_request_get_status_any_f +#pragma weak pmpi_request_get_status_any_ = ompi_request_get_status_any_f +#pragma weak pmpi_request_get_status_any__ = ompi_request_get_status_any_f + +#pragma weak PMPI_Request_get_status_any_f = ompi_request_get_status_any_f +#pragma weak PMPI_Request_get_status_any_f08 = ompi_request_get_status_any_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_STATUS_GET_ANY, + pmpi_request_get_status_any, + pmpi_request_get_status_any_, + pmpi_request_get_status_any__, + pompi_request_get_status_any_f, + (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr), + (count, array_of_requests, indx, flag, status, ierr)) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REQUEST_STATUS_GET_ANY = ompi_request_get_status_any_f +#pragma weak mpi_request_get_status_any = ompi_request_get_status_any_f +#pragma weak mpi_request_get_status_any_ = ompi_request_get_status_any_f +#pragma weak mpi_request_get_status_any__ = ompi_request_get_status_any_f + +#pragma weak MPI_Request_get_status_any_f = ompi_request_get_status_any_f +#pragma weak MPI_Request_get_status_any_f08 = ompi_request_get_status_any_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_STATUS_GET_ANY, + mpi_request_get_status_any, + mpi_request_get_status_any_, + mpi_request_get_status_any__, + ompi_request_get_status_any_f, + (MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr), + (count, array_of_requests, indx, flag, status, ierr)) +#else +#define ompi_request_get_status_any_f pompi_request_get_status_any_f +#endif +#endif + + +static const char FUNC_NAME[] = "MPI_REQUEST_STATUS_GET_ANY"; + + +void ompi_request_get_status_any_f(MPI_Fint *count, MPI_Fint *array_of_requests, + MPI_Fint *indx, ompi_fortran_logical_t *flag, MPI_Fint *status, MPI_Fint *ierr) +{ + MPI_Request *c_req; + MPI_Status c_status; + int i, c_ierr; + OMPI_LOGICAL_NAME_DECL(flag); + OMPI_SINGLE_NAME_DECL(indx); + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*count))) { + *indx = OMPI_INT_2_FINT(MPI_UNDEFINED); + PMPI_Status_c2f(&ompi_status_empty, status); + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*count) * sizeof(MPI_Request)); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + + for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + c_ierr = PMPI_Request_get_status_any(OMPI_FINT_2_INT(*count), c_req, + OMPI_SINGLE_NAME_CONVERT(indx), OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag), + &c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + + OMPI_SINGLE_INT_2_LOGICAL(flag); + + /* Increment index by one for fortran conventions */ + + OMPI_SINGLE_INT_2_FINT(indx); + if (MPI_UNDEFINED != *(OMPI_SINGLE_NAME_CONVERT(indx))) { + array_of_requests[OMPI_INT_2_FINT(*indx)] = + c_req[OMPI_INT_2_FINT(*indx)]->req_f_to_c_index; + ++(*indx); + } + if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } + } + free(c_req); +} diff --git a/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c b/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c new file mode 100644 index 00000000000..7cf85edddba --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c @@ -0,0 +1,140 @@ +/* + * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2005 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights reserved. + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/fortran/mpif-h/bindings.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_REQUEST_GET_STATUS_SOME = ompi_request_get_status_some_f +#pragma weak pmpi_request_get_status_some = ompi_request_get_status_some_f +#pragma weak pmpi_request_get_status_some_ = ompi_request_get_status_some_f +#pragma weak pmpi_request_get_status_some__ = ompi_request_get_status_some_f + +#pragma weak PMPI_Request_get_status_some_f = ompi_request_get_status_some_f +#pragma weak PMPI_Request_get_status_some_f08 = ompi_request_get_status_some_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_REQUEST_GET_STATUS_SOME, + pmpi_request_get_status_some, + pmpi_request_get_status_some_, + pmpi_request_get_status_some__, + pompi_request_get_status_some_f, + (MPI_Fint *incount, MPI_Fint *array_of_requests, MPI_Fint *outcount, MPI_Fint *array_of_indices, MPI_Fint *array_of_statuses, MPI_Fint *ierr), + (incount, array_of_requests, outcount, array_of_indices, array_of_statuses, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_REQUEST_GET_STATUS_SOME = ompi_request_get_status_some_f +#pragma weak mpi_request_get_status_some = ompi_request_get_status_some_f +#pragma weak mpi_request_get_status_some_ = ompi_request_get_status_some_f +#pragma weak mpi_request_get_status_some__ = ompi_request_get_status_some_f + +#pragma weak MPI_Request_get_status_some_f = ompi_request_get_status_some_f +#pragma weak MPI_Request_get_status_some_f08 = ompi_request_get_status_some_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_REQUEST_GET_STATUS_SOME, + mpi_request_get_status_some, + mpi_request_get_status_some_, + mpi_request_get_status_some__, + ompi_request_get_status_some_f, + (MPI_Fint *incount, MPI_Fint *array_of_requests, MPI_Fint *outcount, MPI_Fint *array_of_indices, MPI_Fint *array_of_statuses, MPI_Fint *ierr), + (incount, array_of_requests, outcount, array_of_indices, array_of_statuses, ierr) ) +#else +#define ompi_request_get_status_some_f pompi_request_get_status_some_f +#endif +#endif + + +static const char FUNC_NAME[] = "MPI_REQUEST_GET_STATUS_SOME"; + + +void ompi_request_get_status_some_f(MPI_Fint *incount, MPI_Fint *array_of_requests, + MPI_Fint *outcount, MPI_Fint *array_of_indices, + MPI_Fint *array_of_statuses, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Request *c_req; + MPI_Status *c_status; + int i; + OMPI_SINGLE_NAME_DECL(outcount); + OMPI_ARRAY_NAME_DECL(array_of_indices); + + /* Shortcut to avoid malloc(0) if *count==0. We're intentionally + skipping other parameter error checks. */ + if (OPAL_UNLIKELY(0 == OMPI_FINT_2_INT(*incount))) { + *outcount = OMPI_INT_2_FINT(MPI_UNDEFINED); + *ierr = OMPI_INT_2_FINT(MPI_SUCCESS); + return; + } + + c_req = (MPI_Request *) malloc(OMPI_FINT_2_INT(*incount) * + (sizeof(MPI_Request) + sizeof(MPI_Status))); + if (NULL == c_req) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_status = (MPI_Status*) (c_req + OMPI_FINT_2_INT(*incount)); + + for (i = 0; i < OMPI_FINT_2_INT(*incount); ++i) { + c_req[i] = PMPI_Request_f2c(array_of_requests[i]); + } + + OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_indices, *incount); + c_ierr = PMPI_Request_get_status_some(OMPI_FINT_2_INT(*incount), c_req, + OMPI_SINGLE_NAME_CONVERT(outcount), + OMPI_ARRAY_NAME_CONVERT(array_of_indices), + c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(outcount); + OMPI_ARRAY_INT_2_FINT(array_of_indices, *incount); + + /* Increment indexes by one for fortran conventions */ + + if (MPI_UNDEFINED != OMPI_FINT_2_INT(*outcount)) { + for (i = 0; i < OMPI_FINT_2_INT(*outcount); ++i) { + array_of_requests[OMPI_INT_2_FINT(array_of_indices[i])] = + c_req[OMPI_INT_2_FINT(array_of_indices[i])]->req_f_to_c_index; + ++array_of_indices[i]; + } + } + if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses)) { + for (i = 0; i < OMPI_FINT_2_INT(*incount); ++i) { + if (!OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) { + PMPI_Status_c2f(&c_status[i], &array_of_statuses[i * (sizeof(MPI_Status) / sizeof(int))]); + } + } + } + } + free(c_req); +} From 2076ec2e61d739f7690d0cef34ac3f706648bbb6 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Mon, 14 Jul 2025 10:36:28 -0600 Subject: [PATCH 7/8] fortran: PR feedback Signed-off-by: Howard Pritchard --- ompi/mpi/bindings/bindings.py | 8 +++----- ompi/mpi/fortran/mpif-h/request_get_status_some_f.c | 2 +- ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am | 2 +- ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am | 2 +- 4 files changed, 6 insertions(+), 8 deletions(-) diff --git a/ompi/mpi/bindings/bindings.py b/ompi/mpi/bindings/bindings.py index a101bfbfd85..9fa858db93b 100644 --- a/ompi/mpi/bindings/bindings.py +++ b/ompi/mpi/bindings/bindings.py @@ -33,20 +33,18 @@ def main(): parser_fortran = subparsers.add_parser('fortran', help='subcommand for generating Fortran code') parser_fortran.add_argument('--generate-ts-suffix', action="store_true", help='generate ts suffixes for appropriate routines') + parser_fortran.add_argument('--fort-std', choices=('f90', 'f08'), + help='fortran standard to use for fortran module and code generation') # Handler for generating actual code subparsers_fortran = parser_fortran.add_subparsers() parser_code = subparsers_fortran.add_parser('code', help='generate binding code') parser_code.set_defaults(handler=lambda args, out: fortran.generate_code(args, out)) - parser_code.add_argument('--lang', choices=('fortran', 'c', 'f90'), + parser_code.add_argument('--lang', choices=('fortran', 'c'), help='language to generate (only for code subparser)') - parser_code.add_argument('--fort-std', choices=('f90', 'f08'), - help='fortran standard to use for fortran module generation') # Handler for generating the Fortran interface files parser_interface = subparsers_fortran.add_parser('interface', help='generate Fortran interface specifications') parser_interface.set_defaults(handler=lambda args, out: fortran.generate_interface(args, out)) - parser_interface.add_argument('--fort-std', choices=('f90', 'f08'), - help='fortran standard to use for fortran module generation') # The prototype files argument must come last and be specified for both subparsers for f_subparser in [parser_code, parser_interface]: f_subparser.add_argument('--prototype-files', nargs='+', help='prototype files to generate code for') diff --git a/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c b/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c index 7cf85edddba..158e33fdf45 100644 --- a/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c +++ b/ompi/mpi/fortran/mpif-h/request_get_status_some_f.c @@ -116,7 +116,7 @@ void ompi_request_get_status_some_f(MPI_Fint *incount, MPI_Fint *array_of_reques if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); if (MPI_SUCCESS == c_ierr) { - OMPI_SINGLE_INT_2_FINT(outcount); + OMPI_SINGLE_INT_2_FINT(*outcount); OMPI_ARRAY_INT_2_FINT(array_of_indices, *incount); /* Increment indexes by one for fortran conventions */ diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am index 089fcb73efb..8ffd19607e8 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am @@ -93,8 +93,8 @@ mpi-f08-interfaces-generated.h: $(template_files) --output $(abs_builddir)/$@ \ fortran \ $(gen_ts) \ - interface \ --fort-std f08 \ + interface \ --prototype-files $(template_files) # Delete generated file on maintainer-clean diff --git a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am index f530bf3fafe..baf818f1129 100644 --- a/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-ignore-tkr/Makefile.am @@ -148,8 +148,8 @@ mpi-ignore-tkr-interfaces-generated.h: $(template_files) --output $(abs_builddir)/$@ \ fortran \ $(gen_ts) \ - interface \ --fort-std f90 \ + interface \ --prototype-files $(template_files) # From 47fbc3944f51a9296e50da9aacf402ed2e717777 Mon Sep 17 00:00:00 2001 From: Edgar Gabriel Date: Thu, 17 Jul 2025 09:53:49 -0500 Subject: [PATCH 8/8] mpi: incorporate review comments Incorporate the comments received during the review of the PR. Signed-off-by: Edgar Gabriel --- .../man3/MPI_Request_get_status_all.3.rst | 5 +++-- .../man3/MPI_Request_get_status_any.3.rst | 4 ++-- .../man3/MPI_Request_get_status_some.3.rst | 6 +++--- ompi/mpi/c/request_get_status_all.c.in | 14 +++++--------- ompi/mpi/c/request_get_status_any.c.in | 6 +++--- ompi/mpi/c/request_get_status_some.c.in | 6 +++--- 6 files changed, 19 insertions(+), 22 deletions(-) diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst index 35f110ed811..ad9a10a9f13 100644 --- a/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst +++ b/docs/man-openmpi/man3/MPI_Request_get_status_all.3.rst @@ -31,14 +31,15 @@ operations associated with *active* handles in the array have completed. In this case, each status entry that corresponds to an active request is set to the status of the corresponding operation. It does not deallocate or deactivate the request; a subsequent call to -test, wait, or free should be executed with each of those requests. +any of the MPI test, wait, or free routines should be executed with each +of those requests. Each status entry that corresponds to a null or inactive handle is set to empty. Otherwise, ``flag = false`` is returned and the values of the status entries are undefined. If your application does not need to examine the *status* field, you can -save resources by using the predefined constant ``MPI_STATUS_IGNORE`` as a +save resources by using the predefined constant ``MPI_STATUSES_IGNORE`` as a special value for the ``array_of_statuses`` argument. diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst index f6572343b9c..1f48215eae9 100644 --- a/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst +++ b/docs/man-openmpi/man3/MPI_Request_get_status_any.3.rst @@ -31,8 +31,8 @@ DESCRIPTION of the operations associated with active handles has completed. In this case it returns in ``index`` the index of this request in the array and the status of the operation in ``status``. It does not -deallocate or deactivate the request; a subsequent call to test, wait, -or free should be executed with that request. +deallocate or deactivate the request; a subsequent call to any of the MPI +test, wait, or free routines should be executed with that request. If no operation completed, it returns ``flag = false`` and a value of ``MPI_UNDEFINED`` in ``index``. ``status`` is undefined in this diff --git a/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst b/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst index 3c8033d3726..963df63f4e1 100644 --- a/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst +++ b/docs/man-openmpi/man3/MPI_Request_get_status_some.3.rst @@ -34,15 +34,15 @@ first ``outcount`` locations of the array ``array_of_indices`` and within the array ``array_of_requests`` and the status of these operations respectively. The array is indexed from zero in C and from one in Fortran. It does not deallocate or deactivate the request; a -subsequent call to test, wait, or free should be executed with each completed -request. +subsequent call to any of the MPI test, wait, or free routines should be +executed with each completed request. If no operation in ``array_of_requests`` is complete, it returns ``outcount = 0``. If all operations in ``array_of_requests`` are either ``MPI_REQUEST_NULL`` or inactive, ``outcount`` will be set to ``MPI_UNDEFINED``. If your application does not need to examine the *status* field, you can -save resources by using the predefined constant ``MPI_STATUS_IGNORE`` as a +save resources by using the predefined constant ``MPI_STATUSES_IGNORE`` as a special value for the ``array_of_statuses`` argument. diff --git a/ompi/mpi/c/request_get_status_all.c.in b/ompi/mpi/c/request_get_status_all.c.in index ef1c36af355..15a406a07b5 100644 --- a/ompi/mpi/c/request_get_status_all.c.in +++ b/ompi/mpi/c/request_get_status_all.c.in @@ -70,10 +70,9 @@ PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_CONST requests:c } bool all_done; - bool one_done; #if OPAL_ENABLE_PROGRESS_THREADS == 0 - int do_it_once = 0; + bool do_it_once = true; recheck_request_status: #endif @@ -81,25 +80,22 @@ PROTOTYPE ERROR_CLASS request_get_status_all(INT count, REQUEST_CONST requests:c int i; all_done = true; for (i = 0; i < count; i++) { - one_done = false; if( (requests[i] == MPI_REQUEST_NULL) || (requests[i]->req_state == OMPI_REQUEST_INACTIVE) || (requests[i]->req_complete) ) { continue; } - if (!one_done) { - all_done = false; - break; - } + all_done = false; + break; } if (!all_done) { #if OPAL_ENABLE_PROGRESS_THREADS == 0 - if( 0 == do_it_once ) { + if(do_it_once) { /* If we run the opal_progress then check the status of the request before leaving. We will call the opal_progress only once per call. */ opal_progress(); - do_it_once++; + do_it_once = false; goto recheck_request_status; } #endif diff --git a/ompi/mpi/c/request_get_status_any.c.in b/ompi/mpi/c/request_get_status_any.c.in index 25613bcef36..b8c12085336 100644 --- a/ompi/mpi/c/request_get_status_any.c.in +++ b/ompi/mpi/c/request_get_status_any.c.in @@ -77,7 +77,7 @@ PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_CONST requests:c bool all_inactive; #if OPAL_ENABLE_PROGRESS_THREADS == 0 - int do_it_once = 0; + bool do_it_once = true; recheck_request_status: #endif @@ -117,12 +117,12 @@ PROTOTYPE ERROR_CLASS request_get_status_any(INT count, REQUEST_CONST requests:c } #if OPAL_ENABLE_PROGRESS_THREADS == 0 - if( 0 == do_it_once ) { + if(do_it_once) { /* If we run the opal_progress then check the status of the request before leaving. We will call the opal_progress only once per call. */ opal_progress(); - do_it_once++; + do_it_once = false; goto recheck_request_status; } #endif diff --git a/ompi/mpi/c/request_get_status_some.c.in b/ompi/mpi/c/request_get_status_some.c.in index b7f524773dd..824b3fcf219 100644 --- a/ompi/mpi/c/request_get_status_some.c.in +++ b/ompi/mpi/c/request_get_status_some.c.in @@ -73,7 +73,7 @@ PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_CONST request bool all_inactive; #if OPAL_ENABLE_PROGRESS_THREADS == 0 - int do_it_once = 0; + bool do_it_once = true; recheck_request_status: #endif @@ -112,12 +112,12 @@ PROTOTYPE ERROR_CLASS request_get_status_some(INT incount, REQUEST_CONST request } #if OPAL_ENABLE_PROGRESS_THREADS == 0 - if( 0 == do_it_once ) { + if(do_it_once) { /* If we run the opal_progress then check the status of the request before leaving. We will call the opal_progress only once per call. */ opal_progress(); - do_it_once++; + do_it_once = false; goto recheck_request_status; } #endif