From 37d0a546a502ef91de61e9416e29737df4a9d9ad Mon Sep 17 00:00:00 2001 From: Edgar Gabriel Date: Mon, 26 May 2025 12:29:27 -0500 Subject: [PATCH 1/6] 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 f636bc542684f4cabbc7ae3a43813fe1be049a11 Mon Sep 17 00:00:00 2001 From: Edgar Gabriel Date: Mon, 26 May 2025 15:00:03 -0500 Subject: [PATCH 2/6] 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 81e3492fc550d1db08fbfbbf035d1278eddea8ca Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 27 May 2025 12:15:35 -0600 Subject: [PATCH 3/6] 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 31a0d60ff620b664ad301b9ecd0fc124c5fcccf7 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Sun, 15 Jun 2025 08:59:29 -0600 Subject: [PATCH 4/6] 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 38627123536..5b44ca7ad62 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 f17f7edefa9..da7046d7335 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 fb2e0988d8a2ddc3de5274b27330feed610993f6 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Tue, 17 Jun 2025 19:46:14 -0600 Subject: [PATCH 5/6] 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 5b44ca7ad62..1e77e5990d5 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(IN) :: {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 a391063acb3c9bd87653b2bcfe115d8474f093f6 Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Thu, 19 Jun 2025 13:50:19 -0600 Subject: [PATCH 6/6] 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); +}