From 4402736bbc3bf74e854cc1125ab156fea6eab73d Mon Sep 17 00:00:00 2001 From: Howard Pritchard Date: Fri, 27 May 2022 11:52:06 -0600 Subject: [PATCH] sessions: add missing errhandler funcs somehow managed to not get into the original sessions pr. also do some cleanup of the use mpi_f08 profiling functions. Related to #10388 Signed-off-by: Howard Pritchard --- .../man3/MPI_Session_call_errhandler.3.rst | 80 ++++++++++++++++ .../man3/MPI_Session_get_errhandler.3.rst | 80 ++++++++++++++++ .../man3/MPI_Session_set_errhandler.3.rst | 79 ++++++++++++++++ docs/man-openmpi/man3/index.rst | 3 + ompi/include/mpi.h.in | 9 +- ompi/instance/instance.c | 8 +- ompi/instance/instance.h | 1 + ompi/mpi/c/Makefile.am | 3 + ompi/mpi/c/session_call_errhandler.c | 59 ++++++++++++ ompi/mpi/c/session_get_errhandler.c | 71 +++++++++++++++ ompi/mpi/c/session_set_errhandler.c | 73 +++++++++++++++ ompi/mpi/fortran/mpif-h/Makefile.am | 4 + ompi/mpi/fortran/mpif-h/profile/Makefile.am | 4 + ompi/mpi/fortran/mpif-h/prototypes_mpi.h | 4 + .../mpif-h/session_call_errhandler_f.c | 81 +++++++++++++++++ .../mpif-h/session_create_errhandler_f.c | 91 +++++++++++++++++++ .../fortran/mpif-h/session_get_errhandler_f.c | 86 ++++++++++++++++++ .../fortran/mpif-h/session_set_errhandler_f.c | 84 +++++++++++++++++ ompi/mpi/fortran/use-mpi-f08/Makefile.am | 4 + .../bindings/mpi-f-interfaces-bind.h | 35 +++++++ .../mod/mpi-f08-interfaces-callbacks.F90 | 9 ++ .../use-mpi-f08/mod/mpi-f08-interfaces.h.in | 41 +++++++++ .../fortran/use-mpi-f08/mod/mpi-f08-rename.h | 10 +- .../fortran/use-mpi-f08/profile/Makefile.am | 9 ++ .../profile/psession_get_info_f08.F90 | 25 ----- .../profile/psession_get_nth_pset_f08.F90 | 27 ------ .../profile/psession_get_num_psets_f08.F90 | 25 ----- .../profile/psession_get_pset_info_f08.F90 | 26 ------ .../use-mpi-f08/profile/psession_init_f08.F90 | 26 ------ .../session_call_errhandler_f08.F90 | 26 ++++++ .../session_create_errhandler_f08.F90 | 32 +++++++ .../session_get_errhandler_f08.F90 | 26 ++++++ .../use-mpi-f08/session_get_info_f08.F90 | 4 +- .../use-mpi-f08/session_get_nth_pset_f08.F90 | 4 +- .../use-mpi-f08/session_get_num_psets_f08.F90 | 4 +- .../use-mpi-f08/session_get_pset_info_f08.F90 | 4 +- .../session_set_errhandler_f08.F90 | 26 ++++++ .../mpi-ignore-tkr-interfaces.h.in | 42 +++++++++ .../pmpi-ignore-tkr-interfaces.h | 4 + .../fortran/use-mpi-tkr/mpi-f90-interfaces.h | 39 ++++++++ .../fortran/use-mpi-tkr/pmpi-f90-interfaces.h | 6 +- 41 files changed, 1136 insertions(+), 138 deletions(-) create mode 100644 docs/man-openmpi/man3/MPI_Session_call_errhandler.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Session_get_errhandler.3.rst create mode 100644 docs/man-openmpi/man3/MPI_Session_set_errhandler.3.rst create mode 100644 ompi/mpi/c/session_call_errhandler.c create mode 100644 ompi/mpi/c/session_get_errhandler.c create mode 100644 ompi/mpi/c/session_set_errhandler.c create mode 100644 ompi/mpi/fortran/mpif-h/session_call_errhandler_f.c create mode 100644 ompi/mpi/fortran/mpif-h/session_create_errhandler_f.c create mode 100644 ompi/mpi/fortran/mpif-h/session_get_errhandler_f.c create mode 100644 ompi/mpi/fortran/mpif-h/session_set_errhandler_f.c delete mode 100644 ompi/mpi/fortran/use-mpi-f08/profile/psession_get_info_f08.F90 delete mode 100644 ompi/mpi/fortran/use-mpi-f08/profile/psession_get_nth_pset_f08.F90 delete mode 100644 ompi/mpi/fortran/use-mpi-f08/profile/psession_get_num_psets_f08.F90 delete mode 100644 ompi/mpi/fortran/use-mpi-f08/profile/psession_get_pset_info_f08.F90 delete mode 100644 ompi/mpi/fortran/use-mpi-f08/profile/psession_init_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/session_call_errhandler_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/session_create_errhandler_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/session_get_errhandler_f08.F90 create mode 100644 ompi/mpi/fortran/use-mpi-f08/session_set_errhandler_f08.F90 diff --git a/docs/man-openmpi/man3/MPI_Session_call_errhandler.3.rst b/docs/man-openmpi/man3/MPI_Session_call_errhandler.3.rst new file mode 100644 index 00000000000..948d5890191 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Session_call_errhandler.3.rst @@ -0,0 +1,80 @@ +.. _mpi_session_call_errhandler: + +MPI_Session_call_errhandler +======================== + +.. include_body + +:ref:`MPI_Session_call_errhandler` - Passes the supplied error code to the error +handler assigned to a session + +Syntax +------ + +C Syntax +^^^^^^^^ + +.. code:: c + + #include + + int MPI_Session_call_errhandler(MPI_Session session, int errorcode) + +Fortran Syntax +^^^^^^^^^^^^^^ + +.. code:: Fortran + + USE MPI + ! or the older form: INCLUDE 'mpif.h' + + MPI_SESSION_CALL_ERRHANDLER(SESSION, ERRORCODE, IERROR) + INTEGER SESSION, ERRORCODE, IERROR + +Fortran 2008 Syntax +^^^^^^^^^^^^^^^^^^^ + +.. code:: Fortran + + USE mpi_f08 + + MPI_Session_call_errhandler(session, errorcode, ierror) + TYPE(MPI_Session), INTENT(IN) :: session + INTEGER, INTENT(IN) :: errorcode + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + +Input Parameter +--------------- + +- session : session with error handler (handle). +- errorcode : error code (integer). + +Output Parameters +----------------- + +- IERROR : Fortran only: Error status (integer). + +Description +----------- + +This function invokes the error handler assigned to the session +session with the supplied error code errorcode. If the error handler was +successfully called, the process is not aborted, and the error handler +returns, this function returns MPI_SUCCESS. + +Notes +----- + +Users should note that the default error handler is +MPI_ERRORS_ARE_FATAL. Thus, calling this function will abort the +processes in session if the default error handler has not been changed. + +Errors +------ + +Almost all MPI routines return an error value; C routines as the value +of the function and Fortran routines in the last argument. See the MPI +man page for a full list of MPI error codes. + + +.. seealso:: :ref:`MPI_Session_create_errhandler` diff --git a/docs/man-openmpi/man3/MPI_Session_get_errhandler.3.rst b/docs/man-openmpi/man3/MPI_Session_get_errhandler.3.rst new file mode 100644 index 00000000000..7a301c85f18 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Session_get_errhandler.3.rst @@ -0,0 +1,80 @@ +.. _mpi_session_get_errhandler: + + +MPI_Session_get_errhandler +========================== + +.. include_body + +:ref:`MPI_Session_get_errhandler` - Retrieves error handler associated with a +session. + + +SYNTAX +------ + + +C Syntax +^^^^^^^^ + +.. code-block:: c + + #include + + int MPI_Session_get_errhandler(MPI_Session session, + MPI_Errhandler *errhandler) + + +Fortran Syntax +^^^^^^^^^^^^^^ + +.. code-block:: fortran + + USE MPI + ! or the older form: INCLUDE 'mpif.h' + MPI_SESSION_GET_ERRHANDLER(SESSION, ERRHANDLER, IERROR) + INTEGER SESSION, ERRHANDLER, IERROR + + +Fortran 2008 Syntax +^^^^^^^^^^^^^^^^^^^ + +.. code-block:: fortran + + USE mpi_f08 + MPI_Session_get_errhandler(session, errhandler, ierror) + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + + +INPUT PARAMETER +--------------- +* ``session``: Session (handle). + +OUTPUT PARAMETERS +----------------- +* ``errhandler``: New error handler for session (handle). +* ``IERROR``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +:ref:`MPI_Session_get_errhandler` retrieves the error handler currently associated +with a session. + + +ERRORS +------ + +Almost all MPI routines return an error value; C routines as the value +of the function and Fortran routines in the last argument. + +Before the error value is returned, the current MPI error handler is +called. By default, this error handler aborts the MPI job, except for +I/O function errors. The error handler may be changed with +:ref:`MPI_Session_set_errhandler`; the predefined error handler MPI_ERRORS_RETURN +may be used to cause error values to be returned. Note that MPI does not +guarantee that an MPI program can continue past an error. + +See the MPI man page for a full list of MPI error codes. diff --git a/docs/man-openmpi/man3/MPI_Session_set_errhandler.3.rst b/docs/man-openmpi/man3/MPI_Session_set_errhandler.3.rst new file mode 100644 index 00000000000..c976666fca3 --- /dev/null +++ b/docs/man-openmpi/man3/MPI_Session_set_errhandler.3.rst @@ -0,0 +1,79 @@ +.. _mpi_session_set_errhandler: + + +MPI_Session_set_errhandler +======================= + +.. include_body + +:ref:`MPI_Session_set_errhandler` - Attaches a new error handler to a +session. + + +SYNTAX +------ + + +C Syntax +^^^^^^^^ + +.. code-block:: c + + #include + + int MPI_Session_set_errhandler(MPI_Session session, + MPI_Errhandler errhandler) + + +Fortran Syntax +^^^^^^^^^^^^^^ + +.. code-block:: fortran + + USE MPI + ! or the older form: INCLUDE 'mpif.h' + MPI_SESSION_SET_ERRHANDLER(SESSION, ERRHANDLER, IERROR) + INTEGER SESSION, ERRHANDLER, IERROR + + +Fortran 2008 Syntax +^^^^^^^^^^^^^^^^^^^ + +.. code-block:: fortran + + USE mpi_f08 + MPI_Session_set_errhandler(session, errhandler, ierror) + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(IN) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + + +INPUT/OUTPUT PARAMETER +---------------------- +* ``session``: Session (handle). + +OUTPUT PARAMETERS +----------------- +* ``errhandler``: New error handler for session (handle). +* ``IERROR``: Fortran only: Error status (integer). + +DESCRIPTION +----------- + +:ref:`MPI_Session_set_errhandler` attaches a new error handler to a session. +The error handler must be either a predefined error handler or an error +handler created by a call to :ref:`MPI_Session_create_errhandler`. + + +ERRORS +------ + +Almost all MPI routines return an error value; C routines as the value +of the function and Fortran routines in the last argument. + +Before the error value is returned, the current MPI error handler is +called. By default, this error handler aborts the MPI job, except for +I/O function errors. The error handler may be changed with +:ref:`MPI_Session_set_errhandler`; the predefined error handler MPI_ERRORS_RETURN +may be used to cause error values to be returned. Note that MPI does not +guarantee that an MPI program can continue past an error. diff --git a/docs/man-openmpi/man3/index.rst b/docs/man-openmpi/man3/index.rst index b2781cdc680..183c2e00144 100644 --- a/docs/man-openmpi/man3/index.rst +++ b/docs/man-openmpi/man3/index.rst @@ -320,14 +320,17 @@ MPI API manual pages (section 3) MPI_Send_init.3.rst MPI_Sendrecv.3.rst MPI_Sendrecv_replace.3.rst + MPI_Session_call_errhandler.3.rst MPI_Session_create_errhandler.3.rst MPI_Session_f2c.3.rst MPI_Session_finalize.3.rst + MPI_Session_get_errhandler.3.rst MPI_Session_get_info.3.rst MPI_Session_get_nth_pset.3.rst MPI_Session_get_num_psets.3.rst MPI_Session_get_pset_info.3.rst MPI_Session_init.3.rst + MPI_Session_set_errhandler.3.rst MPI_Sizeof.3.rst MPI_Ssend.3.rst MPI_Ssend_init.3.rst diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index 76154a5b278..e97255fd555 100644 --- a/ompi/include/mpi.h.in +++ b/ompi/include/mpi.h.in @@ -26,7 +26,7 @@ * reserved. * Copyright (c) 2021 Bull S.A.S. All rights reserved. * Copyright (c) 2018 Triad National Security, LLC. All rights - * Copyright (c) 2018-2021 Triad National Security, LLC. All rights + * Copyright (c) 2018-2022 Triad National Security, LLC. All rights * reserved. * $COPYRIGHT$ * @@ -513,7 +513,6 @@ typedef int (MPI_Type_delete_attr_function)(MPI_Datatype, int, typedef int (MPI_Win_copy_attr_function)(MPI_Win, int, void *, void *, void *, int *); typedef int (MPI_Win_delete_attr_function)(MPI_Win, int, void *, void *); -typedef int (MPI_Session_delete_attr_function)(MPI_Session, int, void *, void *); typedef int (MPI_Grequest_query_function)(void *, MPI_Status *); typedef int (MPI_Grequest_free_function)(void *); typedef int (MPI_Grequest_cancel_function)(void *, int); @@ -1939,9 +1938,11 @@ OMPI_DECLSPEC int MPI_Sendrecv_replace(void * buf, int count, MPI_Datatype data int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC MPI_Fint MPI_Session_c2f (const MPI_Session session); +OMPI_DECLSPEC int MPI_Session_call_errhandler(MPI_Session session, int errorcode); OMPI_DECLSPEC int MPI_Session_create_errhandler (MPI_Session_errhandler_function *session_errhandler_fn, MPI_Errhandler *errhandler); OMPI_DECLSPEC int MPI_Session_finalize (MPI_Session *session); +OMPI_DECLSPEC int MPI_Session_get_errhandler(MPI_Session session, MPI_Errhandler *erhandler); OMPI_DECLSPEC int MPI_Session_get_info (MPI_Session session, MPI_Info *info_used); OMPI_DECLSPEC int MPI_Session_get_num_psets (MPI_Session session, MPI_Info info, int *npset_names); OMPI_DECLSPEC int MPI_Session_get_nth_pset (MPI_Session session, MPI_Info info, int n, int *len, char *pset_name); @@ -1949,6 +1950,7 @@ OMPI_DECLSPEC int MPI_Session_get_pset_info (MPI_Session session, const char *p OMPI_DECLSPEC int MPI_Session_init (MPI_Info info, MPI_Errhandler errhandler, MPI_Session *session); OMPI_DECLSPEC MPI_Session MPI_Session_f2c (MPI_Fint session); +OMPI_DECLSPEC int MPI_Session_set_errhandler(MPI_Session session, MPI_Errhandler errhandler); OMPI_DECLSPEC int MPI_Session_set_info (MPI_Session session, MPI_Info info); OMPI_DECLSPEC int MPI_Ssend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, @@ -2700,9 +2702,11 @@ OMPI_DECLSPEC int PMPI_Sendrecv_replace(void * buf, int count, MPI_Datatype dat int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC MPI_Fint PMPI_Session_c2f (const MPI_Session session); +OMPI_DECLSPEC int PMPI_Session_call_errhandler(MPI_Session session, int errorcode); OMPI_DECLSPEC int PMPI_Session_create_errhandler (MPI_Session_errhandler_function *session_errhandler_fn, MPI_Errhandler *errhandler); OMPI_DECLSPEC int PMPI_Session_finalize (MPI_Session *session); +OMPI_DECLSPEC int PMPI_Session_get_errhandler(MPI_Session session, MPI_Errhandler *erhandler); OMPI_DECLSPEC int PMPI_Session_get_info (MPI_Session session, MPI_Info *info_used); OMPI_DECLSPEC int PMPI_Session_get_num_psets (MPI_Session session, MPI_Info info, int *npset_names); OMPI_DECLSPEC int PMPI_Session_get_nth_pset (MPI_Session session, MPI_Info info, int n, int *len, char *pset_name); @@ -2710,6 +2714,7 @@ OMPI_DECLSPEC int PMPI_Session_get_pset_info (MPI_Session session, const char * OMPI_DECLSPEC int PMPI_Session_init (MPI_Info info, MPI_Errhandler errhandler, MPI_Session *session); OMPI_DECLSPEC MPI_Session PMPI_Session_f2c (MPI_Fint session); +OMPI_DECLSPEC int PMPI_Session_set_errhandler(MPI_Session session, MPI_Errhandler erhandler); OMPI_DECLSPEC int PMPI_Session_set_info (MPI_Session session, MPI_Info info); OMPI_DECLSPEC int PMPI_Ssend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, diff --git a/ompi/instance/instance.c b/ompi/instance/instance.c index 704135b21f6..42ac10fc4e3 100644 --- a/ompi/instance/instance.c +++ b/ompi/instance/instance.c @@ -84,10 +84,16 @@ static void ompi_instance_construct (ompi_instance_t *instance) instance->i_name[0] = '\0'; instance->i_flags = 0; instance->i_keyhash = NULL; + OBJ_CONSTRUCT(&instance->s_lock, opal_mutex_t); instance->errhandler_type = OMPI_ERRHANDLER_TYPE_INSTANCE; } -OBJ_CLASS_INSTANCE(ompi_instance_t, opal_infosubscriber_t, ompi_instance_construct, NULL); +static void ompi_instance_destruct(ompi_instance_t *instance) +{ + OBJ_DESTRUCT(&instance->s_lock); +} + +OBJ_CLASS_INSTANCE(ompi_instance_t, opal_infosubscriber_t, ompi_instance_construct, ompi_instance_destruct); /* NTH: frameworks needed by MPI */ static mca_base_framework_t *ompi_framework_dependencies[] = { diff --git a/ompi/instance/instance.h b/ompi/instance/instance.h index 13945a92362..b488a6cb292 100644 --- a/ompi/instance/instance.h +++ b/ompi/instance/instance.h @@ -27,6 +27,7 @@ struct ompi_group_t; struct ompi_instance_t { opal_infosubscriber_t super; + opal_mutex_t s_lock; int i_thread_level; char i_name[MPI_MAX_OBJECT_NAME]; uint32_t i_flags; diff --git a/ompi/mpi/c/Makefile.am b/ompi/mpi/c/Makefile.am index 58261b7ea54..784923a7d22 100644 --- a/ompi/mpi/c/Makefile.am +++ b/ompi/mpi/c/Makefile.am @@ -369,7 +369,9 @@ interface_profile_sources = \ sendrecv.c \ sendrecv_replace.c \ session_c2f.c \ + session_call_errhandler.c \ session_create_errhandler.c \ + session_get_errhandler.c \ session_get_info.c \ session_get_num_psets.c \ session_get_nth_pset.c \ @@ -377,6 +379,7 @@ interface_profile_sources = \ session_init.c \ session_f2c.c \ session_finalize.c \ + session_set_errhandler.c \ session_set_info.c \ ssend_init.c \ ssend.c \ diff --git a/ompi/mpi/c/session_call_errhandler.c b/ompi/mpi/c/session_call_errhandler.c new file mode 100644 index 00000000000..bec49e9cfb1 --- /dev/null +++ b/ompi/mpi/c/session_call_errhandler.c @@ -0,0 +1,59 @@ +/* + * Copyright (c) 2004-2007 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 Triad National Security, LLC. 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/instance/instance.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_Session_call_errhandler = PMPI_Session_call_errhandler +#endif +#define MPI_Session_call_errhandler PMPI_Session_call_errhandler +#endif + + +static const char FUNC_NAME[] = "MPI_Session_call_errhandler"; + + +int MPI_Session_call_errhandler(MPI_Session session, int errorcode) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == session) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Invoke the errhandler */ + + OMPI_ERRHANDLER_INVOKE(session, errorcode, FUNC_NAME); + + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/session_get_errhandler.c b/ompi/mpi/c/session_get_errhandler.c new file mode 100644 index 00000000000..b09dcd2663d --- /dev/null +++ b/ompi/mpi/c/session_get_errhandler.c @@ -0,0 +1,71 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2004-2007 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-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) 2007-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2022 Triad National Security, LLC. 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/errhandler/errhandler.h" +#include "ompi/instance/instance.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_Session_get_errhandler = PMPI_Session_get_errhandler +#endif +#define MPI_Session_get_errhandler PMPI_Session_get_errhandler +#endif + + +static const char FUNC_NAME[] = "MPI_Session_get_errhandler"; + + +int MPI_Session_get_errhandler(MPI_Session session, MPI_Errhandler *errhandler) +{ + int ret = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == session) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + OPAL_THREAD_LOCK(&(session->s_lock)); + /* Retain the errhandler, corresponding to object refcount decrease + in errhandler_free.c. */ + OBJ_RETAIN(session->error_handler); + *errhandler = session->error_handler; + OPAL_THREAD_UNLOCK(&(session->s_lock)); + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + + /* All done */ + + return ret; +} diff --git a/ompi/mpi/c/session_set_errhandler.c b/ompi/mpi/c/session_set_errhandler.c new file mode 100644 index 00000000000..e1a22aedf8a --- /dev/null +++ b/ompi/mpi/c/session_set_errhandler.c @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2004-2007 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-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) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2022 Triad National Security, LLC. 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/errhandler/errhandler.h" +#include "ompi/instance/instance.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_Session_set_errhandler = PMPI_Session_set_errhandler +#endif +#define MPI_Session_set_errhandler PMPI_Session_set_errhandler +#endif + +static const char FUNC_NAME[] = "MPI_Session_set_errhandler"; + + +int MPI_Session_set_errhandler(MPI_Session session, MPI_Errhandler errhandler) +{ + MPI_Errhandler tmp; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (NULL == session) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + ( OMPI_ERRHANDLER_TYPE_INSTANCE != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Prepare the new error handler */ + OBJ_RETAIN(errhandler); + + OPAL_THREAD_LOCK(&(session->s_lock)); + /* Ditch the old errhandler, and decrement its refcount. */ + tmp = session->error_handler; + session->error_handler = errhandler; + OBJ_RELEASE(tmp); + OPAL_THREAD_UNLOCK(&(session->s_lock)); + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/fortran/mpif-h/Makefile.am b/ompi/mpi/fortran/mpif-h/Makefile.am index 93e97d20249..e2fc6465bfe 100644 --- a/ompi/mpi/fortran/mpif-h/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/Makefile.am @@ -420,12 +420,16 @@ lib@OMPI_LIBMPI_NAME@_mpifh_la_SOURCES += \ send_init_f.c \ sendrecv_f.c \ sendrecv_replace_f.c \ + session_call_errhandler_f.c \ + session_create_errhandler_f.c \ + session_get_errhandler_f.c \ session_get_info_f.c \ session_get_nth_pset_f.c \ session_get_num_psets_f.c \ session_get_pset_info_f.c \ session_init_f.c \ session_finalize_f.c \ + session_set_errhandler_f.c \ ssend_f.c \ ssend_init_f.c \ startall_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/profile/Makefile.am b/ompi/mpi/fortran/mpif-h/profile/Makefile.am index b16c8a3ad70..3d0a56bd9cc 100644 --- a/ompi/mpi/fortran/mpif-h/profile/Makefile.am +++ b/ompi/mpi/fortran/mpif-h/profile/Makefile.am @@ -331,12 +331,16 @@ linked_files = \ psend_init_f.c \ psendrecv_f.c \ psendrecv_replace_f.c \ + psession_call_errhandler_f.c \ + psession_create_errhandler_f.c \ + psession_get_errhandler_f.c \ psession_get_info_f.c \ psession_get_nth_pset_f.c \ psession_get_num_psets_f.c \ psession_get_pset_info_f.c \ psession_init_f.c \ psession_finalize_f.c \ + psession_set_errhandler_f.c \ pssend_f.c \ pssend_init_f.c \ pstartall_f.c \ diff --git a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h index b85fdb27ffd..6e9201458ad 100644 --- a/ompi/mpi/fortran/mpif-h/prototypes_mpi.h +++ b/ompi/mpi/fortran/mpif-h/prototypes_mpi.h @@ -388,12 +388,16 @@ PN2(void, MPI_Send_init, mpi_send_init, MPI_SEND_INIT, (char *buf, MPI_Fint *cou PN2(void, MPI_Send, mpi_send, MPI_SEND, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr)); PN2(void, MPI_Sendrecv, mpi_sendrecv, MPI_SENDRECV, (char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype, MPI_Fint *dest, MPI_Fint *sendtag, char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype, MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr)); PN2(void, MPI_Sendrecv_replace, mpi_sendrecv_replace, MPI_SENDRECV_REPLACE, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *sendtag, MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr)); +PN2(void, MPI_Session_call_errhandler, mpi_session_call_errhandler, MPI_SESSION_CALL_ERRHANDLER, (MPI_Fint *session, MPI_Fint *errorcode, MPI_Fint *ierr)); +PN2(void, MPI_Session_create_errhandler, mpi_session_create_errhandler, MPI_SESSION_CREATE_ERRHANDLER, (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr)); +PN2(void, MPI_Session_get_errhandler, mpi_session_get_errhandler, MPI_SESSION_GET_ERRHANDLER, (MPI_Fint *session, MPI_Fint *erhandler, MPI_Fint *ierr)); PN2(void, MPI_Session_get_info, mpi_session_get_info, MPI_SESSION_GET_INFO, (MPI_Fint *session, MPI_Fint *info, MPI_Fint *ierr)); PN2(void, MPI_Session_get_nth_pset, mpi_session_get_nth_pset, MPI_SESSION_GET_NTH_PSET, (MPI_Fint *session, MPI_Fint *info, MPI_Fint *n, MPI_Fint *pset_len, char *pset_name, MPI_Fint *ierr)); PN2(void, MPI_Session_get_num_psets, mpi_session_get_num_psets, MPI_SESSION_GET_NUM_PSETS, (MPI_Fint *session, MPI_Fint *info, MPI_Fint *npset_names, MPI_Fint *ierr)); PN2(void, MPI_Session_get_pset_info, mpi_session_get_pset_info, MPI_SESSION_GET_PSET_INFO, (MPI_Fint *session, char *pset_name, MPI_Fint *info, MPI_Fint *ierr, int name_len)); PN2(void, MPI_Session_init, mpi_session_init, MPI_SESSION_INIT, (MPI_Fint *info, MPI_Fint *errhandler, MPI_Fint *session, MPI_Fint *ierr)); PN2(void, MPI_Session_finalize, mpi_session_finalize, MPI_SESSION_FINALIZE, (MPI_Fint *session, MPI_Fint *ierr)); +PN2(void, MPI_Session_set_errhandler, mpi_session_set_errhandler, MPI_SESSION_SET_ERRHANDLER, (MPI_Fint *session, MPI_Fint *erhandler, MPI_Fint *ierr)); PN2(void, MPI_Ssend_init, mpi_ssend_init, MPI_SSEND_INIT, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)); PN2(void, MPI_Ssend, mpi_ssend, MPI_SSEND, (char *buf, MPI_Fint *count, MPI_Fint *datatype, MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr)); PN2(void, MPI_Start, mpi_start, MPI_START, (MPI_Fint *request, MPI_Fint *ierr)); diff --git a/ompi/mpi/fortran/mpif-h/session_call_errhandler_f.c b/ompi/mpi/fortran/mpif-h/session_call_errhandler_f.c new file mode 100644 index 00000000000..deb4360c752 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/session_call_errhandler_f.c @@ -0,0 +1,81 @@ +/* + * 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 (c) 2022 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" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_SESSION_CALL_ERRHANDLER = ompi_session_call_errhandler_f +#pragma weak pmpi_session_call_errhandler = ompi_session_call_errhandler_f +#pragma weak pmpi_session_call_errhandler_ = ompi_session_call_errhandler_f +#pragma weak pmpi_session_call_errhandler__ = ompi_session_call_errhandler_f + +#pragma weak PMPI_Session_call_errhandler_f = ompi_session_call_errhandler_f +#pragma weak PMPI_Session_call_errhandler_f08 = ompi_session_call_errhandler_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_SESSION_CALL_ERRHANDLER, + pmpi_session_call_errhandler, + pmpi_session_call_errhandler_, + pmpi_session_call_errhandler__, + pompi_session_call_errhandler_f, + (MPI_Fint *session, MPI_Fint *errorcode, MPI_Fint *ierr), + (session, errorcode, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_SESSION_CALL_ERRHANDLER = ompi_session_call_errhandler_f +#pragma weak mpi_session_call_errhandler = ompi_session_call_errhandler_f +#pragma weak mpi_session_call_errhandler_ = ompi_session_call_errhandler_f +#pragma weak mpi_session_call_errhandler__ = ompi_session_call_errhandler_f + +#pragma weak MPI_Session_call_errhandler_f = ompi_session_call_errhandler_f +#pragma weak MPI_Session_call_errhandler_f08 = ompi_session_call_errhandler_f +#else +#if ! OMPI_BUILD_MPI_PROFILING + OMPI_GENERATE_F77_BINDINGS (MPI_SESSION_CALL_ERRHANDLER, + mpi_session_call_errhandler, + mpi_session_call_errhandler_, + mpi_session_call_errhandler__, + ompi_session_call_errhandler_f, + (MPI_Fint *session, MPI_Fint *errorcode, MPI_Fint *ierr), + (session, errorcode, ierr) ) +#else +#define ompi_session_call_errhandler_f pompi_session_call_errhandler_f +#endif +#endif + + +void ompi_session_call_errhandler_f(MPI_Fint *session, MPI_Fint *errorcode, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Session c_session; + + c_session = PMPI_Session_f2c(*session); + + c_ierr = PMPI_Session_call_errhandler(c_session, OMPI_FINT_2_INT(*errorcode)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/mpif-h/session_create_errhandler_f.c b/ompi/mpi/fortran/mpif-h/session_create_errhandler_f.c new file mode 100644 index 00000000000..bf97f332570 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/session_create_errhandler_f.c @@ -0,0 +1,91 @@ +/* + * 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) 2008-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$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/fortran/mpif-h/bindings.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/instance/instance.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_SESSION_CREATE_ERRHANDLER = ompi_session_create_errhandler_f +#pragma weak pmpi_session_create_errhandler = ompi_session_create_errhandler_f +#pragma weak pmpi_session_create_errhandler_ = ompi_session_create_errhandler_f +#pragma weak pmpi_session_create_errhandler__ = ompi_session_create_errhandler_f + +#pragma weak PMPI_Session_create_errhandler_f = ompi_session_create_errhandler_f +#pragma weak PMPI_Session_create_errhandler_f08 = ompi_session_create_errhandler_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_SESSION_CREATE_ERRHANDLER, + pmpi_session_create_errhandler, + pmpi_session_create_errhandler_, + pmpi_session_create_errhandler__, + pompi_session_create_errhandler_f, + (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr), + (function, errhandler, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_SESSION_CREATE_ERRHANDLER = ompi_session_create_errhandler_f +#pragma weak mpi_session_create_errhandler = ompi_session_create_errhandler_f +#pragma weak mpi_session_create_errhandler_ = ompi_session_create_errhandler_f +#pragma weak mpi_session_create_errhandler__ = ompi_session_create_errhandler_f + +#pragma weak MPI_Session_create_errhandler_f = ompi_session_create_errhandler_f +#pragma weak MPI_Session_create_errhandler_f08 = ompi_session_create_errhandler_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_SESSION_CREATE_ERRHANDLER, + mpi_session_create_errhandler, + mpi_session_create_errhandler_, + mpi_session_create_errhandler__, + ompi_session_create_errhandler_f, + (ompi_errhandler_fortran_handler_fn_t* function, MPI_Fint *errhandler, MPI_Fint *ierr), + (function, errhandler, ierr) ) +#else +#define ompi_session_create_errhandler_f pompi_session_create_errhandler_f +#endif +#endif + +static const char FUNC_NAME[] = "MPI_SESSION_CREATE_ERRHANDLER"; + + +void ompi_session_create_errhandler_f(ompi_errhandler_fortran_handler_fn_t *function, + MPI_Fint *errhandler, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Errhandler c_errhandler; + + c_errhandler = ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_INSTANCE, + (ompi_errhandler_generic_handler_fn_t*) function, + OMPI_ERRHANDLER_LANG_FORTRAN); + if (MPI_ERRHANDLER_NULL != c_errhandler) { + *errhandler = PMPI_Errhandler_c2f(c_errhandler); + c_ierr = MPI_SUCCESS; + } else { + c_ierr = MPI_ERR_INTERN; + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, FUNC_NAME); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/mpif-h/session_get_errhandler_f.c b/ompi/mpi/fortran/mpif-h/session_get_errhandler_f.c new file mode 100644 index 00000000000..9ea6ce1941a --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/session_get_errhandler_f.c @@ -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-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 (c) 2022 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" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_SESSION_GET_ERRHANDLER = ompi_session_get_errhandler_f +#pragma weak pmpi_session_get_errhandler = ompi_session_get_errhandler_f +#pragma weak pmpi_session_get_errhandler_ = ompi_session_get_errhandler_f +#pragma weak pmpi_session_get_errhandler__ = ompi_session_get_errhandler_f + +#pragma weak PMPI_Session_get_errhandler_f = ompi_session_get_errhandler_f +#pragma weak PMPI_Session_get_errhandler_f08 = ompi_session_get_errhandler_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_SESSION_GET_ERRHANDLER, + pmpi_session_get_errhandler, + pmpi_session_get_errhandler_, + pmpi_session_get_errhandler__, + pompi_session_get_errhandler_f, + (MPI_Fint *session, MPI_Fint *erhandler, MPI_Fint *ierr), + (session, erhandler, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_SESSION_GET_ERRHANDLER = ompi_session_get_errhandler_f +#pragma weak mpi_session_get_errhandler = ompi_session_get_errhandler_f +#pragma weak mpi_session_get_errhandler_ = ompi_session_get_errhandler_f +#pragma weak mpi_session_get_errhandler__ = ompi_session_get_errhandler_f + +#pragma weak MPI_Session_get_errhandler_f = ompi_session_get_errhandler_f +#pragma weak MPI_Session_get_errhandler_f08 = ompi_session_get_errhandler_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_SESSION_GET_ERRHANDLER, + mpi_session_get_errhandler, + mpi_session_get_errhandler_, + mpi_session_get_errhandler__, + ompi_session_get_errhandler_f, + (MPI_Fint *session, MPI_Fint *erhandler, MPI_Fint *ierr), + (session, erhandler, ierr) ) +#else +#define ompi_session_get_errhandler_f pompi_session_get_errhandler_f +#endif +#endif + + +void ompi_session_get_errhandler_f(MPI_Fint *session, MPI_Fint *errhandler, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Session c_session; + MPI_Errhandler c_errhandler; + + c_session = PMPI_Session_f2c(*session); + + c_ierr = PMPI_Session_get_errhandler(c_session, &c_errhandler); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *errhandler = PMPI_Errhandler_c2f(c_errhandler); + } +} diff --git a/ompi/mpi/fortran/mpif-h/session_set_errhandler_f.c b/ompi/mpi/fortran/mpif-h/session_set_errhandler_f.c new file mode 100644 index 00000000000..e90a2895063 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/session_set_errhandler_f.c @@ -0,0 +1,84 @@ +/* + * 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) 2008-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 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/errhandler/errhandler.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak PMPI_SESSION_SET_ERRHANDLER = ompi_session_set_errhandler_f +#pragma weak pmpi_session_set_errhandler = ompi_session_set_errhandler_f +#pragma weak pmpi_session_set_errhandler_ = ompi_session_set_errhandler_f +#pragma weak pmpi_session_set_errhandler__ = ompi_session_set_errhandler_f + +#pragma weak PMPI_Session_set_errhandler_f = ompi_session_set_errhandler_f +#pragma weak PMPI_Session_set_errhandler_f08 = ompi_session_set_errhandler_f +#else +OMPI_GENERATE_F77_BINDINGS (PMPI_SESSION_SET_ERRHANDLER, + pmpi_session_set_errhandler, + pmpi_session_set_errhandler_, + pmpi_session_set_errhandler__, + pompi_session_set_errhandler_f, + (MPI_Fint *session, MPI_Fint *errhandler, MPI_Fint *ierr), + (session, errhandler, ierr) ) +#endif +#endif + +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_SESSION_SET_ERRHANDLER = ompi_session_set_errhandler_f +#pragma weak mpi_session_set_errhandler = ompi_session_set_errhandler_f +#pragma weak mpi_session_set_errhandler_ = ompi_session_set_errhandler_f +#pragma weak mpi_session_set_errhandler__ = ompi_session_set_errhandler_f + +#pragma weak MPI_Session_set_errhandler_f = ompi_session_set_errhandler_f +#pragma weak MPI_Session_set_errhandler_f08 = ompi_session_set_errhandler_f +#else +#if ! OMPI_BUILD_MPI_PROFILING +OMPI_GENERATE_F77_BINDINGS (MPI_SESSION_SET_ERRHANDLER, + mpi_session_set_errhandler, + mpi_session_set_errhandler_, + mpi_session_set_errhandler__, + ompi_session_set_errhandler_f, + (MPI_Fint *session, MPI_Fint *errhandler, MPI_Fint *ierr), + (session, errhandler, ierr) ) +#else +#define ompi_session_set_errhandler_f pompi_session_set_errhandler_f +#endif +#endif + + +void ompi_session_set_errhandler_f(MPI_Fint *session, MPI_Fint *errhandler, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Session c_session; + MPI_Errhandler c_errhandler; + + c_session = PMPI_Session_f2c(*session); + c_errhandler = PMPI_Errhandler_f2c(*errhandler); + + c_ierr = PMPI_Session_set_errhandler(c_session, c_errhandler); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 95f449ffc34..a331be916f2 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -403,12 +403,16 @@ mpi_api_files = \ send_init_f08.F90 \ sendrecv_f08.F90 \ sendrecv_replace_f08.F90 \ + session_call_errhandler_f08.F90\ + session_create_errhandler_f08.F90\ + session_get_errhandler_f08.F90\ session_get_info_f08.F90 \ session_get_nth_pset_f08.F90 \ session_get_num_psets_f08.F90 \ session_get_pset_info_f08.F90 \ session_init_f08.F90 \ session_finalize_f08.F90 \ + session_set_errhandler_f08.F90\ ssend_f08.F90 \ ssend_init_f08.F90 \ startall_f08.F90 \ diff --git a/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h b/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h index 668ec44e9c8..9a7d390d37d 100644 --- a/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h +++ b/ompi/mpi/fortran/use-mpi-f08/bindings/mpi-f-interfaces-bind.h @@ -4040,4 +4040,39 @@ subroutine ompi_session_finalize_f(session, ierror) & integer, intent(out) :: ierror end subroutine ompi_session_finalize_f +subroutine ompi_session_call_errhandler_f(session,errorcode,ierror) & + BIND(C, name="ompi_session_call_errhandler_f") + implicit none + INTEGER, INTENT(IN) :: session + INTEGER, INTENT(IN) :: errorcode + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_session_call_errhandler_f + + +subroutine ompi_session_create_errhandler_f(session_errhandler_fn,errhandler,ierror) & + BIND(C, name="ompi_session_create_errhandler_f") + use, intrinsic :: iso_c_binding, only: c_funptr + implicit none + type(c_funptr), value :: session_errhandler_fn + INTEGER, INTENT(OUT) :: errhandler + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_session_create_errhandler_f + +subroutine ompi_session_get_errhandler_f(session,errhandler,ierror) & + BIND(C, name="ompi_session_get_errhandler_f") + implicit none + INTEGER, INTENT(IN) :: session + INTEGER, INTENT(OUT) :: errhandler + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_session_get_errhandler_f + +subroutine ompi_session_set_errhandler_f(session,errhandler,ierror) & + BIND(C, name="ompi_session_set_errhandler_f") + implicit none + INTEGER, INTENT(IN) :: session + INTEGER, INTENT(IN) :: errhandler + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_session_set_errhandler_f + + end interface diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-callbacks.F90 b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-callbacks.F90 index d72ce1b9e2f..efe1f7a8422 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-callbacks.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-callbacks.F90 @@ -160,6 +160,15 @@ SUBROUTINE MPI_File_errhandler_function(file, error_code) END SUBROUTINE END INTERFACE +OMPI_ABSTRACT INTERFACE +SUBROUTINE MPI_Session_errhandler_function(session,error_code) + USE mpi_f08_types + IMPLICIT NONE + TYPE(MPI_Session) :: session + INTEGER :: error_code +END SUBROUTINE +END INTERFACE + OMPI_ABSTRACT INTERFACE SUBROUTINE MPI_Grequest_query_function(extra_state,status,ierror) USE mpi_f08_types 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 f67a295eacc..85af0ea64e3 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 @@ -421,6 +421,37 @@ subroutine MPI_Send_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) end subroutine MPI_Send_init_f08 end interface MPI_Send_init +interface MPI_Session_call_errhandler +subroutine MPI_Session_call_errhandler_f08(session,errorcode,ierror) + use :: mpi_f08_types, only : MPI_Session + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + INTEGER, INTENT(IN) :: errorcode + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Session_call_errhandler_f08 +end interface MPI_Session_call_errhandler + +interface MPI_Session_create_errhandler +subroutine MPI_Session_create_errhandler_f08(session_errhandler_fn,errhandler,ierror) + use :: mpi_f08_types, only : MPI_Errhandler + use :: mpi_f08_interfaces_callbacks, only : MPI_Session_errhandler_function + implicit none + PROCEDURE(MPI_Session_errhandler_function) :: session_errhandler_fn + TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Session_create_errhandler_f08 +end interface MPI_Session_create_errhandler + +interface MPI_Session_get_errhandler +subroutine MPI_Session_get_errhandler_f08(session,errhandler,ierror) + use :: mpi_f08_types, only : MPI_Session, MPI_Errhandler + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Session_get_errhandler_f08 +end interface MPI_Session_get_errhandler + interface MPI_Session_get_info subroutine MPI_Session_get_info_f08(session, info, ierror) use :: mpi_f08_types, only : MPI_Session, MPI_Info @@ -486,6 +517,16 @@ subroutine MPI_Session_finalize_f08(session,ierror) end subroutine MPI_Session_finalize_f08 end interface MPI_Session_finalize +interface MPI_Session_set_errhandler +subroutine MPI_Session_set_errhandler_f08(session,errhandler,ierror) + use :: mpi_f08_types, only : MPI_Session, MPI_Errhandler + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(IN) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Session_set_errhandler_f08 +end interface MPI_Session_set_errhandler + interface MPI_Ssend subroutine MPI_Ssend_f08(buf,count,datatype,dest,tag,comm,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm 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 06d2bb0e426..2ee375999df 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 @@ -67,6 +67,13 @@ #define MPI_Sendrecv_replace_f08 PMPI_Sendrecv_replace_f08 #define MPI_Send_init PMPI_Send_init #define MPI_Send_init_f08 PMPI_Send_init_f08 +#define MPI_Session_call_errhandler PMPI_Session_call_errhandler +#define MPI_Session_call_errhandler_f08 PMPI_Session_call_errhandler_f08 +#define MPI_Session_create_errhandler PMPI_Session_create_errhandler +#define MPI_Session_create_errhandler_f08 PMPI_Session_create_errhandler_f08 +#define MPI_Session_get_errhandler PMPI_Session_get_errhandler +#define MPI_Session_get_errhandler_f08 PMPI_Session_get_errhandler_f08 +#define MPI_Session_get_info PMPI_Session_get_info #define MPI_Session_get_info PMPI_Session_get_info #define MPI_Session_get_info_f08 PMPI_Session_get_info_f08 #define MPI_Session_get_nth_pset PMPI_Session_get_nth_pset @@ -81,6 +88,8 @@ #define MPI_Session_init_f08 PMPI_Session_init_f08 #define MPI_Session_finalize PMPI_Session_finalize #define MPI_Session_finalize_f08 PMPI_Session_finalize_f08 +#define MPI_Session_set_errhandler PMPI_Session_set_errhandler +#define MPI_Session_set_errhandler_f08 PMPI_Session_set_errhandler_f08 #define MPI_Ssend PMPI_Ssend #define MPI_Ssend_f08 PMPI_Ssend_f08 #define MPI_Ssend_init PMPI_Ssend_init @@ -789,5 +798,4 @@ #define MPI_Ineighbor_alltoallw_f08 PMPI_Ineighbor_alltoallw_f08 #define MPI_Neighbor_alltoallw_init PMPI_Neighbor_alltoallw_init #define MPI_Neighbor_alltoallw_init_f08 PMPI_Neighbor_alltoallw_init_f08 - #endif diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am index c855a01d4db..47179817979 100644 --- a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am @@ -337,6 +337,15 @@ pmpi_api_files = \ psend_init_f08.F90 \ psendrecv_f08.F90 \ psendrecv_replace_f08.F90 \ + psession_create_errhandler_f08.F90\ + psession_get_errhandler_f08.F90\ + psession_get_info_f08.F90 \ + psession_get_nth_pset_f08.F90 \ + psession_get_num_psets_f08.F90 \ + psession_get_pset_info_f08.F90 \ + psession_init_f08.F90 \ + psession_finalize_f08.F90 \ + psession_set_errhandler_f08.F90\ pssend_f08.F90 \ pssend_init_f08.F90 \ pstartall_f08.F90 \ diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_info_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_info_f08.F90 deleted file mode 100644 index bfe72d516e6..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_info_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_get_info_f08(session, info, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Info - use :: ompi_mpifh_bindings, only : ompi_session_get_info_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - TYPE(MPI_Info), INTENT(OUT) :: info - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_get_info_f(session%MPI_VAL, info%MPI_VAL, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_get_info_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_nth_pset_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_nth_pset_f08.F90 deleted file mode 100644 index 249a25ddc1b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_nth_pset_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019-2020 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_get_nth_pset_f08(session, info, n, pset_len, pset_name, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Info, MPI_INFO_NULL - use :: ompi_mpifh_bindings, only : ompi_session_get_nth_pset_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - TYPE(MPI_Info), INTENT(IN) :: info - INTEGER, OPTIONAL, INTENT(IN) :: n - INTEGER, OPTIONAL, INTENT(INOUT) :: pset_len - CHARACTER(LEN=*), INTENT(OUT) :: pset_name - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_get_nth_pset_f(session%MPI_VAL, MPI_INFO_NULL%MPI_VAL, n, pset_len, pset_name, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_get_nth_pset_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_num_psets_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_num_psets_f08.F90 deleted file mode 100644 index 01fd0dc9c1b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_num_psets_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_get_num_psets_f08(session, info, npset_names, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Info, MPI_INFO_NULL - use :: ompi_mpifh_bindings, only : ompi_session_get_num_psets_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - TYPE(MPI_Info), INTENT(IN) :: info - INTEGER, OPTIONAL, INTENT(OUT) :: npset_names - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_get_num_psets_f(session%MPI_VAL, MPI_INFO_NULL%MPI_VAL, npset_names, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_get_num_psets_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_pset_info_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_pset_info_f08.F90 deleted file mode 100644 index 0271b976f3a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_get_pset_info_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_get_pset_info_f08(session, pset_name, info, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Info - use :: ompi_mpifh_bindings, only : ompi_session_get_pset_info_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - CHARACTER(LEN=*), INTENT(IN) :: pset_name - TYPE(MPI_Info), INTENT(OUT) :: info - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_get_pset_info_f(session%MPI_VAL, pset_name, info%MPI_VAL, c_ierror, len(pset_name)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_get_pset_info_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_init_f08.F90 deleted file mode 100644 index 555aa10e9dd..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_init_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -subroutine PMPI_Session_init_f08(info,errhandler,session,ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Info, MPI_Errhandler - use :: ompi_mpifh_bindings, only : ompi_session_init_f - implicit none - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler - TYPE(MPI_Session), INTENT(OUT) :: session - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_init_f(info%MPI_VAL,errhandler%MPI_VAL,session%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_init_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/session_call_errhandler_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_call_errhandler_f08.F90 new file mode 100644 index 00000000000..bbd849dd624 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/session_call_errhandler_f08.F90 @@ -0,0 +1,26 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2022 Triad National Security, LLC. All rights +! reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Session_call_errhandler_f08(session,errorcode,ierror) + use :: mpi_f08_types, only : MPI_Session + use :: ompi_mpifh_bindings, only : ompi_session_call_errhandler_f + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + INTEGER, INTENT(IN) :: errorcode + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_session_call_errhandler_f(session%MPI_VAL,errorcode,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Session_call_errhandler_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/session_create_errhandler_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_create_errhandler_f08.F90 new file mode 100644 index 00000000000..497e1e19d57 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/session_create_errhandler_f08.F90 @@ -0,0 +1,32 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2014 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2020-2022 Triad National Security, LLC. All rights +! reserved. +! $COPYRIGHT$ + +#include "ompi/mpi/fortran/configure-fortran-output.h" + +#include "mpi-f08-rename.h" + +subroutine MPI_Session_create_errhandler_f08(session_errhandler_fn,errhandler,ierror) + use, intrinsic :: iso_c_binding, only: c_funptr, c_funloc + use :: mpi_f08_types, only : MPI_Errhandler + use :: mpi_f08_interfaces_callbacks, only : MPI_Session_errhandler_function + use :: ompi_mpifh_bindings, only : ompi_session_create_errhandler_f + implicit none + PROCEDURE(MPI_Session_errhandler_function) :: session_errhandler_fn + TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + type(c_funptr) :: fn + + fn = c_funloc(session_errhandler_fn) + call ompi_session_create_errhandler_f(fn,errhandler%MPI_VAL,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Session_create_errhandler_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/session_get_errhandler_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_get_errhandler_f08.F90 new file mode 100644 index 00000000000..8867d35db03 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/session_get_errhandler_f08.F90 @@ -0,0 +1,26 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2022 Triad National Security, LLC. All rights +! reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Session_get_errhandler_f08(session,errhandler,ierror) + use :: mpi_f08_types, only : MPI_Session, MPI_Errhandler + use :: ompi_mpifh_bindings, only : ompi_session_get_errhandler_f + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(OUT) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_session_get_errhandler_f(session%MPI_VAL,errhandler%MPI_VAL,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Session_get_errhandler_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/session_get_info_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_get_info_f08.F90 index c0e1eb16577..a1abe6dfdb5 100644 --- a/ompi/mpi/fortran/use-mpi-f08/session_get_info_f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/session_get_info_f08.F90 @@ -5,10 +5,12 @@ ! All rights reserved. ! Copyright (c) 2018 Research Organization for Information Science ! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights +! Copyright (c) 2019-2022 Triad National Security, LLC. All rights ! reserved. ! $COPYRIGHT$ +#include "mpi-f08-rename.h" + subroutine MPI_Session_get_info_f08(session, info, ierror) use :: mpi_f08_types, only : MPI_Session, MPI_Info use :: ompi_mpifh_bindings, only : ompi_session_get_info_f diff --git a/ompi/mpi/fortran/use-mpi-f08/session_get_nth_pset_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_get_nth_pset_f08.F90 index fa41b9f2ac3..0c610b05f46 100644 --- a/ompi/mpi/fortran/use-mpi-f08/session_get_nth_pset_f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/session_get_nth_pset_f08.F90 @@ -5,10 +5,12 @@ ! All rights reserved. ! Copyright (c) 2018 Research Organization for Information Science ! and Technology (RIST). All rights reserved. -! Copyright (c) 2019-2020 Triad National Security, LLC. All rights +! Copyright (c) 2019-2022 Triad National Security, LLC. All rights ! reserved. ! $COPYRIGHT$ +#include "mpi-f08-rename.h" + subroutine MPI_Session_get_nth_pset_f08(session, info, n, pset_len, pset_name, ierror) use :: mpi_f08_types, only : MPI_Session, MPI_Info, MPI_INFO_NULL use :: ompi_mpifh_bindings, only : ompi_session_get_nth_pset_f diff --git a/ompi/mpi/fortran/use-mpi-f08/session_get_num_psets_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_get_num_psets_f08.F90 index b5d114efea8..51a6e4a0a75 100644 --- a/ompi/mpi/fortran/use-mpi-f08/session_get_num_psets_f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/session_get_num_psets_f08.F90 @@ -5,10 +5,12 @@ ! All rights reserved. ! Copyright (c) 2018 Research Organization for Information Science ! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights +! Copyright (c) 2019-2022 Triad National Security, LLC. All rights ! reserved. ! $COPYRIGHT$ +#include "mpi-f08-rename.h" + subroutine MPI_Session_get_num_psets_f08(session, info, npset_names, ierror) use :: mpi_f08_types, only : MPI_Session, MPI_Info, MPI_INFO_NULL use :: ompi_mpifh_bindings, only : ompi_session_get_num_psets_f diff --git a/ompi/mpi/fortran/use-mpi-f08/session_get_pset_info_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_get_pset_info_f08.F90 index 51383469b1c..2227de4c15e 100644 --- a/ompi/mpi/fortran/use-mpi-f08/session_get_pset_info_f08.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/session_get_pset_info_f08.F90 @@ -5,10 +5,12 @@ ! All rights reserved. ! Copyright (c) 2018 Research Organization for Information Science ! and Technology (RIST). All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights +! Copyright (c) 2019-2022 Triad National Security, LLC. All rights ! reserved. ! $COPYRIGHT$ +#include "mpi-f08-rename.h" + subroutine MPI_Session_get_pset_info_f08(session, pset_name, info, ierror) use :: mpi_f08_types, only : MPI_Session, MPI_Info use :: ompi_mpifh_bindings, only : ompi_session_get_pset_info_f diff --git a/ompi/mpi/fortran/use-mpi-f08/session_set_errhandler_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/session_set_errhandler_f08.F90 new file mode 100644 index 00000000000..68864a070ae --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/session_set_errhandler_f08.F90 @@ -0,0 +1,26 @@ +! -*- f90 -*- +! +! Copyright (c) 2010-2012 Cisco Systems, Inc. All rights reserved. +! Copyright (c) 2009-2012 Los Alamos National Security, LLC. +! All Rights reserved. +! Copyright (c) 2018-2020 Research Organization for Information Science +! and Technology (RIST). All rights reserved. +! Copyright (c) 2019-2022 Triad National Security, LLC. All rights +! reserved. +! $COPYRIGHT$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Session_set_errhandler_f08(session,errhandler,ierror) + use :: mpi_f08_types, only : MPI_Session, MPI_Errhandler + use :: ompi_mpifh_bindings, only : ompi_session_set_errhandler_f + implicit none + TYPE(MPI_Session), INTENT(IN) :: session + TYPE(MPI_Errhandler), INTENT(IN) :: errhandler + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_session_set_errhandler_f(session%MPI_VAL,errhandler%MPI_VAL,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Session_set_errhandler_f08 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 ed878001c21..22fa630feb8 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 @@ -3668,6 +3668,38 @@ end subroutine MPI_Sendrecv_replace end interface +interface + +subroutine MPI_Session_call_errhandler(session, errorcode, ierror) + integer, intent(in) :: session + integer, intent(in) :: errorcode + integer, intent(out) :: ierror +end subroutine MPI_Session_call_errhandler + +end interface + + +interface + +subroutine MPI_Session_create_errhandler(function, errhandler, ierror) + external :: function + integer, intent(out) :: errhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_create_errhandler + +end interface + +interface + +subroutine MPI_Session_get_errhandler(session, erhandler, ierror) + integer, intent(in) :: session + integer, intent(out) :: erhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_get_errhandler + +end interface + + interface MPI_Session_get_info subroutine MPI_Session_get_info(session, info, ierror) integer, INTENT(IN) :: session @@ -3726,6 +3758,16 @@ end interface interface +subroutine MPI_Session_set_errhandler(session, erhandler, ierror) + integer, intent(in) :: session + integer, intent(out) :: erhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_set_errhandler + +end interface + +interface + subroutine MPI_Ssend(buf, count, datatype, dest, tag, & comm, ierror) @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf 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 510283c0c40..4b72cda55fb 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 @@ -243,12 +243,16 @@ #define MPI_Send_init PMPI_Send_init #define MPI_Sendrecv PMPI_Sendrecv #define MPI_Sendrecv_replace PMPI_Sendrecv_replace +#define MPI_Session_call_errhandler PMPI_Session_call_errhandler +#define MPI_Session_create_errhandler PMPI_Session_create_errhandler +#define MPI_Session_get_errhandler PMPI_Session_get_errhandler #define MPI_Session_get_info PMPI_Session_get_info #define MPI_Session_get_nth_pset PMPI_Session_get_nth_pset #define MPI_Session_get_nth_psetlen PMPI_Session_get_nth_psetlen #define MPI_Session_get_pset_info PMPI_Session_get_pset_info #define MPI_Session_init PMPI_Session_init #define MPI_Session_finalize PMPI_Session_finalize +#define MPI_Session_set_errhandler PMPI_Session_set_errhandler #define MPI_Ssend PMPI_Ssend #define MPI_Ssend_init PMPI_Ssend_init #define MPI_Start PMPI_Start diff --git a/ompi/mpi/fortran/use-mpi-tkr/mpi-f90-interfaces.h b/ompi/mpi/fortran/use-mpi-tkr/mpi-f90-interfaces.h index 43f6e313508..180bc03c32c 100644 --- a/ompi/mpi/fortran/use-mpi-tkr/mpi-f90-interfaces.h +++ b/ompi/mpi/fortran/use-mpi-tkr/mpi-f90-interfaces.h @@ -1374,6 +1374,35 @@ end subroutine MPI_Request_get_status end interface +interface + +subroutine MPI_Session_call_errhandler(session, errorcode, ierror) + integer, intent(in) :: session + integer, intent(in) :: errorcode + integer, intent(out) :: ierror +end subroutine MPI_Session_call_errhandler + +end interface + +interface + +subroutine MPI_Session_create_errhandler(function, errhandler, ierror) + external :: function + integer, intent(out) :: errhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_create_errhandler + +end interface + + +subroutine MPI_Session_get_errhandler(session, erhandler, ierror) + integer, intent(in) :: session + integer, intent(out) :: erhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_get_errhandler + +end interface + interface MPI_Session_get_info subroutine MPI_Session_get_info(session, info, ierror) implicit none @@ -1441,6 +1470,16 @@ end interface MPI_Session_finalize interface +interface + +subroutine MPI_Session_set_errhandler(session, errhandler, ierror) + integer, intent(in) :: session + integer, intent(in) :: errhandler + integer, intent(out) :: ierror +end subroutine MPI_Session_set_errhandler + +end interface + subroutine MPI_Start(request, ierror) integer, intent(inout) :: request integer, intent(out) :: ierror diff --git a/ompi/mpi/fortran/use-mpi-tkr/pmpi-f90-interfaces.h b/ompi/mpi/fortran/use-mpi-tkr/pmpi-f90-interfaces.h index dd10025ce74..66b92d7966a 100644 --- a/ompi/mpi/fortran/use-mpi-tkr/pmpi-f90-interfaces.h +++ b/ompi/mpi/fortran/use-mpi-tkr/pmpi-f90-interfaces.h @@ -123,12 +123,16 @@ #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_Session_call_errhandler PMPI_Session_call_errhandler +#define MPI_Session_create_errhandler PMPI_Session_create_errhandler +#define MPI_Session_get_errhandler PMPI_Session_get_errhandler #define MPI_Session_get_info PMPI_Session_get_info #define MPI_Session_get_nth_pset PMPI_Session_get_nth_pset -#define MPI_Session_get_num_psets PMPI_Session_get_num_psets +#define MPI_Session_get_nth_psetlen PMPI_Session_get_nth_psetlen #define MPI_Session_get_pset_info PMPI_Session_get_pset_info #define MPI_Session_init PMPI_Session_init #define MPI_Session_finalize PMPI_Session_finalize +#define MPI_Session_set_errhandler PMPI_Session_set_errhandler #define MPI_Start PMPI_Start #define MPI_Startall PMPI_Startall #define MPI_Status_f2f08 PMPI_Status_f2f08