diff --git a/.gitignore b/.gitignore index 21ab8f5ddcc..24027a0ea8d 100644 --- a/.gitignore +++ b/.gitignore @@ -201,6 +201,7 @@ ompi/mpi/fortran/mpiext/mpi-ext-module.F90 ompi/mpi/fortran/mpiext/mpi-f08-ext-module.F90 ompi/mpi/fortran/mpiext-use-mpi/mpi-ext-module.F90 ompi/mpi/fortran/mpiext-use-mpi-f08/mpi-f08-ext-module.F90 +ompi/mpi/fortran/use-mpi-f08/psizeof_f08.f90 ompi/mpi/fortran/mpif-h/sizeof_f.f90 ompi/mpi/fortran/mpif-h/profile/p*.c @@ -516,9 +517,10 @@ docs/_static docs/_static/css/custom.css docs/_templates -# Common Python virtual environment directory names +# Common Python virtual environment and cache directory names venv py?? +__pycache__/ # Copies of PRRTE RST files (i.e., not source controlled in this tree) docs/prrte-rst-content @@ -528,3 +530,11 @@ docs/schizo-ompi-rst-content # tarballs) docs/html docs/man + +# Generated C Bindings +ompi/mpi/c/*_generated*.c + +# Generated Fortran Bindings +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 diff --git a/config/ompi_config_files.m4 b/config/ompi_config_files.m4 index 7c869ba7967..21d1e3eb791 100644 --- a/config/ompi_config_files.m4 +++ b/config/ompi_config_files.m4 @@ -38,7 +38,6 @@ AC_DEFUN([OMPI_CONFIG_FILES],[ ompi/mpi/fortran/use-mpi-ignore-tkr/mpi-ignore-tkr-removed-interfaces.h ompi/mpi/fortran/use-mpi-f08/Makefile ompi/mpi/fortran/use-mpi-f08/base/Makefile - ompi/mpi/fortran/use-mpi-f08/profile/Makefile ompi/mpi/fortran/use-mpi-f08/bindings/Makefile ompi/mpi/fortran/use-mpi-f08/mod/Makefile ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h diff --git a/config/ompi_configure_options.m4 b/config/ompi_configure_options.m4 index 1ebf01f0dc4..0593a317024 100644 --- a/config/ompi_configure_options.m4 +++ b/config/ompi_configure_options.m4 @@ -253,5 +253,12 @@ else fi AM_CONDITIONAL(OMPI_OMPIO_SUPPORT, test "$ompi_want_ompio" = "1") +# If the binding source files don't exist, then we need Python to generate them +AM_PATH_PYTHON([3.6],,[:]) +binding_file="${srcdir}/ompi/mpi/c/ompi_send.c" +AS_IF([! test -e "$binding_file" && test "$PYTHON" = ":"], + [AC_MSG_ERROR([Open MPI requires Python >=3.6 for generating the bindings. Aborting])]) +AM_CONDITIONAL(OMPI_GENERATE_BINDINGS,[test "$PYTHON" != ":"]) + ])dnl diff --git a/config/ompi_fortran_check_ts.m4 b/config/ompi_fortran_check_ts.m4 new file mode 100644 index 00000000000..1cc9d07a827 --- /dev/null +++ b/config/ompi_fortran_check_ts.m4 @@ -0,0 +1,69 @@ +dnl -*- shell-script -*- +dnl +dnl Copyright (c) 2019 Research Organization for Information Science +dnl and Technology (RIST). All rights reserved. +dnl $COPYRIGHT$ +dnl +dnl Additional copyrights may follow +dnl +dnl $HEADER$ +dnl + +# Check whether or not the C compiler supports ISO_Fortran_binding.h +# Also check whether C and Fortran compiler interoperate. +# +# OMPI_FORTRAN_CHECK_TS([action if found], [action if not found]) +# ---------------------------------------------------- +AC_DEFUN([OMPI_FORTRAN_CHECK_TS],[ + AS_VAR_PUSHDEF([fortran_ts], [ompi_cv_fortran_have_ts]) + + AC_CHECK_HEADERS([ISO_Fortran_binding.h], + [AC_CACHE_CHECK([if Fortran and C compilers support ISO_Fortran_binding.h], fortran_ts, + [mkdir conftest.$$ + cd conftest.$$ + + # Try to compile the C bindings + cat > conftest_c.c << EOF +#include + +int is_contiguous_c(CFI_cdesc_t* x) { + return CFI_is_contiguous(x); +} +EOF + OPAL_LOG_COMMAND([$CC $CCFLAGS -c conftest_c.c], + [cat > conftest.f90 << EOF +module MOD_IS_CONTIGUOUS + +interface + +function is_contiguous(buf) BIND(C, name="is_contiguous_c") + implicit none + type(*), dimension(..) :: buf + integer :: is_contiguous +end function is_contiguous + +end interface + +end module + +program test_is_contiguous + use MOD_IS_CONTIGUOUS + implicit none + integer :: a0, a1(2), a2(2,2), a3(2,2,2) + write (*,*) is_contiguous(a0) + write (*,*) is_contiguous(a1) + write (*,*) is_contiguous(a2) + write (*,*) is_contiguous(a3) +end program +EOF + OPAL_LOG_COMMAND([$FC $FCFLAGS $FCFLAGS_f90 -o conftest conftest.f90 conftest_c.o $LDFLAGS $LIBS], + [AS_VAR_SET(fortran_ts, yes)], + [AS_VAR_SET(fortran_ts, no)])], + [AS_VAR_SET(fortran_ts, no)]) + cd .. + rm -rf conftest.$$])], + [AS_VAR_SET(fortran_ts, no)]) + + AS_VAR_IF(fortran_ts, [yes], [$1], [$2]) + AS_VAR_POPDEF([fortran_ts])dnl +]) diff --git a/config/ompi_setup_mpi_fortran.m4 b/config/ompi_setup_mpi_fortran.m4 index cf3e3329c42..758268b6f35 100644 --- a/config/ompi_setup_mpi_fortran.m4 +++ b/config/ompi_setup_mpi_fortran.m4 @@ -435,14 +435,27 @@ end program]])], # If we got all the stuff from above, then also look for the new # F08 syntax that we can use for the use_mpif08 module. - # We need to have ignore TKR functionality to build the mpi_f08 + OMPI_FORTRAN_HAVE_TS=0 + OMPI_MPI_SUBARRAYS_SUPPORTED=.false. + OMPI_MPI_ASYNC_PROTECTS_NONBLOCKING=.false. + AS_IF([test $OMPI_TRY_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS], + [OMPI_FORTRAN_CHECK_TS([OMPI_FORTRAN_HAVE_TS=1])]) + + # We need to have ignore TKR or the ISO Fortran bindings functionality to build the mpi_f08 # module - AS_IF([test $OMPI_TRY_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS && \ - test $OMPI_FORTRAN_HAVE_IGNORE_TKR -eq 1], - [OMPI_BUILD_FORTRAN_BINDINGS=$OMPI_FORTRAN_USEMPIF08_BINDINGS - OMPI_FORTRAN_F08_PREDECL=$OMPI_FORTRAN_IGNORE_TKR_PREDECL - OMPI_FORTRAN_F08_TYPE=$OMPI_FORTRAN_IGNORE_TKR_TYPE - ]) + AS_IF([test $OMPI_TRY_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS], + [AS_IF([test $OMPI_FORTRAN_HAVE_IGNORE_TKR -eq 1], + [OMPI_BUILD_FORTRAN_BINDINGS=$OMPI_FORTRAN_USEMPIF08_BINDINGS + OMPI_FORTRAN_F08_PREDECL=$OMPI_FORTRAN_IGNORE_TKR_PREDECL + OMPI_FORTRAN_F08_TYPE=$OMPI_FORTRAN_IGNORE_TKR_TYPE + ]) + AS_IF([test $OMPI_FORTRAN_HAVE_TS -eq 1], + [OMPI_BUILD_FORTRAN_BINDINGS=$OMPI_FORTRAN_USEMPIF08_BINDINGS + OMPI_MPI_SUBARRAYS_SUPPORTED=.true. + OMPI_MPI_ASYNC_PROTECTS_NONBLOCKING=.true.])]) + + AC_SUBST(OMPI_MPI_SUBARRAYS_SUPPORTED) + AC_SUBST(OMPI_MPI_ASYNC_PROTECTS_NONBLOCKING) # The overall "_BIND_C" variable will be set to 1 if we have all # the necessary forms of BIND(C) @@ -576,8 +589,6 @@ end type test_mpi_handle], ]) OMPI_FORTRAN_NEED_WRAPPER_ROUTINES=1 - OMPI_FORTRAN_F08_PREDECL='!' - OMPI_FORTRAN_F08_TYPE=real OMPI_FORTRAN_HAVE_F08_ASSUMED_RANK=0 AS_IF([test $OMPI_TRY_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS && \ test $OMPI_BUILD_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS], @@ -585,8 +596,6 @@ end type test_mpi_handle], OMPI_FORTRAN_CHECK_F08_ASSUMED_RANK( [ # If we have assumed rank, we can build the use # mpi_f08 module "better" - OMPI_FORTRAN_F08_PREDECL='!' - OMPI_FORTRAN_F08_TYPE='type(*), dimension(..)' OMPI_FORTRAN_HAVE_F08_ASSUMED_RANK=1]) # Which mpi_f08 implementation are we using? @@ -616,6 +625,12 @@ end type test_mpi_handle], [OMPI_FORTRAN_ELEMENTAL_TYPE=])]) AC_SUBST(OMPI_FORTRAN_ELEMENTAL_TYPE) + OMPI_FORTRAN_HAVE_C_ISO_FORTRAN=0 + AS_IF([test $OMPI_TRY_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS && \ + test $OMPI_BUILD_FORTRAN_BINDINGS -ge $OMPI_FORTRAN_USEMPIF08_BINDINGS], + [OMPI_FORTRAN_CHECK_TS([OMPI_FORTRAN_HAVE_TS=1], + [OMPI_FORTRAN_HAVE_TS=0])]) + # Note: the current implementation *only* has wrappers; # there is no optimized implementation for a "good" # compiler. I'm leaving the above logic in place for @@ -778,10 +793,9 @@ end type test_mpi_handle], # This goes into mpifort-wrapper-data.txt AC_SUBST(OMPI_FORTRAN_USEMPIF08_LIB) - # These go into interfaces/mpi-f08-interfaces-[no]bind.h (and - # mpi-f*-interfaces*.h files) - AC_SUBST(OMPI_FORTRAN_F08_PREDECL) - AC_SUBST(OMPI_FORTRAN_F08_TYPE) + # These go into mod/mpi-f08-interfaces.h + AC_SUBST(OMPI_F08_IGNORE_TKR_PREDECL) + AC_SUBST(OMPI_F08_IGNORE_TKR_TYPE) AC_SUBST(OMPI_MPI_PREFIX) AC_SUBST(OMPI_MPI_BIND_PREFIX) @@ -863,6 +877,25 @@ end type test_mpi_handle], # For configure-fortran-output.h AC_SUBST(OMPI_FORTRAN_HAVE_BIND_C) + AM_CONDITIONAL(OMPI_FORTRAN_HAVE_TS, + [test $OMPI_FORTRAN_HAVE_TS -eq 1]) + AC_SUBST(OMPI_FORTRAN_HAVE_TS) + AC_DEFINE_UNQUOTED([OMPI_FORTRAN_HAVE_TS], + [$OMPI_FORTRAN_HAVE_TS], + [For ompi/mpi/fortran/use-mpi-f08/base/ts.*: whether the compiler supports TS 29113 or not]) + + AS_IF([test $OMPI_FORTRAN_HAVE_TS -eq 1], + [OMPI_F08_IGNORE_TKR_TYPE="type(*), dimension(..)" + OMPI_F08_IGNORE_TKR_PREDECL="no attribute required for" + OMPI_F08_BINDINGS_EXTENSION="ts" + OMPI_F08_BINDINGS_TS_SUFFIX="ts"], + [OMPI_F08_IGNORE_TKR_TYPE=$OMPI_FORTRAN_IGNORE_TKR_TYPE + OMPI_F08_IGNORE_TKR_PREDECL=${OMPI_FORTRAN_IGNORE_TKR_PREDECL:1} + OMPI_F08_BINDINGS_EXTENSION="f" + OMPI_F08_BINDINGS_TS_SUFFIX=""]) + AC_SUBST(OMPI_F08_BINDINGS_EXTENSION) + AC_SUBST(OMPI_F08_BINDINGS_TS_SUFFIX) + # Somewhat redundant because ompi/Makefile.am won't traverse into # ompi/mpi/fortran/use-mpi-f08 if it's not to be built, but we # might as well have ompi/mpi/fortran/use-mpi-f08/Makefile.am be diff --git a/docs/developers/bindings.rst b/docs/developers/bindings.rst new file mode 100644 index 00000000000..5363f559494 --- /dev/null +++ b/docs/developers/bindings.rst @@ -0,0 +1,112 @@ +C and Fortran Bindings +====================== + +The C and Fortran (mpi_f08) bindings are generated from Python code in +``ompi/mpi/bindings``. Both the language bindings are generated from +template files for each function. In the C case, each template file corresponds +to a single generated C file, while in the Fortran case there are three major +files generated for all functions. + +The Python code depends on special prototype lines used with both the C and +Fortran bindings. These "prototypes" are designed to be easy to parse and use +specific type constants that can be mapped directly to the expanded +language-specific code, error-handling, and conversion code. + +C Bindings +---------- + +This will walk through adding (or converting) a plain-C binding into a +templated version controlled by the script. + +As an example, for ``MPI_Send`` you might have a C file that looks something +like this: + +.. code-block:: c + + #include "ompi_config.h" + ...other includes... + + int MPI_Send(const void *buf, int count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm) + { + ...internal checks... + return internal_mpi_send(buf, count, datatype, dest, tag, comm); + } + +To convert this to a template, you will have to first ensure that only a single +function is defined in the file, removing or abstracting out static functions, +and separating multiple definitions, such as ``MPI_Send`` and ``MPI_Isend``, +into different files. The template should also not include any macro-processing +that attempts to change the name of the function or parameter types; this code +should be generated by the script, or abstracted into header files that can +work easily with multiple functions. + +At this point, the template should look like the example above, with a "header" +section, with simple includes or macros, maybe a static global, and the +function defintion and nothing else. + +The next step is to convert the signature line into the prototype format that +the script expects. For ``MPI_Send``, this should look something like this: + +.. code-block:: c + + PROTOTYPE ERROR_CLASS send(BUFFER buf, COUNT count, DATATYPE type, RANK dest, + TAG tag, COMM comm) + +Notice how the function name is changed, the ``MPI_`` prefix removed and the +rest converted to lowercase, and also how each parameter is simplified into a +``TYPE name`` format, where the ``TYPE`` conforms to an allowed list in +``ompi/mpi/bindings/ompi_bindings/c_type.py``. For newer functions and types, +you may have to extend the ``c_type.py`` file with a new class showing how to +handle the type. + +The final step is to update ``Makefile.am``, adding the template name, in this +case ``send.c.in``, to the ``prototype_sources`` variable, and the generated +file name, ``generated_send.c``, to ``interface_profile_sources``. The +generated file name must be of the form ``generated_${basename}.c``, where +``${basename}`` is the name of the template file stripped of all extensions. + +Fortran Bindings +---------------- + +Adding new Fortran bindings follows a similar process to the C version above. +All new interfaces are actually based on a single C-template file following the +same format as the C interface templates. However, the C file generated will +use Fortran-specific arguments, including ``CFI_*`` arguments, when TS 29113 is +enabled, ``MPI_Fint *`` arguments in other cases, and others specific to how +the Fortran MPI types are defined. Most of these files perform Fortran-specific +error handling, Fortran-to-C type conversion, and other necessary steps before +calling the actually C bindings with the proper arguments. + +These templates are used not only to generate a C backing file for the Fortran +code, but also the Fortran interface definitions and the Fortran subroutines +corresponding to the generated C file. These are output in three separate files: + +* ``ompi/mpi/fortran/use-mpi-f08/api_f08_generated.F90`` +* ``ompi/mpi/fortran/use-mpi-f08/base/api_f08_generated.c`` +* ``ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces-generated.h`` + +The Fortran file ``api_f08_generated.F90`` contains all the internal subroutine +definitions, each of which makes a call into corresponding C functions. The +internal subroutine names are mapped to the external interface, including +multiple interfaces for the bigcount version of functions, in +``mpi-f08-interfaces-generated.h``. The C file ``api_f08_generated.c`` +basically contains a concatenation of all fully expanded C templates. +These files contain preprocessing directives to ensure they can support +compilers with and without TS 29113 support, allowing use of +``CFI_cdesc_t`` types when available (see `Fortran 2018`_ for more details). + +.. _Fortran 2018: https://fortranwiki.org/fortran/show/Fortran+2018 + +If a new type needs to be added, then one will need to extend +``fortran_type.py`` in ``ompi/mpi/bindings/ompi_bindings`` with an additional +type class specifying how to handle the type in the above generated files, +including any required key-value attributes for more complicated types. New +types use a ``Type`` base class with functions that can be implemented by +derived classes, each returning expanded Fortran or C code. + +Other Considerations +-------------------- + +Keep in mind that the generated files will not be deleted with a ``make clean`` +or ``make distclean``; instead use ``make maintainer-clean`` to delete those. diff --git a/docs/developers/index.rst b/docs/developers/index.rst index 0bc31dbd3e8..6e82d253d37 100644 --- a/docs/developers/index.rst +++ b/docs/developers/index.rst @@ -22,3 +22,4 @@ probably don't need to read this section. gnu-autotools sphinx rst-for-markdown-expats.rst + bindings diff --git a/docs/developers/prerequisites.rst b/docs/developers/prerequisites.rst index 2ac278e2285..e2aa34d4c9c 100644 --- a/docs/developers/prerequisites.rst +++ b/docs/developers/prerequisites.rst @@ -47,6 +47,15 @@ build them manually, see the :ref:`how to build and install GNU Autotools section ` for much more detail. +Python +------ + +Python >= v3.6 is required for generating the Fortran bindings, which +is necessary if you build Open MPI from a Git clone. + +Python is also required for running Sphinx to generate the docs, too +(:ref:`see below `). + Perl ---- @@ -88,6 +97,8 @@ MacPorts on MacOS), see `the Flex Github repository `_. +.. _developers-requirements-sphinx-label: + Sphinx (and therefore Python) ----------------------------- diff --git a/ompi/include/mpi.h.in b/ompi/include/mpi.h.in index 15025e73391..dfb31852048 100644 --- a/ompi/include/mpi.h.in +++ b/ompi/include/mpi.h.in @@ -494,6 +494,8 @@ typedef struct ompi_f08_status_public_t ompi_f08_status_public_t; typedef int (MPI_Datarep_extent_function)(MPI_Datatype, MPI_Aint *, void *); typedef int (MPI_Datarep_conversion_function)(void *, MPI_Datatype, int, void *, MPI_Offset, void *); +typedef int (MPI_Datarep_conversion_function_c)(void *, MPI_Datatype, + MPI_Count, void *, MPI_Offset, void *); typedef void (MPI_Comm_errhandler_function)(MPI_Comm *, int *, ...); typedef void (MPI_Session_errhandler_function) (MPI_Session *, int *, ...); @@ -504,6 +506,7 @@ typedef void (MPI_Session_errhandler_function) (MPI_Session *, int *, ...); typedef void (ompi_file_errhandler_function)(MPI_File *, int *, ...); typedef void (MPI_Win_errhandler_function)(MPI_Win *, int *, ...); typedef void (MPI_User_function)(void *, void *, int *, MPI_Datatype *); +typedef void (MPI_User_function_c)(void *, void *, MPI_Count *, MPI_Datatype *); typedef int (MPI_Comm_copy_attr_function)(MPI_Comm, int, void *, void *, void *, int *); typedef int (MPI_Comm_delete_attr_function)(MPI_Comm, int, void *, void *); @@ -1032,6 +1035,7 @@ typedef void (*MPI_T_event_cb_function) (MPI_T_event_instance event, must be able to be present, and therefore has to be in this conditional block in mpi.h. */ #define MPI_CONVERSION_FN_NULL ((MPI_Datarep_conversion_function*) 0) +#define MPI_CONVERSION_FN_NULL_C ((MPI_Datarep_conversion_function_c*) 0) #endif OMPI_DECLSPEC int OMPI_C_MPI_TYPE_NULL_DELETE_FN( MPI_Datatype datatype, @@ -1427,82 +1431,147 @@ OMPI_DECLSPEC extern struct ompi_predefined_datatype_t ompi_mpi_ub; /* * MPI API */ - OMPI_DECLSPEC int MPI_Abort(MPI_Comm comm, int errorcode); OMPI_DECLSPEC int MPI_Accumulate(const 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_Op op, MPI_Win win); +OMPI_DECLSPEC int MPI_Accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); OMPI_DECLSPEC int MPI_Add_error_class(int *errorclass); OMPI_DECLSPEC int MPI_Add_error_code(int errorclass, int *errorcode); OMPI_DECLSPEC int MPI_Add_error_string(int errorcode, const char *string); OMPI_DECLSPEC int MPI_Allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iallgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iallgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Allgather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Iallgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iallgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Allgatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr); OMPI_DECLSPEC int MPI_Allreduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Allreduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iallreduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iallreduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Allreduce_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Allreduce_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm); OMPI_DECLSPEC int MPI_Ialltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ialltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request); + void *recvbuf, int recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Alltoall_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ialltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ialltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Alltoallv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm); +OMPI_DECLSPEC int MPI_Alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ialltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Alltoallw_init(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Alltoallw_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Barrier(MPI_Comm comm); OMPI_DECLSPEC int MPI_Ibarrier(MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Barrier_init(MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Bcast_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Ibcast(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ibcast_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Bcast_init(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Bcast_init_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Bsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Bsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm); OMPI_DECLSPEC int MPI_Bsend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Bsend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Buffer_attach(void *buffer, int size); +OMPI_DECLSPEC int MPI_Buffer_attach_c(void *buffer, MPI_Count size); OMPI_DECLSPEC int MPI_Buffer_detach(void *buffer, int *size); +OMPI_DECLSPEC int MPI_Buffer_detach_c(void *buffer, MPI_Count *size); OMPI_DECLSPEC int MPI_Cancel(MPI_Request *request); OMPI_DECLSPEC int MPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int coords[]); OMPI_DECLSPEC int MPI_Cart_create(MPI_Comm old_comm, int ndims, const int dims[], @@ -1601,10 +1670,16 @@ OMPI_DECLSPEC int MPI_Error_class(int errorcode, int *errorclass); OMPI_DECLSPEC int MPI_Error_string(int errorcode, char *string, int *resultlen); OMPI_DECLSPEC int MPI_Exscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Exscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iexscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iexscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Exscan_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Exscan_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Fetch_and_op(const void *origin_addr, void *result_addr, MPI_Datatype datatype, int target_rank, MPI_Aint target_disp, MPI_Op op, MPI_Win win); OMPI_DECLSPEC MPI_Fint MPI_File_c2f(MPI_File file); @@ -1632,74 +1707,132 @@ OMPI_DECLSPEC int MPI_File_get_view(MPI_File fh, MPI_Offset *disp, MPI_Datatype *filetype, char *datarep); OMPI_DECLSPEC int MPI_File_read_at(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_at_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_read_at_all(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_at_all_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_at(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_at_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_at_all(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_at_all_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_iread_at(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iread_at_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iwrite_at(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iwrite_at_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iread_at_all(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype, MPI_Request *request); + int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iread_at_all_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iwrite_at_all(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype, MPI_Request *request); + int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iwrite_at_all_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_read(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_read_all(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_all_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_all(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_all_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_iread(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iread_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iwrite(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iwrite_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iread_all(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Request *request); + MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iread_all_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iwrite_all(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype, MPI_Request *request); + MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iwrite_all_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_seek(MPI_File fh, MPI_Offset offset, int whence); OMPI_DECLSPEC int MPI_File_get_position(MPI_File fh, MPI_Offset *offset); OMPI_DECLSPEC int MPI_File_get_byte_offset(MPI_File fh, MPI_Offset offset, MPI_Offset *disp); OMPI_DECLSPEC int MPI_File_read_shared(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_shared_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_shared(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_shared_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_iread_shared(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iread_shared_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_iwrite_shared(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int MPI_File_iwrite_shared_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int MPI_File_read_ordered(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_read_ordered_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_ordered(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int MPI_File_write_ordered_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int MPI_File_seek_shared(MPI_File fh, MPI_Offset offset, int whence); OMPI_DECLSPEC int MPI_File_get_position_shared(MPI_File fh, MPI_Offset *offset); OMPI_DECLSPEC int MPI_File_read_at_all_begin(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_read_at_all_begin_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_read_at_all_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_at_all_begin(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_write_at_all_begin_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_write_at_all_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_read_all_begin(MPI_File fh, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_read_all_begin_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_read_all_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_all_begin(MPI_File fh, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_write_all_begin_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_write_all_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_read_ordered_begin(MPI_File fh, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_read_ordered_begin_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_read_ordered_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_write_ordered_begin(MPI_File fh, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_File_write_ordered_begin_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int MPI_File_write_ordered_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int MPI_File_get_type_extent(MPI_File fh, MPI_Datatype datatype, MPI_Aint *extent); +OMPI_DECLSPEC int MPI_File_get_type_extent_c(MPI_File fh, MPI_Datatype datatype, + MPI_Count *extent); OMPI_DECLSPEC int MPI_File_set_atomicity(MPI_File fh, int flag); OMPI_DECLSPEC int MPI_File_get_atomicity(MPI_File fh, int *flag); OMPI_DECLSPEC int MPI_File_sync(MPI_File fh); @@ -1709,33 +1842,61 @@ OMPI_DECLSPEC int MPI_Free_mem(void *base); OMPI_DECLSPEC int MPI_Gather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Gather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Igather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Gather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Gather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Gatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Gatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], + MPI_Datatype recvtype, int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Igatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Igatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Gatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Gatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Get_address(const void *location, MPI_Aint *address); OMPI_DECLSPEC int MPI_Get_count(const MPI_Status *status, MPI_Datatype datatype, int *count); +OMPI_DECLSPEC int MPI_Get_count_c(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); OMPI_DECLSPEC int MPI_Get_elements(const MPI_Status *status, MPI_Datatype datatype, int *count); +OMPI_DECLSPEC int MPI_Get_elements_c(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); OMPI_DECLSPEC int MPI_Get_elements_x(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); OMPI_DECLSPEC int MPI_Get(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); +OMPI_DECLSPEC int MPI_Get_c(void *origin_addr, MPI_Count origin_count, + MPI_Datatype origin_datatype, int target_rank, + MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Win win); OMPI_DECLSPEC int MPI_Get_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, void *result_addr, int result_count, MPI_Datatype result_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); +OMPI_DECLSPEC int MPI_Get_accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + void *result_addr, MPI_Count result_count, MPI_Datatype result_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); OMPI_DECLSPEC int MPI_Get_library_version(char *version, int *resultlen); OMPI_DECLSPEC int MPI_Get_processor_name(char *name, int *resultlen); OMPI_DECLSPEC int MPI_Get_version(int *version, int *subversion); @@ -1779,11 +1940,15 @@ OMPI_DECLSPEC int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup); OMPI_DECLSPEC int MPI_Ibsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ibsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Improbe(int source, int tag, MPI_Comm comm, int *flag, MPI_Message *message, MPI_Status *status); OMPI_DECLSPEC int MPI_Imrecv(void *buf, int count, MPI_Datatype type, MPI_Message *message, MPI_Request *request); +OMPI_DECLSPEC int MPI_Imrecv_c(void *buf, MPI_Count count, MPI_Datatype type, + MPI_Message *message, MPI_Request *request); OMPI_DECLSPEC MPI_Fint MPI_Info_c2f(MPI_Info info); OMPI_DECLSPEC int MPI_Info_create(MPI_Info *info); OMPI_DECLSPEC int MPI_Info_create_env(int argc, char *argv[], MPI_Info *info); @@ -1812,19 +1977,34 @@ OMPI_DECLSPEC int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, MPI_Status *status); OMPI_DECLSPEC int MPI_Irecv(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Irecv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Irsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Irsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Isend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Isend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Isendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag, void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Isendrecv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + int dest, int sendtag, void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, int source, int recvtag, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Isendrecv_replace(void * buf, int count, MPI_Datatype datatype, int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Isendrecv_replace_c(void * buf, MPI_Count count, MPI_Datatype datatype, + int dest, int sendtag, int source, int recvtag, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Issend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Issend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Is_thread_main(int *flag); OMPI_DECLSPEC int MPI_Lookup_name(const char *service_name, MPI_Info info, char *port_name); OMPI_DECLSPEC MPI_Fint MPI_Message_c2f(MPI_Message message); @@ -1834,72 +2014,129 @@ OMPI_DECLSPEC int MPI_Mprobe(int source, int tag, MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC int MPI_Mrecv(void *buf, int count, MPI_Datatype type, MPI_Message *message, MPI_Status *status); +OMPI_DECLSPEC int MPI_Mrecv_c(void *buf, MPI_Count count, MPI_Datatype type, + MPI_Message *message, MPI_Status *status); OMPI_DECLSPEC int MPI_Neighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Neighbor_allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ineighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ineighbor_allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Neighbor_allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], + MPI_Datatype recvtype, MPI_Comm comm); OMPI_DECLSPEC int MPI_Neighbor_allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Neighbor_allgather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Ineighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ineighbor_allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Neighbor_allgatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Neighbor_alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ineighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ineighbor_alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Neighbor_alltoall_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Neighbor_alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ineighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ineighbor_alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Neighbor_alltoallv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm); +OMPI_DECLSPEC int MPI_Neighbor_alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm); OMPI_DECLSPEC int MPI_Ineighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ineighbor_alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Neighbor_alltoallw_init(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Neighbor_alltoallw_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC MPI_Fint MPI_Op_c2f(MPI_Op op); OMPI_DECLSPEC int MPI_Op_commutative(MPI_Op op, int *commute); OMPI_DECLSPEC int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op); +OMPI_DECLSPEC int MPI_Op_create_c(MPI_User_function_c *function, int commute, MPI_Op *op); OMPI_DECLSPEC int MPI_Open_port(MPI_Info info, char *port_name); OMPI_DECLSPEC MPI_Op MPI_Op_f2c(MPI_Fint op); OMPI_DECLSPEC int MPI_Op_free(MPI_Op *op); OMPI_DECLSPEC int MPI_Pack_external(const char datarep[], const void *inbuf, int incount, MPI_Datatype datatype, void *outbuf, MPI_Aint outsize, MPI_Aint *position); +OMPI_DECLSPEC int MPI_Pack_external_c(const char datarep[], const void *inbuf, MPI_Count incount, + MPI_Datatype datatype, void *outbuf, + MPI_Count outsize, MPI_Count *position); OMPI_DECLSPEC int MPI_Pack_external_size(const char datarep[], int incount, MPI_Datatype datatype, MPI_Aint *size); +OMPI_DECLSPEC int MPI_Pack_external_size_c(const char datarep[], MPI_Count incount, + MPI_Datatype datatype, MPI_Count *size); OMPI_DECLSPEC int MPI_Pack(const void *inbuf, int incount, MPI_Datatype datatype, void *outbuf, int outsize, int *position, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Pack_c(const void *inbuf, MPI_Count incount, MPI_Datatype datatype, + void *outbuf, MPI_Count outsize, MPI_Count *position, MPI_Comm comm); OMPI_DECLSPEC int MPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int *size); +OMPI_DECLSPEC int MPI_Pack_size_c(MPI_Count incount, MPI_Datatype datatype, MPI_Comm comm, + MPI_Count *size); OMPI_DECLSPEC int MPI_Parrived(MPI_Request request, int partition, int *flag); OMPI_DECLSPEC int MPI_Pcontrol(const int level, ...); OMPI_DECLSPEC int MPI_Pready(int partitions, MPI_Request request); OMPI_DECLSPEC int MPI_Pready_range(int partition_low, int partition_high, MPI_Request request); -OMPI_DECLSPEC int MPI_Pready_list(int length, int partition_list[], MPI_Request request); +OMPI_DECLSPEC int MPI_Pready_list(int length, const int partition_list[], MPI_Request request); OMPI_DECLSPEC int MPI_Precv_init(void* buf, int partitions, MPI_Count count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Info info, MPI_Request *request); @@ -1912,39 +2149,76 @@ OMPI_DECLSPEC int MPI_Publish_name(const char *service_name, MPI_Info info, OMPI_DECLSPEC int MPI_Put(const 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); +OMPI_DECLSPEC int MPI_Put_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Win win); OMPI_DECLSPEC int MPI_Query_thread(int *provided); OMPI_DECLSPEC int MPI_Raccumulate(const 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_Op op, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int MPI_Raccumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int MPI_Recv_init(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Recv_init_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int MPI_Recv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int MPI_Recv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC int MPI_Reduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Reduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Ireduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ireduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Reduce_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Reduce_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Reduce_local(const void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op); +OMPI_DECLSPEC int MPI_Reduce_local_c(const void *inbuf, void *inoutbuf, MPI_Count count, + MPI_Datatype datatype, MPI_Op op); OMPI_DECLSPEC int MPI_Reduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Reduce_scatter_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int MPI_Ireduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ireduce_scatter_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Reduce_scatter_init(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Reduce_scatter_init_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Reduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Reduce_scatter_block_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int MPI_Ireduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ireduce_scatter_block_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Reduce_scatter_block_init(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Reduce_scatter_block_init_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Register_datarep(const char *datarep, MPI_Datarep_conversion_function *read_conversion_fn, MPI_Datarep_conversion_function *write_conversion_fn, MPI_Datarep_extent_function *dtype_file_extent_fn, void *extra_state); +OMPI_DECLSPEC int MPI_Register_datarep_c(const char *datarep, + MPI_Datarep_conversion_function_c *read_conversion_fn, + MPI_Datarep_conversion_function_c *write_conversion_fn, + MPI_Datarep_extent_function *dtype_file_extent_fn, + void *extra_state); OMPI_DECLSPEC MPI_Fint MPI_Request_c2f(MPI_Request request); OMPI_DECLSPEC MPI_Request MPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int MPI_Request_free(MPI_Request *request); @@ -1953,55 +2227,107 @@ OMPI_DECLSPEC int MPI_Request_get_status(MPI_Request request, int *flag, 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); +OMPI_DECLSPEC int MPI_Rget_c(void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, MPI_Datatype target_datatype, + MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int MPI_Rget_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, void *result_addr, int result_count, MPI_Datatype result_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int MPI_Rget_accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + void *result_addr, MPI_Count result_count, MPI_Datatype result_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, + MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int MPI_Rput(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_cout, MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int MPI_Rput_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_cout, + MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int MPI_Rsend(const void *ibuf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Rsend_c(const void *ibuf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int MPI_Rsend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Rsend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int MPI_Scan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Scan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Scan_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Scan_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Scatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Scatter_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iscatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iscatter_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Scatter_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Scatter_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Scatterv(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Scatterv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int MPI_Iscatterv(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Iscatterv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int MPI_Scatterv_init(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int MPI_Scatterv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int MPI_Send_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int MPI_Send_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int MPI_Send(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Send_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int MPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag, void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int MPI_Sendrecv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + int dest, int sendtag, void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, int source, int recvtag, + MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC int MPI_Sendrecv_replace(void * buf, int count, MPI_Datatype datatype, int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int MPI_Sendrecv_replace_c(void * buf, MPI_Count count, MPI_Datatype datatype, + 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, @@ -2020,8 +2346,13 @@ 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, MPI_Request *request); +OMPI_DECLSPEC int MPI_Ssend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int MPI_Ssend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Ssend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int MPI_Start(MPI_Request *request); OMPI_DECLSPEC int MPI_Startall(int count, MPI_Request array_of_requests[]); OMPI_DECLSPEC int MPI_Status_c2f(const MPI_Status *c_status, MPI_Fint *f_status); @@ -2039,6 +2370,8 @@ OMPI_DECLSPEC int MPI_Status_set_source(MPI_Status *status, int source); OMPI_DECLSPEC int MPI_Status_set_tag(MPI_Status *status, int tag); OMPI_DECLSPEC int MPI_Status_set_elements(MPI_Status *status, MPI_Datatype datatype, int count); +OMPI_DECLSPEC int MPI_Status_set_elements_c(MPI_Status *status, MPI_Datatype datatype, + MPI_Count count); OMPI_DECLSPEC int MPI_Status_set_elements_x(MPI_Status *status, MPI_Datatype datatype, MPI_Count count); OMPI_DECLSPEC int MPI_Testall(int count, MPI_Request array_of_requests[], int *flag, @@ -2055,11 +2388,18 @@ OMPI_DECLSPEC MPI_Fint MPI_Type_c2f(MPI_Datatype datatype); OMPI_DECLSPEC int MPI_Type_commit(MPI_Datatype *type); OMPI_DECLSPEC int MPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_contiguous_c(MPI_Count count, MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_darray(int size, int rank, int ndims, const int gsize_array[], const int distrib_array[], const int darg_array[], const int psize_array[], int order, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_darray_c(int size, int rank, int ndims, + const MPI_Count gsize_array[], const int distrib_array[], + const int darg_array[], const int psize_array[], + int order, MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_f90_complex(int p, int r, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_f90_integer(int r, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_f90_real(int p, int r, MPI_Datatype *newtype); @@ -2067,13 +2407,24 @@ OMPI_DECLSPEC int MPI_Type_create_hindexed_block(int count, int blocklength, const MPI_Aint array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_hindexed_block_c(MPI_Count count, MPI_Count blocklength, + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_hindexed(int count, const int array_of_blocklengths[], const MPI_Aint array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_hindexed_c(MPI_Count count, const MPI_Count array_of_blocklengths[], + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_hvector(int count, int blocklength, MPI_Aint stride, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_hvector_c(MPI_Count count, MPI_Count blocklength, MPI_Count stride, + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_keyval(MPI_Type_copy_attr_function *type_copy_attr_fn, MPI_Type_delete_attr_function *type_delete_attr_fn, int *type_keyval, void *extra_state); @@ -2081,15 +2432,28 @@ OMPI_DECLSPEC int MPI_Type_create_indexed_block(int count, int blocklength, const int array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_indexed_block_c(MPI_Count count, MPI_Count blocklength, + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_struct(int count, const int array_of_block_lengths[], const MPI_Aint array_of_displacements[], const MPI_Datatype array_of_types[], MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_struct_c(MPI_Count count, const MPI_Count array_of_block_lengths[], + const MPI_Count array_of_displacements[], + const MPI_Datatype array_of_types[], + MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_subarray(int ndims, const int size_array[], const int subsize_array[], const int start_array[], int order, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_subarray_c(int ndims, const MPI_Count size_array[], const MPI_Count subsize_array[], + const MPI_Count start_array[], int order, + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_create_resized(MPI_Datatype oldtype, MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_create_resized_c(MPI_Datatype oldtype, MPI_Count lb, + MPI_Count extent, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_delete_attr(MPI_Datatype type, int type_keyval); OMPI_DECLSPEC int MPI_Type_dup(MPI_Datatype type, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_free(MPI_Datatype *type); @@ -2102,37 +2466,63 @@ OMPI_DECLSPEC int MPI_Type_get_contents(MPI_Datatype mtype, int max_integers, int array_of_integers[], MPI_Aint array_of_addresses[], MPI_Datatype array_of_datatypes[]); +OMPI_DECLSPEC int MPI_Type_get_contents_c(MPI_Datatype mtype, MPI_Count max_integers, + MPI_Count max_addresses, MPI_Count max_large_counts, + MPI_Count max_datatypes, + int array_of_integers[], + MPI_Aint array_of_addresses[], + MPI_Count array_of_large_counts[], + MPI_Datatype array_of_datatypes[]); OMPI_DECLSPEC int MPI_Type_get_envelope(MPI_Datatype type, int *num_integers, int *num_addresses, int *num_datatypes, int *combiner); +OMPI_DECLSPEC int MPI_Type_get_envelope_c(MPI_Datatype type, MPI_Count *num_integers, + MPI_Count *num_addresses, MPI_Count *num_large_counts, + MPI_Count *num_datatypes, int *combiner); OMPI_DECLSPEC int MPI_Type_get_extent(MPI_Datatype type, MPI_Aint *lb, MPI_Aint *extent); +OMPI_DECLSPEC int MPI_Type_get_extent_c(MPI_Datatype type, MPI_Count *lb, + MPI_Count *extent); OMPI_DECLSPEC int MPI_Type_get_extent_x(MPI_Datatype type, MPI_Count *lb, MPI_Count *extent); OMPI_DECLSPEC int MPI_Type_get_name(MPI_Datatype type, char *type_name, int *resultlen); OMPI_DECLSPEC int MPI_Type_get_true_extent(MPI_Datatype datatype, MPI_Aint *true_lb, MPI_Aint *true_extent); +OMPI_DECLSPEC int MPI_Type_get_true_extent_c(MPI_Datatype datatype, MPI_Count *true_lb, + MPI_Count *true_extent); OMPI_DECLSPEC int MPI_Type_get_true_extent_x(MPI_Datatype datatype, MPI_Count *true_lb, MPI_Count *true_extent); OMPI_DECLSPEC int MPI_Type_indexed(int count, const int array_of_blocklengths[], const int array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_indexed_c(MPI_Count count, const MPI_Count array_of_blocklengths[], + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Type_match_size(int typeclass, int size, MPI_Datatype *type); OMPI_DECLSPEC int MPI_Type_set_attr(MPI_Datatype type, int type_keyval, void *attr_val); OMPI_DECLSPEC int MPI_Type_set_name(MPI_Datatype type, const char *type_name); OMPI_DECLSPEC int MPI_Type_size(MPI_Datatype type, int *size); +OMPI_DECLSPEC int MPI_Type_size_c(MPI_Datatype type, MPI_Count *size); OMPI_DECLSPEC int MPI_Type_size_x(MPI_Datatype type, MPI_Count *size); OMPI_DECLSPEC int MPI_Type_vector(int count, int blocklength, int stride, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int MPI_Type_vector_c(MPI_Count count, MPI_Count blocklength, MPI_Count stride, + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int MPI_Unpack(const void *inbuf, int insize, int *position, void *outbuf, int outcount, MPI_Datatype datatype, MPI_Comm comm); +OMPI_DECLSPEC int MPI_Unpack_c(const void *inbuf, MPI_Count insize, MPI_Count *position, + void *outbuf, MPI_Count outcount, MPI_Datatype datatype, + MPI_Comm comm); OMPI_DECLSPEC int MPI_Unpublish_name(const char *service_name, MPI_Info info, const char *port_name); OMPI_DECLSPEC int MPI_Unpack_external (const char datarep[], const void *inbuf, MPI_Aint insize, MPI_Aint *position, void *outbuf, int outcount, MPI_Datatype datatype); +OMPI_DECLSPEC int MPI_Unpack_external_c (const char datarep[], const void *inbuf, MPI_Count insize, + MPI_Count *position, void *outbuf, MPI_Count outcount, + MPI_Datatype datatype); OMPI_DECLSPEC int MPI_Waitall(int count, MPI_Request array_of_requests[], MPI_Status *array_of_statuses); OMPI_DECLSPEC int MPI_Waitany(int count, MPI_Request array_of_requests[], @@ -2143,14 +2533,20 @@ OMPI_DECLSPEC int MPI_Waitsome(int incount, MPI_Request array_of_requests[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int MPI_Win_allocate(MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, void *baseptr, MPI_Win *win); +OMPI_DECLSPEC int MPI_Win_allocate_c(MPI_Aint size, MPI_Aint disp_unit, MPI_Info info, + MPI_Comm comm, void *baseptr, MPI_Win *win); OMPI_DECLSPEC int MPI_Win_allocate_shared(MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, void *baseptr, MPI_Win *win); +OMPI_DECLSPEC int MPI_Win_allocate_shared_c(MPI_Aint size, MPI_Aint disp_unit, MPI_Info info, + MPI_Comm comm, void *baseptr, MPI_Win *win); OMPI_DECLSPEC int MPI_Win_attach(MPI_Win win, void *base, MPI_Aint size); OMPI_DECLSPEC MPI_Fint MPI_Win_c2f(MPI_Win win); OMPI_DECLSPEC int MPI_Win_call_errhandler(MPI_Win win, int errorcode); OMPI_DECLSPEC int MPI_Win_complete(MPI_Win win); OMPI_DECLSPEC int MPI_Win_create(void *base, MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, MPI_Win *win); +OMPI_DECLSPEC int MPI_Win_create_c(void *base, MPI_Aint size, MPI_Aint disp_unit, + MPI_Info info, MPI_Comm comm, MPI_Win *win); OMPI_DECLSPEC int MPI_Win_create_dynamic(MPI_Info info, MPI_Comm comm, MPI_Win *win); OMPI_DECLSPEC int MPI_Win_create_errhandler(MPI_Win_errhandler_function *function, MPI_Errhandler *errhandler); @@ -2181,6 +2577,7 @@ OMPI_DECLSPEC int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler OMPI_DECLSPEC int MPI_Win_set_info(MPI_Win win, MPI_Info info); OMPI_DECLSPEC int MPI_Win_set_name(MPI_Win win, const char *win_name); OMPI_DECLSPEC int MPI_Win_shared_query(MPI_Win win, int rank, MPI_Aint *size, int *disp_unit, void *baseptr); +OMPI_DECLSPEC int MPI_Win_shared_query_c(MPI_Win win, int rank, MPI_Aint *size, MPI_Aint *disp_unit, void *baseptr); OMPI_DECLSPEC int MPI_Win_start(MPI_Group group, int mpi_assert, MPI_Win win); OMPI_DECLSPEC int MPI_Win_sync(MPI_Win win); OMPI_DECLSPEC int MPI_Win_test(MPI_Win win, int *flag); @@ -2197,98 +2594,143 @@ OMPI_DECLSPEC int PMPI_Abort(MPI_Comm comm, int errorcode); OMPI_DECLSPEC int PMPI_Accumulate(const 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_Op op, MPI_Win win); +OMPI_DECLSPEC int PMPI_Accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); OMPI_DECLSPEC int PMPI_Add_error_class(int *errorclass); OMPI_DECLSPEC int PMPI_Add_error_code(int errorclass, int *errorcode); OMPI_DECLSPEC int PMPI_Add_error_string(int errorcode, const char *string); OMPI_DECLSPEC int PMPI_Allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iallgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iallgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Allgather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], - const int displs[], MPI_Datatype recvtype, MPI_Comm comm); + void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, + MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iallgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iallgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Allgatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr); -OMPI_DECLSPEC int PMPI_Allreduce(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Allreduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Allreduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iallreduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iallreduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Allreduce_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Allreduce_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ialltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ialltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request); + void *recvbuf, int recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Alltoall_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ialltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ialltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Alltoallv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ialltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Alltoallw_init(const void *sendbuf, const int sendcounts[], const int sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Info info, MPI_Request *request); -OMPI_DECLSPEC int PMPI_Dist_graph_create(MPI_Comm comm_old, int n, const int nodes[], - const int degrees[], const int targets[], - const int weights[], MPI_Info info, - int reorder, MPI_Comm * newcomm); -OMPI_DECLSPEC int PMPI_Dist_graph_create_adjacent(MPI_Comm comm_old, - int indegree, const int sources[], - const int sourceweights[], - int outdegree, - const int destinations[], - const int destweights[], - MPI_Info info, int reorder, - MPI_Comm *comm_dist_graph); -OMPI_DECLSPEC int PMPI_Dist_graph_neighbors(MPI_Comm comm, int maxindegree, - int sources[], int sourceweights[], - int maxoutdegree, - int destinations[], - int destweights[]); -OMPI_DECLSPEC int PMPI_Dist_graph_neighbors_count(MPI_Comm comm, - int *inneighbors, - int *outneighbors, - int *weighted); +OMPI_DECLSPEC int PMPI_Alltoallw_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Barrier(MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ibarrier(MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Barrier_init(MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Bcast(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Bcast_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ibcast(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ibcast_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Bcast_init(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Bcast_init_c(void *buffer, MPI_Count count, MPI_Datatype datatype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Bsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Bsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Bsend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Bsend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Buffer_attach(void *buffer, int size); +OMPI_DECLSPEC int PMPI_Buffer_attach_c(void *buffer, MPI_Count size); OMPI_DECLSPEC int PMPI_Buffer_detach(void *buffer, int *size); +OMPI_DECLSPEC int PMPI_Buffer_detach_c(void *buffer, MPI_Count *size); OMPI_DECLSPEC int PMPI_Cancel(MPI_Request *request); OMPI_DECLSPEC int PMPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int coords[]); OMPI_DECLSPEC int PMPI_Cart_create(MPI_Comm old_comm, int ndims, const int dims[], @@ -2317,7 +2759,7 @@ OMPI_DECLSPEC int PMPI_Comm_create_keyval(MPI_Comm_copy_attr_function *comm_cop int *comm_keyval, void *extra_state); OMPI_DECLSPEC int PMPI_Comm_create_group(MPI_Comm comm, MPI_Group group, int tag, MPI_Comm *newcomm); OMPI_DECLSPEC int PMPI_Comm_create_from_group(MPI_Group group, const char *tag, MPI_Info info, - MPI_Errhandler errhandler, MPI_Comm *newcomm); + MPI_Errhandler errhandler, MPI_Comm *newcomm); OMPI_DECLSPEC int PMPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm); OMPI_DECLSPEC int PMPI_Comm_delete_attr(MPI_Comm comm, int comm_keyval); OMPI_DECLSPEC int PMPI_Comm_disconnect(MPI_Comm *comm); @@ -2331,6 +2773,27 @@ OMPI_DECLSPEC int PMPI_Comm_free_keyval(int *comm_keyval); OMPI_DECLSPEC int PMPI_Comm_free(MPI_Comm *comm); OMPI_DECLSPEC int PMPI_Comm_get_attr(MPI_Comm comm, int comm_keyval, void *attribute_val, int *flag); +OMPI_DECLSPEC int PMPI_Dist_graph_create(MPI_Comm comm_old, int n, const int nodes[], + const int degrees[], const int targets[], + const int weights[], MPI_Info info, + int reorder, MPI_Comm * newcomm); +OMPI_DECLSPEC int PMPI_Dist_graph_create_adjacent(MPI_Comm comm_old, + int indegree, const int sources[], + const int sourceweights[], + int outdegree, + const int destinations[], + const int destweights[], + MPI_Info info, int reorder, + MPI_Comm *comm_dist_graph); +OMPI_DECLSPEC int PMPI_Dist_graph_neighbors(MPI_Comm comm, int maxindegree, + int sources[], int sourceweights[], + int maxoutdegree, + int destinations[], + int destweights[]); +OMPI_DECLSPEC int PMPI_Dist_graph_neighbors_count(MPI_Comm comm, + int *inneighbors, + int *outneighbors, + int *weighted); OMPI_DECLSPEC int PMPI_Comm_get_errhandler(MPI_Comm comm, MPI_Errhandler *erhandler); OMPI_DECLSPEC int PMPI_Comm_get_info(MPI_Comm comm, MPI_Info *info_used); OMPI_DECLSPEC int PMPI_Comm_get_name(MPI_Comm comm, char *comm_name, int *resultlen); @@ -2366,10 +2829,16 @@ OMPI_DECLSPEC int PMPI_Error_class(int errorcode, int *errorclass); OMPI_DECLSPEC int PMPI_Error_string(int errorcode, char *string, int *resultlen); OMPI_DECLSPEC int PMPI_Exscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Exscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iexscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iexscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Exscan_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Exscan_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Fetch_and_op(const void *origin_addr, void *result_addr, MPI_Datatype datatype, int target_rank, MPI_Aint target_disp, MPI_Op op, MPI_Win win); OMPI_DECLSPEC MPI_Fint PMPI_File_c2f(MPI_File file); @@ -2397,74 +2866,132 @@ OMPI_DECLSPEC int PMPI_File_get_view(MPI_File fh, MPI_Offset *disp, MPI_Datatype *filetype, char *datarep); OMPI_DECLSPEC int PMPI_File_read_at(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_at_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_read_at_all(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_at_all_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_at(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_at_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_at_all(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_at_all_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_iread_at(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iread_at_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iwrite_at(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iwrite_at_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iread_at_all(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iread_at_all_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iwrite_at_all(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iwrite_at_all_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_read(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_read_all(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_all_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_all(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_all_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_iread(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iread_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iwrite(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iwrite_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iread_all(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iread_all_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iwrite_all(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iwrite_all_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_seek(MPI_File fh, MPI_Offset offset, int whence); OMPI_DECLSPEC int PMPI_File_get_position(MPI_File fh, MPI_Offset *offset); OMPI_DECLSPEC int PMPI_File_get_byte_offset(MPI_File fh, MPI_Offset offset, MPI_Offset *disp); OMPI_DECLSPEC int PMPI_File_read_shared(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_shared_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_shared(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_shared_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_iread_shared(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iread_shared_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_iwrite_shared(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Request *request); +OMPI_DECLSPEC int PMPI_File_iwrite_shared_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Request *request); OMPI_DECLSPEC int PMPI_File_read_ordered(MPI_File fh, void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_read_ordered_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_ordered(MPI_File fh, const void *buf, int count, MPI_Datatype datatype, MPI_Status *status); +OMPI_DECLSPEC int PMPI_File_write_ordered_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_seek_shared(MPI_File fh, MPI_Offset offset, int whence); OMPI_DECLSPEC int PMPI_File_get_position_shared(MPI_File fh, MPI_Offset *offset); OMPI_DECLSPEC int PMPI_File_read_at_all_begin(MPI_File fh, MPI_Offset offset, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_read_at_all_begin_c(MPI_File fh, MPI_Offset offset, void *buf, + MPI_Count count, MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_read_at_all_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_at_all_begin(MPI_File fh, MPI_Offset offset, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_write_at_all_begin_c(MPI_File fh, MPI_Offset offset, const void *buf, + MPI_Count count, MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_write_at_all_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_read_all_begin(MPI_File fh, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_read_all_begin_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_read_all_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_all_begin(MPI_File fh, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_write_all_begin_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_write_all_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_read_ordered_begin(MPI_File fh, void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_read_ordered_begin_c(MPI_File fh, void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_read_ordered_end(MPI_File fh, void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_write_ordered_begin(MPI_File fh, const void *buf, int count, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_File_write_ordered_begin_c(MPI_File fh, const void *buf, MPI_Count count, + MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_File_write_ordered_end(MPI_File fh, const void *buf, MPI_Status *status); OMPI_DECLSPEC int PMPI_File_get_type_extent(MPI_File fh, MPI_Datatype datatype, MPI_Aint *extent); +OMPI_DECLSPEC int PMPI_File_get_type_extent_c(MPI_File fh, MPI_Datatype datatype, + MPI_Count *extent); OMPI_DECLSPEC int PMPI_File_set_atomicity(MPI_File fh, int flag); OMPI_DECLSPEC int PMPI_File_get_atomicity(MPI_File fh, int *flag); OMPI_DECLSPEC int PMPI_File_sync(MPI_File fh); @@ -2474,35 +3001,61 @@ OMPI_DECLSPEC int PMPI_Free_mem(void *base); OMPI_DECLSPEC int PMPI_Gather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Gather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Igather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Gather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Gather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Gatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Gatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], + MPI_Datatype recvtype, int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Igatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Igatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Gatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Gatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Get_address(const void *location, MPI_Aint *address); OMPI_DECLSPEC int PMPI_Get_count(const MPI_Status *status, MPI_Datatype datatype, int *count); -OMPI_DECLSPEC int PMPI_Get_elements(const MPI_Status *status, MPI_Datatype datatype, - int *count); -OMPI_DECLSPEC int PMPI_Get_elements_x(const MPI_Status *status, MPI_Datatype datatype, - MPI_Count *count); +OMPI_DECLSPEC int PMPI_Get_count_c(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); +OMPI_DECLSPEC int PMPI_Get_elements(const MPI_Status *status, MPI_Datatype datatype, int *count); +OMPI_DECLSPEC int PMPI_Get_elements_c(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); +OMPI_DECLSPEC int PMPI_Get_elements_x(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count); OMPI_DECLSPEC int PMPI_Get(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); +OMPI_DECLSPEC int PMPI_Get_c(void *origin_addr, MPI_Count origin_count, + MPI_Datatype origin_datatype, int target_rank, + MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Win win); OMPI_DECLSPEC int PMPI_Get_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, void *result_addr, int result_count, MPI_Datatype result_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); +OMPI_DECLSPEC int PMPI_Get_accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + void *result_addr, MPI_Count result_count, MPI_Datatype result_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win); OMPI_DECLSPEC int PMPI_Get_library_version(char *version, int *resultlen); OMPI_DECLSPEC int PMPI_Get_processor_name(char *name, int *resultlen); OMPI_DECLSPEC int PMPI_Get_version(int *version, int *subversion); @@ -2546,11 +3099,15 @@ OMPI_DECLSPEC int PMPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup); OMPI_DECLSPEC int PMPI_Ibsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ibsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Improbe(int source, int tag, MPI_Comm comm, int *flag, MPI_Message *message, MPI_Status *status); OMPI_DECLSPEC int PMPI_Imrecv(void *buf, int count, MPI_Datatype type, MPI_Message *message, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Imrecv_c(void *buf, MPI_Count count, MPI_Datatype type, + MPI_Message *message, MPI_Request *request); OMPI_DECLSPEC MPI_Fint PMPI_Info_c2f(MPI_Info info); OMPI_DECLSPEC int PMPI_Info_create(MPI_Info *info); OMPI_DECLSPEC int PMPI_Info_create_env(int argc, char *argv[], MPI_Info *info); @@ -2574,144 +3131,253 @@ OMPI_DECLSPEC int PMPI_Intercomm_create_from_groups (MPI_Group local_group, int int remote_leader, const char *tag, MPI_Info info, MPI_Errhandler errhandler, MPI_Comm *newintercomm); OMPI_DECLSPEC int PMPI_Intercomm_merge(MPI_Comm intercomm, int high, - MPI_Comm *newintercomm); + MPI_Comm *newintracomm); OMPI_DECLSPEC int PMPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, MPI_Status *status); OMPI_DECLSPEC int PMPI_Irecv(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Irecv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Irsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Irsend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Isend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Isend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Isendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag, void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Isendrecv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + int dest, int sendtag, void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, int source, int recvtag, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Isendrecv_replace(void * buf, int count, MPI_Datatype datatype, int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Isendrecv_replace_c(void * buf, MPI_Count count, MPI_Datatype datatype, + int dest, int sendtag, int source, int recvtag, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Issend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); -OMPI_DECLSPEC int PMPI_Precv_init(void* buf, int partitions, MPI_Count count, - MPI_Datatype datatype, int source, int tag, MPI_Comm comm, - MPI_Info info, MPI_Request *request); -OMPI_DECLSPEC int PMPI_Psend_init(const void* buf, int partitions, MPI_Count count, - MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, - MPI_Info info, MPI_Request *request); -OMPI_DECLSPEC int PMPI_Pready(int partitions, MPI_Request request); -OMPI_DECLSPEC int PMPI_Pready_range(int partition_low, int partition_high, - MPI_Request request); -OMPI_DECLSPEC int PMPI_Pready_list(int length, int partition_list[], MPI_Request request); -OMPI_DECLSPEC int PMPI_Parrived(MPI_Request request, int partition, int *flag); +OMPI_DECLSPEC int PMPI_Issend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Is_thread_main(int *flag); OMPI_DECLSPEC int PMPI_Lookup_name(const char *service_name, MPI_Info info, char *port_name); OMPI_DECLSPEC MPI_Fint PMPI_Message_c2f(MPI_Message message); OMPI_DECLSPEC MPI_Message PMPI_Message_f2c(MPI_Fint message); OMPI_DECLSPEC int PMPI_Mprobe(int source, int tag, MPI_Comm comm, - MPI_Message *message, - MPI_Status *status); + MPI_Message *message, + MPI_Status *status); OMPI_DECLSPEC int PMPI_Mrecv(void *buf, int count, MPI_Datatype type, MPI_Message *message, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Mrecv_c(void *buf, MPI_Count count, MPI_Datatype type, + MPI_Message *message, MPI_Status *status); OMPI_DECLSPEC int PMPI_Neighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ineighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); -OMPI_DECLSPEC int PMPI_Neighbor_allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ineighbor_allgather_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], + MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, + void *recvbuf, int recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Neighbor_allgather_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Ineighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ineighbor_allgatherv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Neighbor_allgatherv_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint displs[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ineighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ineighbor_alltoall_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Neighbor_alltoall_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ineighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ineighbor_alltoallv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Neighbor_alltoallv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], MPI_Datatype sendtype, + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], MPI_Datatype recvtype, + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Neighbor_alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ineighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ineighbor_alltoallw_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Neighbor_alltoallw_init(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Neighbor_alltoallw_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint sdispls[], const MPI_Datatype sendtypes[], + void *recvbuf, const MPI_Count recvcounts[], const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], + MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC MPI_Fint PMPI_Op_c2f(MPI_Op op); OMPI_DECLSPEC int PMPI_Op_commutative(MPI_Op op, int *commute); OMPI_DECLSPEC int PMPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op); +OMPI_DECLSPEC int PMPI_Op_create_c(MPI_User_function_c *function, int commute, MPI_Op *op); OMPI_DECLSPEC int PMPI_Open_port(MPI_Info info, char *port_name); OMPI_DECLSPEC MPI_Op PMPI_Op_f2c(MPI_Fint op); OMPI_DECLSPEC int PMPI_Op_free(MPI_Op *op); OMPI_DECLSPEC int PMPI_Pack_external(const char datarep[], const void *inbuf, int incount, MPI_Datatype datatype, void *outbuf, MPI_Aint outsize, MPI_Aint *position); +OMPI_DECLSPEC int PMPI_Pack_external_c(const char datarep[], const void *inbuf, MPI_Count incount, + MPI_Datatype datatype, void *outbuf, + MPI_Count outsize, MPI_Count *position); OMPI_DECLSPEC int PMPI_Pack_external_size(const char datarep[], int incount, MPI_Datatype datatype, MPI_Aint *size); +OMPI_DECLSPEC int PMPI_Pack_external_size_c(const char datarep[], MPI_Count incount, + MPI_Datatype datatype, MPI_Count *size); OMPI_DECLSPEC int PMPI_Pack(const void *inbuf, int incount, MPI_Datatype datatype, void *outbuf, int outsize, int *position, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Pack_c(const void *inbuf, MPI_Count incount, MPI_Datatype datatype, + void *outbuf, MPI_Count outsize, MPI_Count *position, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int *size); +OMPI_DECLSPEC int PMPI_Pack_size_c(MPI_Count incount, MPI_Datatype datatype, MPI_Comm comm, + MPI_Count *size); +OMPI_DECLSPEC int PMPI_Parrived(MPI_Request request, int partition, int *flag); OMPI_DECLSPEC int PMPI_Pcontrol(const int level, ...); +OMPI_DECLSPEC int PMPI_Pready(int partitions, MPI_Request request); +OMPI_DECLSPEC int PMPI_Pready_range(int partition_low, int partition_high, + MPI_Request request); +OMPI_DECLSPEC int PMPI_Pready_list(int length, const int partition_list[], MPI_Request request); +OMPI_DECLSPEC int PMPI_Precv_init(void* buf, int partitions, MPI_Count count, + MPI_Datatype datatype, int source, int tag, MPI_Comm comm, + MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Probe(int source, int tag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Psend_init(const void* buf, int partitions, MPI_Count count, + MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, + MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Publish_name(const char *service_name, MPI_Info info, const char *port_name); OMPI_DECLSPEC int PMPI_Put(const 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); +OMPI_DECLSPEC int PMPI_Put_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Win win); OMPI_DECLSPEC int PMPI_Query_thread(int *provided); OMPI_DECLSPEC int PMPI_Raccumulate(const 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_Op op, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Raccumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int PMPI_Recv_init(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Recv_init_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Recv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Recv_c(void *buf, MPI_Count count, MPI_Datatype datatype, int source, + int tag, MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC int PMPI_Reduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Reduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ireduce(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ireduce_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Reduce_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Reduce_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Reduce_local(const void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op); +OMPI_DECLSPEC int PMPI_Reduce_local_c(const void *inbuf, void *inoutbuf, MPI_Count count, + MPI_Datatype datatype, MPI_Op op); OMPI_DECLSPEC int PMPI_Reduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Reduce_scatter_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ireduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ireduce_scatter_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Reduce_scatter_init(const void *sendbuf, void *recvbuf, const int recvcounts[], MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Reduce_scatter_init_c(const void *sendbuf, void *recvbuf, const MPI_Count recvcounts[], MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Reduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Reduce_scatter_block_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Ireduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ireduce_scatter_block_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Reduce_scatter_block_init(const void *sendbuf, void *recvbuf, int recvcount, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Reduce_scatter_block_init_c(const void *sendbuf, void *recvbuf, MPI_Count recvcount, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Register_datarep(const char *datarep, MPI_Datarep_conversion_function *read_conversion_fn, MPI_Datarep_conversion_function *write_conversion_fn, MPI_Datarep_extent_function *dtype_file_extent_fn, void *extra_state); +OMPI_DECLSPEC int PMPI_Register_datarep_c(const char *datarep, + MPI_Datarep_conversion_function_c *read_conversion_fn, + MPI_Datarep_conversion_function_c *write_conversion_fn, + MPI_Datarep_extent_function *dtype_file_extent_fn, + void *extra_state); OMPI_DECLSPEC MPI_Fint PMPI_Request_c2f(MPI_Request request); OMPI_DECLSPEC MPI_Request PMPI_Request_f2c(MPI_Fint request); OMPI_DECLSPEC int PMPI_Request_free(MPI_Request *request); @@ -2720,55 +3386,107 @@ OMPI_DECLSPEC int PMPI_Request_get_status(MPI_Request request, int *flag, 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); +OMPI_DECLSPEC int PMPI_Rget_c(void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, MPI_Datatype target_datatype, + MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int PMPI_Rget_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, void *result_addr, int result_count, MPI_Datatype result_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Rget_accumulate_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + void *result_addr, MPI_Count result_count, MPI_Datatype result_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_count, + MPI_Datatype target_datatype, MPI_Op op, + MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int PMPI_Rput(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_cout, MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Rput_c(const void *origin_addr, MPI_Count origin_count, MPI_Datatype origin_datatype, + int target_rank, MPI_Aint target_disp, MPI_Count target_cout, + MPI_Datatype target_datatype, MPI_Win win, MPI_Request *request); OMPI_DECLSPEC int PMPI_Rsend(const void *ibuf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Rsend_c(const void *ibuf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Rsend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Rsend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int PMPI_Scan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Scan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iscan_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Scan_init(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Scan_init_c(const void *sendbuf, void *recvbuf, MPI_Count count, MPI_Datatype datatype, + MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Scatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Scatter_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iscatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iscatter_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Scatter_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Scatter_init_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Scatterv(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Scatterv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Iscatterv(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Iscatterv_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Request *request); OMPI_DECLSPEC int PMPI_Scatterv_init(const void *sendbuf, const int sendcounts[], const int displs[], MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Scatterv_init_c(const void *sendbuf, const MPI_Count sendcounts[], const MPI_Aint displs[], MPI_Datatype sendtype, + void *recvbuf, MPI_Count recvcount, MPI_Datatype recvtype, + int root, MPI_Comm comm, MPI_Info info, MPI_Request *request); OMPI_DECLSPEC int PMPI_Send_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Send_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int PMPI_Send(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Send_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag, void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Sendrecv_c(const void *sendbuf, MPI_Count sendcount, MPI_Datatype sendtype, + int dest, int sendtag, void *recvbuf, MPI_Count recvcount, + MPI_Datatype recvtype, int source, int recvtag, + MPI_Comm comm, MPI_Status *status); OMPI_DECLSPEC int PMPI_Sendrecv_replace(void * buf, int count, MPI_Datatype datatype, int dest, int sendtag, int source, int recvtag, MPI_Comm comm, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Sendrecv_replace_c(void * buf, MPI_Count count, MPI_Datatype datatype, + 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, @@ -2780,21 +3498,26 @@ OMPI_DECLSPEC int PMPI_Session_get_num_psets (MPI_Session session, MPI_Info inf OMPI_DECLSPEC int PMPI_Session_get_nth_pset (MPI_Session session, MPI_Info info, int n, int *len, char *pset_name); OMPI_DECLSPEC int PMPI_Session_get_pset_info (MPI_Session session, const char *pset_name, MPI_Info *info_used); OMPI_DECLSPEC int PMPI_Session_init (MPI_Info info, MPI_Errhandler errhandler, - MPI_Session *session); + 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_errhandler(MPI_Session session, MPI_Errhandler errhandler); 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, MPI_Request *request); +OMPI_DECLSPEC int PMPI_Ssend_init_c(const void *buf, MPI_Count count, MPI_Datatype datatype, + int dest, int tag, MPI_Comm comm, + MPI_Request *request); OMPI_DECLSPEC int PMPI_Ssend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Ssend_c(const void *buf, MPI_Count count, MPI_Datatype datatype, int dest, + int tag, MPI_Comm comm); OMPI_DECLSPEC int PMPI_Start(MPI_Request *request); OMPI_DECLSPEC int PMPI_Startall(int count, MPI_Request array_of_requests[]); OMPI_DECLSPEC int PMPI_Status_c2f(const MPI_Status *c_status, MPI_Fint *f_status); OMPI_DECLSPEC int PMPI_Status_c2f08(const MPI_Status *c_status, MPI_F08_status *f08_status); -OMPI_DECLSPEC int PMPI_Status_f082f(const MPI_F08_status *f08_status, MPI_Fint *f_status); OMPI_DECLSPEC int PMPI_Status_f082c(const MPI_F08_status *f08_status, MPI_Status *c_status); +OMPI_DECLSPEC int PMPI_Status_f082f(const MPI_F08_status *f08_status, MPI_Fint *f_status); OMPI_DECLSPEC int PMPI_Status_f2c(const MPI_Fint *f_status, MPI_Status *c_status); OMPI_DECLSPEC int PMPI_Status_f2f08(const MPI_Fint *f_status, MPI_F08_status *f08_status); OMPI_DECLSPEC int PMPI_Status_get_error(const MPI_Status *status, int *error); @@ -2806,11 +3529,14 @@ OMPI_DECLSPEC int PMPI_Status_set_source(MPI_Status *status, int source); OMPI_DECLSPEC int PMPI_Status_set_tag(MPI_Status *status, int tag); OMPI_DECLSPEC int PMPI_Status_set_elements(MPI_Status *status, MPI_Datatype datatype, int count); +OMPI_DECLSPEC int PMPI_Status_set_elements_c(MPI_Status *status, MPI_Datatype datatype, + MPI_Count count); OMPI_DECLSPEC int PMPI_Status_set_elements_x(MPI_Status *status, MPI_Datatype datatype, MPI_Count count); OMPI_DECLSPEC int PMPI_Testall(int count, MPI_Request array_of_requests[], int *flag, MPI_Status array_of_statuses[]); -OMPI_DECLSPEC int PMPI_Testany(int count, MPI_Request array_of_requests[], int *index, int *flag, MPI_Status *status); +OMPI_DECLSPEC int PMPI_Testany(int count, MPI_Request array_of_requests[], int *index, + int *flag, MPI_Status *status); OMPI_DECLSPEC int PMPI_Test(MPI_Request *request, int *flag, MPI_Status *status); OMPI_DECLSPEC int PMPI_Test_cancelled(const MPI_Status *status, int *flag); OMPI_DECLSPEC int PMPI_Testsome(int incount, MPI_Request array_of_requests[], @@ -2821,41 +3547,72 @@ OMPI_DECLSPEC MPI_Fint PMPI_Type_c2f(MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_Type_commit(MPI_Datatype *type); OMPI_DECLSPEC int PMPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_contiguous_c(MPI_Count count, MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_darray(int size, int rank, int ndims, const int gsize_array[], const int distrib_array[], const int darg_array[], const int psize_array[], int order, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_darray_c(int size, int rank, int ndims, + const MPI_Count gsize_array[], const int distrib_array[], + const int darg_array[], const int psize_array[], + int order, MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_f90_complex(int p, int r, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_f90_integer(int r, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_f90_real(int p, int r, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_hindexed_block(int count, int blocklength, + const MPI_Aint array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_hindexed_block_c(MPI_Count count, MPI_Count blocklength, + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_hindexed(int count, const int array_of_blocklengths[], const MPI_Aint array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_hindexed_c(MPI_Count count, const MPI_Count array_of_blocklengths[], + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_hvector(int count, int blocklength, MPI_Aint stride, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_hvector_c(MPI_Count count, MPI_Count blocklength, MPI_Count stride, + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_keyval(MPI_Type_copy_attr_function *type_copy_attr_fn, MPI_Type_delete_attr_function *type_delete_attr_fn, int *type_keyval, void *extra_state); -OMPI_DECLSPEC int PMPI_Type_create_hindexed_block(int count, int blocklength, - const MPI_Aint array_of_displacements[], - MPI_Datatype oldtype, - MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_indexed_block(int count, int blocklength, const int array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_indexed_block_c(MPI_Count count, MPI_Count blocklength, + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_struct(int count, const int array_of_block_lengths[], const MPI_Aint array_of_displacements[], const MPI_Datatype array_of_types[], MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_struct_c(MPI_Count count, const MPI_Count array_of_block_lengths[], + const MPI_Count array_of_displacements[], + const MPI_Datatype array_of_types[], + MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_subarray(int ndims, const int size_array[], const int subsize_array[], const int start_array[], int order, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_subarray_c(int ndims, const MPI_Count size_array[], const MPI_Count subsize_array[], + const MPI_Count start_array[], int order, + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_create_resized(MPI_Datatype oldtype, MPI_Aint lb, MPI_Aint extent, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_create_resized_c(MPI_Datatype oldtype, MPI_Count lb, + MPI_Count extent, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_delete_attr(MPI_Datatype type, int type_keyval); OMPI_DECLSPEC int PMPI_Type_dup(MPI_Datatype type, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_free(MPI_Datatype *type); @@ -2868,40 +3625,65 @@ OMPI_DECLSPEC int PMPI_Type_get_contents(MPI_Datatype mtype, int max_integers, int array_of_integers[], MPI_Aint array_of_addresses[], MPI_Datatype array_of_datatypes[]); +OMPI_DECLSPEC int PMPI_Type_get_contents_c(MPI_Datatype mtype, MPI_Count max_integers, + MPI_Count max_addresses, MPI_Count max_large_counts, + MPI_Count max_datatypes, + int array_of_integers[], + MPI_Aint array_of_addresses[], + MPI_Count array_of_large_counts[], + MPI_Datatype array_of_datatypes[]); OMPI_DECLSPEC int PMPI_Type_get_envelope(MPI_Datatype type, int *num_integers, int *num_addresses, int *num_datatypes, int *combiner); +OMPI_DECLSPEC int PMPI_Type_get_envelope_c(MPI_Datatype type, MPI_Count *num_integers, + MPI_Count *num_addresses, MPI_Count *num_large_counts, + MPI_Count *num_datatypes, int *combiner); OMPI_DECLSPEC int PMPI_Type_get_extent(MPI_Datatype type, MPI_Aint *lb, MPI_Aint *extent); +OMPI_DECLSPEC int PMPI_Type_get_extent_c(MPI_Datatype type, MPI_Count *lb, + MPI_Count *extent); OMPI_DECLSPEC int PMPI_Type_get_extent_x(MPI_Datatype type, MPI_Count *lb, MPI_Count *extent); OMPI_DECLSPEC int PMPI_Type_get_name(MPI_Datatype type, char *type_name, int *resultlen); OMPI_DECLSPEC int PMPI_Type_get_true_extent(MPI_Datatype datatype, MPI_Aint *true_lb, MPI_Aint *true_extent); +OMPI_DECLSPEC int PMPI_Type_get_true_extent_c(MPI_Datatype datatype, MPI_Count *true_lb, + MPI_Count *true_extent); OMPI_DECLSPEC int PMPI_Type_get_true_extent_x(MPI_Datatype datatype, MPI_Count *true_lb, MPI_Count *true_extent); OMPI_DECLSPEC int PMPI_Type_indexed(int count, const int array_of_blocklengths[], const int array_of_displacements[], MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_indexed_c(MPI_Count count, const MPI_Count array_of_blocklengths[], + const MPI_Count array_of_displacements[], + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Type_match_size(int typeclass, int size, MPI_Datatype *type); OMPI_DECLSPEC int PMPI_Type_set_attr(MPI_Datatype type, int type_keyval, void *attr_val); OMPI_DECLSPEC int PMPI_Type_set_name(MPI_Datatype type, const char *type_name); OMPI_DECLSPEC int PMPI_Type_size(MPI_Datatype type, int *size); +OMPI_DECLSPEC int PMPI_Type_size_c(MPI_Datatype type, MPI_Count *size); OMPI_DECLSPEC int PMPI_Type_size_x(MPI_Datatype type, MPI_Count *size); OMPI_DECLSPEC int PMPI_Type_vector(int count, int blocklength, int stride, MPI_Datatype oldtype, MPI_Datatype *newtype); +OMPI_DECLSPEC int PMPI_Type_vector_c(MPI_Count count, MPI_Count blocklength, MPI_Count stride, + MPI_Datatype oldtype, MPI_Datatype *newtype); OMPI_DECLSPEC int PMPI_Unpack(const void *inbuf, int insize, int *position, void *outbuf, int outcount, MPI_Datatype datatype, MPI_Comm comm); -OMPI_DECLSPEC int PMPI_Unpublish_name(const char *service_name, MPI_Info info, - const char *port_name); +OMPI_DECLSPEC int PMPI_Unpack_c(const void *inbuf, MPI_Count insize, MPI_Count *position, + void *outbuf, MPI_Count outcount, MPI_Datatype datatype, + MPI_Comm comm); +OMPI_DECLSPEC int PMPI_Unpublish_name(const char *service_name, MPI_Info info, const char *port_name); OMPI_DECLSPEC int PMPI_Unpack_external (const char datarep[], const void *inbuf, MPI_Aint insize, MPI_Aint *position, void *outbuf, int outcount, MPI_Datatype datatype); +OMPI_DECLSPEC int PMPI_Unpack_external_c (const char datarep[], const void *inbuf, MPI_Count insize, + MPI_Count *position, void *outbuf, MPI_Count outcount, + MPI_Datatype datatype); OMPI_DECLSPEC int PMPI_Waitall(int count, MPI_Request array_of_requests[], - MPI_Status array_of_statuses[]); + MPI_Status *array_of_statuses); OMPI_DECLSPEC int PMPI_Waitany(int count, MPI_Request array_of_requests[], int *index, MPI_Status *status); OMPI_DECLSPEC int PMPI_Wait(MPI_Request *request, MPI_Status *status); @@ -2910,14 +3692,20 @@ OMPI_DECLSPEC int PMPI_Waitsome(int incount, MPI_Request array_of_requests[], MPI_Status array_of_statuses[]); OMPI_DECLSPEC int PMPI_Win_allocate(MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, void *baseptr, MPI_Win *win); +OMPI_DECLSPEC int PMPI_Win_allocate_c(MPI_Aint size, MPI_Aint disp_unit, MPI_Info info, + MPI_Comm comm, void *baseptr, MPI_Win *win); OMPI_DECLSPEC int PMPI_Win_allocate_shared(MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, void *baseptr, MPI_Win *win); +OMPI_DECLSPEC int PMPI_Win_allocate_shared_c(MPI_Aint size, MPI_Aint disp_unit, MPI_Info info, + MPI_Comm comm, void *baseptr, MPI_Win *win); OMPI_DECLSPEC int PMPI_Win_attach(MPI_Win win, void *base, MPI_Aint size); OMPI_DECLSPEC MPI_Fint PMPI_Win_c2f(MPI_Win win); OMPI_DECLSPEC int PMPI_Win_call_errhandler(MPI_Win win, int errorcode); OMPI_DECLSPEC int PMPI_Win_complete(MPI_Win win); OMPI_DECLSPEC int PMPI_Win_create(void *base, MPI_Aint size, int disp_unit, MPI_Info info, MPI_Comm comm, MPI_Win *win); +OMPI_DECLSPEC int PMPI_Win_create_c(void *base, MPI_Aint size, MPI_Aint disp_unit, + MPI_Info info, MPI_Comm comm, MPI_Win *win); OMPI_DECLSPEC int PMPI_Win_create_dynamic(MPI_Info info, MPI_Comm comm, MPI_Win *win); OMPI_DECLSPEC int PMPI_Win_create_errhandler(MPI_Win_errhandler_function *function, MPI_Errhandler *errhandler); @@ -2948,6 +3736,7 @@ OMPI_DECLSPEC int PMPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandle OMPI_DECLSPEC int PMPI_Win_set_info(MPI_Win win, MPI_Info info); OMPI_DECLSPEC int PMPI_Win_set_name(MPI_Win win, const char *win_name); OMPI_DECLSPEC int PMPI_Win_shared_query(MPI_Win win, int rank, MPI_Aint *size, int *disp_unit, void *baseptr); +OMPI_DECLSPEC int PMPI_Win_shared_query_c(MPI_Win win, int rank, MPI_Aint *size, MPI_Aint *disp_unit, void *baseptr); OMPI_DECLSPEC int PMPI_Win_start(MPI_Group group, int mpi_assert, MPI_Win win); OMPI_DECLSPEC int PMPI_Win_sync(MPI_Win win); OMPI_DECLSPEC int PMPI_Win_test(MPI_Win win, int *flag); diff --git a/ompi/mpi/Makefile.am b/ompi/mpi/Makefile.am index 3d22f4755dc..80ae278fde2 100644 --- a/ompi/mpi/Makefile.am +++ b/ompi/mpi/Makefile.am @@ -22,4 +22,11 @@ EXTRA_DIST += \ mpi/fortran/configure-fortran-output-bottom.h \ - mpi/help-mpi-api.txt + mpi/help-mpi-api.txt \ + mpi/bindings/bindings.py \ + mpi/bindings/ompi_bindings/consts.py \ + mpi/bindings/ompi_bindings/c.py \ + mpi/bindings/ompi_bindings/c_type.py \ + mpi/bindings/ompi_bindings/fortran.py \ + mpi/bindings/ompi_bindings/fortran_type.py \ + mpi/bindings/ompi_bindings/util.py diff --git a/ompi/mpi/bindings/bindings.py b/ompi/mpi/bindings/bindings.py new file mode 100644 index 00000000000..b2bf67f8bdf --- /dev/null +++ b/ompi/mpi/bindings/bindings.py @@ -0,0 +1,75 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +"""Main binding generation script. + +This script is used for generating the bindings for both C and Fortran. See the +scripts in 'ompi_bindings/' for the bulk of the code. +""" +import argparse +import os +import sys + + +def handle_missing_command(args, out): + print('missing subcommand (one of {fortran,c} required)', file=sys.stderr) + sys.exit(1) + + +def main(): + parser = argparse.ArgumentParser(description='generate fortran binding files') + parser.add_argument('--builddir', required=True, help='absolute path to automake builddir (abs_top_builddir)') + parser.add_argument('--output', required=True, help='output file to use') + parser.add_argument('--srcdir', required=True, help='absolute path to automake srcdir (abs_top_srcdir)') + parser.set_defaults(handler=handle_missing_command) + subparsers = parser.add_subparsers() + + # Fortran set up code + parser_fortran = subparsers.add_parser('fortran', help='subcommand for generating Fortran code') + # Handler for generating actual code + subparsers_fortran = parser_fortran.add_subparsers() + parser_code = subparsers_fortran.add_parser('code', help='generate binding code') + parser_code.set_defaults(handler=lambda args, out: fortran.generate_code(args, out)) + parser_code.add_argument('--lang', choices=('fortran', 'c'), + help='language to generate (only for code subparser)') + # 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)) + # 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') + + # C set up code + parser_c = subparsers.add_parser('c', help='subcommand for generating C code') + subparsers_c = parser_c.add_subparsers() + parser_header = subparsers_c.add_parser('header', help='generate header file from template files') + parser_header.add_argument('file', nargs='+', help='list of template source files') + parser_header.add_argument('--external', action='store_true', help='generate external mpi.h header file') + parser_header.add_argument('--srcdir', help='source directory') + parser_header.set_defaults(handler=lambda args, out: c.generate_header(args, out)) + parser_gen = subparsers_c.add_parser('source', help='generate source file from template file') + # parser = argparse.ArgumentParser(description='C ABI binding generation code') + parser_gen.add_argument('type', choices=('ompi', 'standard'), + help='generate the OMPI ABI functions or the standard ABI functions') + parser_gen.add_argument('source_file', help='template file to use for C code generation') + parser_gen.set_defaults(handler=lambda args, out: c.generate_source(args, out)) + args = parser.parse_args() + + # Pull in both generated python files and src files on import + sys.path.insert(0, os.path.join(args.builddir, 'ompi/mpi/bindings')) + sys.path.insert(0, os.path.join(args.srcdir, 'ompi/mpi/bindings')) + from ompi_bindings import c, fortran + from ompi_bindings.util import OutputFile + + with open(args.output, 'w') as f: + args.handler(args, OutputFile(f)) + + +if __name__ == '__main__': + main() diff --git a/ompi/mpi/bindings/ompi_bindings/c.py b/ompi/mpi/bindings/ompi_bindings/c.py new file mode 100644 index 00000000000..362f481d11b --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/c.py @@ -0,0 +1,386 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights reserved. +# Copyright (c) 2023 Research Organization for Information Science +# and Technology (RIST). All rights reserved. +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADERS$ +# +# +"""MPI C Binding Code. + +This file is used for generating C bindings, as well as bigcount interfaces, +from individual *.c.in template files. This also currently includes unused ABI +code, in preparation for the standard ABI. + +TEMPLATE SOURCE FILE ASSUMPTIONS: +* Only one function per file +* Nothing (other than blank lines) after closing '}' +* Function prototype is preceded by PROTOTYPE +* All types in the function prototype are converted to one-word capital types + as defined here (to be later converted to ompi or standard ABI types) +* Functions requiring a bigcount implementation should have type COUNT in + place of MPI_Count or int for each count parameter. Bigcount functions will + be generated automatically for any function that includes a COUNT type. +""" +from abc import ABC, abstractmethod +import argparse +import re +import sys +import os +from ompi_bindings import consts, util +from ompi_bindings.consts import ConvertFuncs, ConvertOMPIToStandard +from ompi_bindings.c_type import Type +from ompi_bindings.parser import SourceTemplate + + +class ABIHeaderBuilder: + """ABI header builder code.""" + + def __init__(self, prototypes, out, external=False): + self.out = out + self.external = external + + if external: + mangle_name = lambda name: name + else: + mangle_name = util.abi_internal_name + + # Build up the list of standard ABI signatures + signatures = [] + for prototype in prototypes: + base_name = util.mpi_fn_name_from_base_fn_name(prototype.name) + signatures.append(prototype.signature(base_name, abi_type='standard', + mangle_name=mangle_name)) + # Profiling prototype + signatures.append(prototype.signature(f'P{base_name}', abi_type='standard', + mangle_name=mangle_name)) + if util.prototype_has_bigcount(prototype): + signatures.append(prototype.signature(f'{base_name}_c', abi_type='standard', + enable_count=True, + mangle_name=mangle_name)) + # Profiling prototype + signatures.append(prototype.signature(f'P{base_name}_c', abi_type='standard', + enable_count=True, + mangle_name=mangle_name)) + self.signatures = signatures + + def mangle_name(self, extname): + """Mangle names, depending on whether building external or internal header.""" + if self.external: + return extname + return util.abi_internal_name(extname) + + def dump(self, *pargs, **kwargs): + self.out.dump(*pargs, **kwargs) + + def dump_lines(self, lines): + lines = util.indent_lines(lines, 4 * ' ', start=1) + for line in lines: + self.dump(line) + + def generate_error_convert_fn(self): + self.dump(f'{consts.INLINE_ATTRS} int {ConvertFuncs.ERROR_CLASS}(int error_class)') + self.dump('{') + lines = [] + lines.append('switch (error_class) {') + for error in consts.ERROR_CLASSES: + lines.append(f'case {self.mangle_name(error)}:') + lines.append(f'return {error};') + lines.append('default:') + lines.append('return error_class;') + lines.append('}') + self.dump_lines(lines) + self.dump('}') + + def generic_convert(self, fn_name, param_name, type_, value_names): + intern_type = self.mangle_name(type_) + self.dump(f'{consts.INLINE_ATTRS} {type_} {fn_name}({intern_type} {param_name})') + self.dump('{') + lines = [] + for i, value_name in enumerate(value_names): + intern_name = self.mangle_name(value_name) + if i == 0: + lines.append('if (%s == %s) {' % (intern_name, param_name)) + else: + lines.append('} else if (%s == %s) {' % (intern_name, param_name)) + lines.append(f'return {value_name};') + lines.append('}') + lines.append(f'return ({type_}) {param_name};') + self.dump_lines(lines) + self.dump('}') + + def generic_convert_reverse(self, fn_name, param_name, type_, value_names): + intern_type = self.mangle_name(type_) + self.dump(f'{consts.INLINE_ATTRS} {intern_type} {fn_name}({type_} {param_name})') + self.dump('{') + lines = [] + for i, value_name in enumerate(value_names): + intern_name = self.mangle_name(value_name) + if i == 0: + lines.append('if (%s == %s) {' % (value_name, param_name)) + else: + lines.append('} else if (%s == %s) {' % (value_name, param_name)) + lines.append(f'return {intern_name};') + lines.append('}') + lines.append(f'return ({intern_type}) {param_name};') + self.dump_lines(lines) + self.dump('}') + + def generate_comm_convert_fn(self): + self.generic_convert(ConvertFuncs.COMM, 'comm', 'MPI_Comm', consts.RESERVED_COMMUNICATORS) + + def generate_comm_convert_fn_intern_to_abi(self): + self.generic_convert_reverse(ConvertOMPIToStandard.COMM, 'comm', 'MPI_Comm', consts.RESERVED_COMMUNICATORS) + + def generate_info_convert_fn(self): + self.generic_convert(ConvertFuncs.INFO, 'info', 'MPI_Info', consts.RESERVED_INFOS) + + def generate_file_convert_fn_intern_to_abi(self): + self.generic_convert_reverse(ConvertFuncs.FILE, 'file', 'MPI_File', consts.RESERVED_FILES) + + def generate_datatype_convert_fn(self): + self.generic_convert(ConvertFuncs.DATATYPE, 'datatype', 'MPI_Datatype', consts.PREDEFINED_DATATYPES) + + def generate_op_convert_fn(self): + self.generic_convert(ConvertFuncs.OP, 'op', 'MPI_Op', consts.COLLECTIVE_OPERATIONS) + + def generate_win_convert_fn(self): + self.generic_convert(ConvertFuncs.WIN, 'win', 'MPI_Win', consts.RESERVED_WINDOWS) + + def generate_pointer_convert_fn(self, type_, fn_name, constants): + abi_type = self.mangle_name(type_) + self.dump(f'{consts.INLINE_ATTRS} void {fn_name}({abi_type} *ptr)') + self.dump('{') + lines = [] + for i, ompi_name in enumerate(constants): + abi_name = self.mangle_name(ompi_name) + if i == 0: + lines.append('if (%s == (%s) *ptr) {' % (ompi_name, type_)) + else: + lines.append('} else if (%s == (%s) *ptr) {' % (ompi_name, type_)) + lines.append(f'*ptr = {abi_name};') + lines.append('}') + self.dump_lines(lines) + self.dump('}') + + def generate_request_convert_fn(self): + self.generate_pointer_convert_fn('MPI_Request', ConvertFuncs.REQUEST, consts.RESERVED_REQUESTS) + + def generate_file_convert_fn(self): + self.generate_pointer_convert_fn('MPI_File', ConvertFuncs.FILE, consts.RESERVED_FILES) + + def generate_status_convert_fn(self): + type_ = 'MPI_Status' + abi_type = self.mangle_name(type_) + self.dump(f'{consts.INLINE_ATTRS} void {ConvertFuncs.STATUS}({abi_type} *out, {type_} *inp)') + self.dump('{') + self.dump(' out->MPI_SOURCE = inp->MPI_SOURCE;') + self.dump(' out->MPI_TAG = inp->MPI_TAG;') + self.dump(f' out->MPI_ERROR = {ConvertFuncs.ERROR_CLASS}(inp->MPI_ERROR);') + # Ignoring the private fields for now + self.dump('}') + + def define(self, type_, name, value): + self.dump(f'#define {name} OMPI_CAST_CONSTANT({type_}, {value})') + + def define_all(self, type_, constants): + for i, const in enumerate(constants): + self.define(self.mangle_name(type_), self.mangle_name(const), i + 1) + self.dump() + + def dump_header(self): + header_guard = '_ABI_INTERNAL_' + self.dump(f'#ifndef {header_guard}') + self.dump(f'#define {header_guard}') + + self.dump('#include "stddef.h"') + self.dump('#include "stdint.h"') + + self.dump(""" +#if defined(c_plusplus) || defined(__cplusplus) +extern "C" { +#endif +""") + + self.dump(""" +#if defined(c_plusplus) || defined(__cplusplus) +#define OMPI_CAST_CONSTANT(type, value) (static_cast (static_cast (value))) +#else +#define OMPI_CAST_CONSTANT(type, value) ((type) ((void *) value)) +#endif +""") + + for i, err in enumerate(consts.ERROR_CLASSES): + self.dump(f'#define {self.mangle_name(err)} {i + 1}') + self.dump() + + self.define_all('MPI_Datatype', consts.PREDEFINED_DATATYPES) + self.define_all('MPI_Op', COLLECTIVE_OPERATIONS) + self.define_all('MPI_Comm', consts.RESERVED_COMMUNICATORS) + self.define_all('MPI_Request', consts.RESERVED_REQUESTS) + self.define_all('MPI_Win', consts.RESERVED_WINDOWS) + self.define_all('MPI_Info', consts.RESERVED_INFOS) + self.define_all('MPI_File', consts.RESERVED_FILES) + + for name, value in consts.VARIOUS_CONSTANTS.items(): + self.dump(f'#define {self.mangle_name(name)} {value}') + self.dump() + + status_type = self.mangle_name('MPI_Status') + for i, name in enumerate(consts.IGNORED_STATUS_HANDLES): + self.define(f'{status_type} *', self.mangle_name(name), i + 1) + self.dump() + + for i, name in enumerate(consts.COMMUNICATOR_SPLIT_TYPES): + self.dump(f'#define {self.mangle_name(name)} {i}') + self.dump() + + for mpi_type, c_type in consts.C_OPAQUE_TYPES.items(): + self.dump(f'typedef {c_type} {self.mangle_name(mpi_type)};') + self.dump() + + for handle in consts.C_HANDLES: + prefix, suffix = handle.split('_') + name = f'{prefix}_ABI_{suffix}' + self.dump(f'typedef struct {self.mangle_name(name)} *{self.mangle_name(handle)};') + self.dump() + self.dump(""" +struct MPI_Status_ABI { + int MPI_SOURCE; + int MPI_TAG; + int MPI_ERROR; + int mpi_abi_private[5]; +};""") + self.dump(f'typedef struct MPI_Status_ABI {self.mangle_name("MPI_Status")};') + self.dump() + # Function signatures + for sig in self.signatures: + self.dump(f'{sig};') + self.dump('int MPI_Abi_details(int *buflen, char *details, MPI_Info *info);') + self.dump('int MPI_Abi_supported(int *flag);') + self.dump('int MPI_Abi_version(int *abi_major, int *abi_minor);') + if not self.external: + # Now generate the conversion code + self.generate_error_convert_fn() + self.generate_comm_convert_fn() + self.generate_comm_convert_fn_intern_to_abi() + self.generate_info_convert_fn() + self.generate_file_convert_fn() + self.generate_datatype_convert_fn() + self.generate_op_convert_fn() + self.generate_win_convert_fn() + self.generate_request_convert_fn() + self.generate_status_convert_fn() + + self.dump(""" +#if defined(c_plusplus) || defined(__cplusplus) +} +#endif +""") + self.dump(f'#endif /* {header_guard} */') + + +def print_profiling_header(fn_name, out): + """Print the profiling header code.""" + out.dump('#if OMPI_BUILD_MPI_PROFILING') + out.dump('#if OPAL_HAVE_WEAK_SYMBOLS') + out.dump(f'#pragma weak {fn_name} = P{fn_name}') + out.dump('#endif') + out.dump(f'#define {fn_name} P{fn_name}') + out.dump('#endif') + + +def print_cdefs_for_bigcount(fn_name, out, enable_count=False): + if enable_count: + out.dump('#undef OMPI_BIGCOUNT_SRC') + out.dump('#define OMPI_BIGCOUNT_SRC 1') + else: + out.dump('#undef OMPI_BIGCOUNT_SRC') + out.dump('#define OMPI_BIGCOUNT_SRC 0') + +def ompi_abi(base_name, template, out): + """Generate the OMPI ABI functions.""" + template.print_header(out) + print_profiling_header(base_name, out) + print_cdefs_for_bigcount(base_name, out) + out.dump(template.prototype.signature(base_name, abi_type='ompi')) + template.print_body(func_name=base_name, out=out) + # Check if we need to generate the bigcount interface + if util.prototype_has_bigcount(template.prototype): + base_name_c = f'{base_name}_c' + print_profiling_header(base_name_c, out) + print_cdefs_for_bigcount(base_name_c, out, enable_count=True) + out.dump(template.prototype.signature(base_name_c, abi_type='ompi', enable_count=True)) + template.print_body(func_name=base_name_c, out=out) + + +ABI_INTERNAL_HEADER = 'ompi/mpi/c/abi.h' + + +def standard_abi(base_name, template, out): + """Generate the standard ABI functions.""" + template.print_header(out) + out.dump(f'#include "{ABI_INTERNAL_HEADER}"') + + # Static internal function (add a random component to avoid conflicts) + internal_name = f'ompi_abi_{template.prototype.name}' + internal_sig = template.prototype.signature(internal_name, abi_type='ompi', + enable_count=True) + out.dump(consts.INLINE_ATTRS, internal_sig) + template.print_body(func_name=base_name, out=out) + + def generate_function(prototype, fn_name, internal_fn, enable_count=False): + """Generate a function for the standard ABI.""" + print_profiling_header(fn_name) + print_cdefs_for_bigcount(fn_name,enable_count) + + # Handle type conversions and arguments + params = [param.construct(abi_type='standard') for param in prototype.params] + out.dump(prototype.signature(fn_name, abi_type='standard', enable_count=enable_count)) + out.dump('{') + lines = [] + return_type = prototype.return_type.construct(abi_type='standard') + lines.append(f'{return_type.tmp_type_text()} ret_value;') + for param in params: + if param.init_code: + lines.extend(param.init_code) + pass_args = ', '.join(param.argument for param in params) + lines.append(f'ret_value = {internal_fn}({pass_args});') + for param in params: + if param.final_code: + lines.extend(param.final_code) + lines.extend(return_type.return_code('ret_value')) + + # Indent the lines + lines = util.indent_lines(lines, 4 * ' ', start=1) + for line in lines: + out.dump(line) + out.dump('}') + + generate_function(template.prototype, base_name, internal_name) + if util.prototype_has_bigcount(template.prototype): + base_name_c = f'{base_name}_c' + generate_function(template.prototype, base_name_c, internal_name, + enable_count=True) + + +def generate_header(args, out): + """Generate an ABI header and conversion code.""" + out.dump(f'/* {consts.GENERATED_MESSAGE} */') + prototypes = [SourceTemplate.load(file_, args.srcdir, type_constructor=Type.construct).prototype + for file_ in args.file] + builder = ABIHeaderBuilder(prototypes, out, external=args.external) + builder.dump_header() + + +def generate_source(args, out): + """Generate source file.""" + out.dump(f'/* {consts.GENERATED_MESSAGE} */') + template = SourceTemplate.load(args.source_file, type_constructor=Type.construct) + base_name = util.mpi_fn_name_from_base_fn_name(template.prototype.name) + if args.type == 'ompi': + ompi_abi(base_name, template, out) + else: + standard_abi(base_name, template, out) diff --git a/ompi/mpi/bindings/ompi_bindings/c_type.py b/ompi/mpi/bindings/ompi_bindings/c_type.py new file mode 100644 index 00000000000..532dfb88e37 --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/c_type.py @@ -0,0 +1,1237 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +"""C type definitions.""" +from abc import ABC, abstractmethod +from ompi_bindings.consts import ConvertFuncs, ConvertOMPIToStandard + + +class Type(ABC): + """Type representation.""" + + PARAMS_OMPI_ABI = {} + + PARAMS_STANDARD_ABI = {} + + def __init__(self, type_name, name=None, + mangle_name=lambda name: abi_internal_name(name), + count_param=None, **kwargs): + self.type = type_name + self.name = name + self.count_param = count_param + self.mangle_name = mangle_name + + @staticmethod + def construct(abi_type, type_name, **kwargs): + """Construct the parameter for the given ABI and type.""" + if abi_type == 'ompi': + return Type.PARAMS_OMPI_ABI[type_name](type_name, **kwargs) + elif abi_type == 'standard': + return Type.PARAMS_STANDARD_ABI[type_name](type_name, **kwargs) + else: + raise RuntimeError(f'invalid ABI type {abi_type}') + + @staticmethod + def add_type(type_name, abi_type=('ompi', 'standard')): + """Add a new class corresponding to a type.""" + def wrapper(class_): + if 'ompi' in abi_type: + Type.PARAMS_OMPI_ABI[type_name] = class_ + if 'standard' in abi_type: + Type.PARAMS_STANDARD_ABI[type_name] = class_ + return class_ + return wrapper + + @property + def is_count(self): + """Return True if this parameter is a count (requiring bigcount API).""" + return False + + @property + def init_code(self): + """Return the initialization code needed for an ABI wrapper.""" + return [] + + @property + def final_code(self): + """Return the finalization code needed for an ABI wrapper.""" + return [] + + def return_code(self, name): + """Process a value and then build up a return statement.""" + return [f'return {name};'] + + @property + def argument(self): + """Return the argument text required for passing an argument to a function.""" + return self.name + + @abstractmethod + def type_text(self, enable_count=False): + """Return the source text corresponding to a type definition.""" + + def tmp_type_text(self, enable_count=False): + """Return source text corresponding to a temporary type definition before conversion.""" + return self.type_text(enable_count=enable_count) + + def parameter(self, enable_count=False, **kwargs): + return f'{self.type_text(enable_count=enable_count)} {self.name}' + + +@Type.add_type('ERROR_CLASS') +class TypeErrorClass(Type): + + def type_text(self, enable_count=False): + return 'int' + + def return_code(self, name): + return [f'return {ConvertFuncs.ERROR_CLASS}({name});'] + + +@Type.add_type('BUFFER') +class TypeBuffer(Type): + + def type_text(self, enable_count=False): + return 'const void *' + + +@Type.add_type('BUFFER_OUT') +class TypeBufferOut(Type): + + def type_text(self, enable_count=False): + return f'void *' + + +@Type.add_type('COUNT') +class TypeCount(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count' if enable_count else 'int' + + +@Type.add_type('COUNT_ARRAY') +class TypeCountArray(Type): + """Array of counts (either int or MPI_Count).""" + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count *' if enable_count else 'int *' + + def parameter(self, enable_count=False, **kwargs): + count_type = 'MPI_Count' if enable_count else 'int' + return f'const {count_type} {self.name}[]' + +@Type.add_type('AINT_COUNT_ARRAY') +class TypeAintCountArray(Type): + """Array of counts (either MPI_Aint or MPI_Count).""" + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count *' if enable_count else 'MPI_Aint *' + + def parameter(self, enable_count=False, **kwargs): + count_type = 'MPI_Count' if enable_count else 'MPI_Aint' + return f'const {count_type} {self.name}[]' + +@Type.add_type('ELEMENT_COUNT') +class ElementCountType(Type): + """Special count type for MPI_Get_element_x""" + + def type_text(self, enable_count=False): + return 'MPI_Count *' + + +@Type.add_type('PARTITIONED_COUNT') +class TypePartitionedCount(Type): + """Count type for partitioned communication functions.""" + + def type_text(self, enable_count=False): + return 'MPI_Count' + + +@Type.add_type('DISP') +class TypeDisp(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Aint' if enable_count else 'int' + + +@Type.add_type('DISP_ARRAY') +class TypeDispArray(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Aint *' if enable_count else 'int *' + + def parameter(self, enable_count=False, **kwargs): + count_type = 'MPI_Aint' if enable_count else 'int' + return f'const {count_type} {self.name}[]' + + +@Type.add_type('INT') +class TypeInt(Type): + + def type_text(self, enable_count=False): + return 'int' + + +@Type.add_type('AINT') +class TypeAint(Type): + + def type_text(self, enable_count=False): + return 'MPI_Aint' + + +@Type.add_type('AINT_OUT') +class TypeAintOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Aint *' + + +@Type.add_type('AINT_ARRAY') +class TypeAintArray(Type): + + def type_text(self, enable_count=False): + return 'const MPI_Aint *' + + def parameter(self, enable_count=False, **kwargs): + return f'const MPI_Aint {self.name}[]' + + +@Type.add_type('INT_OUT') +class TypeIntOut(Type): + + def type_text(self, enable_count=False): + return 'int *' + + def parameter(self, enable_count=False, **kwargs): + if self.count_param is None: + return f'int *{self.name}' + else: + return f'int {self.name}[]' + + +@Type.add_type('COUNT_OUT') +class TypeCountOut(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count *' if enable_count else 'int *' + + +@Type.add_type('AINT_COUNT') +class TypeAintCountOut(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count' if enable_count else 'MPI_Aint' + + +@Type.add_type('AINT_COUNT_OUT') +class TypeAintCountOut(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Count *' if enable_count else 'MPI_Aint *' + + +@Type.add_type('INT_ARRAY') +class TypeIntArray(Type): + + def type_text(self, enable_count=False): + return 'const int *' + + def parameter(self, enable_count=False, **kwargs): + return f'const int {self.name}[]' + +@Type.add_type('INT_AINT_OUT') +class TypeIntAintOut(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Aint *' if enable_count else 'int *' + +@Type.add_type('RANGE_ARRAY') +class TypeRangeArray(Type): + + def type_text(self, enable_count=False): + return 'int *' + + def parameter(self, enable_count=False, **kwargs): + return f'int {self.name}[][3]' + + +@Type.add_type('OFFSET') +class TypeOffset(Type): + + def type_text(self, enable_count=False): + return 'MPI_Offset' + + +@Type.add_type('OFFSET_OUT') +class TypeOffsetOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Offset *' + + +@Type.add_type('DOUBLE') +class TypeDouble(Type): + + def type_text(self, enable_count=False): + return 'double' + + +@Type.add_type('ARGV') +class TypeArgv(Type): + + def type_text(self, enable_count=False): + return 'char ***' + + +@Type.add_type('STRING_ARRAY') +class TypeStringArray(Type): + + def type_text(self, enable_count=False): + return 'char **' + + def parameter(self, enable_count=False, **kwargs): + return f'char *{self.name}[]' + + +@Type.add_type('DATATYPE', abi_type=['ompi']) +class TypeDatatype(Type): + + def type_text(self, enable_count=False): + return 'MPI_Datatype' + + +@Type.add_type('DATATYPE_ARRAY', abi_type=['ompi']) +class TypeDatatypeArray(Type): + + def type_text(self, enable_count=False): + return 'MPI_Datatype' + + def parameter(self, enable_count=False, **kwargs): + return f'const {self.type_text(enable_count=enable_count)} {self.name}[]' + + +class StandardABIType(Type): + + @property + def tmpname(self): + return f'{self.name}_tmp' + + @property + def argument(self): + return self.tmpname + + +@Type.add_type('DATATYPE', abi_type=['standard']) +class TypeDatatypeStandard(StandardABIType): + + @property + def init_code(self): + return [f'MPI_Datatype {self.tmpname} = {ConvertFuncs.DATATYPE}({self.name});'] + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Datatype') + + +@Type.add_type('DATATYPE_OUT', abi_type=['ompi']) +class TypeDatatypeOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Datatype *' + + +@Type.add_type('DATATYPE_OUT', abi_type=['standard']) +class TypeDatatypeStandard(Type): + + @property + def final_code(self): + return [f'*{self.name} = {ConvertOMPIToStandard.DATATYPE}((MPI_Datatype) *{self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Datatype') + return f'{type_name} *' + + @property + def argument(self): + return f'(MPI_Datatype *) {self.name}' + + +@Type.add_type('OP', abi_type=['ompi']) +class TypeDatatype(Type): + + def type_text(self, enable_count=False): + return 'MPI_Op' + + +@Type.add_type('OP', abi_type=['standard']) +class TypeDatatype(StandardABIType): + + @property + def init_code(self): + return [f'MPI_Op {self.tmpname} = {ConvertFuncs.OP}({self.name});'] + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Op') + + +@Type.add_type('OP_OUT', abi_type=['ompi']) +class TypeOpOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Op *' + + +@Type.add_type('OP_OUT', abi_type=['standard']) +class TypeOpOutStandard(Type): + + @property + def final_code(self): + return [f'*{self.name} = {ConvertOMPIToStandard.OP}((MPI_Op) *{self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Op') + return f'{type_name} *' + + @property + def argument(self): + return f'(MPI_Op *) {self.name}' + + +@Type.add_type('RANK') +class TypeRank(Type): + + def type_text(self, enable_count=False): + return 'int' + + +@Type.add_type('TAG') +class TypeRank(Type): + + def type_text(self, enable_count=False): + return 'int' + + +@Type.add_type('COMM', abi_type=['ompi']) +class TypeCommunicator(Type): + + def type_text(self, enable_count=False): + return 'MPI_Comm' + + +@Type.add_type('COMM', abi_type=['standard']) +class TypeCommunicatorStandard(StandardABIType): + + @property + def init_code(self): + return [f'MPI_Comm {self.tmpname} = {ConvertFuncs.COMM}({self.name});'] + + def tmp_type_text(self, enable_count=False): + return 'MPI_Comm' + + def return_code(self, name): + return [f'return {ConvertOMPIToStandard.COMM}({name});'] + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Comm') + + +@Type.add_type('COMM_OUT', abi_type=['ompi']) +class TypeCommunicator(Type): + + def type_text(self, enable_count=False): + return 'MPI_Comm *' + + +@Type.add_type('COMM_OUT', abi_type=['standard']) +class TypeCommunicator(Type): + + @property + def final_code(self): + return [f'*{self.name} = {ConvertOMPIToStandard.COMM}((MPI_Comm) *{self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Comm') + return f'{type_name} *' + + @property + def argument(self): + return f'(MPI_Comm *) {self.name}' + + +@Type.add_type('WIN', abi_type=['ompi']) +class TypeWindow(Type): + + def type_text(self, enable_count=False): + return 'MPI_Win' + + +@Type.add_type('WIN', abi_type=['standard']) +class TypeWindowStandard(StandardABIType): + + @property + def init_code(self): + return [f'MPI_Win {self.tmpname} = {ConvertFuncs.WIN}({self.name});'] + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Win') + + +@Type.add_type('WIN_OUT', abi_type=['ompi']) +class TypeWindowOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Win *' + + +@Type.add_type('WIN_OUT', abi_type=['standard']) +class TypeWindowOutStandard(StandardABIType): + + @property + def final_code(self): + return [f'*{self.name} = {ConvertOMPIToStandard.WIN}((MPI_Win) *{self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Win') + return f'{type_name} *' + + @property + def argument(self): + return f'(MPI_Win *) {self.name}' + + +@Type.add_type('REQUEST', abi_type=['ompi']) +class TypeRequest(Type): + + def type_text(self, enable_count=False): + return 'MPI_Request' + + +@Type.add_type('REQUEST', abi_type=['standard']) +class TypeRequestStandard(Type): + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Request') + + @property + def argument(self): + return f'(MPI_Request) {self.name}' + + +@Type.add_type('REQUEST_INOUT', abi_type=['ompi']) +class TypeRequestInOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Request *' + + +@Type.add_type('REQUEST_INOUT', abi_type=['standard']) +class TypeRequestInOutStandard(Type): + + @property + def final_code(self): + if self.count_param is None: + return [f'{ConvertFuncs.REQUEST}({self.name});'] + else: + return [ + 'for (int i = 0; i < %s; ++i) {' % (self.count_param,), + f'{ConvertFuncs.REQUEST}(&{self.name}[i]);', + '}', + ] + + @property + def argument(self): + return f'(MPI_Request *) {self.name}' + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Request') + return f'{type_name} *' + + def parameter(self, enable_count=False, **kwargs): + type_name = self.mangle_name('MPI_Request') + if self.count_param is None: + return f'{type_name} *{self.name}' + else: + return f'{type_name} {self.name}[]' + + +@Type.add_type('STATUS', abi_type=['ompi']) +class TypeStatus(Type): + + def type_text(self, enable_count=False): + return 'const MPI_Status *' + + +@Type.add_type('STATUS', abi_type=['standard']) +class TypeStatusStandard(StandardABIType): + + @property + def init_code(self): + # TODO: Need to ensure this is the correct conversion function for MPI_Status + return [f'{ConvertFuncs.STATUS}({self.name}, &{self.tmpname});'] + + def typ_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Status') + return f'const {type_name} *' + + +@Type.add_type('STATUS_OUT', abi_type=['ompi']) +class TypeStatusOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Status *' + + def parameter(self, enable_count=False, **kwargs): + if self.count_param is None: + return f'MPI_Status *{self.name}' + else: + return f'MPI_Status {self.name}[]' + + +@Type.add_type('STATUS_OUT', abi_type=['standard']) +class TypeStausOutStandard(StandardABIType): + + def if_should_set_status(self): + """Generate the condition to check if the status(es) should be set.""" + condition = ' && '.join(f'{self.mangle_name(const)} != {self.name}' + for const in IGNORED_STATUS_HANDLES) + return 'if (%s) {' % (condition,) + + @property + def status_argument(self): + return f'{self.name}_arg' + + @property + def init_code(self): + code = [f'MPI_Status *{self.status_argument} = NULL;'] + if self.count_param is None: + code.append(f'MPI_Status {self.tmpname};') + else: + code.append(f'MPI_Status *{self.tmpname} = NULL;') + code.append(self.if_should_set_status()) + if self.count_param is not None: + code.append(f'{self.tmpname} = malloc({self.count_param} * sizeof(MPI_Status));') + code.append(f'{self.status_argument} = {self.tmpname};') + else: + code.append(f'{self.status_argument} = &{self.tmpname};') + code.append('} else {') + if self.count_param is not None: + code.append(f'{self.status_argument} = MPI_STATUSES_IGNORE;') + else: + code.append(f'{self.status_argument} = MPI_STATUS_IGNORE;') + code.append('}') + return code + + @property + def final_code(self): + code = [self.if_should_set_status()] + if self.count_param is None: + code.append(f'{ConvertFuncs.STATUS}({self.name}, &{self.tmpname});') + else: + code.extend([ + 'for (int i = 0; i < %s; ++i) {' % (self.count_param,), + f'{ConvertFuncs.STATUS}(&{self.name}[i], &{self.tmpname}[i]);', + '}', + f'free({self.tmpname});', + ]) + code.append('}') + return code + + @property + def argument(self): + return self.status_argument + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Status') + return f'{type_name} *' + + def parameter(self, enable_count=False, **kwargs): + type_name = self.mangle_name('MPI_Status') + if self.count_param is None: + return f'{type_name} *{self.name}' + else: + return f'{type_name} {self.name}[]' + + +@Type.add_type('F08_STATUS') +class TypeF08Status(Type): + + def type_text(self, enable_count=False): + return 'const MPI_F08_status *' + + +@Type.add_type('F08_STATUS_OUT') +class TypeF08StatusOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_F08_status *' + + +# TODO: For now this just assumes that MPI_Fint doesn't need any conversions +@Type.add_type('FINT') +class TypeFint(Type): + + def type_text(self, enable_count=False): + return 'MPI_Fint' + + +@Type.add_type('FINT_CONST') +class TypeFintRef(Type): + + def type_text(self, enable_count=False): + return 'const MPI_Fint *' + + +@Type.add_type('FINT_OUT') +class TypeFintOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Fint *' + + +@Type.add_type('STRING') +class TypeString(Type): + + def type_text(self, enable_count=False): + return 'const char *' + + +@Type.add_type('STRING_OUT') +class TypeStringOut(Type): + + def type_text(self, enable_count=False): + return 'char *' + + +@Type.add_type('INFO', abi_type=['ompi']) +class TypeInfo(Type): + + def type_text(self, enable_count=False): + return 'MPI_Info' + + +@Type.add_type('INFO', abi_type=['standard']) +class TypeInfoStandard(StandardABIType): + + @property + def init_code(self): + return [f'MPI_Info {self.tmpname} = {ConvertFuncs.INFO}({self.name});'] + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Info') + + +@Type.add_type('INFO_OUT', abi_type=['ompi']) +class TypeInfoOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Info *' + + +@Type.add_type('INFO_OUT', abi_type=['standard']) +class TypeInfoOutStandard(Type): + + @property + def argument(self): + return f'(MPI_Info *) {self.name}' + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Info') + return f'{type_name} *' + + +@Type.add_type('INFO_ARRAY', abi_type=['ompi']) +class TypeInfoArray(Type): + + def type_text(self, enable_count=False): + return 'const MPI_Info *' + + def parameter(self, enable_count=False, **kwargs): + return f'const MPI_Info {self.name}[]' + + +@Type.add_type('INFO_ARRAY', abi_type=['standard']) +class TypeInfoArray(Type): + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Info') + return f'const {type_name} *' + + def parameter(self, enable_count=False, **kwargs): + type_name = self.mangle_name('MPI_Info') + return f'const {type_name} {self.name}[]' + + +@Type.add_type('FILE', abi_type=['ompi']) +class TypeFile(Type): + + def type_text(self, enable_count=False): + return 'MPI_File' + + +@Type.add_type('FILE', abi_type=['standard']) +class TypeFileStandard(Type): + + @property + def argument(self): + return f'(MPI_File) {self.name}' + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_File') + + +@Type.add_type('FILE_OUT', abi_type=['ompi']) +class TypeFileOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_File *' + + +@Type.add_type('FILE_OUT', abi_type=['standard']) +class TypeFileOutStandard(Type): + + @property + def argument(self): + return f'(MPI_File *) {self.name}' + + @property + def final_code(self): + return [f'{ConvertFuncs.FILE}({self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_File') + return f'{type_name} *' + + +@Type.add_type('MESSAGE', abi_type=['ompi']) +class TypeMessage(Type): + + def type_text(self, enable_count=False): + return 'MPI_Message' + + +@Type.add_type('MESSAGE', abi_type=['standard']) +class TypeMessageStandard(Type): + + @property + def argument(self): + return f'(MPI_File) {self.name}' + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Message') + + +@Type.add_type('MESSAGE_OUT', abi_type=['ompi']) +class TypeMessageOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Message *' + + +@Type.add_type('MESSAGE_OUT', abi_type=['standard']) +class TypeMessageOutStandard(Type): + + @property + def argument(self): + return f'(MPI_Message *) {self.name}' + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Message') + return f'{type_name} *' + + +@Type.add_type('COMM_ERRHANDLER_FUNCTION', abi_type=['ompi']) +class TypeCommErrhandlerFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Comm_errhandler_function *' + + +@Type.add_type('COMM_ERRHANDLER_FUNCTION', abi_type=['standard']) +class TypeCommErrhandlerFunctionStandard(Type): + # TODO: This may require a special function to wrap the calllback + pass + + +@Type.add_type('FILE_ERRHANDLER_FUNCTION', abi_type=['ompi']) +class TypeFileErrhandlerFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_File_errhandler_function *' + + +@Type.add_type('FILE_ERRHANDLER_FUNCTION', abi_type=['standard']) +class TypeFileErrhandlerFunction(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('COPY_FUNCTION', abi_type=['ompi']) +class TypeCopyFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Copy_function *' + + +@Type.add_type('COPY_FUNCTION', abi_type=['standard']) +class TypeCopyFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('DELETE_FUNCTION', abi_type=['ompi']) +class TypeDeleteFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Delete_function *' + + +@Type.add_type('DELETE_FUNCTION', abi_type=['standard']) +class TypeDeleteFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('USER_FUNCTION', abi_type=['ompi']) +class TypeUserFunction(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_User_function_c *' if enable_count else 'MPI_User_function *' + + +@Type.add_type('USER_FUNCTION', abi_type=['standard']) +class TypeUserFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('COMM_COPY_ATTR_FUNCTION', abi_type=['ompi']) +class TypeCommCopyAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Comm_copy_attr_function *' + + +@Type.add_type('COMM_COPY_ATTR_FUNCTION', abi_type=['standard']) +class TypeCommCopyAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('COMM_DELETE_ATTR_FUNCTION', abi_type=['ompi']) +class TypeCommDeleteAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Comm_delete_attr_function *' + + +@Type.add_type('COMM_DELETE_ATTR_FUNCTION', abi_type=['standard']) +class TypeCommDeleteAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('GREQUEST_QUERY_FUNCTION', abi_type=['ompi']) +class TypeGrequestQueryFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Grequest_query_function *' + + +@Type.add_type('GREQUEST_QUERY_FUNCTION', abi_type=['standard']) +class TypeGrequestQueryFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('GREQUEST_FREE_FUNCTION', abi_type=['ompi']) +class TypeGrequestFreeFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Grequest_free_function *' + + +@Type.add_type('GREQUEST_FREE_FUNCTION', abi_type=['standard']) +class TypeGrequestFreeFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('GREQUEST_CANCEL_FUNCTION', abi_type=['ompi']) +class TypeGrequestCancelFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Grequest_cancel_function *' + + +@Type.add_type('GREQUEST_CANCEL_FUNCTION', abi_type=['standard']) +class TypeGrequestCancelFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('DATAREP_CONVERSION_FUNCTION', abi_type=['ompi']) +class TypeDatarepConversionFunction(Type): + + @property + def is_count(self): + return True + + def type_text(self, enable_count=False): + return 'MPI_Datarep_conversion_function_c *' if enable_count else 'MPI_Datarep_conversion_function *' + +@Type.add_type('DATAREP_CONVERSION_FUNCTION', abi_type=['standard']) +class TypeDatarepConversionFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('DATAREP_EXTENT_FUNCTION', abi_type=['ompi']) +class TypeDatarepExtentFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Datarep_extent_function *' + + +@Type.add_type('DATAREP_EXTENT_FUNCTION', abi_type=['standard']) +class TypeDatarepExtentFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('SESSION_ERRHANDLER_FUNCTION', abi_type=['ompi']) +class TypeSessionErrhandlerFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Session_errhandler_function *' + + +@Type.add_type('SESSION_ERRHANDLER_FUNCTION', abi_type=['standard']) +class TypeSessionErrhandlerFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('TYPE_COPY_ATTR_FUNCTION', abi_type=['ompi']) +class TypeTypeCopyAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Type_copy_attr_function *' + + +@Type.add_type('TYPE_COPY_ATTR_FUNCTION', abi_type=['standard']) +class TypeTypeCopyAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('TYPE_DELETE_ATTR_FUNCTION', abi_type=['ompi']) +class TypeTypeDeleteAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Type_delete_attr_function *' + + +@Type.add_type('TYPE_DELETE_ATTR_FUNCTION', abi_type=['standard']) +class TypeTypeDeleteAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('WIN_ERRHANLDER_FUNCTION', abi_type=['ompi']) +class TypeWinErrhandlerFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Win_errhandler_function *' + + +@Type.add_type('WIN_ERRHANDLER_FUNCTION', abi_type=['standard']) +class TypeWinErrhandlerFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('WIN_COPY_ATTR_FUNCTION', abi_type=['ompi']) +class TypeWinCopyAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Win_copy_attr_function *' + + +@Type.add_type('WIN_COPY_ATTR_FUNCTION', abi_type=['standard']) +class TypeWinCopyAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('WIN_DELETE_ATTR_FUNCTION', abi_type=['ompi']) +class TypeWinDeleteAttrFunction(Type): + + def type_text(self, enable_count=False): + return 'MPI_Win_delete_attr_function *' + + +@Type.add_type('WIN_DELETE_ATTR_FUNCTION', abi_type=['standard']) +class TypeWinDeleteAttrFunctionStandard(Type): + # TODO: This may require a special function to wrap the callback + pass + + +@Type.add_type('ERRHANDLER', abi_type=['ompi']) +class TypeErrhandler(Type): + + def type_text(self, enable_count=False): + return 'MPI_Errhandler' + + +@Type.add_type('ERRHANDLER', abi_type=['standard']) +class TypeErrhandlerStandard(Type): + + @property + def argument(self): + return f'(MPI_Errhandler) {self.name}' + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Errhandler') + + +@Type.add_type('ERRHANDLER_OUT', abi_type=['ompi']) +class TypeErrhandlerOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Errhandler *' + + +@Type.add_type('ERRHANDLER_OUT', abi_type=['standard']) +class TypeErrhandlerOutStandard(Type): + + @property + def argument(self): + return f'(MPI_Errhandler *) {self.name}' + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Errhandler') + return f'{MPI_Errhandler} *' + + +@Type.add_type('GROUP', abi_type=['ompi']) +class TypeGroup(Type): + + def type_text(self, enable_count=False): + return 'MPI_Group' + + +@Type.add_type('GROUP', abi_type=['standard']) +class TypeGroupStandard(Type): + + @property + def argument(self): + return f'(MPI_Group) {self.name}' + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Group') + + +@Type.add_type('GROUP_OUT', abi_type=['ompi']) +class TypeGroupOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Group *' + + +@Type.add_type('GROUP_OUT', abi_type=['standard']) +class TypeGroupOutStandard(Type): + + @property + def final_code(self): + return [f'*{self.name} = {ConvertOMPIToStandard.GROUP}((MPI_Group) *{self.name});'] + + def type_text(self, enable_count=False): + type_name = self.mangle_name('MPI_Group') + return f'{type_name} *' + + @property + def argument(self): + return f'(MPI_Group *) {self.name}' + + +@Type.add_type('SESSION_OUT', abi_type=['ompi']) +class TypeSessionOut(Type): + + def type_text(self, enable_count=False): + return 'MPI_Session *' + + +@Type.add_type('SESSION_OUT', abi_type=['standard']) +class TypeSessionOutStandard(Type): + + # TODO: This will require some conversion code for the ABI + @property + def argument(self): + return f'(MPI_Session *) {self.name}' + + def type_text(self): + type_name = self.mangle_name('MPI_Session') + return f'{type_name} *' + + +@Type.add_type('SESSION', abi_type=['ompi']) +class TypeSession(Type): + + def type_text(self, enable_count=False): + return 'MPI_Session' + + +@Type.add_type('SESSION', abi_type=['standard']) +class TypeSessionStandard(Type): + + # TODO: This will require some conversion code for the ABI + @property + def argument(self): + return f'(MPI_Session) {self.name}' + + def type_text(self, enable_count=False): + return self.mangle_name('MPI_Session') diff --git a/ompi/mpi/bindings/ompi_bindings/consts.py b/ompi/mpi/bindings/ompi_bindings/consts.py new file mode 100644 index 00000000000..48ef249223f --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/consts.py @@ -0,0 +1,253 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +# +"""Constants used for generating bindings.""" +import re + +FORTRAN_ERROR_NAME = 'ierror' +C_ERROR_NAME = 'ierr' +C_ERROR_TMP_NAME = 'c_ierr' +GENERATED_MESSAGE = 'THIS FILE WAS AUTOMATICALLY GENERATED. DO NOT EDIT BY HAND.' + +# +# C and ABI constants +# +# C type: const int +ERROR_CLASSES = [ + 'MPI_SUCCESS', + 'MPI_ERR_BUFFER', + 'MPI_ERR_COUNT', + 'MPI_ERR_TYPE', + 'MPI_ERR_TAG', + 'MPI_ERR_COMM', + 'MPI_ERR_RANK', + 'MPI_ERR_REQUEST', + 'MPI_ERR_ROOT', + 'MPI_ERR_GROUP', + 'MPI_ERR_OP', + 'MPI_ERR_TOPOLOGY', + 'MPI_ERR_DIMS', + 'MPI_ERR_ARG', + 'MPI_ERR_UNKNOWN', + 'MPI_ERR_TRUNCATE', + 'MPI_ERR_OTHER', + 'MPI_ERR_INTERN', + 'MPI_ERR_PENDING', + 'MPI_ERR_IN_STATUS', + 'MPI_ERR_ACCESS', + 'MPI_ERR_AMODE', + 'MPI_ERR_ASSERT', + 'MPI_ERR_BAD_FILE', + 'MPI_ERR_BASE', + 'MPI_ERR_CONVERSION', + 'MPI_ERR_DISP', + 'MPI_ERR_DUP_DATAREP', + 'MPI_ERR_FILE_EXISTS', + 'MPI_ERR_FILE_IN_USE', + 'MPI_ERR_FILE', + 'MPI_ERR_INFO_KEY', + 'MPI_ERR_INFO_NOKEY', + 'MPI_ERR_INFO_VALUE', + 'MPI_ERR_INFO', + 'MPI_ERR_IO', + 'MPI_ERR_KEYVAL', + 'MPI_ERR_LOCKTYPE', + 'MPI_ERR_NAME', + 'MPI_ERR_NO_MEM', + 'MPI_ERR_NOT_SAME', + 'MPI_ERR_NO_SPACE', + 'MPI_ERR_NO_SUCH_FILE', + 'MPI_ERR_PORT', + 'MPI_ERR_PROC_ABORTED', + 'MPI_ERR_QUOTA', + 'MPI_ERR_READ_ONLY', + 'MPI_ERR_RMA_ATTACH', + 'MPI_ERR_RMA_CONFLICT', + 'MPI_ERR_RMA_RANGE', + 'MPI_ERR_RMA_SHARED', + 'MPI_ERR_RMA_SYNC', + 'MPI_ERR_RMA_FLAVOR', + 'MPI_ERR_SERVICE', + 'MPI_ERR_SESSION', + 'MPI_ERR_SIZE', + 'MPI_ERR_SPAWN', + 'MPI_ERR_UNSUPPORTED_DATAREP', + 'MPI_ERR_UNSUPPORTED_OPERATION', + 'MPI_ERR_WIN', + 'MPI_T_ERR_CANNOT_INIT', + 'MPI_T_ERR_NOT_INITIALIZED', + 'MPI_T_ERR_MEMORY', + 'MPI_T_ERR_INVALID', + 'MPI_T_ERR_INVALID_INDEX', + 'MPI_T_ERR_INVALID_ITEM', + 'MPI_T_ERR_INVALID_SESSION', + 'MPI_T_ERR_INVALID_HANDLE', + 'MPI_T_ERR_INVALID_NAME', + 'MPI_T_ERR_OUT_OF_HANDLES', + 'MPI_T_ERR_OUT_OF_SESSIONS', + 'MPI_T_ERR_CVAR_SET_NOT_NOW', + 'MPI_T_ERR_CVAR_SET_NEVER', + 'MPI_T_ERR_PVAR_NO_WRITE', + 'MPI_T_ERR_PVAR_NO_STARTSTOP', + 'MPI_T_ERR_PVAR_NO_ATOMIC', + 'MPI_ERR_LASTCODE', +] + +PREDEFINED_DATATYPES = [ + 'MPI_CHAR', + 'MPI_SHORT', + 'MPI_INT', + 'MPI_LONG', + 'MPI_LONG_LONG_INT', + 'MPI_LONG_LONG', + 'MPI_SIGNED_CHAR', + 'MPI_UNSIGNED_CHAR', + 'MPI_UNSIGNED_SHORT', + 'MPI_UNSIGNED', + 'MPI_UNSIGNED_LONG', + 'MPI_UNSIGNED_LONG_LONG', + 'MPI_FLOAT', + 'MPI_DOUBLE', + 'MPI_LONG_DOUBLE', + 'MPI_WCHAR', + 'MPI_C_BOOL', + 'MPI_INT8_T', + 'MPI_INT16_T', + 'MPI_INT32_T', + 'MPI_INT64_T', + 'MPI_UINT8_T', + 'MPI_UINT16_T', + 'MPI_UINT32_T', + 'MPI_UINT64_T', + 'MPI_AINT', + 'MPI_COUNT', + 'MPI_OFFSET', + 'MPI_C_COMPLEX', + 'MPI_C_FLOAT_COMPLEX', + 'MPI_C_DOUBLE_COMPLEX', + 'MPI_C_LONG_DOUBLE_COMPLEX', + 'MPI_BYTE', + 'MPI_PACKED', + 'MPI_CXX_BOOL', + 'MPI_CXX_FLOAT_COMPLEX', + 'MPI_CXX_DOUBLE_COMPLEX', + 'MPI_CXX_LONG_DOUBLE_COMPLEX', + 'MPI_FLOAT_INT', + 'MPI_DOUBLE_INT', + 'MPI_LONG_INT', + 'MPI_2INT', + 'MPI_SHORT_INT', + 'MPI_LONG_DOUBLE_INT', +] + +# C type: MPI_Comm +RESERVED_COMMUNICATORS = [ + 'MPI_COMM_NULL', + 'MPI_COMM_WORLD', + 'MPI_COMM_SELF', +] + +COMMUNICATOR_SPLIT_TYPES = [ + 'MPI_COMM_TYPE_SHARED', + 'MPI_COMM_TYPE_HW_UNGUIDED', + 'MPI_COMM_TYPE_HW_GUIDED', +] + +RESERVED_WINDOWS = [ + 'MPI_WIN_NULL', +] + +RESERVED_REQUESTS = [ + 'MPI_REQUEST_NULL', +] + +RESERVED_INFOS = [ + 'MPI_INFO_ENV', + 'MPI_INFO_NULL', +] + +RESERVED_FILES = [ + 'MPI_FILE_NULL', +] + +IGNORED_STATUS_HANDLES = [ + 'MPI_STATUSES_IGNORE', + 'MPI_STATUS_IGNORE', +] + +COLLECTIVE_OPERATIONS = [ + 'MPI_MAX', + 'MPI_MIN', + 'MPI_SUM', + 'MPI_PROD', + 'MPI_MAXLOC', + 'MPI_MINLOC', + 'MPI_BAND', + 'MPI_BOR', + 'MPI_BXOR', + 'MPI_LAND', + 'MPI_LOR', + 'MPI_LXOR', + 'MPI_REPLACE', + 'MPI_NO_OP', +] + +VARIOUS_CONSTANTS = { + # Just setting this to the same as ompi ABI for right now, but will need to + # match the standard ABI value when defined + 'MPI_MAX_LIBRARY_VERSION_STRING': 256, + 'MPI_MAX_PROCESSOR_NAME': 256, +} + +# Types + +C_OPAQUE_TYPES = { + 'MPI_Aint': 'intptr_t', + 'MPI_Offset': 'int64_t', + 'MPI_Count': 'size_t', + # The below type needs to be set externally depending on Fortran compiler + 'MPI_Fint': 'int64_t', +} + +C_HANDLES = [ + 'MPI_Comm', + 'MPI_Datatype', + 'MPI_Errhandler', + 'MPI_File', + 'MPI_Group', + 'MPI_Info', + 'MPI_Message', + 'MPI_Op', + 'MPI_Request', + 'MPI_Session', + 'MPI_Win', +] + +class ConvertFuncs: + """Names of conversion functions (between standard ABI and OMPI ABI).""" + + ERROR_CLASS = 'ompi_convert_intern_error_abi_error' + COMM = 'ompi_convert_abi_comm_intern_comm' + DATATYPE = 'ompi_convert_abi_datatype_intern_datatype' + REQUEST = 'ompi_convert_abi_request_intern_request' + STATUS = 'ompi_convert_intern_status_abi_status' + OP = 'ompi_convert_abi_op_intern_op' + WIN = 'ompi_convert_abi_win_intern_win' + INFO = 'ompi_convert_abi_info_intern_info' + FILE = 'ompi_convert_abi_file_intern_file' + + +class ConvertOMPIToStandard: + """Generated function for converting from OMPI to standard ABI.""" + + COMM = 'ompi_convert_comm_ompi_to_standard' + + +# Inline function attributes +INLINE_ATTRS = '__opal_attribute_always_inline__ static inline' diff --git a/ompi/mpi/bindings/ompi_bindings/fortran.py b/ompi/mpi/bindings/ompi_bindings/fortran.py new file mode 100644 index 00000000000..d35824965e0 --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/fortran.py @@ -0,0 +1,288 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +# +"""Fortran binding generation code. + +This takes as input a *.in file containing a list of prototypes for Fortran +subroutines with generic types. Using this file, it can generate the Fortran +subroutines in one file and the C wraping code in another for all prototypes +listed. +""" +from collections import namedtuple +import json +import re +from ompi_bindings import consts, util +from ompi_bindings.fortran_type import FortranType +from ompi_bindings.parser import SourceTemplate + + +class FortranBinding: + """Class for generating the binding for a single function.""" + + def __init__(self, prototype, out, template=None, bigcount=False): + # Generate bigcount interface version + self.bigcount = bigcount + self.fn_name = template.prototype.name + self.out = out + self.template = template + self.parameters = [] + for param in self.template.prototype.params: + self.parameters.append(param.construct(fn_name=self.fn_name, + bigcount=bigcount)) + + def dump(self, *pargs, **kwargs): + """Write to the output file.""" + self.out.dump(*pargs, **kwargs) + + def _fn_name_suffix(self): + """Return a suffix for function names.""" + return '_c' if self.bigcount else '' + + @property + def c_func_name(self): + """Produce the final C func name from base_name.""" + return f'ompi_{self.fn_name}_wrapper_f08{self._fn_name_suffix()}' + + @property + def inner_call(self): + """Produce the name of the function to call in the body of the C code.""" + return f'PMPI_{self.fn_name.capitalize()}{self._fn_name_suffix()}' + + def _use(self): + """Determine the Fortran use-statements needed.""" + use = {} + for param in self.parameters: + for mod, name in param.use(): + if mod not in use: + use[mod] = set() + use[mod].add(name) + return use + + def _use_stmts(self): + """Return a list of required use statments.""" + use = self._use() + stmts = [] + for mod, names in use.items(): + names = ', '.join(names) + stmts.append(f'use :: {mod}, only: {names}') + return stmts + + def _print_fortran_interface(self): + """Output the C subroutine binding for the Fortran code.""" + name = self.c_func_name + self.dump(' interface') + + # Print the subroutine and parameter list, breaking parameters across lines + subroutine_start = f' subroutine {name}(' + params = [param.name for param in self.parameters] + params.append(consts.FORTRAN_ERROR_NAME) + lines = util.break_param_lines_fortran(start=subroutine_start, params=params, end=') &') + for line in lines: + self.dump(line) + self.dump(f' BIND(C, name="{name}")') + + use_stmts = self._use_stmts() + for stmt in use_stmts: + self.dump(f' {stmt}') + self.dump(' implicit none') + for param in self.parameters: + self.dump(f' {param.declare_cbinding_fortran()}') + self.dump(f' INTEGER, INTENT(OUT) :: {consts.FORTRAN_ERROR_NAME}') + self.dump(f' end subroutine {name}') + self.dump(' end interface') + + def _print_fortran_header(self, is_interface=False): + """Print the header, including use stmts, dummy variable decls, etc.. + + This does not include the subroutine line. + """ + # Use statements + use_stmts = self._use_stmts() + for stmt in use_stmts: + self.dump(f' {stmt}') + self.dump(' implicit none') + # 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}') + + def _print_fortran_subroutine(self): + """Output the Fortran subroutine line.""" + sub_name = util.fortran_f08_name(self.fn_name, bigcount=self.bigcount) + 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, ')') + for line in lines: + self.dump(line) + + def _print_fortran_subroutine_end(self): + """Output the Fortran end subroutine line.""" + sub_name = util.fortran_f08_name(self.fn_name, bigcount=self.bigcount) + self.dump(f'end subroutine {sub_name}') + + def dump_lines(self, line_text): + for line in line_text.split('\n'): + line = line.rstrip() + if line: + self.dump(f' {line}') + + def print_f_source(self): + """Output the main MPI Fortran subroutine.""" + self._print_fortran_subroutine() + self._print_fortran_header() + + # Temporaries + self.dump(f' INTEGER :: {consts.C_ERROR_TMP_NAME}') + for param in self.parameters: + self.dump_lines(param.declare_tmp()) + + # Interface for call to C function + self.dump() + self._print_fortran_interface() + self.dump() + + # Call into the C function + call_start = f' call {self.c_func_name}(' + params = [param.argument() for param in self.parameters] + params.append(consts.C_ERROR_TMP_NAME) + lines = util.break_param_lines_fortran(start=call_start, params=params, end=')') + for line in lines: + self.dump(line) + + # Convert error type + self.dump(f' if (present({consts.FORTRAN_ERROR_NAME})) {consts.FORTRAN_ERROR_NAME} = {consts.C_ERROR_TMP_NAME}') + + for param in self.parameters: + self.dump_lines(param.post()) + + self._print_fortran_subroutine_end() + + def print_c_source(self): + """Output the C source and function that the Fortran calls into.""" + if self.template is None: + return + parameters = [param.c_parameter() for param in self.parameters] + # Always append the integer error + parameters.append(f'MPI_Fint *{consts.C_ERROR_NAME}') + parameters = ', '.join(parameters) + # Just put the signature here to silence `-Wmissing-prototypes` + c_func = self.c_func_name + self.dump(f'void {c_func}({parameters});') + self.dump(f'void {c_func}({parameters})') + count_type, disp_type = ('MPI_Count', 'MPI_Aint') if self.bigcount else ('int', 'int') + self.template.print_body(c_func, out=self.out, + replacements={'INNER_CALL': self.inner_call, + 'COUNT_TYPE': count_type, + 'DISP_TYPE': disp_type}) + + def print_interface(self): + """Output just the Fortran interface for this binding.""" + self._print_fortran_subroutine() + self._print_fortran_header(is_interface=True) + self._print_fortran_subroutine_end() + + +def print_f_source_header(out): + """Print the fortran f08 file header.""" + out.dump(f'! {consts.GENERATED_MESSAGE}') + out.dump('#include "ompi/mpi/fortran/configure-fortran-output.h"') + + +def print_profiling_rename_macros(templates, out): + """Print macros for renaming functions for the profiling interface. + + Previously hardcoded in mpi-f08-rename.h. + """ + out.dump('#if OMPI_BUILD_MPI_PROFILING') + for template in templates: + name = util.fortran_f08_name(template.prototype.name) + 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) + out.dump(f'#define {bigcount_name} P{bigcount_name}') + out.dump('#endif /* OMPI_BUILD_MPI_PROFILING */') + + +def print_c_source_header(out): + """Print the header of the C source file.""" + out.dump(f'/* {consts.GENERATED_MESSAGE} */') + out.dump('#include "ompi_config.h"') + out.dump('#include "mpi.h"') + out.dump('#include "ompi/errhandler/errhandler.h"') + out.dump('#include "ompi/mpi/fortran/mpif-h/status-conversion.h"') + out.dump('#include "ompi/mpi/fortran/base/constants.h"') + out.dump('#include "ompi/mpi/fortran/base/fint_2_int.h"') + out.dump('#include "ompi/request/request.h"') + out.dump('#include "ompi/communicator/communicator.h"') + out.dump('#include "ompi/win/win.h"') + 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/mca/coll/base/coll_base_util.h"') + out.dump('#include "ts.h"') + out.dump('#include "bigcount.h"') + + +def print_binding(prototype, lang, out, bigcount=False, template=None): + """Print the binding with or without bigcount.""" + binding = FortranBinding(prototype, out=out, bigcount=bigcount, template=template) + if lang == 'fortran': + binding.print_f_source() + else: + binding.print_c_source() + + +def load_function_templates(prototype_files): + """Load the templates from a file list.""" + return [ + SourceTemplate.load(fname, type_constructor=FortranType.construct) + for fname in prototype_files + ] + + +def generate_code(args, out): + """Generate binding code based on arguments.""" + templates = load_function_templates(args.prototype_files) + + if args.lang == 'fortran': + print_f_source_header(out) + out.dump() + print_profiling_rename_macros(templates, out) + out.dump() + else: + print_c_source_header(out) + + for template in templates: + out.dump() + print_binding(template.prototype, args.lang, out, template=template) + if util.prototype_has_bigcount(template.prototype): + out.dump() + print_binding(template.prototype, args.lang, bigcount=True, out=out, template=template) + + +def generate_interface(args, out): + """Generate the Fortran interface files.""" + out.dump(f'! {consts.GENERATED_MESSAGE}') + + templates = load_function_templates(args.prototype_files) + for template in templates: + ext_name = util.ext_api_func_name(template.prototype.name) + out.dump(f'interface {ext_name}') + binding = FortranBinding(template.prototype, template=template, out=out) + binding.print_interface() + if util.prototype_has_bigcount(template.prototype): + out.dump() + binding_c = FortranBinding(template.prototype, out=out, template=template, + bigcount=True) + binding_c.print_interface() + out.dump(f'end interface {ext_name}') diff --git a/ompi/mpi/bindings/ompi_bindings/fortran_type.py b/ompi/mpi/bindings/ompi_bindings/fortran_type.py new file mode 100644 index 00000000000..38627123536 --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/fortran_type.py @@ -0,0 +1,761 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +# +"""Fortran types and corresponding template code. + +All types used in the Fortran bindings are defined here as classes that derive +from the FortranType base class. These are used for generating both Fortran and +supporting C code for the mpi_f08 bindings. +""" +from abc import ABC, abstractmethod +from ompi_bindings import consts, util + + +class FortranType(ABC): + + def __init__(self, name, fn_name, bigcount=False, count_param=None, **kwargs): + self.name = name + self.fn_name = fn_name + # Generate the bigcount interface version? + self.bigcount = bigcount + self.count_param = count_param + self.used_counters = 0 + + TYPES = {} + + @classmethod + def add(cls, type_name): + """Decorator for adding types.""" + def wrapper(class_): + cls.TYPES[type_name] = class_ + return class_ + return wrapper + + @classmethod + def get(cls, type_name): + return cls.TYPES[type_name] + + @classmethod + def construct(cls, type_name, **kwargs): + type_ = cls.TYPES[type_name] + return type_(**kwargs) + + @property + def fn_api_name(self): + """Return the MPI API name to be used in error messages, etc..""" + return util.ext_api_func_name(self.fn_name, bigcount=self.bigcount).upper() + + @property + def tmp_name(self): + """Return a temporary name for use in C.""" + return f'c_{self.name}' + + @property + def tmp_name2(self): + """Return a secondary temporary name for use in C.""" + return f'c_{self.name}2' + + def tmp_counter(self): + """Get a temporary counter variable to be used in a loop.""" + name = f'{self.name}_i_{self.used_counters}' + self.used_counters += 1 + return name + + def interface_predeclare(self): + """Return predeclaration code, if required for the interface.""" + return '' + + @abstractmethod + def declare(self): + """Return a declaration for the type.""" + + def declare_tmp(self): + """Declare temporaries on in the subroutine.""" + return '' + + def declare_cbinding_fortran(self): + """Return the C binding declaration as seen from Fortran.""" + return self.declare() + + def argument(self): + """Return the value to pass as an argument.""" + return self.name + + def use(self): + """Return list of (module, name) for a Fortran use-statement.""" + return [] + + def post(self): + """Return post-processing code to be run after the call.""" + return '' + + @abstractmethod + def c_parameter(self): + """Return the parameter expression to be used in the C function.""" + +# +# Definitions of generic types in Fortran and how these can be converted +# to and from C. +# + +@FortranType.add('BUFFER') +class BufferType(FortranType): + def interface_predeclare(self): + return f'!OMPI_F08_IGNORE_TKR_PREDECL {self.name}' + + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: {self.name}' + + def c_parameter(self): + # See fortran/use-mpi-f08/base/ts.h; OMPI_CFI_BUFFER is expanded based + # on whether or not the compiler supports TS 29113. + return f'OMPI_CFI_BUFFER *{self.name}' + + +@FortranType.add('BUFFER_ASYNC') +class BufferAsyncType(BufferType): + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: {self.name}' + + +@FortranType.add('BUFFER_OUT') +class BufferOutType(BufferType): + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE :: {self.name}' + + +@FortranType.add('BUFFER_ASYNC_OUT') +class BufferAsyncOutType(BufferType): + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: {self.name}' + + +@FortranType.add('VBUFFER') +class VBufferType(FortranType): + """Variable buffer type, as used by MPI_*v() functions.""" + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: {self.name}' + + def c_parameter(self): + return f'OMPI_CFI_BUFFER *{self.name}' + + +@FortranType.add('VBUFFER_OUT') +class VBufferType(FortranType): + """Variable buffer receive type, as used by MPI_*v() functions.""" + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE :: {self.name}' + + def c_parameter(self): + return f'OMPI_CFI_BUFFER *{self.name}' + + +@FortranType.add('WBUFFER') +class WBufferType(FortranType): + """Variable buffer send type, used with MPI_*w() functions.""" + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: {self.name}' + + def c_parameter(self): + return f'OMPI_CFI_BUFFER *{self.name}' + + +@FortranType.add('WBUFFER_OUT') +class WBufferType(FortranType): + """Variable buffer receive type, used with MPI_*w() functions.""" + def declare(self): + return f'OMPI_F08_IGNORE_TKR_TYPE :: {self.name}' + + def c_parameter(self): + return f'OMPI_CFI_BUFFER *{self.name}' + + +@FortranType.add('C_PTR_OUT') +class CptrType(FortranType): + def declare(self): + return f'TYPE(C_PTR), INTENT(OUT) :: {self.name}' + + def use(self): + return [('ISO_C_BINDING', 'C_PTR')] + + def c_parameter(self): + return f'char *{self.name}' + +@FortranType.add('COUNT') +class CountType(FortranType): + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: {self.name}' + 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('COUNT_INOUT') +class CountTypeInOut(FortranType): + """COUNT type with INOUT INTENT""" + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(INOUT) :: {self.name}' + 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): + """COUNT type with OUT INTENT""" + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: {self.name}' + 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): + def declare(self): + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + + def c_parameter(self): + return f'MPI_Count *{self.name}' + + +@FortranType.add('DATATYPE') +class DatatypeType(FortranType): + def declare(self): + return f'TYPE(MPI_Datatype), 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_Datatype')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('DATATYPE_OUT') +class DatatypeTypeOut(FortranType): + 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_ARRAY') +class DatatypeArrayType(FortranType): + def declare(self): + return f'TYPE(MPI_Datatype), INTENT(IN) :: {self.name}(*)' + + def use(self): + return [('mpi_f08_types', 'MPI_Datatype')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('INT') +class IntType(FortranType): + def declare(self): + return f'INTEGER, INTENT(IN) :: {self.name}' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('RANK') +class RankType(IntType): + pass + + +@FortranType.add('TAG') +class TagType(IntType): + pass + + +@FortranType.add('INDEX_OUT') +class IndexOutType(IntType): + def declare(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + + +@FortranType.add('LOGICAL_OUT') +class LogicalOutType(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. On + completion the logical type is set based on C's true/false rules. + """ + + def declare(self): + return f'LOGICAL, INTENT(OUT) :: {self.name}' + + def declare_tmp(self): + return f'INTEGER :: {self.tmp_name} = 0' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(OUT) :: {self.name}' + + def argument(self): + return self.tmp_name + + def post(self): + return f'{self.name} = {self.tmp_name} /= 0' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('COMM') +class CommType(FortranType): + def declare(self): + return f'TYPE(MPI_Comm), 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_Comm')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('STATUS') +class StatusType(FortranType): + def declare(self): + return f'TYPE(MPI_Status) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Status')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('STATUS_OUT') +class StatusOutType(FortranType): + 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('REQUEST_OUT') +class RequestType(FortranType): + def declare(self): + return f'TYPE(MPI_Request), 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_ARRAY') +class RequestArrayType(FortranType): + def declare(self): + return f'TYPE(MPI_Request), INTENT(INOUT) :: {self.name}({self.count_param})' + + def declare_cbinding_fortran(self): + return f'INTEGER, INTENT(INOUT) :: {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): + 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): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('INT_ARRAY') +class IntArray(FortranType): + """Integer array as used for MPI_*v() variable length functions.""" + + def declare(self): + return f'INTEGER, INTENT(IN) :: {self.name}(*)' + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@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}(*)' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + return [] + + def c_parameter(self): + count_type = 'MPI_Count' if self.bigcount else 'MPI_Fint' + return f'{count_type} *{self.name}' + +@FortranType.add('AINT_COUNT_ARRAY') +class CountArray(IntArray): + """Array of MPI_Count or int.""" + + def declare(self): + kind = '(KIND=MPI_COUNT_KIND)' if self.bigcount else '(KIND=MPI_ADDRESS_KIND)' + return f'INTEGER{kind}, INTENT(IN) :: {self.name}(*)' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + + def c_parameter(self): + count_type = 'MPI_Count' if self.bigcount else 'MPI_Aint' + return f'{count_type} *{self.name}' + + + +@FortranType.add('AINT') +class Aint(FortranType): + """MPI_Aint type.""" + + def declare(self): + return f'INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: {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_OUT') +class AintOut(FortranType): + """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): + """AINT/COUNT type with ININTENT""" + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: {self.name}' + else: + return f'INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: {self.name}' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + + def c_parameter(self): + type_ = 'MPI_Count' if self.bigcount else 'MPI_Aint' + return f'{type_} *{self.name}' + + +@FortranType.add('AINT_COUNT_INOUT') +class AintCountTypeInOut(FortranType): + """AINT/COUNT type with INOUT INTENT""" + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(INOUT) :: {self.name}' + else: + return f'INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(INOUT) :: {self.name}' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + + def c_parameter(self): + type_ = 'MPI_Count' if self.bigcount else 'MPI_Aint' + return f'{type_} *{self.name}' + + +@FortranType.add('AINT_COUNT_OUT') +class AintCountTypeOut(FortranType): + """AINT/COUNT type with OUT INTENT""" + def declare(self): + if self.bigcount: + return f'INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: {self.name}' + else: + return f'INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT) :: {self.name}' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_COUNT_KIND')] + else: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + + def c_parameter(self): + type_ = 'MPI_Count' if self.bigcount else 'MPI_Aint' + return f'{type_} *{self.name}' + + +@FortranType.add('AINT_ARRAY') +class AintArrayType(FortranType): + """Array of MPI_Aint.""" + + 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}(*)' + + def use(self): + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + + def c_parameter(self): + return f'MPI_Aint *{self.name}' + + +@FortranType.add('DISP') +class Disp(FortranType): + """Displacecment type.""" + + def declare(self): + kind = '(KIND=MPI_ADDRESS_KIND)' if self.bigcount else '' + return f'INTEGER{kind}, INTENT(IN) :: {self.name}' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + return [] + + def c_parameter(self): + count_type = 'MPI_Aint' if self.bigcount else 'MPI_Fint' + return f'{count_type} *{self.name}' + +@FortranType.add('DISP_OUT') +class DispOut(FortranType): + """Displacecment out type.""" + + def declare(self): + kind = '(KIND=MPI_ADDRESS_KIND)' if self.bigcount else '' + return f'INTEGER{kind}, INTENT(OUT) :: {self.name}' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + return [] + + def c_parameter(self): + count_type = 'MPI_Aint' if self.bigcount else 'MPI_Fint' + return f'{count_type} *{self.name}' + + +@FortranType.add('DISP_ARRAY') +class DispArray(IntArray): + """Array of MPI_Aint or int.""" + + def declare(self): + kind = '(KIND=MPI_ADDRESS_KIND)' if self.bigcount else '' + return f'INTEGER{kind}, INTENT(IN) :: {self.name}(*)' + + def use(self): + if self.bigcount: + return [('mpi_f08_types', 'MPI_ADDRESS_KIND')] + return [] + + def c_parameter(self): + count_type = 'MPI_Aint' if self.bigcount else 'MPI_Fint' + return f'{count_type} *{self.name}' + + +@FortranType.add('OP') +class Op(FortranType): + """MPI_Op type.""" + + def declare(self): + return f'TYPE(MPI_Op), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Op')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + + +@FortranType.add('WIN') +class Win(FortranType): + """MPI_Win type.""" + + def declare(self): + return f'TYPE(MPI_Win), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Win')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('WIN_OUT') +class WinOut(FortranType): + """MPI_Win out type.""" + + def declare(self): + return f'TYPE(MPI_Win), 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('FILE') +class File(FortranType): + """MPI_File type.""" + + def declare(self): + return f'TYPE(MPI_File), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_File')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('INFO') +class Info(FortranType): + """MPI_Info type.""" + + def declare(self): + return f'TYPE(MPI_Info), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Info')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' + +@FortranType.add('OFFSET') +class Offset(FortranType): + """MPI_Offset type.""" + + def declare(self): + return f'INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_OFFSET_KIND')] + + def c_parameter(self): + return f'MPI_Offset *{self.name}' + + +@FortranType.add('CHAR_ARRAY') +class CharArray(FortranType): + """Fortran CHAR type.""" + + def declare(self): + return f'CHARACTER(LEN=*), INTENT(IN) :: {self.name}' + + def use(self): + return [('iso_c_binding', 'c_char')] + + def declare_cbinding_fortran(self): + return f'CHARACTER(KIND=C_CHAR), INTENT(IN) :: {self.name}(*)' + + def c_parameter(self): + return f'char *{self.name}' + + +@FortranType.add('MESSAGE_INOUT') +class MessageInOut(FortranType): + """MPI_Message INOUT type.""" + + def declare(self): + return f'TYPE(MPI_Message), INTENT(INOUT) :: {self.name}' + + def use(self): + return [('mpi_f08_types', 'MPI_Message')] + + def c_parameter(self): + return f'MPI_Fint *{self.name}' diff --git a/ompi/mpi/bindings/ompi_bindings/parser.py b/ompi/mpi/bindings/ompi_bindings/parser.py new file mode 100644 index 00000000000..b7c6b36eba4 --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/parser.py @@ -0,0 +1,145 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +"""Source parsing code.""" + +class Parameter: + + def __init__(self, text, type_constructor): + """Parse a parameter.""" + # parameter in the form "TYPE NAME" or "TYPE NAME:COUNT_VAR" + type_name, namecount = text.split() + if ':' in namecount: + name, count_param = namecount.split(':') + else: + name, count_param = namecount, None + self.type_name = type_name + self.name = name + self.count_param = count_param + self.type_constructor = type_constructor + + def construct(self, **kwargs): + """Construct the type parameter for the given ABI.""" + return self.type_constructor(type_name=self.type_name, name=self.name, + count_param=self.count_param, **kwargs) + + +class ReturnType: + """Return type wrapper.""" + + def __init__(self, type_name, type_constructor): + self.type_name = type_name + self.type_constructor = type_constructor + + def construct(self, **kwargs): + """Construct the return type for the given ABI.""" + return self.type_constructor(type_name=self.type_name, **kwargs) + + +class Prototype: + """MPI function prototype.""" + + def __init__(self, name, return_type, params): + self.name = name + self.return_type = return_type + self.params = params + + def signature(self, fn_name, enable_count=False, **kwargs): + """Build a signature with the given name and if count is enabled.""" + params = ', '.join(param.construct(**kwargs).parameter(enable_count=enable_count, **kwargs) + for param in self.params) + if not params: + params = 'void' + return_type_text = self.return_type.construct(**kwargs).type_text(enable_count=enable_count) + return f'{return_type_text} {fn_name}({params})' + + +def validate_body(body): + """Validate the body of a template.""" + # Just do a simple bracket balance test to determine the bounds of the + # function body. All lines after the function body should be blank. There + # are cases where this will break, such as if someone puts code all on one + # line. + bracket_balance = 0 + line_count = 0 + for line in body: + line = line.strip() + if bracket_balance == 0 and line_count > 0 and line: + raise util.BindingError('Extra code found in template; only one function body is allowed') + + update = line.count('{') - line.count('}') + bracket_balance += update + if bracket_balance != 0: + line_count += 1 + + if bracket_balance != 0: + raise util.BindingError('Mismatched brackets found in template') + + +class SourceTemplate: + """Source template for a single API function.""" + + def __init__(self, prototype, header, body): + self.prototype = prototype + self.header = header + self.body = body + + @staticmethod + def load(fname, prefix=None, type_constructor=None): + """Load a template file and return the SourceTemplate.""" + if prefix is not None: + fname = os.path.join(prefix, fname) + with open(fname) as fp: + header = [] + prototype = [] + body = [] + + for line in fp: + line = line.rstrip() + if prototype and line.startswith('PROTOTYPE'): + raise util.BindingError('more than one prototype found in template file') + elif ((prototype and not any(')' in s for s in prototype)) + or line.startswith('PROTOTYPE')): + prototype.append(line) + elif prototype: + # Validate bracket balance + body.append(line) + else: + header.append(line) + + if not prototype: + raise RuntimeError(f'missing prototype for {fname}') + # Parse the prototype + prototype = ''.join(prototype) + prototype = prototype[len('PROTOTYPE'):] + i = prototype.index('(') + j = prototype.index(')') + return_type, name = prototype[:i].split() + return_type = ReturnType(return_type, type_constructor=type_constructor) + params = [param.strip() for param in prototype[i + 1:j].split(',') if param.strip()] + params = [Parameter(param, type_constructor=type_constructor) for param in params] + prototype = Prototype(name, return_type, params) + # Ensure the body contains only one function + validate_body(body) + return SourceTemplate(prototype, header, body) + + def print_header(self, out): + """Print the source header.""" + for line in self.header: + out.dump(line) + + def print_body(self, func_name, out, replacements=None): + """Print the body.""" + replacements = {} if replacements is None else replacements + for line in self.body: + # FUNC_NAME is used for error messages + line = line.replace('FUNC_NAME', f'"{func_name}"') + # Replace other parts in the body of the form '@KEY_NAME@' + for key, value in replacements.items(): + line = line.replace(f'@{key}@', value) + out.dump(line) diff --git a/ompi/mpi/bindings/ompi_bindings/util.py b/ompi/mpi/bindings/ompi_bindings/util.py new file mode 100644 index 00000000000..b8b9f1e7a46 --- /dev/null +++ b/ompi/mpi/bindings/ompi_bindings/util.py @@ -0,0 +1,149 @@ +# Copyright (c) 2024 Triad National Security, LLC. All rights +# reserved. +# +# $COPYRIGHT$ +# +# Additional copyrights may follow +# +# $HEADER$ +"""Utility code for OMPI binding generation.""" +import textwrap + + +class OutputFile: + """Output file of script.""" + + def __init__(self, fp): + self.fp = fp + + def dump(self, *pargs, **kwargs): + print(*pargs, **kwargs, file=self.fp) + + +def prepare_text(text): + """Prepare text to be output, removing extra lines and whitespace.""" + text = textwrap.dedent(text) + lines = text.split('\n') + out_lines = [] + new_lines = 0 + for line in lines: + line = line.rstrip() + # Only allow one blank line + if not line: + new_lines += 1 + else: + new_lines = 0 + if new_lines > 1: + continue + out_lines.append(line) + return '\n'.join(line for line in lines if line.strip()) + + +class BindingError(Exception): + """Thrown when a binding error is encountered.""" + + +def validate_allowed_keys(keys, req_keys, type_name, param_name): + """Validate allowed keys for a type, raising an error on failure.""" + missing_keys = [key for key in req_keys if key not in keys] + invalid_keys = [key for key in keys if key not in req_keys] + init_message = f'Param {param_name} with type {type_name}' + if missing_keys and invalid_keys: + raise BindingError(f'{init_message} has missing keys ({missing_keys}) and invalid keys ({invalid_keys})') + elif missing_keys: + raise BindingError(f'{init_message} has missing keys: {missing_keys}') + elif invalid_keys: + raise BindingError(f'{init_message} has invalid keys: {invalid_keys}') + + +def ext_api_func_name(fn_name, bigcount=False): + """Produce the external MPI API function name.""" + suffix = '_c' if bigcount else '' + return f'MPI_{fn_name.capitalize()}{suffix}' + + +def ext_api_func_name_profile(fn_name, bigcount=False): + """Produce the external PMPI API function name.""" + return f'P{ext_api_func_name(fn_name, bigcount)}' + + +def fortran_f08_name(fn_name, bigcount=False): + """Produce the final f08 name from base_name.""" + suffix = '_c' if bigcount else '' + return f'MPI_{fn_name.capitalize()}_f08{suffix}' + + +def break_param_lines_fortran(start, params, end): + """Break paramters for a fortran call onto multiple lines. + + This is often necessary to avoid going over the max line length of 132 + characters. + """ + assert len(params) > 1, 'expected more than one parameter' + indent = len(start) * ' ' + lines = [f'{start}{params[0]},'] + for param in params[1:-1]: + lines.append(f'{indent}{param},') + last_line = f'{indent}{params[-1]}{end}' + max_len = max(len(line) for line in lines) + max_len = max(max_len, len(last_line)) + result_lines = [] + for line in lines: + spaces = (max_len - len(line) + 1) * ' ' + result_lines.append(f'{line}{spaces}&') + result_lines.append(last_line) + return result_lines + + +def indent_lines(lines, tab, start=0): + """Crude pretty-printing function.""" + new_lines = [] + indent_count = start + for line in lines: + # Closing bracket + if '}' in line: + indent_count -= 1 + + prefix = indent_count * tab + new_lines.append(f'{prefix}{line}') + + # Opening bracket + if '{' in line: + indent_count += 1 + return new_lines + + +def mpi_fn_name_from_base_fn_name(name): + """Convert from a base name to the standard 'MPI_*' name.""" + return f'MPI_{name.capitalize()}' + + +def abi_internal_name(extname): + """Convert from the ABI external name to an internal name. + + Used to avoid conflicts with existing MPI names. + """ + return f'{extname}_ABI_INTERNAL' + + +BIGCOUNT_TYPE_NAMES = [ + 'COUNT', + 'COUNT_ARRAY', + 'DISP', + 'DISP_ARRAY', + 'DISP_OUT', + 'COUNT_INOUT', + 'COUNT_OUT', + 'AINT_COUNT', + 'AINT_COUNT_ARRAY', + 'AINT_COUNT_OUT', + 'AINT_COUNT_INOUT', + 'INT_AINT_OUT', + 'USER_FUNCTION', + 'DATAREP_CONVERSION_FUNCTION', +] + + +def prototype_has_bigcount(prototype): + """Should this prototype have a bigcount version?""" + return any(param.type_name in BIGCOUNT_TYPE_NAMES for param in prototype.params) diff --git a/ompi/mpi/c/Makefile.am b/ompi/mpi/c/Makefile.am index 3a8e8356f38..67eed568e4f 100644 --- a/ompi/mpi/c/Makefile.am +++ b/ompi/mpi/c/Makefile.am @@ -35,6 +35,8 @@ # layer, if weak symbols can't be used to alias the MPI_ namespace # into the PMPI_ namespace. +include $(top_srcdir)/Makefile.ompi-rules + noinst_LTLIBRARIES = libmpi_c.la libmpi_c_profile.la if BUILD_MPI_BINDINGS_LAYER noinst_LTLIBRARIES += libmpi_c_noprofile.la @@ -42,6 +44,443 @@ endif headers = bindings.h +# +# Template/prototype source files used for generating MPI functions +# + +prototype_sources = \ + abort.c.in \ + accumulate.c.in \ + add_error_class.c.in \ + add_error_code.c.in \ + add_error_string.c.in \ + allgather.c.in \ + allgather_init.c.in \ + allgatherv.c.in \ + allgatherv_init.c.in \ + alloc_mem.c.in \ + allreduce.c.in \ + allreduce_init.c.in \ + alltoall.c.in \ + alltoall_init.c.in \ + alltoallv.c.in \ + alltoallv_init.c.in \ + alltoallw.c.in \ + alltoallw_init.c.in \ + attr_delete.c.in \ + attr_get.c.in \ + attr_put.c.in \ + barrier.c.in \ + barrier_init.c.in \ + bcast.c.in \ + bcast_init.c.in \ + bsend.c.in \ + bsend_init.c.in \ + buffer_attach.c.in \ + buffer_detach.c.in \ + cancel.c.in \ + cart_coords.c.in \ + cart_create.c.in \ + cartdim_get.c.in \ + cart_get.c.in \ + cart_map.c.in \ + cart_rank.c.in \ + cart_shift.c.in \ + cart_sub.c.in \ + close_port.c.in \ + comm_accept.c.in \ + comm_c2f.c.in \ + comm_call_errhandler.c.in \ + comm_compare.c.in \ + comm_connect.c.in \ + comm_create.c.in \ + comm_create_errhandler.c.in \ + comm_create_group.c.in \ + comm_create_from_group.c.in \ + comm_create_keyval.c.in \ + comm_delete_attr.c.in \ + comm_disconnect.c.in \ + comm_dup.c.in \ + comm_dup_with_info.c.in \ + comm_f2c.c.in \ + comm_free.c.in \ + comm_free_keyval.c.in \ + comm_get_attr.c.in \ + comm_get_errhandler.c.in \ + comm_get_info.c.in \ + comm_get_name.c.in \ + comm_get_parent.c.in \ + comm_group.c.in \ + comm_idup.c.in \ + comm_idup_with_info.c.in \ + comm_join.c.in \ + comm_rank.c.in \ + comm_remote_group.c.in \ + comm_remote_size.c.in \ + comm_set_attr.c.in \ + comm_set_errhandler.c.in \ + comm_set_info.c.in \ + comm_set_name.c.in \ + comm_size.c.in \ + comm_spawn.c.in \ + comm_spawn_multiple.c.in \ + comm_split.c.in \ + comm_split_type.c.in \ + comm_test_inter.c.in \ + compare_and_swap.c.in \ + dims_create.c.in \ + dist_graph_create_adjacent.c.in \ + dist_graph_create.c.in \ + dist_graph_neighbors.c.in \ + dist_graph_neighbors_count.c.in \ + errhandler_c2f.c.in \ + errhandler_f2c.c.in \ + errhandler_free.c.in \ + error_class.c.in \ + error_string.c.in \ + exscan.c.in \ + exscan_init.c.in \ + fetch_and_op.c.in \ + file_c2f.c.in \ + file_call_errhandler.c.in \ + file_close.c.in \ + file_create_errhandler.c.in \ + file_delete.c.in \ + file_f2c.c.in \ + file_get_amode.c.in \ + file_get_atomicity.c.in \ + file_get_byte_offset.c.in \ + file_get_errhandler.c.in \ + file_get_group.c.in \ + file_get_info.c.in \ + file_get_position.c.in \ + file_get_position_shared.c.in \ + file_get_size.c.in \ + file_get_type_extent.c.in \ + file_get_view.c.in \ + file_iread_all.c.in \ + file_iread_at_all.c.in \ + file_iread_at.c.in \ + file_iread.c.in \ + file_iread_shared.c.in \ + file_iwrite_all.c.in \ + file_iwrite_at_all.c.in \ + file_iwrite_at.c.in \ + file_iwrite.c.in \ + file_iwrite_shared.c.in \ + file_open.c.in \ + file_preallocate.c.in \ + file_read_all_begin.c.in \ + file_read_all.c.in \ + file_read_all_end.c.in \ + file_read_at_all_begin.c.in \ + file_read_at_all.c.in \ + file_read_at_all_end.c.in \ + file_read_at.c.in \ + file_read.c.in \ + file_read_ordered_begin.c.in \ + file_read_ordered.c.in \ + file_read_ordered_end.c.in \ + file_read_shared.c.in \ + file_seek.c.in \ + file_seek_shared.c.in \ + file_set_atomicity.c.in \ + file_set_errhandler.c.in \ + file_set_info.c.in \ + file_set_size.c.in \ + file_set_view.c.in \ + file_sync.c.in \ + file_write_all_begin.c.in \ + file_write_all.c.in \ + file_write_all_end.c.in \ + file_write_at_all_begin.c.in \ + file_write_at_all.c.in \ + file_write_at_all_end.c.in \ + file_write_at.c.in \ + file_write.c.in \ + file_write_ordered_begin.c.in \ + file_write_ordered.c.in \ + file_write_ordered_end.c.in \ + file_write_shared.c.in \ + finalize.c.in \ + finalized.c.in \ + free_mem.c.in \ + gather.c.in \ + gather_init.c.in \ + gatherv.c.in \ + gatherv_init.c.in \ + get_accumulate.c.in \ + get_address.c.in \ + get.c.in \ + get_count.c.in \ + get_elements.c.in \ + get_elements_x.c.in \ + get_library_version.c.in \ + get_processor_name.c.in \ + get_version.c.in \ + graph_create.c.in \ + graphdims_get.c.in \ + graph_get.c.in \ + graph_map.c.in \ + graph_neighbors.c.in \ + graph_neighbors_count.c.in \ + grequest_complete.c.in \ + grequest_start.c.in \ + group_c2f.c.in \ + group_compare.c.in \ + group_difference.c.in \ + group_excl.c.in \ + group_f2c.c.in \ + group_free.c.in \ + group_from_session_pset.c.in \ + group_incl.c.in \ + group_intersection.c.in \ + group_range_excl.c.in \ + group_range_incl.c.in \ + group_rank.c.in \ + group_size.c.in \ + group_translate_ranks.c.in \ + group_union.c.in \ + iallgather.c.in \ + iallgatherv.c.in \ + ialltoall.c.in \ + ialltoallv.c.in \ + ialltoallw.c.in \ + ibarrier.c.in \ + ibcast.c.in \ + ibsend.c.in \ + iexscan.c.in \ + igather.c.in \ + igatherv.c.in \ + improbe.c.in \ + imrecv.c.in \ + ineighbor_allgather.c.in \ + ineighbor_allgatherv.c.in \ + ineighbor_alltoall.c.in \ + ineighbor_alltoallv.c.in \ + ineighbor_alltoallw.c.in \ + info_c2f.c.in \ + info_create.c.in \ + info_create_env.c.in \ + info_delete.c.in \ + info_dup.c.in \ + info_f2c.c.in \ + info_free.c.in \ + info_get.c.in \ + info_get_nkeys.c.in \ + info_get_nthkey.c.in \ + info_get_string.c.in \ + info_get_valuelen.c.in \ + info_set.c.in \ + init.c.in \ + initialized.c.in \ + init_thread.c.in \ + intercomm_create.c.in \ + intercomm_create_from_groups.c.in \ + intercomm_merge.c.in \ + iprobe.c.in \ + iallreduce.c.in \ + irecv.c.in \ + ireduce.c.in \ + ireduce_scatter_block.c.in \ + ireduce_scatter.c.in \ + irsend.c.in \ + iscan.c.in \ + iscatter.c.in \ + iscatterv.c.in \ + isend.c.in \ + isendrecv.c.in \ + isendrecv_replace.c.in \ + issend.c.in \ + is_thread_main.c.in \ + keyval_create.c.in \ + keyval_free.c.in \ + lookup_name.c.in \ + message_c2f.c.in \ + message_f2c.c.in \ + mprobe.c.in \ + mrecv.c.in \ + neighbor_allgather.c.in \ + neighbor_allgather_init.c.in \ + neighbor_allgatherv.c.in \ + neighbor_allgatherv_init.c.in \ + neighbor_alltoall.c.in \ + neighbor_alltoall_init.c.in \ + neighbor_alltoallv.c.in \ + neighbor_alltoallv_init.c.in\ + neighbor_alltoallw.c.in \ + neighbor_alltoallw_init.c.in \ + open_port.c.in \ + op_c2f.c.in \ + op_commutative.c.in \ + op_create.c.in \ + op_free.c.in \ + op_f2c.c.in \ + pack.c.in \ + pack_external.c.in \ + pack_external_size.c.in \ + pack_size.c.in \ + parrived.c.in \ + pready.c.in \ + pready_list.c.in \ + pready_range.c.in \ + precv_init.c.in \ + probe.c.in \ + psend_init.c.in \ + publish_name.c.in \ + put.c.in \ + query_thread.c.in \ + raccumulate.c.in \ + recv.c.in \ + recv_init.c.in \ + reduce.c.in \ + reduce_init.c.in \ + reduce_local.c.in \ + reduce_scatter_block.c.in \ + reduce_scatter_block_init.c.in \ + reduce_scatter.c.in \ + reduce_scatter_init.c.in \ + register_datarep.c.in \ + request_c2f.c.in \ + request_f2c.c.in \ + request_free.c.in \ + request_get_status.c.in \ + rget_accumulate.c.in \ + rget.c.in \ + rput.c.in \ + rsend.c.in \ + rsend_init.c.in \ + scan.c.in \ + scan_init.c.in \ + scatter.c.in \ + scatter_init.c.in \ + scatterv.c.in \ + scatterv_init.c.in \ + send.c.in \ + send_init.c.in \ + sendrecv.c.in \ + sendrecv_replace.c.in \ + session_c2f.c.in \ + session_call_errhandler.c.in \ + session_create_errhandler.c.in \ + session_f2c.c.in \ + session_finalize.c.in \ + session_get_errhandler.c.in \ + session_get_info.c.in \ + session_get_nth_pset.c.in \ + session_get_num_psets.c.in \ + session_get_pset_info.c.in \ + session_init.c.in \ + session_set_errhandler.c.in \ + session_set_info.c.in \ + ssend.c.in \ + ssend_init.c.in \ + startall.c.in \ + start.c.in \ + status_c2f08.c.in \ + status_c2f.c.in \ + status_f082c.c.in \ + status_f082f.c.in \ + status_f2c.c.in \ + status_f2f08.c.in \ + status_get_error.c.in \ + status_get_source.c.in \ + status_get_tag.c.in \ + status_set_cancelled.c.in \ + status_set_elements.c.in \ + status_set_elements_x.c.in \ + status_set_error.c.in \ + status_set_source.c.in \ + status_set_tag.c.in \ + testall.c.in \ + testany.c.in \ + test.c.in \ + test_cancelled.c.in \ + testsome.c.in \ + topo_test.c.in \ + type_c2f.c.in \ + type_commit.c.in \ + type_contiguous.c.in \ + type_create_darray.c.in \ + type_create_f90_complex.c.in \ + type_create_f90_integer.c.in \ + type_create_f90_real.c.in \ + type_create_hindexed.c.in \ + type_create_hindexed_block.c.in \ + type_create_hvector.c.in \ + type_create_indexed_block.c.in \ + type_create_keyval.c.in \ + type_create_resized.c.in \ + type_create_struct.c.in \ + type_create_subarray.c.in \ + type_delete_attr.c.in \ + type_dup.c.in \ + type_f2c.c.in \ + type_free.c.in \ + type_free_keyval.c.in \ + type_get_attr.c.in \ + type_get_extent.c.in \ + type_get_extent_x.c.in \ + type_get_name.c.in \ + type_get_true_extent.c.in \ + type_get_true_extent_x.c.in \ + type_indexed.c.in \ + type_match_size.c.in \ + type_set_attr.c.in \ + type_set_name.c.in \ + type_size.c.in \ + type_size_x.c.in \ + type_vector.c.in \ + unpack.c.in \ + unpack_external.c.in \ + unpublish_name.c.in \ + waitall.c.in \ + waitany.c.in \ + wait.c.in \ + waitsome.c.in \ + win_allocate.c.in \ + win_allocate_shared.c.in \ + win_attach.c.in \ + win_c2f.c.in \ + win_call_errhandler.c.in \ + win_complete.c.in \ + win_create.c.in \ + win_create_dynamic.c.in \ + win_create_errhandler.c.in \ + win_create_keyval.c.in \ + win_delete_attr.c.in \ + win_detach.c.in \ + win_fence.c.in \ + win_flush_all.c.in \ + win_flush.c.in \ + win_flush_local_all.c.in \ + win_flush_local.c.in \ + win_free.c.in \ + win_free_keyval.c.in \ + win_get_attr.c.in \ + win_get_errhandler.c.in \ + win_get_group.c.in \ + win_get_info.c.in \ + win_get_name.c.in \ + win_lock_all.c.in \ + win_lock.c.in \ + win_post.c.in \ + win_set_attr.c.in \ + win_set_errhandler.c.in \ + win_set_info.c.in \ + win_set_name.c.in \ + win_shared_query.c.in \ + win_start.c.in \ + win_sync.c.in \ + win_test.c.in \ + win_unlock_all.c.in \ + win_unlock.c.in \ + win_wait.c.in \ + wtime.c.in + +# Include template files in case someone wants to update them +EXTRA_DIST = $(prototype_sources) + # attr_fn.c contains attribute manipulation functions which do not # profiling implications, and so are always built. libmpi_c_la_SOURCES = \ @@ -58,442 +497,24 @@ ompi_HEADERS = $(headers) endif # -# List of all C files that have profile versions +# List of all C files that have profile versions (generated_*.c files were +# generated from prototype_sources above). +# # -interface_profile_sources = \ - abort.c \ - add_error_class.c \ - add_error_code.c \ - add_error_string.c \ - allgather.c \ - iallgather.c \ - allgather_init.c \ - allgatherv.c \ - iallgatherv.c \ - allgatherv_init.c \ - alloc_mem.c \ - allreduce.c \ - iallreduce.c \ - allreduce_init.c \ - alltoall.c \ - ialltoall.c \ - alltoall_init.c \ - alltoallv.c \ - ialltoallv.c \ - alltoallv_init.c \ - alltoallw.c \ - ialltoallw.c \ - alltoallw_init.c \ - attr_delete.c \ - attr_get.c \ - attr_put.c \ - barrier.c \ - ibarrier.c \ - barrier_init.c \ - bcast.c \ - ibcast.c \ - bcast_init.c \ - bsend.c \ - bsend_init.c \ - buffer_attach.c \ - buffer_detach.c \ - cancel.c \ - cart_coords.c \ - cart_create.c \ - cartdim_get.c \ - cart_get.c \ - cart_map.c \ - cart_rank.c \ - cart_shift.c \ - cart_sub.c \ - close_port.c \ - comm_accept.c \ - comm_c2f.c \ - comm_call_errhandler.c \ - comm_compare.c \ - comm_connect.c \ - comm_create.c \ - comm_create_errhandler.c \ - comm_create_from_group.c \ - comm_create_group.c \ - comm_create_keyval.c \ - comm_delete_attr.c \ - comm_disconnect.c \ - comm_dup.c \ - comm_dup_with_info.c \ - comm_idup.c \ - comm_idup_with_info.c \ - comm_f2c.c \ - comm_free.c \ - comm_free_keyval.c \ - comm_get_attr.c \ - comm_get_errhandler.c \ - comm_get_info.c \ - comm_get_name.c \ - comm_get_parent.c \ - comm_group.c \ - comm_join.c \ - comm_rank.c \ - comm_remote_group.c \ - comm_remote_size.c \ - comm_set_attr.c \ - comm_set_info.c \ - dist_graph_create.c \ - dist_graph_create_adjacent.c \ - dist_graph_neighbors.c \ - dist_graph_neighbors_count.c \ - comm_set_errhandler.c \ - comm_set_name.c \ - comm_size.c \ - comm_spawn.c \ - comm_spawn_multiple.c \ - comm_split.c \ - comm_split_type.c \ - comm_test_inter.c \ - compare_and_swap.c \ - dims_create.c \ - errhandler_c2f.c \ - errhandler_f2c.c \ - errhandler_free.c \ - error_class.c \ - error_string.c \ - exscan.c \ - iexscan.c \ - exscan_init.c \ - fetch_and_op.c \ - file_c2f.c \ - file_call_errhandler.c \ - file_close.c \ - file_create_errhandler.c \ - file_delete.c \ - file_f2c.c \ - file_get_amode.c \ - file_get_atomicity.c \ - file_get_byte_offset.c \ - file_get_errhandler.c \ - file_get_group.c \ - file_get_info.c \ - file_get_position.c \ - file_get_position_shared.c \ - file_get_size.c \ - file_get_type_extent.c \ - file_get_view.c \ - file_iread_at.c \ - file_iread_at_all.c \ - file_iread.c \ - file_iread_all.c \ - file_iread_shared.c \ - file_iwrite_at.c \ - file_iwrite_at_all.c \ - file_iwrite.c \ - file_iwrite_all.c \ - file_iwrite_shared.c \ - file_open.c \ - file_preallocate.c \ - file_read_all_begin.c \ - file_read_all.c \ - file_read_all_end.c \ - file_read_at_all_begin.c \ - file_read_at_all.c \ - file_read_at_all_end.c \ - file_read_at.c \ - file_read.c \ - file_read_ordered_begin.c \ - file_read_ordered.c \ - file_read_ordered_end.c \ - file_read_shared.c \ - file_seek.c \ - file_seek_shared.c \ - file_set_atomicity.c \ - file_set_errhandler.c \ - file_set_info.c \ - file_set_size.c \ - file_set_view.c \ - file_sync.c \ - file_write_all_begin.c \ - file_write_all.c \ - file_write_all_end.c \ - file_write_at_all_begin.c \ - file_write_at_all.c \ - file_write_at_all_end.c \ - file_write_at.c \ - file_write.c \ - file_write_ordered_begin.c \ - file_write_ordered.c \ - file_write_ordered_end.c \ - file_write_shared.c \ - finalize.c \ - finalized.c \ - free_mem.c \ - gather.c \ - igather.c \ - gather_init.c \ - gatherv.c \ - igatherv.c \ - gatherv_init.c \ - get_address.c \ - get_count.c \ - get_elements.c \ - get_elements_x.c \ - get_accumulate.c \ - get_library_version.c \ - get_processor_name.c \ - get_version.c \ - graph_create.c \ - graph_get.c \ - graph_map.c \ - graph_neighbors_count.c \ - graph_neighbors.c \ - graphdims_get.c \ - grequest_complete.c \ - grequest_start.c \ - group_c2f.c \ - group_compare.c \ - group_difference.c \ - group_excl.c \ - group_f2c.c \ - group_free.c \ - group_from_session_pset.c \ - group_incl.c \ - group_intersection.c \ - group_range_excl.c \ - group_range_incl.c \ - group_rank.c \ - group_size.c \ - group_translate_ranks.c \ - group_union.c \ - ibsend.c \ - improbe.c \ - imrecv.c \ - info_c2f.c \ - info_create.c \ - info_create_env.c \ - info_delete.c \ - info_dup.c \ - info_f2c.c \ - info_free.c \ - info_get.c \ - info_get_nkeys.c \ - info_get_nthkey.c \ - info_get_string.c \ - info_get_valuelen.c \ - info_set.c \ - init.c \ - init_thread.c \ - initialized.c \ - intercomm_create.c \ - intercomm_create_from_groups.c \ - intercomm_merge.c \ - iprobe.c \ - irecv.c \ - irsend.c \ - is_thread_main.c \ - isend.c \ - isendrecv.c \ - isendrecv_replace.c \ - issend.c \ - lookup_name.c \ - message_f2c.c \ - message_c2f.c \ - mprobe.c \ - mrecv.c \ - neighbor_allgather.c \ - ineighbor_allgather.c \ - neighbor_allgather_init.c \ - neighbor_allgatherv.c \ - ineighbor_allgatherv.c \ - neighbor_allgatherv_init.c \ - neighbor_alltoall.c \ - ineighbor_alltoall.c \ - neighbor_alltoall_init.c \ - neighbor_alltoallv.c \ - ineighbor_alltoallv.c \ - neighbor_alltoallv_init.c \ - neighbor_alltoallw.c \ - ineighbor_alltoallw.c \ - neighbor_alltoallw_init.c \ - keyval_create.c \ - keyval_free.c \ - op_c2f.c \ - op_commutative.c \ - op_create.c \ - op_f2c.c \ - op_free.c \ - open_port.c \ - pack_external.c \ - pack_external_size.c \ - pack.c \ - pack_size.c \ - parrived.c \ +interface_profile_sources = $(prototype_sources:.c.in=_generated.c) + + +# The following are special case functions where we +# have to deal manually +# +interface_profile_sources += \ pcontrol.c \ - pready.c \ - pready_list.c \ - pready_range.c \ - precv_init.c \ - probe.c \ - psend_init.c \ - publish_name.c \ - query_thread.c \ - raccumulate.c \ - recv_init.c \ - recv.c \ - reduce.c \ - ireduce.c \ - reduce_init.c \ - register_datarep.c \ - reduce_local.c \ - reduce_scatter.c \ - ireduce_scatter.c \ - reduce_scatter_init.c \ - reduce_scatter_block.c \ - ireduce_scatter_block.c \ - reduce_scatter_block_init.c \ - request_c2f.c \ - request_f2c.c \ - request_free.c \ - request_get_status.c \ - rget.c \ - rget_accumulate.c \ - rput.c \ - rsend_init.c \ - rsend.c \ - scan.c \ - iscan.c \ - scan_init.c \ - scatter.c \ - iscatter.c \ - scatter_init.c \ - scatterv.c \ - iscatterv.c \ - scatterv_init.c \ - send.c \ - send_init.c \ - 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 \ - session_get_pset_info.c \ - session_init.c \ - session_f2c.c \ - session_finalize.c \ - session_set_errhandler.c \ - session_set_info.c \ - ssend_init.c \ - ssend.c \ - start.c \ - startall.c \ - status_c2f.c \ - status_c2f08.c \ - status_f082c.c \ - status_f082f.c \ - status_f2c.c \ - status_f2f08.c \ - status_get_error.c \ - status_get_source.c \ - status_get_tag.c \ - status_set_cancelled.c \ - status_set_elements.c \ - status_set_elements_x.c \ - status_set_error.c \ - status_set_source.c \ - status_set_tag.c \ - testall.c \ - testany.c \ - test.c \ - test_cancelled.c \ - testsome.c \ - topo_test.c \ - type_c2f.c \ - type_commit.c \ - type_contiguous.c \ - type_create_darray.c \ - type_create_f90_complex.c \ - type_create_f90_integer.c \ - type_create_f90_real.c \ - type_create_hindexed.c \ - type_create_hvector.c \ - type_create_indexed_block.c \ - type_create_hindexed_block.c \ - type_create_keyval.c \ - type_create_resized.c \ - type_create_struct.c \ - type_create_subarray.c \ - type_delete_attr.c \ - type_dup.c \ - type_f2c.c \ - type_free.c \ - type_free_keyval.c \ - type_get_attr.c \ - type_get_contents.c \ + type_get_contents.c \ + type_get_contents_c.c \ type_get_envelope.c \ - type_get_extent.c \ - type_get_extent_x.c \ - type_get_name.c \ - type_get_true_extent.c \ - type_get_true_extent_x.c \ - type_indexed.c \ - type_match_size.c \ - type_set_attr.c \ - type_set_name.c \ - type_size.c \ - type_size_x.c \ - type_vector.c \ - unpack_external.c \ - unpack.c \ - unpublish_name.c \ - wait.c \ - waitall.c \ - waitany.c \ - waitsome.c \ - wtime.c \ - wtick.c \ - accumulate.c \ - get.c \ - put.c \ - win_allocate.c \ - win_allocate_shared.c \ - win_attach.c \ - win_c2f.c \ - win_call_errhandler.c \ - win_complete.c \ - win_create_errhandler.c \ - win_create_keyval.c \ - win_create.c \ - win_create_dynamic.c \ - win_delete_attr.c \ - win_detach.c \ + type_get_envelope_c.c \ win_f2c.c \ - win_fence.c \ - win_flush.c \ - win_flush_all.c \ - win_flush_local.c \ - win_flush_local_all.c \ - win_free_keyval.c \ - win_free.c \ - win_get_attr.c \ - win_get_errhandler.c \ - win_get_group.c \ - win_get_info.c \ - win_get_name.c \ - win_lock.c \ - win_lock_all.c \ - win_post.c \ - win_set_attr.c \ - win_set_errhandler.c \ - win_set_info.c \ - win_set_name.c \ - win_shared_query.c \ - win_sync.c \ - win_start.c \ - win_test.c \ - win_unlock.c \ - win_unlock_all.c \ - win_wait.c + wtick.c # The following functions were removed from the MPI standard, but are # retained for ABI compliance reasons. They are listed independently @@ -516,3 +537,19 @@ libmpi_c_profile_la_CPPFLAGS = -DOMPI_BUILD_MPI_PROFILING=1 libmpi_c_noprofile_la_SOURCES = $(interface_profile_sources) libmpi_c_noprofile_la_CPPFLAGS = -DOMPI_BUILD_MPI_PROFILING=0 + +# ABI generation rules +if OMPI_GENERATE_BINDINGS +%_generated.c: %.c.in + $(OMPI_V_GEN) $(PYTHON) $(top_srcdir)/ompi/mpi/bindings/bindings.py \ + --builddir $(abs_top_builddir) \ + --srcdir $(abs_top_srcdir) \ + --output $@ \ + c \ + source \ + ompi \ + $< + +endif +# Delete generated files on maintainer-clean +MAINTAINERCLEANFILES = *_generated.c diff --git a/ompi/mpi/c/abort.c b/ompi/mpi/c/abort.c deleted file mode 100644 index 889fe1738b3..00000000000 --- a/ompi/mpi/c/abort.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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-2008 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 "opal/util/show_help.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/memchecker.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Abort = PMPI_Abort -#endif -#define MPI_Abort PMPI_Abort -#endif - -static const char FUNC_NAME[] = "MPI_Abort"; - - -int MPI_Abort(MPI_Comm comm, int errorcode) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Don't even bother checking comm and errorcode values for - errors */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - opal_show_help("help-mpi-api.txt", "mpi-abort", true, - ompi_comm_rank(comm), - ('\0' != comm->c_name[0]) ? comm->c_name : "", - OMPI_NAME_PRINT(OMPI_PROC_MY_NAME), - errorcode); - return ompi_mpi_abort(comm, errorcode); -} diff --git a/ompi/mpi/c/abort.c.in b/ompi/mpi/c/abort.c.in new file mode 100644 index 00000000000..f8fe6381ec3 --- /dev/null +++ b/ompi/mpi/c/abort.c.in @@ -0,0 +1,53 @@ +/* + * 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-2008 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "opal/util/show_help.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/memchecker.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS abort(COMM comm, INT errorcode) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Don't even bother checking comm and errorcode values for + errors */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + opal_show_help("help-mpi-api.txt", "mpi-abort", true, + ompi_comm_rank(comm), + ('\0' != comm->c_name[0]) ? comm->c_name : "", + OMPI_NAME_PRINT(OMPI_PROC_MY_NAME), + errorcode); + return ompi_mpi_abort(comm, errorcode); +} diff --git a/ompi/mpi/c/accumulate.c b/ompi/mpi/c/accumulate.c deleted file mode 100644 index a1e6bf91365..00000000000 --- a/ompi/mpi/c/accumulate.c +++ /dev/null @@ -1,137 +0,0 @@ -/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. 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 -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/op/op.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Accumulate = PMPI_Accumulate -#endif -#define MPI_Accumulate PMPI_Accumulate -#endif - -static const char FUNC_NAME[] = "MPI_Accumulate"; - -int MPI_Accumulate(const 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_Op op, MPI_Win win) -{ - int rc; - ompi_win_t *ompi_win = (ompi_win_t*) win; - - MEMCHECKER( - memchecker_datatype(origin_datatype); - memchecker_datatype(target_datatype); - memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (MPI_OP_NULL == op || MPI_NO_OP == op) { - rc = MPI_ERR_OP; - } else if (!ompi_op_is_intrinsic(op)) { - rc = MPI_ERR_OP; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - if (OMPI_SUCCESS == rc) { - /* While technically the standard probably requires that the - datatypes used with MPI_REPLACE conform to all the rules - for other reduction operators, we don't require such - behavior, as checking for it is expensive here and we don't - care in implementation.. */ - if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { - ompi_datatype_t *op_check_dt, *origin_check_dt; - char *msg; - - /* ACCUMULATE, unlike REDUCE, can use with derived - datatypes with predefinied operations, with some - restrictions outlined in MPI-3:11.3.4. The derived - datatype must be composed entirely from one predefined - datatype (so you can do all the construction you want, - but at the bottom, you can only use one datatype, say, - MPI_INT). If the datatype at the target isn't - predefined, then make sure it's composed of only one - datatype, and check that datatype against - ompi_op_is_valid(). */ - origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); - op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); - - if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { - OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); - } - - /* check to make sure primitive type is valid for - reduction. Should do this on the target, but - then can't get the errcode back for this - call */ - if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); - free(msg); - return ret; - } - } - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - return MPI_SUCCESS; - } - - rc = ompi_win->w_osc_module->osc_accumulate(origin_addr, - origin_count, - origin_datatype, - target_rank, - target_disp, - target_count, - target_datatype, - op, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/accumulate.c.in b/ompi/mpi/c/accumulate.c.in new file mode 100644 index 00000000000..d778f5dc822 --- /dev/null +++ b/ompi/mpi/c/accumulate.c.in @@ -0,0 +1,131 @@ +/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/op/op.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS accumulate(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win) +{ + int rc; + ompi_win_t *ompi_win = (ompi_win_t*) win; + + MEMCHECKER( + memchecker_datatype(origin_datatype); + memchecker_datatype(target_datatype); + memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (MPI_OP_NULL == op || MPI_NO_OP == op) { + rc = MPI_ERR_OP; + } else if (!ompi_op_is_intrinsic(op)) { + rc = MPI_ERR_OP; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + if (OMPI_SUCCESS == rc) { + /* While technically the standard probably requires that the + datatypes used with MPI_REPLACE conform to all the rules + for other reduction operators, we don't require such + behavior, as checking for it is expensive here and we don't + care in implementation.. */ + if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { + ompi_datatype_t *op_check_dt, *origin_check_dt; + char *msg; + + /* ACCUMULATE, unlike REDUCE, can use with derived + datatypes with predefinied operations, with some + restrictions outlined in MPI-3:11.3.4. The derived + datatype must be composed entirely from one predefined + datatype (so you can do all the construction you want, + but at the bottom, you can only use one datatype, say, + MPI_INT). If the datatype at the target isn't + predefined, then make sure it's composed of only one + datatype, and check that datatype against + ompi_op_is_valid(). */ + origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); + op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); + + if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { + OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); + } + + /* check to make sure primitive type is valid for + reduction. Should do this on the target, but + then can't get the errcode back for this + call */ + if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); + free(msg); + return ret; + } + } + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + return MPI_SUCCESS; + } + + rc = ompi_win->w_osc_module->osc_accumulate(origin_addr, + origin_count, + origin_datatype, + target_rank, + target_disp, + target_count, + target_datatype, + op, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/add_error_class.c b/ompi/mpi/c/add_error_class.c deleted file mode 100644 index f0756e0ad5f..00000000000 --- a/ompi/mpi/c/add_error_class.c +++ /dev/null @@ -1,80 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/errhandler/errcode.h" -#include "ompi/communicator/communicator.h" -#include "ompi/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Add_error_class = PMPI_Add_error_class -#endif -#define MPI_Add_error_class PMPI_Add_error_class -#endif - -static const char FUNC_NAME[] = "MPI_Add_error_class"; - - -int MPI_Add_error_class(int *errorclass) -{ - int err_class; - int rc; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == errorclass) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, - MPI_ERR_ARG, FUNC_NAME); - } - } - - err_class = ompi_mpi_errclass_add(); - if ( 0 > err_class ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, - FUNC_NAME); - } - - - /* - ** Update the attribute value. See the comments - ** in attribute/attribute.c and attribute/attribute_predefined.c - ** why we have to call the fortran attr_set function - */ - rc = ompi_attr_set_fint (COMM_ATTR, - MPI_COMM_WORLD, - &MPI_COMM_WORLD->c_keyhash, - MPI_LASTUSEDCODE, - ompi_mpi_errcode_lastused, - true); - if ( MPI_SUCCESS != rc ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); - } - - *errorclass = err_class; - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/add_error_class.c.in b/ompi/mpi/c/add_error_class.c.in new file mode 100644 index 00000000000..624be311675 --- /dev/null +++ b/ompi/mpi/c/add_error_class.c.in @@ -0,0 +1,73 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/errhandler/errcode.h" +#include "ompi/communicator/communicator.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS add_error_class(INT_OUT errorclass) +{ + int err_class; + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == errorclass) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, + MPI_ERR_ARG, FUNC_NAME); + } + } + + err_class = ompi_mpi_errclass_add(); + if ( 0 > err_class ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + + /* + ** Update the attribute value. See the comments + ** in attribute/attribute.c and attribute/attribute_predefined.c + ** why we have to call the fortran attr_set function + */ + rc = ompi_attr_set_fint (COMM_ATTR, + MPI_COMM_WORLD, + &MPI_COMM_WORLD->c_keyhash, + MPI_LASTUSEDCODE, + ompi_mpi_errcode_lastused, + true); + if ( MPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + + *errorclass = err_class; + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/add_error_code.c b/ompi/mpi/c/add_error_code.c deleted file mode 100644 index 288926e7f38..00000000000 --- a/ompi/mpi/c/add_error_code.c +++ /dev/null @@ -1,86 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/errhandler/errcode.h" -#include "ompi/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Add_error_code = PMPI_Add_error_code -#endif -#define MPI_Add_error_code PMPI_Add_error_code -#endif - -static const char FUNC_NAME[] = "MPI_Add_error_code"; - - -int MPI_Add_error_code(int errorclass, int *errorcode) -{ - int code; - int rc; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_mpi_errcode_is_invalid(errorclass) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - - if ( !ompi_mpi_errnum_is_class ( errorclass) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - - if (NULL == errorcode) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_ARG, FUNC_NAME); - } - } - - code = ompi_mpi_errcode_add ( errorclass); - if ( 0 > code ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, - FUNC_NAME); - } - - /* - ** Update the attribute value. See the comments - ** in attribute/attribute.c and attribute/attribute_predefined.c - ** why we have to call the fortran attr_set function - */ - rc = ompi_attr_set_fint (COMM_ATTR, - MPI_COMM_WORLD, - &MPI_COMM_WORLD->c_keyhash, - MPI_LASTUSEDCODE, - ompi_mpi_errcode_lastused, - true); - if ( MPI_SUCCESS != rc ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); - } - - *errorcode = code; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/add_error_code.c.in b/ompi/mpi/c/add_error_code.c.in new file mode 100644 index 00000000000..a4755ff275e --- /dev/null +++ b/ompi/mpi/c/add_error_code.c.in @@ -0,0 +1,79 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS add_error_code(INT errorclass, INT_OUT errorcode) +{ + int code; + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_mpi_errcode_is_invalid(errorclass) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + + if ( !ompi_mpi_errnum_is_class ( errorclass) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + + if (NULL == errorcode) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_ARG, FUNC_NAME); + } + } + + code = ompi_mpi_errcode_add ( errorclass); + if ( 0 > code ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + /* + ** Update the attribute value. See the comments + ** in attribute/attribute.c and attribute/attribute_predefined.c + ** why we have to call the fortran attr_set function + */ + rc = ompi_attr_set_fint (COMM_ATTR, + MPI_COMM_WORLD, + &MPI_COMM_WORLD->c_keyhash, + MPI_LASTUSEDCODE, + ompi_mpi_errcode_lastused, + true); + if ( MPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + + *errorcode = code; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/add_error_string.c b/ompi/mpi/c/add_error_string.c deleted file mode 100644 index e367745c308..00000000000 --- a/ompi/mpi/c/add_error_string.c +++ /dev/null @@ -1,68 +0,0 @@ -/* - * 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-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 University of Houston. 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/errhandler/errcode.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Add_error_string = PMPI_Add_error_string -#endif -#define MPI_Add_error_string PMPI_Add_error_string -#endif - -static const char FUNC_NAME[] = "MPI_Add_error_string"; - - -int MPI_Add_error_string(int errorcode, const char *string) -{ - int rc; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_mpi_errcode_is_invalid(errorcode) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - - if ( ompi_mpi_errcode_is_predefined(errorcode) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - - if ( MPI_MAX_ERROR_STRING < (strlen(string)+1) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - - rc = ompi_mpi_errnum_add_string (errorcode, string, (int)(strlen(string)+1)); - if ( OMPI_SUCCESS != rc ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, - FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/add_error_string.c.in b/ompi/mpi/c/add_error_string.c.in new file mode 100644 index 00000000000..d5e1e0e5d74 --- /dev/null +++ b/ompi/mpi/c/add_error_string.c.in @@ -0,0 +1,60 @@ +/* + * 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-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 University of Houston. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" + +PROTOTYPE ERROR_CLASS add_error_string(INT errorcode, STRING string) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_mpi_errcode_is_invalid(errorcode) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + + if ( ompi_mpi_errcode_is_predefined(errorcode) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + + if ( MPI_MAX_ERROR_STRING < (strlen(string)+1) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + rc = ompi_mpi_errnum_add_string (errorcode, string, (int)(strlen(string)+1)); + if ( OMPI_SUCCESS != rc ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INTERN, + FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/allgather.c b/ompi/mpi/c/allgather.c deleted file mode 100644 index 5cd9858d8e6..00000000000 --- a/ompi/mpi/c/allgather.c +++ /dev/null @@ -1,140 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010 University of Houston. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allgather = PMPI_Allgather -#endif -#define MPI_Allgather PMPI_Allgather -#endif - -static const char FUNC_NAME[] = "MPI_Allgather"; - - -int MPI_Allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_ALLGATHER, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*recvcount*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? Everyone had to give the same send - signature, which means that everyone must have given a - sendcount > 0 if there's anything to send for the intra-communicator - case. If we're doing IN_PLACE, however, check recvcount, - not sendcount. */ - if ( OMPI_COMM_IS_INTRA(comm) ) { - if ((MPI_IN_PLACE != sendbuf && 0 == sendcount) || - (0 == recvcount)) { - return MPI_SUCCESS; - } - } - else if ( OMPI_COMM_IS_INTER(comm) ){ - /* for inter comunicators, the communication pattern - need not be symmetric. Specifically, one group is - allows to have sendcount=0, while the other has - a valid sendcount. Thus, the only way not to do - anything is if both sendcount and recvcount are zero. */ - if ( 0 == sendcount && 0 == recvcount ) { - return MPI_SUCCESS; - } - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_allgather(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - comm->c_coll->coll_allgather_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/allgather.c.in b/ompi/mpi/c/allgather.c.in new file mode 100644 index 00000000000..ec9e57c1079 --- /dev/null +++ b/ompi/mpi/c/allgather.c.in @@ -0,0 +1,132 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010 University of Houston. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS allgather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_ALLGATHER, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*recvcount*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? Everyone had to give the same send + signature, which means that everyone must have given a + sendcount > 0 if there's anything to send for the intra-communicator + case. If we're doing IN_PLACE, however, check recvcount, + not sendcount. */ + if ( OMPI_COMM_IS_INTRA(comm) ) { + if ((MPI_IN_PLACE != sendbuf && 0 == sendcount) || + (0 == recvcount)) { + return MPI_SUCCESS; + } + } + else if ( OMPI_COMM_IS_INTER(comm) ){ + /* for inter comunicators, the communication pattern + need not be symmetric. Specifically, one group is + allows to have sendcount=0, while the other has + a valid sendcount. Thus, the only way not to do + anything is if both sendcount and recvcount are zero. */ + if ( 0 == sendcount && 0 == recvcount ) { + return MPI_SUCCESS; + } + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_allgather(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + comm->c_coll->coll_allgather_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/allgather_init.c b/ompi/mpi/c/allgather_init.c deleted file mode 100644 index d46c2e77d8d..00000000000 --- a/ompi/mpi/c/allgather_init.c +++ /dev/null @@ -1,109 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allgather_init = PMPI_Allgather_init -#endif -#define MPI_Allgather_init PMPI_Allgather_init -#endif - -static const char FUNC_NAME[] = "MPI_Allgather_init"; - - -int MPI_Allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_ALLGATHER_INIT, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_allgather_init(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - info, request, comm->c_coll->coll_allgather_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/allgather_init.c.in b/ompi/mpi/c/allgather_init.c.in new file mode 100644 index 00000000000..54a14756231 --- /dev/null +++ b/ompi/mpi/c/allgather_init.c.in @@ -0,0 +1,101 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS allgather_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_ALLGATHER_INIT, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_allgather_init(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + info, request, comm->c_coll->coll_allgather_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/allgatherv.c b/ompi/mpi/c/allgatherv.c deleted file mode 100644 index 303cc6baeac..00000000000 --- a/ompi/mpi/c/allgatherv.c +++ /dev/null @@ -1,165 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allgatherv = PMPI_Allgatherv -#endif -#define MPI_Allgatherv PMPI_Allgatherv -#endif - -static const char FUNC_NAME[] = "MPI_Allgatherv"; - - -int MPI_Allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], - const int displs[], MPI_Datatype recvtype, MPI_Comm comm) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_ALLGATHERV, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - size = ompi_comm_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[rank]*ext, - recvcounts[rank], recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? Everyone had to give the same - signature, which means that everyone must have given a - sum(recvounts) > 0 if there's anything to do. */ - - if ( OMPI_COMM_IS_INTRA( comm) ) { - for (i = 0; i < ompi_comm_size(comm); ++i) { - if (0 != recvcounts[i]) { - break; - } - } - if (i >= ompi_comm_size(comm)) { - return MPI_SUCCESS; - } - } - /* There is no rule that can be applied for inter-communicators, since - recvcount(s)=0 only indicates that the processes in the other group - do not send anything, sendcount=0 only indicates that I do not send - anything. However, other processes in my group might very well send - something */ - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_allgatherv(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, - displs_desc, recvtype, comm, - comm->c_coll->coll_allgatherv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/allgatherv.c.in b/ompi/mpi/c/allgatherv.c.in new file mode 100644 index 00000000000..e0501ce3887 --- /dev/null +++ b/ompi/mpi/c/allgatherv.c.in @@ -0,0 +1,158 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + + +PROTOTYPE ERROR_CLASS allgatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY displs, DATATYPE recvtype, COMM comm) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_ALLGATHERV, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + size = ompi_comm_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[rank]*ext, + recvcounts[rank], recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? Everyone had to give the same + signature, which means that everyone must have given a + sum(recvounts) > 0 if there's anything to do. */ + + if ( OMPI_COMM_IS_INTRA( comm) ) { + for (i = 0; i < ompi_comm_size(comm); ++i) { + if (0 != recvcounts[i]) { + break; + } + } + if (i >= ompi_comm_size(comm)) { + return MPI_SUCCESS; + } + } + /* There is no rule that can be applied for inter-communicators, since + recvcount(s)=0 only indicates that the processes in the other group + do not send anything, sendcount=0 only indicates that I do not send + anything. However, other processes in my group might very well send + something */ + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_allgatherv(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, + displs_desc, recvtype, comm, + comm->c_coll->coll_allgatherv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/allgatherv_init.c b/ompi/mpi/c/allgatherv_init.c deleted file mode 100644 index 9049d1a7091..00000000000 --- a/ompi/mpi/c/allgatherv_init.c +++ /dev/null @@ -1,138 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allgatherv_init = PMPI_Allgatherv_init -#endif -#define MPI_Allgatherv_init PMPI_Allgatherv_init -#endif - -static const char FUNC_NAME[] = "MPI_Allgatherv_init"; - - -int MPI_Allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_ALLGATHERV_INIT, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - size = ompi_comm_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[rank]*ext, - recvcounts[rank], recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_allgatherv_init(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, displs_desc, - recvtype, comm, info, request, - comm->c_coll->coll_allgatherv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/allgatherv_init.c.in b/ompi/mpi/c/allgatherv_init.c.in new file mode 100644 index 00000000000..090b1b9befb --- /dev/null +++ b/ompi/mpi/c/allgatherv_init.c.in @@ -0,0 +1,130 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS allgatherv_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_ALLGATHERV_INIT, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + size = ompi_comm_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[rank]*ext, + recvcounts[rank], recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_allgatherv_init(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, displs_desc, + recvtype, comm, info, request, + comm->c_coll->coll_allgatherv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/alloc_mem.c b/ompi/mpi/c/alloc_mem.c deleted file mode 100644 index 28942fbbbae..00000000000 --- a/ompi/mpi/c/alloc_mem.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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-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) 2007-2020 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Los Alamos National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "opal/mca/mpool/mpool.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alloc_mem = PMPI_Alloc_mem -#endif -#define MPI_Alloc_mem PMPI_Alloc_mem -#endif - -static const char FUNC_NAME[] = "MPI_Alloc_mem"; - - -int MPI_Alloc_mem(MPI_Aint size, MPI_Info info, void *baseptr) -{ - opal_cstring_t *info_str = NULL; - const char *mpool_hints = NULL; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (size < 0 || NULL == baseptr) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - /* Per these threads: - - https://www.open-mpi.org/community/lists/devel/2007/07/1977.php - https://www.open-mpi.org/community/lists/devel/2007/07/1979.php - - If you call MPI_ALLOC_MEM with a size of 0, you get NULL - back .*/ - if (0 == size) { - *((void **) baseptr) = NULL; - return MPI_SUCCESS; - } - - if (MPI_INFO_NULL != info) { - int flag; - (void) ompi_info_get (info, "mpool_hints", &info_str, &flag); - if (flag) { - mpool_hints = info_str->string; - } - } - - *((void **) baseptr) = mca_mpool_base_alloc ((size_t) size, (struct opal_info_t*)info, - mpool_hints); - - if (NULL != info_str) { - OBJ_RELEASE(info_str); - } - - if (NULL == *((void **) baseptr)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, - FUNC_NAME); - } - - /* All done */ - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/alloc_mem.c.in b/ompi/mpi/c/alloc_mem.c.in new file mode 100644 index 00000000000..4dfd3d5bbfe --- /dev/null +++ b/ompi/mpi/c/alloc_mem.c.in @@ -0,0 +1,90 @@ +/* -*- 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-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) 2007-2020 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "opal/mca/mpool/mpool.h" + +PROTOTYPE ERROR_CLASS alloc_mem(AINT size, INFO info, BUFFER_OUT baseptr) +{ + opal_cstring_t *info_str = NULL; + const char *mpool_hints = NULL; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (size < 0 || NULL == baseptr) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + /* Per these threads: + + https://www.open-mpi.org/community/lists/devel/2007/07/1977.php + https://www.open-mpi.org/community/lists/devel/2007/07/1979.php + + If you call MPI_ALLOC_MEM with a size of 0, you get NULL + back .*/ + if (0 == size) { + *((void **) baseptr) = NULL; + return MPI_SUCCESS; + } + + if (MPI_INFO_NULL != info) { + int flag; + (void) ompi_info_get (info, "mpool_hints", &info_str, &flag); + if (flag) { + mpool_hints = info_str->string; + } + } + + *((void **) baseptr) = mca_mpool_base_alloc ((size_t) size, (struct opal_info_t*)info, + mpool_hints); + + if (NULL != info_str) { + OBJ_RELEASE(info_str); + } + + if (NULL == *((void **) baseptr)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + } + + /* All done */ + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/allreduce.c b/ompi/mpi/c/allreduce.c deleted file mode 100644 index 9f2c5023cac..00000000000 --- a/ompi/mpi/c/allreduce.c +++ /dev/null @@ -1,129 +0,0 @@ -/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allreduce = PMPI_Allreduce -#endif -#define MPI_Allreduce PMPI_Allreduce -#endif - -static const char FUNC_NAME[] = "MPI_Allreduce"; - - -int MPI_Allreduce(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_ALLREDUCE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - /* check whether receive buffer is defined. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else if( (sendbuf == recvbuf) && - (MPI_BOTTOM != sendbuf) && - (count > 1) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* MPI-1, p114, says that each process must supply at least - one element. But at least the Pallas benchmarks call - MPI_REDUCE with a count of 0. So be sure to handle it. */ - - if (0 == count) { - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - OBJ_RETAIN(op); - err = comm->c_coll->coll_allreduce(sendbuf, recvbuf, count, - datatype, op, comm, - comm->c_coll->coll_allreduce_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/allreduce.c.in b/ompi/mpi/c/allreduce.c.in new file mode 100644 index 00000000000..182fa1fd02d --- /dev/null +++ b/ompi/mpi/c/allreduce.c.in @@ -0,0 +1,121 @@ +/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS allreduce(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_ALLREDUCE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + /* check whether receive buffer is defined. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else if( (sendbuf == recvbuf) && + (MPI_BOTTOM != sendbuf) && + (count > 1) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* MPI-1, p114, says that each process must supply at least + one element. But at least the Pallas benchmarks call + MPI_REDUCE with a count of 0. So be sure to handle it. */ + + if (0 == count) { + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + OBJ_RETAIN(op); + err = comm->c_coll->coll_allreduce(sendbuf, recvbuf, count, + datatype, op, comm, + comm->c_coll->coll_allreduce_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/allreduce_init.c b/ompi/mpi/c/allreduce_init.c deleted file mode 100644 index 55bc5570093..00000000000 --- a/ompi/mpi/c/allreduce_init.c +++ /dev/null @@ -1,122 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Allreduce_init = PMPI_Allreduce_init -#endif -#define MPI_Allreduce_init PMPI_Allreduce_init -#endif - -static const char FUNC_NAME[] = "MPI_Allreduce_init"; - - -int MPI_Allreduce_init(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_ALLREDUCE_INIT, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - /* check whether receive buffer is defined. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else if( (sendbuf == recvbuf) && - (MPI_BOTTOM != sendbuf) && - (count > 1) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - if (0 == count) { - err = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_allreduce_init(sendbuf, recvbuf, count, datatype, - op, comm, info, request, comm->c_coll->coll_allreduce_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/allreduce_init.c.in b/ompi/mpi/c/allreduce_init.c.in new file mode 100644 index 00000000000..3f613c2d587 --- /dev/null +++ b/ompi/mpi/c/allreduce_init.c.in @@ -0,0 +1,114 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS allreduce_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_ALLREDUCE_INIT, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + /* check whether receive buffer is defined. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else if( (sendbuf == recvbuf) && + (MPI_BOTTOM != sendbuf) && + (count > 1) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + if (0 == count) { + err = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_allreduce_init(sendbuf, recvbuf, count, datatype, + op, comm, info, request, comm->c_coll->coll_allreduce_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/alltoall.c b/ompi/mpi/c/alltoall.c deleted file mode 100644 index 41bf608c890..00000000000 --- a/ompi/mpi/c/alltoall.c +++ /dev/null @@ -1,125 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Mellanox Technologies. 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoall = PMPI_Alltoall -#endif -#define MPI_Alltoall PMPI_Alltoall -#endif - -static const char FUNC_NAME[] = "MPI_Alltoall"; - - -int MPI_Alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm) -{ - int err; - size_t recvtype_size; - - SPC_RECORD(OMPI_SPC_ALLTOALL, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - if(MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - size_t sendtype_size, recvtype_size_tmp; - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size_tmp); - if ((sendtype_size*sendcount) != (recvtype_size_tmp*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - if (! OMPI_COMM_IS_INTER(comm)) { - ompi_datatype_type_size(recvtype, &recvtype_size); - if( (0 == recvcount) || (0 == recvtype_size) ) { - return MPI_SUCCESS; - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_alltoall(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, - comm, comm->c_coll->coll_alltoall_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/alltoall.c.in b/ompi/mpi/c/alltoall.c.in new file mode 100644 index 00000000000..63124937903 --- /dev/null +++ b/ompi/mpi/c/alltoall.c.in @@ -0,0 +1,116 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Mellanox Technologies. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoall(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int err; + size_t recvtype_size; + + SPC_RECORD(OMPI_SPC_ALLTOALL, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + if(MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + size_t sendtype_size, recvtype_size_tmp; + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size_tmp); + if ((sendtype_size*sendcount) != (recvtype_size_tmp*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + if (! OMPI_COMM_IS_INTER(comm)) { + ompi_datatype_type_size(recvtype, &recvtype_size); + if( (0 == recvcount) || (0 == recvtype_size) ) { + return MPI_SUCCESS; + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_alltoall(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, + comm, comm->c_coll->coll_alltoall_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/alltoall_init.c b/ompi/mpi/c/alltoall_init.c deleted file mode 100644 index 1a47e7b7cbf..00000000000 --- a/ompi/mpi/c/alltoall_init.c +++ /dev/null @@ -1,107 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoall_init = PMPI_Alltoall_init -#endif -#define MPI_Alltoall_init PMPI_Alltoall_init -#endif - -static const char FUNC_NAME[] = "MPI_Alltoall_init"; - - -int MPI_Alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - size_t sendtype_size, recvtype_size; - int err; - - SPC_RECORD(OMPI_SPC_ALLTOALL_INIT, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_alltoall_init(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, info, - request, comm->c_coll->coll_alltoall_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/alltoall_init.c.in b/ompi/mpi/c/alltoall_init.c.in new file mode 100644 index 00000000000..becb9f77d54 --- /dev/null +++ b/ompi/mpi/c/alltoall_init.c.in @@ -0,0 +1,99 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoall_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_INOUT request) +{ + size_t sendtype_size, recvtype_size; + int err; + + SPC_RECORD(OMPI_SPC_ALLTOALL_INIT, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_alltoall_init(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, info, + request, comm->c_coll->coll_alltoall_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/alltoallv.c b/ompi/mpi/c/alltoallv.c deleted file mode 100644 index 99c2629b749..00000000000 --- a/ompi/mpi/c/alltoallv.c +++ /dev/null @@ -1,150 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoallv = PMPI_Alltoallv -#endif -#define MPI_Alltoallv PMPI_Alltoallv -#endif - -static const char FUNC_NAME[] = "MPI_Alltoallv"; - - -int MPI_Alltoallv(const void *sendbuf, const int sendcounts[], - const int sdispls[], MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int rdispls[], - MPI_Datatype recvtype, MPI_Comm comm) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_ALLTOALLV, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(sendtype, &send_ext); - } - memchecker_datatype(recvtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - - memchecker_comm(comm); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtype = recvtype; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || - (NULL == recvcounts) || (NULL == rdispls) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - size_t sendtype_size, recvtype_size; - int me = ompi_comm_rank(comm); - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, sendtype, - recvbuf, recvcounts_desc, rdispls_desc, recvtype, - comm, comm->c_coll->coll_alltoallv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/alltoallv.c.in b/ompi/mpi/c/alltoallv.c.in new file mode 100644 index 00000000000..dd9fabc5db1 --- /dev/null +++ b/ompi/mpi/c/alltoallv.c.in @@ -0,0 +1,142 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoallv(BUFFER sendbuf, COUNT_ARRAY sendcounts, + DISP_ARRAY sdispls, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY rdispls, + DATATYPE recvtype, COMM comm) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + SPC_RECORD(OMPI_SPC_ALLTOALLV, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(sendtype, &send_ext); + } + memchecker_datatype(recvtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + + memchecker_comm(comm); + + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtype = recvtype; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || + (NULL == recvcounts) || (NULL == rdispls) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + size_t sendtype_size, recvtype_size; + int me = ompi_comm_rank(comm); + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, sendtype, + recvbuf, recvcounts_desc, rdispls_desc, recvtype, + comm, comm->c_coll->coll_alltoallv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/alltoallv_init.c b/ompi/mpi/c/alltoallv_init.c deleted file mode 100644 index 192097bac96..00000000000 --- a/ompi/mpi/c/alltoallv_init.c +++ /dev/null @@ -1,143 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoallv_init = PMPI_Alltoallv_init -#endif -#define MPI_Alltoallv_init PMPI_Alltoallv_init -#endif - -static const char FUNC_NAME[] = "MPI_Alltoallv_init"; - - -int MPI_Alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], - MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], - const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_ALLTOALLV_INIT, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(sendtype, &send_ext); - } - - memchecker_datatype(recvtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtype = recvtype; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || - (NULL == recvcounts) || (NULL == rdispls) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - int me = ompi_comm_rank(comm); - size_t sendtype_size, recvtype_size; - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_alltoallv_init(sendbuf, sendcounts_desc, sdispls_desc, - sendtype, recvbuf, recvcounts_desc, rdispls_desc, - recvtype, comm, info, request, comm->c_coll->coll_alltoallv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/alltoallv_init.c.in b/ompi/mpi/c/alltoallv_init.c.in new file mode 100644 index 00000000000..da7a9358426 --- /dev/null +++ b/ompi/mpi/c/alltoallv_init.c.in @@ -0,0 +1,135 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoallv_init(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_ALLTOALLV_INIT, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(sendtype, &send_ext); + } + + memchecker_datatype(recvtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtype = recvtype; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || + (NULL == recvcounts) || (NULL == rdispls) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + int me = ompi_comm_rank(comm); + size_t sendtype_size, recvtype_size; + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_alltoallv_init(sendbuf, sendcounts_desc, sdispls_desc, + sendtype, recvbuf, recvcounts_desc, rdispls_desc, + recvtype, comm, info, request, comm->c_coll->coll_alltoallv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/alltoallw.c b/ompi/mpi/c/alltoallw.c deleted file mode 100644 index 3c4e5f12aac..00000000000 --- a/ompi/mpi/c/alltoallw.c +++ /dev/null @@ -1,140 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoallw = PMPI_Alltoallw -#endif -#define MPI_Alltoallw PMPI_Alltoallw -#endif - -static const char FUNC_NAME[] = "MPI_Alltoallw"; - - -int MPI_Alltoallw(const void *sendbuf, const int sendcounts[], - const int sdispls[], const MPI_Datatype sendtypes[], - void *recvbuf, const int recvcounts[], const int rdispls[], - const MPI_Datatype recvtypes[], MPI_Comm comm) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_ALLTOALLW, 1); - - MEMCHECKER( - memchecker_comm(comm); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtypes[i]); - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i], - sendcounts[i], sendtypes[i]); - } - memchecker_datatype(recvtypes[i]); - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i], - recvcounts[i], recvtypes[i]); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtypes = recvtypes; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || - (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - size_t sendtype_size, recvtype_size; - int me = ompi_comm_rank(comm); - ompi_datatype_type_size(sendtypes[me], &sendtype_size); - ompi_datatype_type_size(recvtypes[me], &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, (ompi_datatype_t **) sendtypes, - recvbuf, recvcounts_desc, rdispls_desc, (ompi_datatype_t **) recvtypes, - comm, comm->c_coll->coll_alltoallw_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/alltoallw.c.in b/ompi/mpi/c/alltoallw.c.in new file mode 100644 index 00000000000..75f0a131ec2 --- /dev/null +++ b/ompi/mpi/c/alltoallw.c.in @@ -0,0 +1,132 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoallw(BUFFER sendbuf, COUNT_ARRAY sendcounts, + DISP_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY rdispls, + DATATYPE_ARRAY recvtypes, COMM comm) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_ALLTOALLW, 1); + + MEMCHECKER( + memchecker_comm(comm); + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtypes[i]); + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i], + sendcounts[i], sendtypes[i]); + } + memchecker_datatype(recvtypes[i]); + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i], + recvcounts[i], recvtypes[i]); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtypes = recvtypes; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || + (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + size_t sendtype_size, recvtype_size; + int me = ompi_comm_rank(comm); + ompi_datatype_type_size(sendtypes[me], &sendtype_size); + ompi_datatype_type_size(recvtypes[me], &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, (ompi_datatype_t **) sendtypes, + recvbuf, recvcounts_desc, rdispls_desc, (ompi_datatype_t **) recvtypes, + comm, comm->c_coll->coll_alltoallw_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/alltoallw_init.c b/ompi/mpi/c/alltoallw_init.c deleted file mode 100644 index 56c347656a4..00000000000 --- a/ompi/mpi/c/alltoallw_init.c +++ /dev/null @@ -1,140 +0,0 @@ -/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Alltoallw_init = PMPI_Alltoallw_init -#endif -#define MPI_Alltoallw_init PMPI_Alltoallw_init -#endif - -static const char FUNC_NAME[] = "MPI_Alltoallw_init"; - - -int MPI_Alltoallw_init(const void *sendbuf, const int sendcounts[], const int sdispls[], - const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], - const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_ALLTOALLW_INIT, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - - memchecker_comm(comm); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtypes[i]); - ompi_datatype_type_extent(sendtypes[i], &send_ext); - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtypes[i]); - } - - memchecker_datatype(recvtypes[i]); - ompi_datatype_type_extent(recvtypes[i], &recv_ext); - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtypes[i]); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtypes = recvtypes; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || - (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - int me = ompi_comm_rank(comm); - size_t sendtype_size, recvtype_size; - ompi_datatype_type_size(sendtypes[me], &sendtype_size); - ompi_datatype_type_size(recvtypes[me], &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_alltoallw_init(sendbuf, sendcounts_desc, sdispls_desc, - sendtypes, recvbuf, recvcounts_desc, - rdispls_desc, recvtypes, comm, info, request, - comm->c_coll->coll_alltoallw_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes_w(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtypes, recvtypes, false); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/alltoallw_init.c.in b/ompi/mpi/c/alltoallw_init.c.in new file mode 100644 index 00000000000..bb37f852993 --- /dev/null +++ b/ompi/mpi/c/alltoallw_init.c.in @@ -0,0 +1,132 @@ +/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS alltoallw_init(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE_ARRAY sendtypes, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_ALLTOALLW_INIT, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + + memchecker_comm(comm); + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtypes[i]); + ompi_datatype_type_extent(sendtypes[i], &send_ext); + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtypes[i]); + } + + memchecker_datatype(recvtypes[i]); + ompi_datatype_type_extent(recvtypes[i], &recv_ext); + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtypes[i]); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtypes = recvtypes; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || + (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + int me = ompi_comm_rank(comm); + size_t sendtype_size, recvtype_size; + ompi_datatype_type_size(sendtypes[me], &sendtype_size); + ompi_datatype_type_size(recvtypes[me], &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_alltoallw_init(sendbuf, sendcounts_desc, sdispls_desc, + sendtypes, recvbuf, recvcounts_desc, + rdispls_desc, recvtypes, comm, info, request, + comm->c_coll->coll_alltoallw_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes_w(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtypes, recvtypes, false); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/attr_delete.c b/ompi/mpi/c/attr_delete.c deleted file mode 100644 index e412b06ea47..00000000000 --- a/ompi/mpi/c/attr_delete.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Attr_delete = PMPI_Attr_delete -#endif -#define MPI_Attr_delete PMPI_Attr_delete -#endif - -static const char FUNC_NAME[] = "MPI_Attr_delete"; - - -int MPI_Attr_delete(MPI_Comm comm, int keyval) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - ret = ompi_attr_delete(COMM_ATTR, comm, comm->c_keyhash, keyval, - false); - - OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); -} - diff --git a/ompi/mpi/c/attr_delete.c.in b/ompi/mpi/c/attr_delete.c.in new file mode 100644 index 00000000000..8bc920ad4f5 --- /dev/null +++ b/ompi/mpi/c/attr_delete.c.in @@ -0,0 +1,55 @@ +/* + * 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 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$ + * + * 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/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS attr_delete(COMM comm, INT keyval) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + ret = ompi_attr_delete(COMM_ATTR, comm, comm->c_keyhash, keyval, + false); + + OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); +} + diff --git a/ompi/mpi/c/attr_get.c b/ompi/mpi/c/attr_get.c deleted file mode 100644 index 3adf3f207a5..00000000000 --- a/ompi/mpi/c/attr_get.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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$ - * - * 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/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Attr_get = PMPI_Attr_get -#endif -#define MPI_Attr_get PMPI_Attr_get -#endif - -static const char FUNC_NAME[] = "MPI_Attr_get"; - -int MPI_Attr_get(MPI_Comm comm, int keyval, void *attribute_val, int *flag) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == attribute_val) || (NULL == flag)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* This stuff is very confusing. Be sure to see - src/attribute/attribute.c for a lengthy comment explaining Open - MPI attribute behavior. */ - - ret = ompi_attr_get_c(comm->c_keyhash, keyval, (void**)attribute_val, flag); - OMPI_ERRHANDLER_RETURN(ret, comm, ret, FUNC_NAME); -} - diff --git a/ompi/mpi/c/attr_get.c.in b/ompi/mpi/c/attr_get.c.in new file mode 100644 index 00000000000..36b1e1f7a9b --- /dev/null +++ b/ompi/mpi/c/attr_get.c.in @@ -0,0 +1,56 @@ +/* + * 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS attr_get(COMM comm, INT keyval, BUFFER_OUT attribute_val, INT_OUT flag) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == attribute_val) || (NULL == flag)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(comm->c_keyhash, keyval, (void**)attribute_val, flag); + OMPI_ERRHANDLER_RETURN(ret, comm, ret, FUNC_NAME); +} + diff --git a/ompi/mpi/c/attr_put.c b/ompi/mpi/c/attr_put.c deleted file mode 100644 index 653b35d309b..00000000000 --- a/ompi/mpi/c/attr_put.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * 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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Attr_put = PMPI_Attr_put -#endif -#define MPI_Attr_put PMPI_Attr_put -#endif - -static const char FUNC_NAME[] = "MPI_Attr_put"; - -int MPI_Attr_put(MPI_Comm comm, int keyval, void *attribute_val) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, - keyval, attribute_val, false); - - OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); -} - diff --git a/ompi/mpi/c/attr_put.c.in b/ompi/mpi/c/attr_put.c.in new file mode 100644 index 00000000000..4b6e5cd8b5c --- /dev/null +++ b/ompi/mpi/c/attr_put.c.in @@ -0,0 +1,55 @@ +/* + * 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 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$ + * + * 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/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS attr_put(COMM comm, INT keyval, BUFFER_OUT attribute_val) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, + keyval, attribute_val, false); + + OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); +} + diff --git a/ompi/mpi/c/barrier.c b/ompi/mpi/c/barrier.c deleted file mode 100644 index 35e629b0524..00000000000 --- a/ompi/mpi/c/barrier.c +++ /dev/null @@ -1,90 +0,0 @@ -/* - * 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) 2010-2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Barrier = PMPI_Barrier -#endif -#define MPI_Barrier PMPI_Barrier -#endif - -static const char FUNC_NAME[] = "MPI_Barrier"; - - -int MPI_Barrier(MPI_Comm comm) -{ - int err = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_BARRIER, 1); - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Intracommunicators: Only invoke the back-end coll module barrier - function if there's more than one process in the communicator */ - - if (OMPI_COMM_IS_INTRA(comm)) { - if (ompi_comm_size(comm) > 1) { - err = comm->c_coll->coll_barrier(comm, comm->c_coll->coll_barrier_module); - } - } - - /* Intercommunicators -- always invoke, because, by definition, - there's always at least 2 processes in an intercommunicator. */ - - else { - err = comm->c_coll->coll_barrier(comm, comm->c_coll->coll_barrier_module); - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/barrier.c.in b/ompi/mpi/c/barrier.c.in new file mode 100644 index 00000000000..1ba1c42d9e1 --- /dev/null +++ b/ompi/mpi/c/barrier.c.in @@ -0,0 +1,82 @@ +/* + * 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) 2010-2012 Oak Ridge National Labs. 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$ + * + * 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS barrier(COMM comm) +{ + int err = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_BARRIER, 1); + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Intracommunicators: Only invoke the back-end coll module barrier + function if there's more than one process in the communicator */ + + if (OMPI_COMM_IS_INTRA(comm)) { + if (ompi_comm_size(comm) > 1) { + err = comm->c_coll->coll_barrier(comm, comm->c_coll->coll_barrier_module); + } + } + + /* Intercommunicators -- always invoke, because, by definition, + there's always at least 2 processes in an intercommunicator. */ + + else { + err = comm->c_coll->coll_barrier(comm, comm->c_coll->coll_barrier_module); + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/barrier_init.c b/ompi/mpi/c/barrier_init.c deleted file mode 100644 index fe0a50a383e..00000000000 --- a/ompi/mpi/c/barrier_init.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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) 2012 Oak Rigde National Laboratory. All rights reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Barrier_init = PMPI_Barrier_init -#endif -#define MPI_Barrier_init PMPI_Barrier_init -#endif - -static const char FUNC_NAME[] = "MPI_Barrier_init"; - - -int MPI_Barrier_init(MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_BARRIER_INIT, 1); - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - } - - err = comm->c_coll->coll_barrier_init(comm, info, request, comm->c_coll->coll_barrier_init_module); - - /* All done */ - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/barrier_init.c.in b/ompi/mpi/c/barrier_init.c.in new file mode 100644 index 00000000000..dde5d3f669e --- /dev/null +++ b/ompi/mpi/c/barrier_init.c.in @@ -0,0 +1,58 @@ +/* + * 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) 2012 Oak Rigde National Laboratory. All rights reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS barrier_init(COMM comm, INFO info, REQUEST_INOUT request) +{ + int err = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_BARRIER_INIT, 1); + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + } + + err = comm->c_coll->coll_barrier_init(comm, info, request, comm->c_coll->coll_barrier_init_module); + + /* All done */ + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/bcast.c b/ompi/mpi/c/bcast.c deleted file mode 100644 index b3c128215a8..00000000000 --- a/ompi/mpi/c/bcast.c +++ /dev/null @@ -1,128 +0,0 @@ -/* - * 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Bcast = PMPI_Bcast -#endif -#define MPI_Bcast PMPI_Bcast -#endif - -static const char FUNC_NAME[] = "MPI_Bcast"; - - -int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype, - int root, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_BCAST, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - if (OMPI_COMM_IS_INTRA(comm)) { - if (ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); - } else { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); - } - } else { - if (MPI_ROOT == root) { - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); - } else if (MPI_PROC_NULL != root) { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Errors for all ranks */ - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (MPI_IN_PLACE == buffer) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* If there's only one node, or if the count is 0, we're done */ - - if ((OMPI_COMM_IS_INTRA(comm) && ompi_comm_size(comm) <= 1) || - 0 == count) { - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_bcast(buffer, count, datatype, root, comm, - comm->c_coll->coll_bcast_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/bcast.c.in b/ompi/mpi/c/bcast.c.in new file mode 100644 index 00000000000..bbb54d24b04 --- /dev/null +++ b/ompi/mpi/c/bcast.c.in @@ -0,0 +1,120 @@ +/* + * 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS bcast(BUFFER_OUT buffer, COUNT count, DATATYPE datatype, + INT root, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_BCAST, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + if (OMPI_COMM_IS_INTRA(comm)) { + if (ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); + } else { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); + } + } else { + if (MPI_ROOT == root) { + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); + } else if (MPI_PROC_NULL != root) { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Errors for all ranks */ + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (MPI_IN_PLACE == buffer) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* If there's only one node, or if the count is 0, we're done */ + + if ((OMPI_COMM_IS_INTRA(comm) && ompi_comm_size(comm) <= 1) || + 0 == count) { + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_bcast(buffer, count, datatype, root, comm, + comm->c_coll->coll_bcast_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/bcast_init.c b/ompi/mpi/c/bcast_init.c deleted file mode 100644 index 8a9791be39e..00000000000 --- a/ompi/mpi/c/bcast_init.c +++ /dev/null @@ -1,97 +0,0 @@ -/* - * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Bcast_init = PMPI_Bcast_init -#endif -#define MPI_Bcast_init PMPI_Bcast_init -#endif - -static const char FUNC_NAME[] = "MPI_Bcast_init"; - - -int MPI_Bcast_init(void *buffer, int count, MPI_Datatype datatype, - int root, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_BCAST_INIT, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Errors for all ranks */ - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (MPI_IN_PLACE == buffer) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_bcast_init(buffer, count, datatype, root, comm, - info, request, - comm->c_coll->coll_bcast_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (!OMPI_COMM_IS_INTRA(comm)) { - if (MPI_PROC_NULL == root) { - datatype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, datatype, NULL); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/bcast_init.c.in b/ompi/mpi/c/bcast_init.c.in new file mode 100644 index 00000000000..08213a90a0a --- /dev/null +++ b/ompi/mpi/c/bcast_init.c.in @@ -0,0 +1,89 @@ +/* + * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS bcast_init(BUFFER_OUT buffer, COUNT count, DATATYPE datatype, + INT root, COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_BCAST_INIT, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Errors for all ranks */ + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (MPI_IN_PLACE == buffer) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_bcast_init(buffer, count, datatype, root, comm, + info, request, + comm->c_coll->coll_bcast_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (!OMPI_COMM_IS_INTRA(comm)) { + if (MPI_PROC_NULL == root) { + datatype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, datatype, NULL); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/bindings.h b/ompi/mpi/c/bindings.h index fec461654ba..2a849feea8d 100644 --- a/ompi/mpi/c/bindings.h +++ b/ompi/mpi/c/bindings.h @@ -104,6 +104,18 @@ BEGIN_C_DECLS } \ } while (0) + +/* check for integer overflow - needed while parts of Open MPI have not been embiggened */ +#define OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(RC, x) \ + do { \ + if ((x) > INT_MAX) { \ + (RC) = MPI_ERR_VALUE_TOO_LARGE; \ + } else { \ + (RC) = MPI_SUCCESS; \ + } \ + } while (0) + + END_C_DECLS #endif /* OMPI_C_BINDINGS_H */ diff --git a/ompi/mpi/c/bsend.c b/ompi/mpi/c/bsend.c deleted file mode 100644 index 881a16ce9bf..00000000000 --- a/ompi/mpi/c/bsend.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/mca/pml/base/pml_base_bsend.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Bsend = PMPI_Bsend -#endif -#define MPI_Bsend PMPI_Bsend -#endif - -static const char FUNC_NAME[] = "MPI_Bsend"; - - -int MPI_Bsend(const void *buf, int count, MPI_Datatype type, int dest, int tag, MPI_Comm comm) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_BSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are communicating with - * a failed process. This is not absolutely necessary since we will - * check for this, and other, error conditions during the completion - * call in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if (MPI_PROC_NULL == dest) { - return MPI_SUCCESS; - } - - rc = MCA_PML_CALL(send(buf, count, type, dest, tag, MCA_PML_BASE_SEND_BUFFERED, comm)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/bsend.c.in b/ompi/mpi/c/bsend.c.in new file mode 100644 index 00000000000..833f096d15f --- /dev/null +++ b/ompi/mpi/c/bsend.c.in @@ -0,0 +1,91 @@ +/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/mca/pml/base/pml_base_bsend.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS bsend(BUFFER buf, COUNT count, DATATYPE type, INT dest, + INT tag, COMM comm) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_BSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are communicating with + * a failed process. This is not absolutely necessary since we will + * check for this, and other, error conditions during the completion + * call in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if (MPI_PROC_NULL == dest) { + return MPI_SUCCESS; + } + + rc = MCA_PML_CALL(send(buf, count, type, dest, tag, MCA_PML_BASE_SEND_BUFFERED, comm)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/bsend_init.c b/ompi/mpi/c/bsend_init.c deleted file mode 100644 index 48982dc7357..00000000000 --- a/ompi/mpi/c/bsend_init.c +++ /dev/null @@ -1,97 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/mca/pml/pml.h" -#include "ompi/mca/pml/base/pml_base_bsend.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Bsend_init = PMPI_Bsend_init -#endif -#define MPI_Bsend_init PMPI_Bsend_init -#endif - -static const char FUNC_NAME[] = "MPI_Bsend_init"; - - -int MPI_Bsend_init(const void *buf, int count, MPI_Datatype type, - int dest, int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (type == MPI_DATATYPE_NULL) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - rc = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. - */ - rc = MCA_PML_CALL(isend_init(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_BUFFERED, comm, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/bsend_init.c.in b/ompi/mpi/c/bsend_init.c.in new file mode 100644 index 00000000000..7a7bb5b0224 --- /dev/null +++ b/ompi/mpi/c/bsend_init.c.in @@ -0,0 +1,89 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/mca/pml/base/pml_base_bsend.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS bsend_init(BUFFER buf, COUNT count, DATATYPE type, + INT dest, INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (type == MPI_DATATYPE_NULL) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + rc = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. + */ + rc = MCA_PML_CALL(isend_init(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_BUFFERED, comm, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/buffer_attach.c b/ompi/mpi/c/buffer_attach.c deleted file mode 100644 index ab28ffba31e..00000000000 --- a/ompi/mpi/c/buffer_attach.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/mca/pml/pml.h" -#include "ompi/mca/pml/base/pml_base_bsend.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Buffer_attach = PMPI_Buffer_attach -#endif -#define MPI_Buffer_attach PMPI_Buffer_attach -#endif - -static const char FUNC_NAME[] = "MPI_Buffer_attach"; - - -int MPI_Buffer_attach(void *buffer, int size) -{ - int ret = OMPI_SUCCESS; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == buffer || size < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - ret = mca_pml_base_bsend_attach(buffer, size); - - return ret; -} - diff --git a/ompi/mpi/c/buffer_attach.c.in b/ompi/mpi/c/buffer_attach.c.in new file mode 100644 index 00000000000..53d5421db8e --- /dev/null +++ b/ompi/mpi/c/buffer_attach.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/mca/pml/base/pml_base_bsend.h" + +PROTOTYPE ERROR_CLASS buffer_attach(BUFFER_OUT buffer, COUNT size) +{ + int ret = OMPI_SUCCESS; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == buffer || size < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + ret = mca_pml_base_bsend_attach(buffer, size); + + return ret; +} + diff --git a/ompi/mpi/c/buffer_detach.c b/ompi/mpi/c/buffer_detach.c deleted file mode 100644 index f50bb609f63..00000000000 --- a/ompi/mpi/c/buffer_detach.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/mca/pml/pml.h" -#include "ompi/mca/pml/base/pml_base_bsend.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Buffer_detach = PMPI_Buffer_detach -#endif -#define MPI_Buffer_detach PMPI_Buffer_detach -#endif - -static const char FUNC_NAME[] = "MPI_Buffer_detach"; - - -int MPI_Buffer_detach(void *buffer, int *size) -{ - size_t size_arg; - int ret = OMPI_SUCCESS; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == buffer || NULL == size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - ret = mca_pml_base_bsend_detach(buffer, &size_arg); - if (MPI_SUCCESS == ret) { - *size = (int)size_arg; - } - - return ret; -} diff --git a/ompi/mpi/c/buffer_detach.c.in b/ompi/mpi/c/buffer_detach.c.in new file mode 100644 index 00000000000..6e15b64e3ef --- /dev/null +++ b/ompi/mpi/c/buffer_detach.c.in @@ -0,0 +1,50 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/mca/pml/base/pml_base_bsend.h" + +PROTOTYPE ERROR_CLASS buffer_detach(BUFFER_OUT buffer, COUNT_OUT size) +{ + size_t size_arg; + int ret = OMPI_SUCCESS; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == buffer || NULL == size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + ret = mca_pml_base_bsend_detach(buffer, &size_arg); + if (MPI_SUCCESS == ret) { + *size = (int)size_arg; + } + + return ret; +} diff --git a/ompi/mpi/c/cancel.c b/ompi/mpi/c/cancel.c deleted file mode 100644 index c0e356d542c..00000000000 --- a/ompi/mpi/c/cancel.c +++ /dev/null @@ -1,70 +0,0 @@ -/* - * 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) 2009 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 - -#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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cancel = PMPI_Cancel -#endif -#define MPI_Cancel PMPI_Cancel -#endif - -static const char FUNC_NAME[] = "MPI_Cancel"; - - -int MPI_Cancel(MPI_Request *request) -{ - int rc; - - SPC_RECORD(OMPI_SPC_CANCEL, 1); - - MEMCHECKER( - memchecker_request(request); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || NULL == *request || - MPI_REQUEST_NULL == *request) { - OMPI_ERRHANDLER_NOHANDLE_RETURN(MPI_ERR_REQUEST, - MPI_ERR_REQUEST, FUNC_NAME); - } - } - - if (MPI_REQUEST_NULL == *request) { - return MPI_SUCCESS; - } - - rc = ompi_request_cancel(*request); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/cancel.c.in b/ompi/mpi/c/cancel.c.in new file mode 100644 index 00000000000..c721098b6e8 --- /dev/null +++ b/ompi/mpi/c/cancel.c.in @@ -0,0 +1,61 @@ +/* + * 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) 2009 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$ + * + * 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS cancel(REQUEST_INOUT request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_CANCEL, 1); + + MEMCHECKER( + memchecker_request(request); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || NULL == *request || + MPI_REQUEST_NULL == *request) { + OMPI_ERRHANDLER_NOHANDLE_RETURN(MPI_ERR_REQUEST, + MPI_ERR_REQUEST, FUNC_NAME); + } + } + + if (MPI_REQUEST_NULL == *request) { + return MPI_SUCCESS; + } + + rc = ompi_request_cancel(*request); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/cart_coords.c b/ompi/mpi/c/cart_coords.c deleted file mode 100644 index fcc6ca105fb..00000000000 --- a/ompi/mpi/c/cart_coords.c +++ /dev/null @@ -1,80 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/group/group.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_coords = PMPI_Cart_coords -#endif -#define MPI_Cart_coords PMPI_Cart_coords -#endif - -static const char FUNC_NAME[] = "MPI_Cart_coords"; - -int MPI_Cart_coords(MPI_Comm comm, int rank, int maxdims, int coords[]) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ( (0 > maxdims) || ((0 < maxdims) && (NULL == coords))) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.cart.cart_coords(comm, rank, maxdims, coords); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_coords.c.in b/ompi/mpi/c/cart_coords.c.in new file mode 100644 index 00000000000..edd02f68a91 --- /dev/null +++ b/ompi/mpi/c/cart_coords.c.in @@ -0,0 +1,73 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/group/group.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_coords(COMM comm, INT rank, INT maxdims, INT_OUT coords) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ( (0 > maxdims) || ((0 < maxdims) && (NULL == coords))) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.cart.cart_coords(comm, rank, maxdims, coords); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cart_create.c b/ompi/mpi/c/cart_create.c deleted file mode 100644 index 64f18827959..00000000000 --- a/ompi/mpi/c/cart_create.c +++ /dev/null @@ -1,126 +0,0 @@ -/* -*- 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-2008 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_create = PMPI_Cart_create -#endif -#define MPI_Cart_create PMPI_Cart_create -#endif - -static const char FUNC_NAME[] = "MPI_Cart_create"; - - -int MPI_Cart_create(MPI_Comm old_comm, int ndims, const int dims[], - const int periods[], int reorder, MPI_Comm *comm_cart) -{ - mca_topo_base_module_t* topo; - int err; - - MEMCHECKER( - memchecker_comm(old_comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(old_comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } else if (OMPI_COMM_IS_INTER(old_comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if (ndims < 0) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } else if (ndims >= 1 && - (NULL == dims || NULL == periods || NULL == comm_cart)) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } - - /* check if the number of processes on the grid are correct */ - { - int i, count_nodes = 1; - const int *p = dims; - int parent_procs = ompi_comm_size(old_comm); - - for (i=0; i < ndims; i++, p++) { - count_nodes *= *p; - } - - if (parent_procs < count_nodes) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - } - - /* - * everything seems to be alright with the communicator, we can go - * ahead and select a topology module for this purpose and create - * the new graph communicator - */ - if (OMPI_SUCCESS != (err = mca_topo_base_comm_select(old_comm, - NULL, - &topo, - OMPI_COMM_CART))) { - return err; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(old_comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, old_comm, err, FUNC_NAME); - } -#endif - - /* Now let that topology module rearrange procs/ranks if it wants to */ - err = topo->topo.cart.cart_create(topo, old_comm, - ndims, dims, periods, - (0 == reorder) ? false : true, comm_cart); - - if (MPI_SUCCESS != err) { - OBJ_RELEASE(topo); - return OMPI_ERRHANDLER_INVOKE(old_comm, err, FUNC_NAME); - } - - /* All done */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/cart_create.c.in b/ompi/mpi/c/cart_create.c.in new file mode 100644 index 00000000000..54c84f5d746 --- /dev/null +++ b/ompi/mpi/c/cart_create.c.in @@ -0,0 +1,118 @@ +/* -*- 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-2008 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/base/base.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_create(COMM old_comm, INT ndims, INT_ARRAY dims, + INT_ARRAY periods, INT reorder, COMM_OUT comm_cart) +{ + mca_topo_base_module_t* topo; + int err; + + MEMCHECKER( + memchecker_comm(old_comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(old_comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } else if (OMPI_COMM_IS_INTER(old_comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if (ndims < 0) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } else if (ndims >= 1 && + (NULL == dims || NULL == periods || NULL == comm_cart)) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } + + /* check if the number of processes on the grid are correct */ + { + int i, count_nodes = 1; + const int *p = dims; + int parent_procs = ompi_comm_size(old_comm); + + for (i=0; i < ndims; i++, p++) { + count_nodes *= *p; + } + + if (parent_procs < count_nodes) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + } + + /* + * everything seems to be alright with the communicator, we can go + * ahead and select a topology module for this purpose and create + * the new graph communicator + */ + if (OMPI_SUCCESS != (err = mca_topo_base_comm_select(old_comm, + NULL, + &topo, + OMPI_COMM_CART))) { + return err; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(old_comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, old_comm, err, FUNC_NAME); + } +#endif + + /* Now let that topology module rearrange procs/ranks if it wants to */ + err = topo->topo.cart.cart_create(topo, old_comm, + ndims, dims, periods, + (0 == reorder) ? false : true, comm_cart); + + if (MPI_SUCCESS != err) { + OBJ_RELEASE(topo); + return OMPI_ERRHANDLER_INVOKE(old_comm, err, FUNC_NAME); + } + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/cart_get.c b/ompi/mpi/c/cart_get.c deleted file mode 100644 index 93242234d9a..00000000000 --- a/ompi/mpi/c/cart_get.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_get = PMPI_Cart_get -#endif -#define MPI_Cart_get PMPI_Cart_get -#endif - -static const char FUNC_NAME[] = "MPI_Cart_get"; - -int MPI_Cart_get(MPI_Comm comm, int maxdims, int dims[], - int periods[], int coords[]) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if ((0 > maxdims) || (0 < maxdims && - ((NULL == dims) || (NULL == periods) || - (NULL == coords)))) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.cart.cart_get(comm, maxdims, dims, periods, coords); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_get.c.in b/ompi/mpi/c/cart_get.c.in new file mode 100644 index 00000000000..d7d222def11 --- /dev/null +++ b/ompi/mpi/c/cart_get.c.in @@ -0,0 +1,67 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_get(COMM comm, INT maxdims, INT_OUT dims, + INT_OUT periods, INT_OUT coords) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if ((0 > maxdims) || (0 < maxdims && + ((NULL == dims) || (NULL == periods) || + (NULL == coords)))) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.cart.cart_get(comm, maxdims, dims, periods, coords); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cart_map.c b/ompi/mpi/c/cart_map.c deleted file mode 100644 index 62bb04909d2..00000000000 --- a/ompi/mpi/c/cart_map.c +++ /dev/null @@ -1,82 +0,0 @@ -/* -*- 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-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_map = PMPI_Cart_map -#endif -#define MPI_Cart_map PMPI_Cart_map -#endif - -static const char FUNC_NAME[] = "MPI_Cart_map"; - - -int MPI_Cart_map(MPI_Comm comm, int ndims, const int dims[], - const int periods[], int *newrank) -{ - int err = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ((NULL == dims) || (NULL == periods) || (NULL == newrank)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if(!OMPI_COMM_IS_CART(comm)) { - /* In case the communicator has no topo-module attached to - it, we just return the "default" value suggested by MPI: - newrank = rank */ - *newrank = ompi_comm_rank(comm); - } else { - err = comm->c_topo->topo.cart.cart_map(comm, ndims, dims, - periods, newrank); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_map.c.in b/ompi/mpi/c/cart_map.c.in new file mode 100644 index 00000000000..c5d6c12649b --- /dev/null +++ b/ompi/mpi/c/cart_map.c.in @@ -0,0 +1,74 @@ +/* -*- 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-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_map(COMM comm, INT ndims, INT_ARRAY dims, + INT_ARRAY periods, INT_OUT newrank) +{ + int err = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ((NULL == dims) || (NULL == periods) || (NULL == newrank)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if(!OMPI_COMM_IS_CART(comm)) { + /* In case the communicator has no topo-module attached to + it, we just return the "default" value suggested by MPI: + newrank = rank */ + *newrank = ompi_comm_rank(comm); + } else { + err = comm->c_topo->topo.cart.cart_map(comm, ndims, dims, + periods, newrank); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cart_rank.c b/ompi/mpi/c/cart_rank.c deleted file mode 100644 index 979dbd22434..00000000000 --- a/ompi/mpi/c/cart_rank.c +++ /dev/null @@ -1,104 +0,0 @@ -/* -*- 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-2013 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-2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). 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/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_rank = PMPI_Cart_rank -#endif -#define MPI_Cart_rank PMPI_Cart_rank -#endif - -static const char FUNC_NAME[] = "MPI_Cart_rank"; - -int MPI_Cart_rank(MPI_Comm comm, const int coords[], int *rank) -{ - int i, err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - mca_topo_base_comm_cart_2_2_0_t* cart; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - - /* Need this check here to protect the access to "cart", - below. I.e., if OMPI_COMM_IS_CART is true, then cart is - guaranteed to be != NULL. */ - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - cart = comm->c_topo->mtc.cart; - /* Per MPI-2.1, coords is only relevant if the dimension of - the cartesian comm is >0 */ - if (((NULL == coords) && - (cart->ndims >= 1)) || - (NULL == rank)){ - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - - /* Check if coords[i] is within the acceptable range if - dimension i is not periodic */ - for (i = 0; i < cart->ndims; ++i) { - if (!cart->periods[i] && - (coords[i] < 0 || - coords[i] >= cart->dims[i])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } else { - /* Need to always test for cartesian communicators, even in - the !MPI_PARAM_CHECK case. */ - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - } - - err = comm->c_topo->topo.cart.cart_rank(comm, coords, rank); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_rank.c.in b/ompi/mpi/c/cart_rank.c.in new file mode 100644 index 00000000000..64f4fe72e76 --- /dev/null +++ b/ompi/mpi/c/cart_rank.c.in @@ -0,0 +1,97 @@ +/* -*- 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-2013 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-2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_rank(COMM comm, INT_ARRAY coords, INT_OUT rank) +{ + int i, err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + mca_topo_base_comm_cart_2_2_0_t* cart; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + + /* Need this check here to protect the access to "cart", + below. I.e., if OMPI_COMM_IS_CART is true, then cart is + guaranteed to be != NULL. */ + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + cart = comm->c_topo->mtc.cart; + /* Per MPI-2.1, coords is only relevant if the dimension of + the cartesian comm is >0 */ + if (((NULL == coords) && + (cart->ndims >= 1)) || + (NULL == rank)){ + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + + /* Check if coords[i] is within the acceptable range if + dimension i is not periodic */ + for (i = 0; i < cart->ndims; ++i) { + if (!cart->periods[i] && + (coords[i] < 0 || + coords[i] >= cart->dims[i])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } else { + /* Need to always test for cartesian communicators, even in + the !MPI_PARAM_CHECK case. */ + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + } + + err = comm->c_topo->topo.cart.cart_rank(comm, coords, rank); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cart_shift.c b/ompi/mpi/c/cart_shift.c deleted file mode 100644 index 99d07693114..00000000000 --- a/ompi/mpi/c/cart_shift.c +++ /dev/null @@ -1,81 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_shift = PMPI_Cart_shift -#endif -#define MPI_Cart_shift PMPI_Cart_shift -#endif - -static const char FUNC_NAME[] = "MPI_Cart_shift"; - - -int MPI_Cart_shift(MPI_Comm comm, int direction, int disp, - int *rank_source, int *rank_dest) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (0 > direction) { /* yet to detect direction >= comm->c_topo_ndims */ - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_DIMS, - FUNC_NAME); - } - if (NULL == rank_source || NULL == rank_dest) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - /* call the function */ - err = comm->c_topo->topo.cart.cart_shift(comm, direction, disp, rank_source, rank_dest); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_shift.c.in b/ompi/mpi/c/cart_shift.c.in new file mode 100644 index 00000000000..3b25ead1fee --- /dev/null +++ b/ompi/mpi/c/cart_shift.c.in @@ -0,0 +1,73 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_shift(COMM comm, INT direction, INT disp, + INT_OUT rank_source, INT_OUT rank_dest) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (0 > direction) { /* yet to detect direction >= comm->c_topo_ndims */ + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_DIMS, + FUNC_NAME); + } + if (NULL == rank_source || NULL == rank_dest) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + /* call the function */ + err = comm->c_topo->topo.cart.cart_shift(comm, direction, disp, rank_source, rank_dest); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cart_sub.c b/ompi/mpi/c/cart_sub.c deleted file mode 100644 index 9cf0ea9717c..00000000000 --- a/ompi/mpi/c/cart_sub.c +++ /dev/null @@ -1,90 +0,0 @@ -/* -*- 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-2017 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) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). 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/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cart_sub = PMPI_Cart_sub -#endif -#define MPI_Cart_sub PMPI_Cart_sub -#endif - -static const char FUNC_NAME[] = "MPI_Cart_sub"; - - -int MPI_Cart_sub(MPI_Comm comm, const int remain_dims[], MPI_Comm *new_comm) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (((NULL == remain_dims) && (0 != comm->c_topo->mtc.cart->ndims)) - && (NULL == new_comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - err = comm->c_topo->topo.cart.cart_sub(comm, remain_dims, new_comm); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cart_sub.c.in b/ompi/mpi/c/cart_sub.c.in new file mode 100644 index 00000000000..939cace0e91 --- /dev/null +++ b/ompi/mpi/c/cart_sub.c.in @@ -0,0 +1,82 @@ +/* -*- 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-2017 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) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cart_sub(COMM comm, INT_ARRAY remain_dims, COMM_OUT new_comm) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (((NULL == remain_dims) && (0 != comm->c_topo->mtc.cart->ndims)) + && (NULL == new_comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + err = comm->c_topo->topo.cart.cart_sub(comm, remain_dims, new_comm); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/cartdim_get.c b/ompi/mpi/c/cartdim_get.c deleted file mode 100644 index 17e1fbaead4..00000000000 --- a/ompi/mpi/c/cartdim_get.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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) 2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Cartdim_get = PMPI_Cartdim_get -#endif -#define MPI_Cartdim_get PMPI_Cartdim_get -#endif - - -static const char FUNC_NAME[] = "MPI_Cartdim_get"; - - -int MPI_Cartdim_get(MPI_Comm comm, int *ndims) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (NULL == ndims) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_CART(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.cart.cartdim_get(comm, ndims); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/cartdim_get.c.in b/ompi/mpi/c/cartdim_get.c.in new file mode 100644 index 00000000000..cad3d1a9af0 --- /dev/null +++ b/ompi/mpi/c/cartdim_get.c.in @@ -0,0 +1,66 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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) 2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS cartdim_get(COMM comm, INT_OUT ndims) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (NULL == ndims) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_CART(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.cart.cartdim_get(comm, ndims); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/close_port.c b/ompi/mpi/c/close_port.c deleted file mode 100644 index 062d2f0ae51..00000000000 --- a/ompi/mpi/c/close_port.c +++ /dev/null @@ -1,59 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Intel, 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/dpm/dpm.h" - - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Close_port = PMPI_Close_port -#endif -#define MPI_Close_port PMPI_Close_port -#endif - -static const char FUNC_NAME[] = "MPI_Close_port"; - - -int MPI_Close_port(const char *port_name) -{ - int ret; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == port_name ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - - ret = ompi_dpm_close_port(port_name); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/close_port.c.in b/ompi/mpi/c/close_port.c.in new file mode 100644 index 00000000000..a351858a48e --- /dev/null +++ b/ompi/mpi/c/close_port.c.in @@ -0,0 +1,50 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Intel, 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$ + * + * 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/dpm/dpm.h" + +PROTOTYPE ERROR_CLASS close_port(STRING port_name) +{ + int ret; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == port_name ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + ret = ompi_dpm_close_port(port_name); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_accept.c b/ompi/mpi/c/comm_accept.c deleted file mode 100644 index 52ceaf3ea36..00000000000 --- a/ompi/mpi/c/comm_accept.c +++ /dev/null @@ -1,134 +0,0 @@ -/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Intel, 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 - -#include "opal/util/show_help.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/dpm/dpm.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_accept = PMPI_Comm_accept -#endif -#define MPI_Comm_accept PMPI_Comm_accept -#endif - -static const char FUNC_NAME[] = "MPI_Comm_accept"; - - -int MPI_Comm_accept(const char *port_name, MPI_Info info, int root, - MPI_Comm comm, MPI_Comm *newcomm) -{ - int rank, rc; - bool send_first=false; /* we receive first */ - ompi_communicator_t *newcomp=MPI_COMM_NULL; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if ( OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == newcomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - rank = ompi_comm_rank ( comm ); - if ( MPI_PARAM_CHECK ) { - if ( rank == root ) { - if ( NULL == port_name ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { - return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); - } - - /* parse info object. no prefedined values for this function in MPI-2 - * so lets ignore it for the moment. - * if ( rank == root && MPI_INFO_NULL != info ) { - * } - */ - -#if OPAL_ENABLE_FT_MPI - /* - * We must not call ompi_comm_iface_create_check() here, because that - * risks leaving the connect side dangling on an unmatched operation. - * We will let the connect_accept logic proceed and discover the - * issue internally so that all sides get informed. - */ -#endif - - if ( rank == root ) { - rc = ompi_dpm_connect_accept (comm, root, port_name, send_first, - &newcomp); - } - else { - rc = ompi_dpm_connect_accept (comm, root, NULL, send_first, - &newcomp); - } - - - if (OPAL_ERR_NOT_SUPPORTED == rc) { - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support accept/connect functionality"); - } - - *newcomm = newcomp; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/comm_accept.c.in b/ompi/mpi/c/comm_accept.c.in new file mode 100644 index 00000000000..5e04389c633 --- /dev/null +++ b/ompi/mpi/c/comm_accept.c.in @@ -0,0 +1,126 @@ +/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Intel, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/util/show_help.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/dpm/dpm.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_accept(STRING port_name, INFO info, INT root, + COMM comm, COMM_OUT newcomm) +{ + int rank, rc; + bool send_first=false; /* we receive first */ + ompi_communicator_t *newcomp=MPI_COMM_NULL; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if ( OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == newcomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + rank = ompi_comm_rank ( comm ); + if ( MPI_PARAM_CHECK ) { + if ( rank == root ) { + if ( NULL == port_name ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { + return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); + } + + /* parse info object. no prefedined values for this function in MPI-2 + * so lets ignore it for the moment. + * if ( rank == root && MPI_INFO_NULL != info ) { + * } + */ + +#if OPAL_ENABLE_FT_MPI + /* + * We must not call ompi_comm_iface_create_check() here, because that + * risks leaving the connect side dangling on an unmatched operation. + * We will let the connect_accept logic proceed and discover the + * issue internally so that all sides get informed. + */ +#endif + + if ( rank == root ) { + rc = ompi_dpm_connect_accept (comm, root, port_name, send_first, + &newcomp); + } + else { + rc = ompi_dpm_connect_accept (comm, root, NULL, send_first, + &newcomp); + } + + + if (OPAL_ERR_NOT_SUPPORTED == rc) { + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support accept/connect functionality"); + } + + *newcomm = newcomp; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/comm_c2f.c b/ompi/mpi/c/comm_c2f.c deleted file mode 100644 index 794cc3c90f1..00000000000 --- a/ompi/mpi/c/comm_c2f.c +++ /dev/null @@ -1,64 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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-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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_c2f = PMPI_Comm_c2f -#endif -#define MPI_Comm_c2f PMPI_Comm_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Comm_c2f"; - - -MPI_Fint MPI_Comm_c2f(MPI_Comm comm) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that ompi_comm_invalid() explicitly checks for - MPI_COMM_NULL, but MPI_COMM_C2F is supposed to treat - MPI_COMM_NULL as a valid communicator (and therefore return - a valid Fortran handle for it). Hence, this function - should not return an error if MPI_COMM_NULL is passed in. - - See a big comment in ompi/communicator/communicator.h about - this. */ - if (ompi_comm_invalid (comm) && MPI_COMM_NULL != comm) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(comm->c_f_to_c_index); -} diff --git a/ompi/mpi/c/comm_c2f.c.in b/ompi/mpi/c/comm_c2f.c.in new file mode 100644 index 00000000000..4458e0f563b --- /dev/null +++ b/ompi/mpi/c/comm_c2f.c.in @@ -0,0 +1,56 @@ +/* + * Copyright (c) 2004-2007 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-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-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_c2f(COMM comm) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that ompi_comm_invalid() explicitly checks for + MPI_COMM_NULL, but MPI_COMM_C2F is supposed to treat + MPI_COMM_NULL as a valid communicator (and therefore return + a valid Fortran handle for it). Hence, this function + should not return an error if MPI_COMM_NULL is passed in. + + See a big comment in ompi/communicator/communicator.h about + this. */ + if (ompi_comm_invalid (comm) && MPI_COMM_NULL != comm) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(comm->c_f_to_c_index); +} diff --git a/ompi/mpi/c/comm_call_errhandler.c b/ompi/mpi/c/comm_call_errhandler.c deleted file mode 100644 index b9db6285c16..00000000000 --- a/ompi/mpi/c/comm_call_errhandler.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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$ - * - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_call_errhandler = PMPI_Comm_call_errhandler -#endif -#define MPI_Comm_call_errhandler PMPI_Comm_call_errhandler -#endif - - -static const char FUNC_NAME[] = "MPI_Comm_call_errhandler"; - - -int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - /* Invoke the errhandler */ - - OMPI_ERRHANDLER_INVOKE(comm, errorcode, FUNC_NAME); - - /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/comm_call_errhandler.c.in b/ompi/mpi/c/comm_call_errhandler.c.in new file mode 100644 index 00000000000..ffe26023940 --- /dev/null +++ b/ompi/mpi/c/comm_call_errhandler.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_call_errhandler(COMM comm, INT errorcode) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + /* Invoke the errhandler */ + + OMPI_ERRHANDLER_INVOKE(comm, errorcode, FUNC_NAME); + + /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/comm_compare.c b/ompi/mpi/c/comm_compare.c deleted file mode 100644 index 55d4b0d38d1..00000000000 --- a/ompi/mpi/c/comm_compare.c +++ /dev/null @@ -1,67 +0,0 @@ -/* - * 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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_compare = PMPI_Comm_compare -#endif -#define MPI_Comm_compare PMPI_Comm_compare -#endif - -static const char FUNC_NAME[] = "MPI_Comm_compare"; - - -int MPI_Comm_compare(MPI_Comm comm1, MPI_Comm comm2, int *result) { - - int rc; - - MEMCHECKER( - memchecker_comm(comm1); - memchecker_comm(comm2); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid(comm1) || ompi_comm_invalid(comm2)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if ( NULL == result ) { - return OMPI_ERRHANDLER_INVOKE(comm1, MPI_ERR_ARG, - FUNC_NAME); - } - } - - rc = ompi_comm_compare ( (ompi_communicator_t*)comm1, - (ompi_communicator_t*)comm2, - result); - OMPI_ERRHANDLER_RETURN ( rc, comm1, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_compare.c.in b/ompi/mpi/c/comm_compare.c.in new file mode 100644 index 00000000000..7cb247d6baf --- /dev/null +++ b/ompi/mpi/c/comm_compare.c.in @@ -0,0 +1,60 @@ +/* + * 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 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_compare(COMM comm1, COMM comm2, INT_OUT result) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm1); + memchecker_comm(comm2); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid(comm1) || ompi_comm_invalid(comm2)) + { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if ( NULL == result ) { + return OMPI_ERRHANDLER_INVOKE(comm1, MPI_ERR_ARG, + FUNC_NAME); + } + } + + rc = ompi_comm_compare ( (ompi_communicator_t*)comm1, + (ompi_communicator_t*)comm2, + result); + OMPI_ERRHANDLER_RETURN ( rc, comm1, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_connect.c b/ompi/mpi/c/comm_connect.c deleted file mode 100644 index dfd4eacc544..00000000000 --- a/ompi/mpi/c/comm_connect.c +++ /dev/null @@ -1,134 +0,0 @@ -/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Intel, 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 - -#include "opal/util/show_help.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/dpm/dpm.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_connect = PMPI_Comm_connect -#endif -#define MPI_Comm_connect PMPI_Comm_connect -#endif - -static const char FUNC_NAME[] = "MPI_Comm_connect"; - - -int MPI_Comm_connect(const char *port_name, MPI_Info info, int root, - MPI_Comm comm, MPI_Comm *newcomm) -{ - int rank, rc; - bool send_first=true; /* yes, we are the active part in this game */ - ompi_communicator_t *newcomp=MPI_COMM_NULL; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if ( OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == newcomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - rank = ompi_comm_rank ( comm ); - if ( MPI_PARAM_CHECK ) { - if ( rank == root ) { - if ( NULL == port_name ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { - return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); - } - - /* parse info object. No prefedined values for this function in MPI-2, - * so lets ignore it for the moment. - * - * if ( rank == root && MPI_INFO_NULL != info ) { - * } - */ - -#if OPAL_ENABLE_FT_MPI - /* - * We must not call ompi_comm_iface_create_check() here, because that - * risks leaving the accept side dangling on an unmatched operation. - * We will let the connect_accept logic proceed and discover the - * issue internally so that all sides get informed. - */ -#endif - - if ( rank == root ) { - rc = ompi_dpm_connect_accept (comm, root, port_name, send_first, - &newcomp); - } - else { - rc = ompi_dpm_connect_accept (comm, root, NULL, send_first, - &newcomp); - } - - if (OPAL_ERR_NOT_SUPPORTED == rc) { - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support accept/connect functionality"); - } - - *newcomm = newcomp; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_connect.c.in b/ompi/mpi/c/comm_connect.c.in new file mode 100644 index 00000000000..006a7a8e042 --- /dev/null +++ b/ompi/mpi/c/comm_connect.c.in @@ -0,0 +1,126 @@ +/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Intel, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/util/show_help.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/dpm/dpm.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_connect(STRING port_name, INFO info, INT root, + COMM comm, COMM_OUT newcomm) +{ + int rank, rc; + bool send_first=true; /* yes, we are the active part in this game */ + ompi_communicator_t *newcomp=MPI_COMM_NULL; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if ( OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == newcomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + rank = ompi_comm_rank ( comm ); + if ( MPI_PARAM_CHECK ) { + if ( rank == root ) { + if ( NULL == port_name ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { + return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); + } + + /* parse info object. No prefedined values for this function in MPI-2, + * so lets ignore it for the moment. + * + * if ( rank == root && MPI_INFO_NULL != info ) { + * } + */ + +#if OPAL_ENABLE_FT_MPI + /* + * We must not call ompi_comm_iface_create_check() here, because that + * risks leaving the accept side dangling on an unmatched operation. + * We will let the connect_accept logic proceed and discover the + * issue internally so that all sides get informed. + */ +#endif + + if ( rank == root ) { + rc = ompi_dpm_connect_accept (comm, root, port_name, send_first, + &newcomp); + } + else { + rc = ompi_dpm_connect_accept (comm, root, NULL, send_first, + &newcomp); + } + + if (OPAL_ERR_NOT_SUPPORTED == rc) { + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support accept/connect functionality"); + } + + *newcomm = newcomp; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_create.c b/ompi/mpi/c/comm_create.c deleted file mode 100644 index fc29be5b6ee..00000000000 --- a/ompi/mpi/c/comm_create.c +++ /dev/null @@ -1,79 +0,0 @@ -/* - * 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-2005 High Performance Computing Center Stuttgart, - * University of Stuttgart. All rights reserved. - * Copyright (c) 2004-2008 The Regents of the University of California. - * All rights reserved. - * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_create = PMPI_Comm_create -#endif -#define MPI_Comm_create PMPI_Comm_create -#endif - -static const char FUNC_NAME[] = "MPI_Comm_create"; - - -int MPI_Comm_create(MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm) { - - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if ( MPI_GROUP_NULL == group || NULL == group ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP, - FUNC_NAME); - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_create ( (ompi_communicator_t*)comm, (ompi_group_t*)group, - (ompi_communicator_t**)newcomm ); - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_create.c.in b/ompi/mpi/c/comm_create.c.in new file mode 100644 index 00000000000..3b315ac1002 --- /dev/null +++ b/ompi/mpi/c/comm_create.c.in @@ -0,0 +1,71 @@ +/* + * 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-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2008 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_create(COMM comm, GROUP group, COMM_OUT newcomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if ( MPI_GROUP_NULL == group || NULL == group ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP, + FUNC_NAME); + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_create ( (ompi_communicator_t*)comm, (ompi_group_t*)group, + (ompi_communicator_t**)newcomm ); + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_create_errhandler.c b/ompi/mpi/c/comm_create_errhandler.c deleted file mode 100644 index 9caf0510300..00000000000 --- a/ompi/mpi/c/comm_create_errhandler.c +++ /dev/null @@ -1,71 +0,0 @@ -/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_create_errhandler = PMPI_Comm_create_errhandler -#endif -#define MPI_Comm_create_errhandler PMPI_Comm_create_errhandler -#endif - - -static const char FUNC_NAME[] = "MPI_Comm_create_errhandler"; - - -int MPI_Comm_create_errhandler(MPI_Comm_errhandler_function *function, - MPI_Errhandler *errhandler) -{ - int err = MPI_SUCCESS; - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == function || - NULL == errhandler) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* Create and cache the errhandler. Sets a refcount of 1. */ - - *errhandler = - ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_COMM, - (ompi_errhandler_generic_handler_fn_t*) function, - OMPI_ERRHANDLER_LANG_C); - if (NULL == *errhandler) { - err = MPI_ERR_INTERN; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_create_errhandler.c.in b/ompi/mpi/c/comm_create_errhandler.c.in new file mode 100644 index 00000000000..2d1ba927233 --- /dev/null +++ b/ompi/mpi/c/comm_create_errhandler.c.in @@ -0,0 +1,62 @@ +/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2021 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS comm_create_errhandler(COMM_ERRHANDLER_FUNCTION function, + ERRHANDLER_OUT errhandler) +{ + int err = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == function || + NULL == errhandler) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Create and cache the errhandler. Sets a refcount of 1. */ + + *errhandler = + ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_COMM, + (ompi_errhandler_generic_handler_fn_t*) function, + OMPI_ERRHANDLER_LANG_C); + if (NULL == *errhandler) { + err = MPI_ERR_INTERN; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_create_from_group.c b/ompi/mpi/c/comm_create_from_group.c deleted file mode 100644 index 96cf895ee07..00000000000 --- a/ompi/mpi/c/comm_create_from_group.c +++ /dev/null @@ -1,115 +0,0 @@ -/* -*- 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-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-2008 The Regents of the University of California. - * All rights reserved. - * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2018 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021-2024 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_create_from_group = PMPI_Comm_create_from_group -#endif -#define MPI_Comm_create_from_group PMPI_Comm_create_from_group -#endif - -static const char FUNC_NAME[] = "MPI_Comm_create_from_group"; - - -int MPI_Comm_create_from_group (MPI_Group group, const char *tag, MPI_Info info, MPI_Errhandler errhandler, - MPI_Comm *newcomm) { - int rc; - char *pmix_group_tag = NULL; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == errhandler || - MPI_ERRHANDLER_NULL == errhandler || - ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && - OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { - return ompi_errhandler_invoke (NULL, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG,FUNC_NAME); - } - - if (NULL == tag) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_TAG, FUNC_NAME); - } - - if (NULL == group) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_GROUP, FUNC_NAME); - } - - if (NULL == info || ompi_info_is_freed(info)) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_INFO, FUNC_NAME); - } - - if (NULL == newcomm) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG, FUNC_NAME); - } - } - - if (MPI_GROUP_NULL == group || MPI_UNDEFINED == ompi_group_rank (group)) { - *newcomm = MPI_COMM_NULL; - return MPI_SUCCESS; - } - - - /* - * we use PMIx group operations to implement comm/intercomm create from group/groups. - * PMIx group constructors require a unique tag across the processes using the same - * PMIx server. This is not equivalent to the uniqueness requirements of the tag argument - * to MPI_Comm_create_from_group and MPI_Intercomm_create_from_groups, hence an - * additional discriminator needs to be added to the user supplied tag argument. - */ - opal_asprintf (&pmix_group_tag, "%s-%s.%d", tag, OPAL_NAME_PRINT(ompi_group_get_proc_name (group, 0)), - ompi_group_size(group)); - if (OPAL_UNLIKELY(NULL == pmix_group_tag)) { - return OMPI_ERR_OUT_OF_RESOURCE; - } - - rc = ompi_comm_create_from_group ((ompi_group_t *) group, pmix_group_tag, &info->super, errhandler, - (ompi_communicator_t **) newcomm); - free(pmix_group_tag); - if (MPI_SUCCESS != rc) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, errhandler->eh_mpi_object_type, - rc, FUNC_NAME); - } - - return rc; -} diff --git a/ompi/mpi/c/comm_create_from_group.c.in b/ompi/mpi/c/comm_create_from_group.c.in new file mode 100644 index 00000000000..26e4049fac5 --- /dev/null +++ b/ompi/mpi/c/comm_create_from_group.c.in @@ -0,0 +1,106 @@ +/* -*- 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-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-2008 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2018 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_create_from_group (GROUP group, STRING tag, INFO info, ERRHANDLER errhandler, + COMM_OUT newcomm) +{ + int rc; + char *pmix_group_tag = NULL; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return ompi_errhandler_invoke (NULL, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG,FUNC_NAME); + } + + if (NULL == tag) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_TAG, FUNC_NAME); + } + + if (NULL == group) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_GROUP, FUNC_NAME); + } + + if (NULL == info || ompi_info_is_freed(info)) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_INFO, FUNC_NAME); + } + + if (NULL == newcomm) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG, FUNC_NAME); + } + } + + if (MPI_GROUP_NULL == group || MPI_UNDEFINED == ompi_group_rank (group)) { + *newcomm = MPI_COMM_NULL; + return MPI_SUCCESS; + } + + + /* + * we use PMIx group operations to implement comm/intercomm create from group/groups. + * PMIx group constructors require a unique tag across the processes using the same + * PMIx server. This is not equivalent to the uniqueness requirements of the tag argument + * to MPI_Comm_create_from_group and MPI_Intercomm_create_from_groups, hence an + * additional discriminator needs to be added to the user supplied tag argument. + */ + opal_asprintf (&pmix_group_tag, "%s-%s.%d", tag, OPAL_NAME_PRINT(ompi_group_get_proc_name (group, 0)), + ompi_group_size(group)); + if (OPAL_UNLIKELY(NULL == pmix_group_tag)) { + return OMPI_ERR_OUT_OF_RESOURCE; + } + + rc = ompi_comm_create_from_group ((ompi_group_t *) group, pmix_group_tag, &info->super, errhandler, + (ompi_communicator_t **) newcomm); + free(pmix_group_tag); + if (MPI_SUCCESS != rc) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, errhandler->eh_mpi_object_type, + rc, FUNC_NAME); + } + + return rc; +} diff --git a/ompi/mpi/c/comm_create_group.c b/ompi/mpi/c/comm_create_group.c deleted file mode 100644 index 507812df3d8..00000000000 --- a/ompi/mpi/c/comm_create_group.c +++ /dev/null @@ -1,90 +0,0 @@ -/* -*- 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-2005 High Performance Computing Center Stuttgart, - * University of Stuttgart. All rights reserved. - * Copyright (c) 2004-2008 The Regents of the University of California. - * All rights reserved. - * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_create_group = PMPI_Comm_create_group -#endif -#define MPI_Comm_create_group PMPI_Comm_create_group -#endif - -static const char FUNC_NAME[] = "MPI_Comm_create_group"; - - -int MPI_Comm_create_group (MPI_Comm comm, MPI_Group group, int tag, MPI_Comm *newcomm) { - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if (tag < 0 || tag > mca_pml.pml_max_tag) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TAG, - FUNC_NAME); - - if ( NULL == group ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP, - FUNC_NAME); - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - - if (MPI_GROUP_NULL == group || MPI_UNDEFINED == ompi_group_rank (group)) { - *newcomm = MPI_COMM_NULL; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_create_group ((ompi_communicator_t *) comm, (ompi_group_t *) group, - tag, (ompi_communicator_t **) newcomm); - OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_create_group.c.in b/ompi/mpi/c/comm_create_group.c.in new file mode 100644 index 00000000000..44852ef4eba --- /dev/null +++ b/ompi/mpi/c/comm_create_group.c.in @@ -0,0 +1,83 @@ +/* -*- 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-2005 High Performance Computing Center Stuttgart, + * University of Stuttgart. All rights reserved. + * Copyright (c) 2004-2008 The Regents of the University of California. + * All rights reserved. + * Copyright (c) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_create_group (COMM comm, GROUP group, INT tag, COMM_OUT newcomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if (tag < 0 || tag > mca_pml.pml_max_tag) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TAG, + FUNC_NAME); + + if ( NULL == group ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_GROUP, + FUNC_NAME); + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + + if (MPI_GROUP_NULL == group || MPI_UNDEFINED == ompi_group_rank (group)) { + *newcomm = MPI_COMM_NULL; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_create_group ((ompi_communicator_t *) comm, (ompi_group_t *) group, + tag, (ompi_communicator_t **) newcomm); + OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_create_keyval.c b/ompi/mpi/c/comm_create_keyval.c deleted file mode 100644 index f47e19731e0..00000000000 --- a/ompi/mpi/c/comm_create_keyval.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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-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) 2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. - * 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/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_create_keyval = PMPI_Comm_create_keyval -#endif -#define MPI_Comm_create_keyval PMPI_Comm_create_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Comm_create_keyval"; - - -int MPI_Comm_create_keyval(MPI_Comm_copy_attr_function *comm_copy_attr_fn, - MPI_Comm_delete_attr_function *comm_delete_attr_fn, - int *comm_keyval, void *extra_state) -{ - int ret; - ompi_attribute_fn_ptr_union_t copy_fn; - ompi_attribute_fn_ptr_union_t del_fn; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == comm_copy_attr_fn) || (NULL == comm_delete_attr_fn) || - (NULL == comm_keyval)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - copy_fn.attr_communicator_copy_fn = comm_copy_attr_fn; - del_fn.attr_communicator_delete_fn = comm_delete_attr_fn; - - ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn, - del_fn, comm_keyval, extra_state, 0, NULL); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_create_keyval.c.in b/ompi/mpi/c/comm_create_keyval.c.in new file mode 100644 index 00000000000..d69c245fc49 --- /dev/null +++ b/ompi/mpi/c/comm_create_keyval.c.in @@ -0,0 +1,58 @@ +/* + * 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-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) 2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. + * All Rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS comm_create_keyval(COMM_COPY_ATTR_FUNCTION comm_copy_attr_fn, + COMM_DELETE_ATTR_FUNCTION comm_delete_attr_fn, + INT_OUT comm_keyval, BUFFER_OUT extra_state) +{ + int ret; + ompi_attribute_fn_ptr_union_t copy_fn; + ompi_attribute_fn_ptr_union_t del_fn; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == comm_copy_attr_fn) || (NULL == comm_delete_attr_fn) || + (NULL == comm_keyval)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + copy_fn.attr_communicator_copy_fn = comm_copy_attr_fn; + del_fn.attr_communicator_delete_fn = comm_delete_attr_fn; + + ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn, + del_fn, comm_keyval, extra_state, 0, NULL); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_delete_attr.c b/ompi/mpi/c/comm_delete_attr.c deleted file mode 100644 index 19a714def7a..00000000000 --- a/ompi/mpi/c/comm_delete_attr.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * 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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_delete_attr = PMPI_Comm_delete_attr -#endif -#define MPI_Comm_delete_attr PMPI_Comm_delete_attr -#endif - -static const char FUNC_NAME[] = "MPI_Comm_delete_attr"; - - -int MPI_Comm_delete_attr(MPI_Comm comm, int comm_keyval) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - ret = ompi_attr_delete(COMM_ATTR, comm, comm->c_keyhash, comm_keyval, - false); - - OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_delete_attr.c.in b/ompi/mpi/c/comm_delete_attr.c.in new file mode 100644 index 00000000000..7d792cd993c --- /dev/null +++ b/ompi/mpi/c/comm_delete_attr.c.in @@ -0,0 +1,53 @@ +/* + * 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 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$ + * + * 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/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_delete_attr(COMM comm, INT comm_keyval) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + ret = ompi_attr_delete(COMM_ATTR, comm, comm->c_keyhash, comm_keyval, + false); + + OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_disconnect.c b/ompi/mpi/c/comm_disconnect.c deleted file mode 100644 index 7d9b1519ba4..00000000000 --- a/ompi/mpi/c/comm_disconnect.c +++ /dev/null @@ -1,76 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Intel, 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_disconnect = PMPI_Comm_disconnect -#endif -#define MPI_Comm_disconnect PMPI_Comm_disconnect -#endif - -#include "ompi/dpm/dpm.h" - - -static const char FUNC_NAME[] = "MPI_Comm_disconnect"; - - -int MPI_Comm_disconnect(MPI_Comm *comm) -{ - int ret = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(*comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid (*comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_COMM_WORLD == *comm || MPI_COMM_SELF == *comm ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - - if ( OMPI_COMM_IS_DYNAMIC(*comm)) { - if (OMPI_SUCCESS != ompi_dpm_disconnect (*comm)) { - ret = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - } - else { - (*comm)->c_coll->coll_barrier(*comm, (*comm)->c_coll->coll_barrier_module); - } - - ompi_comm_free(comm); - - return ret; -} diff --git a/ompi/mpi/c/comm_disconnect.c.in b/ompi/mpi/c/comm_disconnect.c.in new file mode 100644 index 00000000000..17e2ef4e43e --- /dev/null +++ b/ompi/mpi/c/comm_disconnect.c.in @@ -0,0 +1,66 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Intel, 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$ + * + * 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/memchecker.h" +#include "ompi/dpm/dpm.h" + +PROTOTYPE ERROR_CLASS comm_disconnect(COMM_OUT comm) +{ + int ret = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(*comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid (*comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_COMM_WORLD == *comm || MPI_COMM_SELF == *comm ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + + if ( OMPI_COMM_IS_DYNAMIC(*comm)) { + if (OMPI_SUCCESS != ompi_dpm_disconnect (*comm)) { + ret = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + } + else { + (*comm)->c_coll->coll_barrier(*comm, (*comm)->c_coll->coll_barrier_module); + } + + ompi_comm_free(comm); + + return ret; +} diff --git a/ompi/mpi/c/comm_dup.c b/ompi/mpi/c/comm_dup.c deleted file mode 100644 index 5f747e7c7a0..00000000000 --- a/ompi/mpi/c/comm_dup.c +++ /dev/null @@ -1,76 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2008 University of Houston. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_dup = PMPI_Comm_dup -#endif -#define MPI_Comm_dup PMPI_Comm_dup -#endif - -static const char FUNC_NAME[] = "MPI_Comm_dup"; - -int MPI_Comm_dup(MPI_Comm comm, MPI_Comm *newcomm) -{ - int rc=MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* argument checking */ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_dup ( comm, newcomm ); - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/comm_dup.c.in b/ompi/mpi/c/comm_dup.c.in new file mode 100644 index 00000000000..c595673298b --- /dev/null +++ b/ompi/mpi/c/comm_dup.c.in @@ -0,0 +1,69 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2008 University of Houston. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_dup(COMM comm, COMM_OUT newcomm) +{ + int rc=MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_dup ( comm, newcomm ); + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/comm_dup_with_info.c b/ompi/mpi/c/comm_dup_with_info.c deleted file mode 100644 index 9b2df72134a..00000000000 --- a/ompi/mpi/c/comm_dup_with_info.c +++ /dev/null @@ -1,83 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2008 University of Houston. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_dup_with_info = PMPI_Comm_dup_with_info -#endif -#define MPI_Comm_dup_with_info PMPI_Comm_dup_with_info -#endif - -static const char FUNC_NAME[] = "MPI_Comm_dup_with_info"; - -int MPI_Comm_dup_with_info(MPI_Comm comm, MPI_Info info, MPI_Comm *newcomm) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* argument checking */ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - } - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_dup_with_info (comm, &info->super, newcomm); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/comm_dup_with_info.c.in b/ompi/mpi/c/comm_dup_with_info.c.in new file mode 100644 index 00000000000..4e6e2ad7b94 --- /dev/null +++ b/ompi/mpi/c/comm_dup_with_info.c.in @@ -0,0 +1,76 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2008 University of Houston. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_dup_with_info(COMM comm, INFO info, COMM_OUT newcomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + } + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_dup_with_info (comm, &info->super, newcomm); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/comm_f2c.c b/ompi/mpi/c/comm_f2c.c deleted file mode 100644 index a0bd6be2acb..00000000000 --- a/ompi/mpi/c/comm_f2c.c +++ /dev/null @@ -1,59 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ -#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/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_f2c = PMPI_Comm_f2c -#endif -#define MPI_Comm_f2c PMPI_Comm_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Comm_f2c"; - - -MPI_Comm MPI_Comm_f2c(MPI_Fint comm) -{ - int o_index= OMPI_FINT_2_INT(comm); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if ( 0 > o_index || - o_index >= opal_pointer_array_get_size(&ompi_comm_f_to_c_table)) { - return NULL; - } - - return (MPI_Comm)opal_pointer_array_get_item(&ompi_comm_f_to_c_table, o_index); -} diff --git a/ompi/mpi/c/comm_f2c.c.in b/ompi/mpi/c/comm_f2c.c.in new file mode 100644 index 00000000000..769b7906a52 --- /dev/null +++ b/ompi/mpi/c/comm_f2c.c.in @@ -0,0 +1,51 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE COMM comm_f2c(FINT comm) +{ + int o_index= OMPI_FINT_2_INT(comm); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if ( 0 > o_index || + o_index >= opal_pointer_array_get_size(&ompi_comm_f_to_c_table)) { + return NULL; + } + + return (MPI_Comm)opal_pointer_array_get_item(&ompi_comm_f_to_c_table, o_index); +} diff --git a/ompi/mpi/c/comm_free.c b/ompi/mpi/c/comm_free.c deleted file mode 100644 index f190011aabd..00000000000 --- a/ompi/mpi/c/comm_free.c +++ /dev/null @@ -1,65 +0,0 @@ -/* - * 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$ - * - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_free = PMPI_Comm_free -#endif -#define MPI_Comm_free PMPI_Comm_free -#endif - -static const char FUNC_NAME[] = "MPI_Comm_free"; - - -int MPI_Comm_free(MPI_Comm *comm) -{ - int ret; - - MEMCHECKER( - memchecker_comm(*comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == *comm || - ompi_comm_invalid (*comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (MPI_COMM_WORLD == *comm || - MPI_COMM_SELF == *comm) { - return OMPI_ERRHANDLER_INVOKE(*comm, MPI_ERR_COMM, - FUNC_NAME); - } - } - - ret = ompi_comm_free ( comm ); - OMPI_ERRHANDLER_CHECK(ret, *comm, ret, FUNC_NAME); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_free.c.in b/ompi/mpi/c/comm_free.c.in new file mode 100644 index 00000000000..9540ab668fd --- /dev/null +++ b/ompi/mpi/c/comm_free.c.in @@ -0,0 +1,57 @@ +/* + * 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_free(COMM_OUT comm) +{ + int ret; + + MEMCHECKER( + memchecker_comm(*comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == *comm || + ompi_comm_invalid (*comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (MPI_COMM_WORLD == *comm || + MPI_COMM_SELF == *comm) { + return OMPI_ERRHANDLER_INVOKE(*comm, MPI_ERR_COMM, + FUNC_NAME); + } + } + + ret = ompi_comm_free ( comm ); + OMPI_ERRHANDLER_CHECK(ret, *comm, ret, FUNC_NAME); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_free_keyval.c b/ompi/mpi/c/comm_free_keyval.c deleted file mode 100644 index 7db43297090..00000000000 --- a/ompi/mpi/c/comm_free_keyval.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_free_keyval = PMPI_Comm_free_keyval -#endif -#define MPI_Comm_free_keyval PMPI_Comm_free_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Comm_free_keyval"; - - -int MPI_Comm_free_keyval(int *comm_keyval) -{ - int ret; - - /* Check for valid key pointer */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == comm_keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - ret = ompi_attr_free_keyval(COMM_ATTR, comm_keyval, 0); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_free_keyval.c.in b/ompi/mpi/c/comm_free_keyval.c.in new file mode 100644 index 00000000000..85ddf34f124 --- /dev/null +++ b/ompi/mpi/c/comm_free_keyval.c.in @@ -0,0 +1,48 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS comm_free_keyval(INT_OUT comm_keyval) +{ + int ret; + + /* Check for valid key pointer */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == comm_keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + ret = ompi_attr_free_keyval(COMM_ATTR, comm_keyval, 0); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_get_attr.c b/ompi/mpi/c/comm_get_attr.c deleted file mode 100644 index 93091f5511e..00000000000 --- a/ompi/mpi/c/comm_get_attr.c +++ /dev/null @@ -1,69 +0,0 @@ -/* - * 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) 2009 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_get_attr = PMPI_Comm_get_attr -#endif -#define MPI_Comm_get_attr PMPI_Comm_get_attr -#endif - -static const char FUNC_NAME[] = "MPI_Comm_get_attr"; - - -int MPI_Comm_get_attr(MPI_Comm comm, int comm_keyval, - void *attribute_val, int *flag) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == attribute_val) || (NULL == flag)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (MPI_KEYVAL_INVALID == comm_keyval) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_KEYVAL, FUNC_NAME); - } - } - - /* This stuff is very confusing. Be sure to see - src/attribute/attribute.c for a lengthy comment explaining Open - MPI attribute behavior. */ - - ret = ompi_attr_get_c(comm->c_keyhash, comm_keyval, - (void**)attribute_val, flag); - OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_get_attr.c.in b/ompi/mpi/c/comm_get_attr.c.in new file mode 100644 index 00000000000..1accf0c2c5e --- /dev/null +++ b/ompi/mpi/c/comm_get_attr.c.in @@ -0,0 +1,61 @@ +/* + * 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) 2009 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$ + * + * 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/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_get_attr(COMM comm, INT comm_keyval, + BUFFER_OUT attribute_val, INT_OUT flag) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == attribute_val) || (NULL == flag)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (MPI_KEYVAL_INVALID == comm_keyval) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_KEYVAL, FUNC_NAME); + } + } + + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(comm->c_keyhash, comm_keyval, + (void**)attribute_val, flag); + OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_get_errhandler.c b/ompi/mpi/c/comm_get_errhandler.c deleted file mode 100644 index 288476e1e9b..00000000000 --- a/ompi/mpi/c/comm_get_errhandler.c +++ /dev/null @@ -1,82 +0,0 @@ -/* -*- 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) 2020 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/instance/instance.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_get_errhandler = PMPI_Comm_get_errhandler -#endif -#define MPI_Comm_get_errhandler PMPI_Comm_get_errhandler -#endif - - -static const char FUNC_NAME[] = "MPI_Comm_get_errhandler"; - - -int MPI_Comm_get_errhandler(MPI_Comm comm, MPI_Errhandler *errhandler) -{ - int ret = MPI_SUCCESS; - - /* Error checking */ - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (NULL == errhandler) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - OPAL_THREAD_LOCK(&(comm->c_lock)); - /* Retain the errhandler, corresponding to object refcount decrease - in errhandler_free.c. */ - OBJ_RETAIN(comm->error_handler); - *errhandler = comm->error_handler; - OPAL_THREAD_UNLOCK(&(comm->c_lock)); - - /* make sure the infrastructure is initialized */ - ret = ompi_mpi_instance_retain (); - - /* All done */ - - return ret; -} diff --git a/ompi/mpi/c/comm_get_errhandler.c.in b/ompi/mpi/c/comm_get_errhandler.c.in new file mode 100644 index 00000000000..170a36fa841 --- /dev/null +++ b/ompi/mpi/c/comm_get_errhandler.c.in @@ -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) 2020-2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" +#include "ompi/instance/instance.h" + +PROTOTYPE ERROR_CLASS comm_get_errhandler(COMM comm, ERRHANDLER_OUT errhandler) +{ + int ret = MPI_SUCCESS; + + /* Error checking */ + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (NULL == errhandler) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + OPAL_THREAD_LOCK(&(comm->c_lock)); + /* Retain the errhandler, corresponding to object refcount decrease + in errhandler_free.c. */ + OBJ_RETAIN(comm->error_handler); + *errhandler = comm->error_handler; + OPAL_THREAD_UNLOCK(&(comm->c_lock)); + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + + /* All done */ + + return ret; +} diff --git a/ompi/mpi/c/comm_get_info.c b/ompi/mpi/c/comm_get_info.c deleted file mode 100644 index 28bb8e776d6..00000000000 --- a/ompi/mpi/c/comm_get_info.c +++ /dev/null @@ -1,67 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_get_info = PMPI_Comm_get_info -#endif -#define MPI_Comm_get_info PMPI_Comm_get_info -#endif - -static const char FUNC_NAME[] = "MPI_Comm_get_info"; - - -int MPI_Comm_get_info(MPI_Comm comm, MPI_Info *info_used) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == info_used) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - if (NULL == comm->super.s_info) { - /* - * Setup any defaults if MPI_Win_set_info was never called - */ - opal_infosubscribe_change_info(&comm->super, &MPI_INFO_NULL->super); - } - - - *info_used = ompi_info_allocate (); - if (NULL == (*info_used)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, - FUNC_NAME); - } - - opal_info_t *opal_info_used = &(*info_used)->super; - - opal_info_dup_public(comm->super.s_info, &opal_info_used); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_get_info.c.in b/ompi/mpi/c/comm_get_info.c.in new file mode 100644 index 00000000000..132a27fb413 --- /dev/null +++ b/ompi/mpi/c/comm_get_info.c.in @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include +#include + +PROTOTYPE ERROR_CLASS comm_get_info(COMM comm, INFO_OUT info_used) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == info_used) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + if (NULL == comm->super.s_info) { + /* + * Setup any defaults if MPI_Win_set_info was never called + */ + opal_infosubscribe_change_info(&comm->super, &MPI_INFO_NULL->super); + } + + + *info_used = ompi_info_allocate (); + if (NULL == (*info_used)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + } + + opal_info_t *opal_info_used = &(*info_used)->super; + + opal_info_dup_public(comm->super.s_info, &opal_info_used); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_get_name.c b/ompi/mpi/c/comm_get_name.c deleted file mode 100644 index e635b768505..00000000000 --- a/ompi/mpi/c/comm_get_name.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include - -#include "opal/mca/threads/mutex.h" -#include "opal/util/string_copy.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/totalview.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_get_name = PMPI_Comm_get_name -#endif -#define MPI_Comm_get_name PMPI_Comm_get_name -#endif - -static const char FUNC_NAME[] = "MPI_Comm_get_name"; - - -int MPI_Comm_get_name(MPI_Comm comm, char *name, int *length) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( comm ) ) - return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == name || NULL == length ) - return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, - FUNC_NAME); - } - OPAL_THREAD_LOCK(&(comm->c_lock)); - /* Note that MPI-2.1 requires: - - terminating the string with a \0 - - name[*resultlen] == '\0' - - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) - - The Fortran API version will pad to the right if necessary. - - Note that comm->c_name is guaranteed to be \0-terminated and - able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., - name+\0). */ - if ( comm->c_flags & OMPI_COMM_NAMEISSET ) { - opal_string_copy(name, comm->c_name, MPI_MAX_OBJECT_NAME); - *length = (int) strlen(comm->c_name); - } else { - name[0] = '\0'; - *length = 0; - } - OPAL_THREAD_UNLOCK(&(comm->c_lock)); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_get_name.c.in b/ompi/mpi/c/comm_get_name.c.in new file mode 100644 index 00000000000..f0714830f27 --- /dev/null +++ b/ompi/mpi/c/comm_get_name.c.in @@ -0,0 +1,76 @@ +/* + * Copyright (c) 2004-2007 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-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-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/mca/threads/mutex.h" +#include "opal/util/string_copy.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/totalview.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_get_name(COMM comm, STRING_OUT name, INT_OUT length) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( comm ) ) + return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == name || NULL == length ) + return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + FUNC_NAME); + } + OPAL_THREAD_LOCK(&(comm->c_lock)); + /* Note that MPI-2.1 requires: + - terminating the string with a \0 + - name[*resultlen] == '\0' + - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) + + The Fortran API version will pad to the right if necessary. + + Note that comm->c_name is guaranteed to be \0-terminated and + able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., + name+\0). */ + if ( comm->c_flags & OMPI_COMM_NAMEISSET ) { + opal_string_copy(name, comm->c_name, MPI_MAX_OBJECT_NAME); + *length = (int) strlen(comm->c_name); + } else { + name[0] = '\0'; + *length = 0; + } + OPAL_THREAD_UNLOCK(&(comm->c_lock)); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_get_parent.c b/ompi/mpi/c/comm_get_parent.c deleted file mode 100644 index a6909ef2459..00000000000 --- a/ompi/mpi/c/comm_get_parent.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_get_parent = PMPI_Comm_get_parent -#endif -#define MPI_Comm_get_parent PMPI_Comm_get_parent -#endif - -static const char FUNC_NAME[] = "MPI_Comm_get_parent"; - - -int MPI_Comm_get_parent(MPI_Comm *parent) -{ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == parent ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* - * ompi_mpi_comm_parent is MPI_COMM_NULL, in case this - * world has not been spawned by another MPI job. - * This is also the return value required by MPI-2. - */ - - *parent = ompi_mpi_comm_parent; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_get_parent.c.in b/ompi/mpi/c/comm_get_parent.c.in new file mode 100644 index 00000000000..49e4f38177b --- /dev/null +++ b/ompi/mpi/c/comm_get_parent.c.in @@ -0,0 +1,49 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS comm_get_parent(COMM_OUT parent) +{ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == parent ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* + * ompi_mpi_comm_parent is MPI_COMM_NULL, in case this + * world has not been spawned by another MPI job. + * This is also the return value required by MPI-2. + */ + + *parent = ompi_mpi_comm_parent; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_group.c b/ompi/mpi/c/comm_group.c deleted file mode 100644 index 7a563578dcc..00000000000 --- a/ompi/mpi/c/comm_group.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_group = PMPI_Comm_group -#endif -#define MPI_Comm_group PMPI_Comm_group -#endif - -static const char FUNC_NAME[] = "MPI_Comm_group"; - - -int MPI_Comm_group(MPI_Comm comm, MPI_Group *group) { - - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* argument checking */ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid (comm) ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == group ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } /* end if ( MPI_PARAM_CHECK) */ - - rc = ompi_comm_group ( (ompi_communicator_t*)comm, (ompi_group_t**)group ); - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_group.c.in b/ompi/mpi/c/comm_group.c.in new file mode 100644 index 00000000000..f354e3e759d --- /dev/null +++ b/ompi/mpi/c/comm_group.c.in @@ -0,0 +1,56 @@ +/* + * 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) 2006 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_group(COMM comm, GROUP_OUT group) +{ + + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid (comm) ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == group ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } /* end if ( MPI_PARAM_CHECK) */ + + rc = ompi_comm_group ( (ompi_communicator_t*)comm, (ompi_group_t**)group ); + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_idup.c b/ompi/mpi/c/comm_idup.c deleted file mode 100644 index 278b9b1706f..00000000000 --- a/ompi/mpi/c/comm_idup.c +++ /dev/null @@ -1,67 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2008 University of Houston. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_idup = PMPI_Comm_idup -#endif -#define MPI_Comm_idup PMPI_Comm_idup -#endif - -static const char FUNC_NAME[] = "MPI_Comm_idup"; - -int MPI_Comm_idup(MPI_Comm comm, MPI_Comm *newcomm, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* argument checking */ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - - rc = ompi_comm_idup (comm, newcomm, request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/comm_idup.c.in b/ompi/mpi/c/comm_idup.c.in new file mode 100644 index 00000000000..e51fd1b5493 --- /dev/null +++ b/ompi/mpi/c/comm_idup.c.in @@ -0,0 +1,60 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2008 University of Houston. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_idup(COMM comm, COMM_OUT newcomm, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + + rc = ompi_comm_idup (comm, newcomm, request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/comm_idup_with_info.c b/ompi/mpi/c/comm_idup_with_info.c deleted file mode 100644 index 1abbd35b5a9..00000000000 --- a/ompi/mpi/c/comm_idup_with_info.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2008 University of Houston. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2021 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_idup_with_info = PMPI_Comm_idup_with_info -#endif -#define MPI_Comm_idup_with_info PMPI_Comm_idup_with_info -#endif - -static const char FUNC_NAME[] = "MPI_Comm_idup_with_info"; - -int MPI_Comm_idup_with_info(MPI_Comm comm, MPI_Info info, MPI_Comm *newcomm, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* argument checking */ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - } - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_idup_with_info (comm, &info->super, newcomm, request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/comm_idup_with_info.c.in b/ompi/mpi/c/comm_idup_with_info.c.in new file mode 100644 index 00000000000..983a2c35d0b --- /dev/null +++ b/ompi/mpi/c/comm_idup_with_info.c.in @@ -0,0 +1,78 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2008 University of Houston. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2021-2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_idup_with_info(COMM comm, INFO info, + COMM_OUT newcomm, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* argument checking */ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + } + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_idup_with_info (comm, &info->super, newcomm, request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/comm_join.c b/ompi/mpi/c/comm_join.c deleted file mode 100644 index 2d84895c29e..00000000000 --- a/ompi/mpi/c/comm_join.c +++ /dev/null @@ -1,249 +0,0 @@ -/* - * 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-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) 2012 Los Alamos National Security, LLC. - * All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include -#include -#ifdef HAVE_UNISTD_H -#include -#endif -#ifdef HAVE_SYS_TYPES_H -#include -#endif -#ifdef HAVE_SYS_SOCKET_H -#include -#endif -#include -#ifdef HAVE_NETINET_IN_H -#include -#endif - -#include "opal/util/show_help.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/dpm/dpm.h" - - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_join = PMPI_Comm_join -#endif -#define MPI_Comm_join PMPI_Comm_join -#endif - -static const char FUNC_NAME[] = "MPI_Comm_join"; - -static int ompi_socket_send (int fd, char *buf, int len ); -static int ompi_socket_recv (int fd, char *buf, int len ); - -int MPI_Comm_join(int fd, MPI_Comm *intercomm) -{ - int rc; - uint32_t len, rlen, llen, lrlen; - int send_first=0; - ompi_process_name_t rname, tmp_name; - - ompi_communicator_t *newcomp; - char port_name[MPI_MAX_PORT_NAME]; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == intercomm ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(OMPI_ERR_NOT_SUPPORTED, - FUNC_NAME); - } - - /* send my process name */ - tmp_name = *OMPI_PROC_MY_NAME; - OMPI_PROCESS_NAME_HTON(tmp_name); - ompi_socket_send(fd, (char*) &tmp_name, sizeof(tmp_name)); - - /* recv the remote name */ - ompi_socket_recv(fd, (char*) &rname, sizeof(rname)); - OMPI_PROCESS_NAME_NTOH(rname); - - /* compare the two to get send_first */ - if (OMPI_PROC_MY_NAME->jobid == rname.jobid) { - if (OMPI_PROC_MY_NAME->vpid < rname.vpid) { - send_first = true; - } else if (OMPI_PROC_MY_NAME->vpid == rname.vpid) { - /* joining to myself is not allowed */ - *intercomm = MPI_COMM_NULL; - return MPI_ERR_INTERN; - } else { - send_first = false; - } - } else if (OMPI_PROC_MY_NAME->jobid < rname.jobid) { - send_first = true; - } - - /* Assumption: socket_send should not block, even if the socket - is not configured to be non-blocking, because the message length are - so short. */ - - /* we will only use the send_first proc's port name, - * so pass it to the recv_first participant */ - if (send_first) { - // The port_name that we get back will be \0-terminated. The - // strlen+\0 will be <= MPI_MAX_PORT_NAME characters. - if (OMPI_SUCCESS != (rc = ompi_dpm_open_port(port_name))) { - goto error; - } - // Send the strlen+1 so that we both send the \0 and the - // receiver receives the \0. - llen = (uint32_t)(strlen(port_name)+1); - len = htonl(llen); - ompi_socket_send( fd, (char *) &len, sizeof(uint32_t)); - ompi_socket_send (fd, port_name, llen); - } else { - ompi_socket_recv (fd, (char *) &rlen, sizeof(uint32_t)); - // The lrlen that we receive will be the strlen+1 (to account - // for \0), and will be <= MPI_MAX_PORT_NAME. - lrlen = ntohl(rlen); - ompi_socket_recv (fd, port_name, lrlen); - } - - /* use the port to connect/accept */ - rc = ompi_dpm_connect_accept (MPI_COMM_SELF, 0, port_name, send_first, &newcomp); - - *intercomm = newcomp; - - error: - if (OPAL_ERR_NOT_SUPPORTED == rc) { - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support join functionality"); - } - - OMPI_ERRHANDLER_RETURN (rc, MPI_COMM_SELF, rc, FUNC_NAME); -} - - -static int ompi_socket_send (int fd, char *buf, int len ) -{ - int num; - size_t s_num; - ssize_t a; - char *c_ptr; - int ret = OMPI_SUCCESS; - - num = len; - c_ptr = buf; - - do { - s_num = (size_t) num; - a = write ( fd, c_ptr, s_num ); - if ( a == -1 ) { - if ( errno == EINTR ) { - /* Catch EINTR on, mainly on IBM RS6000 */ - continue; - } -#ifdef __SR8000 - else if ( errno == EWOULDBLOCK ) { - /*Catch EWOULDBLOCK on Hitachi SR8000 */ - continue; - } - else if ( errno == EAGAIN ) { - /* Catch EAGAIN on Hitachi SR8000 */ - continue; - } -#endif - else { - /* Another error occurred */ - fprintf (stderr,"ompi_socket_send: error while writing to socket" - " error:%s", strerror (errno) ); - return MPI_ERR_OTHER; - } - } - num -= a; - c_ptr += a; - } while ( num > 0 ); - - - if ( num < 0 ) { - fprintf (stderr, "ompi_socket_send: more data written then available"); - ret = MPI_ERR_INTERN; - } - - return ret; -} - -static int ompi_socket_recv (int fd, char *buf, int len ) -{ - int num; - size_t s_num; - ssize_t a; - char *c_ptr; - int ret = MPI_SUCCESS; - - num = len; - c_ptr = buf; - - do { - s_num = (size_t ) num; - a = read ( fd, c_ptr, s_num ); - if ( a == -1 ) { - if ( errno == EINTR ) { - /* Catch EINTR on, mainly on IBM RS6000 */ - continue; - } -#ifdef __SR8000 - else if ( errno == EWOULDBLOCK ) { - /*Catch EWOULDBLOCK on Hitachi SR8000 */ - continue; - } - else if ( errno == EAGAIN ) { - /* Catch EAGAIN on Hitachi SR8000 */ - continue; - } -#endif - else { - /* Another error occurred */ - fprintf (stderr,"ompi_socket_recv: error while reading from socket" - " error:%s", strerror (errno) ); - return MPI_ERR_OTHER; - } - } - num -= a; - c_ptr += a; - } while ( num > 0 ); - - if ( num < 0 ) { - fprintf (stderr, "ompi_socket_recv: more data read then available"); - ret = MPI_ERR_INTERN; - } - - return ret; -} diff --git a/ompi/mpi/c/comm_join.c.in b/ompi/mpi/c/comm_join.c.in new file mode 100644 index 00000000000..28d6c545c60 --- /dev/null +++ b/ompi/mpi/c/comm_join.c.in @@ -0,0 +1,243 @@ +/* + * 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-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) 2012 Los Alamos National Security, LLC. + * All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_TYPES_H +#include +#endif +#ifdef HAVE_SYS_SOCKET_H +#include +#endif +#include +#ifdef HAVE_NETINET_IN_H +#include +#endif + +#include "opal/util/show_help.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/dpm/dpm.h" + + + +static int ompi_socket_send (int fd, char *buf, int len ); +static int ompi_socket_recv (int fd, char *buf, int len ); + +static int ompi_socket_send (int fd, char *buf, int len ) +{ + int num; + size_t s_num; + ssize_t a; + char *c_ptr; + int ret = OMPI_SUCCESS; + + num = len; + c_ptr = buf; + + do { + s_num = (size_t) num; + a = write ( fd, c_ptr, s_num ); + if ( a == -1 ) { + if ( errno == EINTR ) { + /* Catch EINTR on, mainly on IBM RS6000 */ + continue; + } +#ifdef __SR8000 + else if ( errno == EWOULDBLOCK ) { + /*Catch EWOULDBLOCK on Hitachi SR8000 */ + continue; + } + else if ( errno == EAGAIN ) { + /* Catch EAGAIN on Hitachi SR8000 */ + continue; + } +#endif + else { + /* Another error occurred */ + fprintf (stderr,"ompi_socket_send: error while writing to socket" + " error:%s", strerror (errno) ); + return MPI_ERR_OTHER; + } + } + num -= a; + c_ptr += a; + } while ( num > 0 ); + + + if ( num < 0 ) { + fprintf (stderr, "ompi_socket_send: more data written then available"); + ret = MPI_ERR_INTERN; + } + + return ret; +} + +static int ompi_socket_recv (int fd, char *buf, int len ) +{ + int num; + size_t s_num; + ssize_t a; + char *c_ptr; + int ret = MPI_SUCCESS; + + num = len; + c_ptr = buf; + + do { + s_num = (size_t ) num; + a = read ( fd, c_ptr, s_num ); + if ( a == -1 ) { + if ( errno == EINTR ) { + /* Catch EINTR on, mainly on IBM RS6000 */ + continue; + } +#ifdef __SR8000 + else if ( errno == EWOULDBLOCK ) { + /*Catch EWOULDBLOCK on Hitachi SR8000 */ + continue; + } + else if ( errno == EAGAIN ) { + /* Catch EAGAIN on Hitachi SR8000 */ + continue; + } +#endif + else { + /* Another error occurred */ + fprintf (stderr,"ompi_socket_recv: error while reading from socket" + " error:%s", strerror (errno) ); + return MPI_ERR_OTHER; + } + } + num -= a; + c_ptr += a; + } while ( num > 0 ); + + if ( num < 0 ) { + fprintf (stderr, "ompi_socket_recv: more data read then available"); + ret = MPI_ERR_INTERN; + } + + return ret; +} + +PROTOTYPE ERROR_CLASS comm_join(INT fd, COMM_OUT intercomm) +{ + + int rc; + uint32_t len, rlen, llen, lrlen; + int send_first=0; + ompi_process_name_t rname, tmp_name; + + ompi_communicator_t *newcomp; + char port_name[MPI_MAX_PORT_NAME]; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == intercomm ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(OMPI_ERR_NOT_SUPPORTED, + FUNC_NAME); + } + + /* send my process name */ + tmp_name = *OMPI_PROC_MY_NAME; + OMPI_PROCESS_NAME_HTON(tmp_name); + ompi_socket_send(fd, (char*) &tmp_name, sizeof(tmp_name)); + + /* recv the remote name */ + ompi_socket_recv(fd, (char*) &rname, sizeof(rname)); + OMPI_PROCESS_NAME_NTOH(rname); + + /* compare the two to get send_first */ + if (OMPI_PROC_MY_NAME->jobid == rname.jobid) { + if (OMPI_PROC_MY_NAME->vpid < rname.vpid) { + send_first = true; + } else if (OMPI_PROC_MY_NAME->vpid == rname.vpid) { + /* joining to myself is not allowed */ + *intercomm = MPI_COMM_NULL; + return MPI_ERR_INTERN; + } else { + send_first = false; + } + } else if (OMPI_PROC_MY_NAME->jobid < rname.jobid) { + send_first = true; + } + + /* Assumption: socket_send should not block, even if the socket + is not configured to be non-blocking, because the message length are + so short. */ + + /* we will only use the send_first proc's port name, + * so pass it to the recv_first participant */ + if (send_first) { + // The port_name that we get back will be \0-terminated. The + // strlen+\0 will be <= MPI_MAX_PORT_NAME characters. + if (OMPI_SUCCESS != (rc = ompi_dpm_open_port(port_name))) { + goto error; + } + // Send the strlen+1 so that we both send the \0 and the + // receiver receives the \0. + llen = (uint32_t)(strlen(port_name)+1); + len = htonl(llen); + ompi_socket_send( fd, (char *) &len, sizeof(uint32_t)); + ompi_socket_send (fd, port_name, llen); + } else { + ompi_socket_recv (fd, (char *) &rlen, sizeof(uint32_t)); + // The lrlen that we receive will be the strlen+1 (to account + // for \0), and will be <= MPI_MAX_PORT_NAME. + lrlen = ntohl(rlen); + ompi_socket_recv (fd, port_name, lrlen); + } + + /* use the port to connect/accept */ + rc = ompi_dpm_connect_accept (MPI_COMM_SELF, 0, port_name, send_first, &newcomp); + + *intercomm = newcomp; + + error: + if (OPAL_ERR_NOT_SUPPORTED == rc) { + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support join functionality"); + } + + OMPI_ERRHANDLER_RETURN (rc, MPI_COMM_SELF, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_rank.c b/ompi/mpi/c/comm_rank.c deleted file mode 100644 index 8709d71f34d..00000000000 --- a/ompi/mpi/c/comm_rank.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_rank = PMPI_Comm_rank -#endif -#define MPI_Comm_rank PMPI_Comm_rank -#endif - -static const char FUNC_NAME[] = "MPI_Comm_rank"; - - -int MPI_Comm_rank(MPI_Comm comm, int *rank) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == rank ) - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - - *rank = ompi_comm_rank((ompi_communicator_t*)comm); - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/comm_rank.c.in b/ompi/mpi/c/comm_rank.c.in new file mode 100644 index 00000000000..8580bc3555d --- /dev/null +++ b/ompi/mpi/c/comm_rank.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2006 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_rank(COMM comm, INT_OUT rank) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == rank ) + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + + *rank = ompi_comm_rank((ompi_communicator_t*)comm); + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/comm_remote_group.c b/ompi/mpi/c/comm_remote_group.c deleted file mode 100644 index 5412d422d0d..00000000000 --- a/ompi/mpi/c/comm_remote_group.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * 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) 2006 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_remote_group = PMPI_Comm_remote_group -#endif -#define MPI_Comm_remote_group PMPI_Comm_remote_group -#endif - - -static const char FUNC_NAME[] = "MPI_Comm_remote_group"; - - -int MPI_Comm_remote_group(MPI_Comm comm, MPI_Group *group) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if ( NULL == group ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if ( OMPI_COMM_IS_INTER(comm) ) { - OBJ_RETAIN(comm->c_remote_group); - } - else { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - - *group = (MPI_Group) comm->c_remote_group; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_remote_group.c.in b/ompi/mpi/c/comm_remote_group.c.in new file mode 100644 index 00000000000..32cf053e040 --- /dev/null +++ b/ompi/mpi/c/comm_remote_group.c.in @@ -0,0 +1,62 @@ +/* + * 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) 2006 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_remote_group(COMM comm, GROUP_OUT group) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if ( NULL == group ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if ( OMPI_COMM_IS_INTER(comm) ) { + OBJ_RETAIN(comm->c_remote_group); + } + else { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + + *group = (MPI_Group) comm->c_remote_group; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_remote_size.c b/ompi/mpi/c/comm_remote_size.c deleted file mode 100644 index e02cb6d4790..00000000000 --- a/ompi/mpi/c/comm_remote_size.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_remote_size = PMPI_Comm_remote_size -#endif -#define MPI_Comm_remote_size PMPI_Comm_remote_size -#endif - - -static const char FUNC_NAME[] = "MPI_Comm_remote_size"; - - -int MPI_Comm_remote_size(MPI_Comm comm, int *size) { - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if ( NULL == size ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - *size = ompi_comm_remote_size ((ompi_communicator_t*)comm); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_remote_size.c.in b/ompi/mpi/c/comm_remote_size.c.in new file mode 100644 index 00000000000..dcdc03bd924 --- /dev/null +++ b/ompi/mpi/c/comm_remote_size.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2006 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_remote_size(COMM comm, INT_OUT size) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if ( NULL == size ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + *size = ompi_comm_remote_size ((ompi_communicator_t*)comm); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_set_attr.c b/ompi/mpi/c/comm_set_attr.c deleted file mode 100644 index 0de8da979b2..00000000000 --- a/ompi/mpi/c/comm_set_attr.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_set_attr = PMPI_Comm_set_attr -#endif -#define MPI_Comm_set_attr PMPI_Comm_set_attr -#endif - -static const char FUNC_NAME[] = "MPI_Comm_set_attr"; - - -int MPI_Comm_set_attr(MPI_Comm comm, int comm_keyval, void *attribute_val) -{ - int ret; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, - comm_keyval, attribute_val, false); - OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_set_attr.c.in b/ompi/mpi/c/comm_set_attr.c.in new file mode 100644 index 00000000000..9baa10aeac0 --- /dev/null +++ b/ompi/mpi/c/comm_set_attr.c.in @@ -0,0 +1,53 @@ +/* + * 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 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$ + * + * 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/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_set_attr(COMM comm, INT comm_keyval, + BUFFER_OUT attribute_val) +{ + int ret; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, + comm_keyval, attribute_val, false); + OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_set_errhandler.c b/ompi/mpi/c/comm_set_errhandler.c deleted file mode 100644 index 0be31b76406..00000000000 --- a/ompi/mpi/c/comm_set_errhandler.c +++ /dev/null @@ -1,79 +0,0 @@ -/* -*- 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$ - * - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_set_errhandler = PMPI_Comm_set_errhandler -#endif -#define MPI_Comm_set_errhandler PMPI_Comm_set_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Comm_set_errhandler"; - - -int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler) -{ - MPI_Errhandler tmp; - - /* Error checking */ - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (NULL == errhandler || - MPI_ERRHANDLER_NULL == errhandler || - ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && - OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* Prepare the new error handler */ - OBJ_RETAIN(errhandler); - - OPAL_THREAD_LOCK(&(comm->c_lock)); - /* Ditch the old errhandler, and decrement its refcount. */ - tmp = comm->error_handler; - comm->error_handler = errhandler; - OBJ_RELEASE(tmp); - OPAL_THREAD_UNLOCK(&(comm->c_lock)); - - /* All done */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_set_errhandler.c.in b/ompi/mpi/c/comm_set_errhandler.c.in new file mode 100644 index 00000000000..9cfabe8e856 --- /dev/null +++ b/ompi/mpi/c/comm_set_errhandler.c.in @@ -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) 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_set_errhandler(COMM comm, ERRHANDLER errhandler) +{ + MPI_Errhandler tmp; + + /* Error checking */ + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Prepare the new error handler */ + OBJ_RETAIN(errhandler); + + OPAL_THREAD_LOCK(&(comm->c_lock)); + /* Ditch the old errhandler, and decrement its refcount. */ + tmp = comm->error_handler; + comm->error_handler = errhandler; + OBJ_RELEASE(tmp); + OPAL_THREAD_UNLOCK(&(comm->c_lock)); + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_set_info.c b/ompi/mpi/c/comm_set_info.c deleted file mode 100644 index 9eca61263be..00000000000 --- a/ompi/mpi/c/comm_set_info.c +++ /dev/null @@ -1,52 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "opal/util/info_subscriber.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_set_info = PMPI_Comm_set_info -#endif -#define MPI_Comm_set_info PMPI_Comm_set_info -#endif - -static const char FUNC_NAME[] = "MPI_Comm_set_info"; - - -int MPI_Comm_set_info(MPI_Comm comm, MPI_Info info) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - - opal_infosubscribe_change_info(&(comm->super), &(info->super)); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_set_info.c.in b/ompi/mpi/c/comm_set_info.c.in new file mode 100644 index 00000000000..30cd717eaf9 --- /dev/null +++ b/ompi/mpi/c/comm_set_info.c.in @@ -0,0 +1,44 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "opal/util/info_subscriber.h" +#include +#include + +PROTOTYPE ERROR_CLASS comm_set_info(COMM comm, INFO info) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + + opal_infosubscribe_change_info(&(comm->super), &(info->super)); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_set_name.c b/ompi/mpi/c/comm_set_name.c deleted file mode 100644 index 538d3b81646..00000000000 --- a/ompi/mpi/c/comm_set_name.c +++ /dev/null @@ -1,76 +0,0 @@ -/* -*- 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-2005 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/totalview.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_set_name = PMPI_Comm_set_name -#endif -#define MPI_Comm_set_name PMPI_Comm_set_name -#endif - -static const char FUNC_NAME[] = "MPI_Comm_set_name"; - - -int MPI_Comm_set_name(MPI_Comm comm, const char *name) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( comm ) ) { - return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - - if ( NULL == name ) { - return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - rc = ompi_comm_set_name (comm, name ); - /* -- Tracing information for new communicator name -- */ -#if 0 - /* Force TotalView DLL to take note of this name setting */ - - ++ompi_tv_comm_sequence_number; -#endif - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_set_name.c.in b/ompi/mpi/c/comm_set_name.c.in new file mode 100644 index 00000000000..46dbd725bad --- /dev/null +++ b/ompi/mpi/c/comm_set_name.c.in @@ -0,0 +1,68 @@ +/* -*- 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-2005 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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$ + * + * 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/totalview.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_set_name(COMM comm, STRING name) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( comm ) ) { + return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + + if ( NULL == name ) { + return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + rc = ompi_comm_set_name (comm, name ); + /* -- Tracing information for new communicator name -- */ +#if 0 + /* Force TotalView DLL to take note of this name setting */ + + ++ompi_tv_comm_sequence_number; +#endif + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_size.c b/ompi/mpi/c/comm_size.c deleted file mode 100644 index 2c9f0232f48..00000000000 --- a/ompi/mpi/c/comm_size.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_size = PMPI_Comm_size -#endif -#define MPI_Comm_size PMPI_Comm_size -#endif - -static const char FUNC_NAME[] = "MPI_Comm_size"; - - -int MPI_Comm_size(MPI_Comm comm, int *size) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_COMM, FUNC_NAME); - } - - if ( NULL == size ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - *size = ompi_comm_size((ompi_communicator_t*)comm); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_size.c.in b/ompi/mpi/c/comm_size.c.in new file mode 100644 index 00000000000..544a2f56256 --- /dev/null +++ b/ompi/mpi/c/comm_size.c.in @@ -0,0 +1,55 @@ +/* + * 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) 2006 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_size(COMM comm, INT_OUT size) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_COMM, FUNC_NAME); + } + + if ( NULL == size ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + *size = ompi_comm_size((ompi_communicator_t*)comm); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/comm_spawn.c b/ompi/mpi/c/comm_spawn.c deleted file mode 100644 index dfeb9bffe07..00000000000 --- a/ompi/mpi/c/comm_spawn.c +++ /dev/null @@ -1,186 +0,0 @@ -/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2009 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Intel, 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 - -#include "opal/util/show_help.h" -#include "opal/util/printf.h" - -#include "ompi/info/info.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/dpm/dpm.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_spawn = PMPI_Comm_spawn -#endif -#define MPI_Comm_spawn PMPI_Comm_spawn -#endif - -static const char FUNC_NAME[] = "MPI_Comm_spawn"; - - -int MPI_Comm_spawn(const char *command, char *argv[], int maxprocs, MPI_Info info, - int root, MPI_Comm comm, MPI_Comm *intercomm, - int array_of_errcodes[]) -{ - int rank, rc=OMPI_SUCCESS, i, flag; - bool send_first = false; /* we wait to be contacted */ - ompi_communicator_t *newcomp=MPI_COMM_NULL; - char port_name[MPI_MAX_PORT_NAME]; char *port_string = NULL; - bool non_mpi = false; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if ( OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == intercomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &rc)) ) { - return OMPI_ERRHANDLER_INVOKE(comm, rc, FUNC_NAME); - } -#endif - - rank = ompi_comm_rank ( comm ); - if ( MPI_PARAM_CHECK ) { - if ( rank == root ) { - if ( NULL == command ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ( 0 > maxprocs ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - } - - if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { - return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); - } - - /* initialize the port name to avoid problems */ - memset(port_name, 0, MPI_MAX_PORT_NAME); - - /* See if the info key "ompi_non_mpi" was set to true */ - if (rank == root) { - ompi_info_get_bool(info, "ompi_non_mpi", &non_mpi, &flag); - } - - if ( rank == root ) { - if (!non_mpi) { - /* Open a port. The port_name is passed as an environment - variable to the children. */ - if (OMPI_SUCCESS != (rc = ompi_dpm_open_port (port_name))) { - goto error; - } - } else if (1 < ompi_comm_size(comm)) { - /* we do not support non_mpi spawns on comms this size */ - rc = OMPI_ERR_NOT_SUPPORTED; - goto error; - } - if (OMPI_SUCCESS != (rc = ompi_dpm_spawn (1, &command, &argv, &maxprocs, - &info, port_name))) { - goto error; - } - } - -error: - if (OMPI_SUCCESS != rc) { - /* There was an error in one of the above stages, - * we still need to do the connect_accept stage so that - * non-root ranks do not deadlock. - * Add the error code to the port string for connect_accept - * to propagate the error code. */ - (void)opal_asprintf(&port_string, "%s:error=%d", port_name, rc); - } - else { - port_string = port_name; - } - - if (non_mpi) { - newcomp = MPI_COMM_NULL; - } else { - rc = ompi_dpm_connect_accept (comm, root, port_string, send_first, &newcomp); - } - - if (OPAL_ERR_NOT_SUPPORTED == rc) { - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support spawn functionality"); - } - - if(port_string != port_name) { - free(port_string); - } - - /* close the port */ - if (rank == root && !non_mpi) { - ompi_dpm_close_port(port_name); - } - - /* set error codes */ - if (MPI_ERRCODES_IGNORE != array_of_errcodes) { - for ( i=0; i < maxprocs; i++ ) { - array_of_errcodes[i]=rc; - } - } - - *intercomm = newcomp; - OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_spawn.c.in b/ompi/mpi/c/comm_spawn.c.in new file mode 100644 index 00000000000..548fb113d02 --- /dev/null +++ b/ompi/mpi/c/comm_spawn.c.in @@ -0,0 +1,178 @@ +/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Intel, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/util/show_help.h" +#include "opal/util/printf.h" + +#include "ompi/info/info.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/dpm/dpm.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_spawn(STRING command, STRING_ARRAY argv, INT maxprocs, INFO info, + INT root, COMM comm, COMM_OUT intercomm, + INT_OUT array_of_errcodes) +{ + int rank, rc=OMPI_SUCCESS, i, flag; + bool send_first = false; /* we wait to be contacted */ + ompi_communicator_t *newcomp=MPI_COMM_NULL; + char port_name[MPI_MAX_PORT_NAME]; char *port_string = NULL; + bool non_mpi = false; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if ( OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == intercomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &rc)) ) { + return OMPI_ERRHANDLER_INVOKE(comm, rc, FUNC_NAME); + } +#endif + + rank = ompi_comm_rank ( comm ); + if ( MPI_PARAM_CHECK ) { + if ( rank == root ) { + if ( NULL == command ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ( 0 > maxprocs ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + } + + if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { + return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); + } + + /* initialize the port name to avoid problems */ + memset(port_name, 0, MPI_MAX_PORT_NAME); + + /* See if the info key "ompi_non_mpi" was set to true */ + if (rank == root) { + ompi_info_get_bool(info, "ompi_non_mpi", &non_mpi, &flag); + } + + if ( rank == root ) { + if (!non_mpi) { + /* Open a port. The port_name is passed as an environment + variable to the children. */ + if (OMPI_SUCCESS != (rc = ompi_dpm_open_port (port_name))) { + goto error; + } + } else if (1 < ompi_comm_size(comm)) { + /* we do not support non_mpi spawns on comms this size */ + rc = OMPI_ERR_NOT_SUPPORTED; + goto error; + } + if (OMPI_SUCCESS != (rc = ompi_dpm_spawn (1, &command, &argv, &maxprocs, + &info, port_name))) { + goto error; + } + } + +error: + if (OMPI_SUCCESS != rc) { + /* There was an error in one of the above stages, + * we still need to do the connect_accept stage so that + * non-root ranks do not deadlock. + * Add the error code to the port string for connect_accept + * to propagate the error code. */ + (void)opal_asprintf(&port_string, "%s:error=%d", port_name, rc); + } + else { + port_string = port_name; + } + + if (non_mpi) { + newcomp = MPI_COMM_NULL; + } else { + rc = ompi_dpm_connect_accept (comm, root, port_string, send_first, &newcomp); + } + + if (OPAL_ERR_NOT_SUPPORTED == rc) { + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support spawn functionality"); + } + + if(port_string != port_name) { + free(port_string); + } + + /* close the port */ + if (rank == root && !non_mpi) { + ompi_dpm_close_port(port_name); + } + + /* set error codes */ + if (MPI_ERRCODES_IGNORE != array_of_errcodes) { + for ( i=0; i < maxprocs; i++ ) { + array_of_errcodes[i]=rc; + } + } + + *intercomm = newcomp; + OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_spawn_multiple.c b/ompi/mpi/c/comm_spawn_multiple.c deleted file mode 100644 index 58b36c855c6..00000000000 --- a/ompi/mpi/c/comm_spawn_multiple.c +++ /dev/null @@ -1,236 +0,0 @@ -/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2009 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Intel, 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 - -#include "opal/util/show_help.h" -#include "opal/util/printf.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/dpm/dpm.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_spawn_multiple = PMPI_Comm_spawn_multiple -#endif -#define MPI_Comm_spawn_multiple PMPI_Comm_spawn_multiple -#endif - -static const char FUNC_NAME[] = "MPI_Comm_spawn_multiple"; - - -int MPI_Comm_spawn_multiple(int count, char *array_of_commands[], char **array_of_argv[], - const int array_of_maxprocs[], const MPI_Info array_of_info[], - int root, MPI_Comm comm, MPI_Comm *intercomm, - int array_of_errcodes[]) -{ - int i=0, rc=0, rank=0, size=0, flag; - ompi_communicator_t *newcomp=MPI_COMM_NULL; - bool send_first=false; /* they are contacting us first */ - char port_name[MPI_MAX_PORT_NAME]; char *port_string = NULL; - bool non_mpi = false, cumulative = false; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if ( OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); - } - if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - if ( NULL == intercomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - rank = ompi_comm_rank ( comm ); - if ( MPI_PARAM_CHECK ) { - if ( rank == root ) { - if ( 0 > count ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - if ( NULL == array_of_commands ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - if ( NULL == array_of_maxprocs ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - if ( NULL == array_of_info ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, FUNC_NAME); - } - for (i = 0; i < count; ++i) { - if (NULL == array_of_info[i] || - ompi_info_is_freed(array_of_info[i])) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - /* If ompi_non_mpi is set to true on any info, it must - be set to true on all of them. Note that not - setting ompi_non_mpi is the same as setting it to - false. */ - ompi_info_get_bool(array_of_info[i], "ompi_non_mpi", &non_mpi, - &flag); - if (flag && 0 == i) { - /* If this is the first info, save its - ompi_non_mpi value */ - cumulative = non_mpi; - } else if (!flag) { - non_mpi = false; - } - /* If this info's effective value doesn't agree with - the rest of them, error */ - if (cumulative != non_mpi) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_INFO, - FUNC_NAME); - } - } - for ( i=0; i array_of_maxprocs[i] ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - } - - if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { - return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); - } - - if (rank == root) { - if (MPI_INFO_NULL == array_of_info[0]) { - non_mpi = false; - } else { - ompi_info_get_bool(array_of_info[0], "ompi_non_mpi", &non_mpi, - &flag); - if (!flag) { - non_mpi = false; - } - } - } - -#if OPAL_ENABLE_FT_MPI - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &rc)) ) { - return OMPI_ERRHANDLER_INVOKE(comm, rc, FUNC_NAME); - } -#endif - - /* initialize the port name to avoid problems */ - memset(port_name, 0, MPI_MAX_PORT_NAME); - - - if ( rank == root ) { - if (!non_mpi) { - /* Open a port. The port_name is passed as an environment - variable to the children. */ - if (OMPI_SUCCESS != (rc = ompi_dpm_open_port (port_name))) { - goto error; - } - } else if (1 < ompi_comm_size(comm)) { - /* we do not support non_mpi spawns on comms this size */ - rc = OMPI_ERR_NOT_SUPPORTED; - goto error; - } - if (OMPI_SUCCESS != (rc = ompi_dpm_spawn(count, (const char **) array_of_commands, - array_of_argv, array_of_maxprocs, - array_of_info, port_name))) { - goto error; - } - } - -error: - if (OMPI_SUCCESS != rc) { - /* There was an error in one of the above stages, - * we still need to do the connect_accept stage so that - * non-root ranks do not deadlock. - * Add the error code to the port string for connect_accept - * to propagate the error code. */ - (void)opal_asprintf(&port_string, "%s:error=%d", port_name, rc); - } - else { - port_string = port_name; - } - - if (non_mpi) { - newcomp = MPI_COMM_NULL; - } else { - rc = ompi_dpm_connect_accept (comm, root, port_string, send_first, &newcomp); - } - - if (OPAL_ERR_NOT_SUPPORTED == rc) { - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support spawn functionality"); - } - - if(port_string != port_name) { - free(port_string); - } - - /* close the port */ - if (rank == root && !non_mpi) { - ompi_dpm_close_port(port_name); - } - - /* set array of errorcodes */ - if (MPI_ERRCODES_IGNORE != array_of_errcodes) { - if (MPI_COMM_NULL != newcomp) { - size = newcomp->c_remote_group->grp_proc_count; - } else { - for ( i=0; i < count; i++) { - size = size + array_of_maxprocs[i]; - } - } - for ( i=0; i < size; i++ ) { - array_of_errcodes[i]=rc; - } - } - - *intercomm = newcomp; - OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/comm_spawn_multiple.c.in b/ompi/mpi/c/comm_spawn_multiple.c.in new file mode 100644 index 00000000000..a729df6dfd0 --- /dev/null +++ b/ompi/mpi/c/comm_spawn_multiple.c.in @@ -0,0 +1,228 @@ +/* -*- 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) 2006-2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Intel, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/util/show_help.h" +#include "opal/util/printf.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/dpm/dpm.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_spawn_multiple(INT count, STRING_ARRAY array_of_commands, ARGV array_of_argv, + INT_ARRAY array_of_maxprocs, INFO_ARRAY array_of_info, + INT root, COMM comm, COMM_OUT intercomm, + INT_OUT array_of_errcodes) +{ + int i=0, rc=0, rank=0, size=0, flag; + ompi_communicator_t *newcomp=MPI_COMM_NULL; + bool send_first=false; /* they are contacting us first */ + char port_name[MPI_MAX_PORT_NAME]; char *port_string = NULL; + bool non_mpi = false, cumulative = false; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if ( OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); + } + if ( (0 > root) || (ompi_comm_size(comm) <= root) ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + if ( NULL == intercomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + rank = ompi_comm_rank ( comm ); + if ( MPI_PARAM_CHECK ) { + if ( rank == root ) { + if ( 0 > count ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + if ( NULL == array_of_commands ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + if ( NULL == array_of_maxprocs ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + if ( NULL == array_of_info ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, FUNC_NAME); + } + for (i = 0; i < count; ++i) { + if (NULL == array_of_info[i] || + ompi_info_is_freed(array_of_info[i])) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + /* If ompi_non_mpi is set to true on any info, it must + be set to true on all of them. Note that not + setting ompi_non_mpi is the same as setting it to + false. */ + ompi_info_get_bool(array_of_info[i], "ompi_non_mpi", &non_mpi, + &flag); + if (flag && 0 == i) { + /* If this is the first info, save its + ompi_non_mpi value */ + cumulative = non_mpi; + } else if (!flag) { + non_mpi = false; + } + /* If this info's effective value doesn't agree with + the rest of them, error */ + if (cumulative != non_mpi) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_INFO, + FUNC_NAME); + } + } + for ( i=0; i array_of_maxprocs[i] ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + } + + if (!ompi_mpi_dynamics_is_enabled(FUNC_NAME)) { + return OMPI_ERRHANDLER_INVOKE(comm, OMPI_ERR_NOT_SUPPORTED, FUNC_NAME); + } + + if (rank == root) { + if (MPI_INFO_NULL == array_of_info[0]) { + non_mpi = false; + } else { + ompi_info_get_bool(array_of_info[0], "ompi_non_mpi", &non_mpi, + &flag); + if (!flag) { + non_mpi = false; + } + } + } + +#if OPAL_ENABLE_FT_MPI + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &rc)) ) { + return OMPI_ERRHANDLER_INVOKE(comm, rc, FUNC_NAME); + } +#endif + + /* initialize the port name to avoid problems */ + memset(port_name, 0, MPI_MAX_PORT_NAME); + + + if ( rank == root ) { + if (!non_mpi) { + /* Open a port. The port_name is passed as an environment + variable to the children. */ + if (OMPI_SUCCESS != (rc = ompi_dpm_open_port (port_name))) { + goto error; + } + } else if (1 < ompi_comm_size(comm)) { + /* we do not support non_mpi spawns on comms this size */ + rc = OMPI_ERR_NOT_SUPPORTED; + goto error; + } + if (OMPI_SUCCESS != (rc = ompi_dpm_spawn(count, (const char **) array_of_commands, + array_of_argv, array_of_maxprocs, + array_of_info, port_name))) { + goto error; + } + } + +error: + if (OMPI_SUCCESS != rc) { + /* There was an error in one of the above stages, + * we still need to do the connect_accept stage so that + * non-root ranks do not deadlock. + * Add the error code to the port string for connect_accept + * to propagate the error code. */ + (void)opal_asprintf(&port_string, "%s:error=%d", port_name, rc); + } + else { + port_string = port_name; + } + + if (non_mpi) { + newcomp = MPI_COMM_NULL; + } else { + rc = ompi_dpm_connect_accept (comm, root, port_string, send_first, &newcomp); + } + + if (OPAL_ERR_NOT_SUPPORTED == rc) { + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support spawn functionality"); + } + + if(port_string != port_name) { + free(port_string); + } + + /* close the port */ + if (rank == root && !non_mpi) { + ompi_dpm_close_port(port_name); + } + + /* set array of errorcodes */ + if (MPI_ERRCODES_IGNORE != array_of_errcodes) { + if (MPI_COMM_NULL != newcomp) { + size = newcomp->c_remote_group->grp_proc_count; + } else { + for ( i=0; i < count; i++) { + size = size + array_of_maxprocs[i]; + } + } + for ( i=0; i < size; i++ ) { + array_of_errcodes[i]=rc; + } + } + + *intercomm = newcomp; + OMPI_ERRHANDLER_RETURN (rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/comm_split.c b/ompi/mpi/c/comm_split.c deleted file mode 100644 index a55f0fa7204..00000000000 --- a/ompi/mpi/c/comm_split.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_split = PMPI_Comm_split -#endif -#define MPI_Comm_split PMPI_Comm_split -#endif - -static const char FUNC_NAME[] = "MPI_Comm_split"; - - -int MPI_Comm_split(MPI_Comm comm, int color, int key, MPI_Comm *newcomm) { - - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( comm )) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if ( color < 0 && MPI_UNDEFINED != color ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - - if ( NULL == newcomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = ompi_comm_split ( (ompi_communicator_t*)comm, color, key, - (ompi_communicator_t**)newcomm, false); - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_split.c.in b/ompi/mpi/c/comm_split.c.in new file mode 100644 index 00000000000..6d361ce539f --- /dev/null +++ b/ompi/mpi/c/comm_split.c.in @@ -0,0 +1,74 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_split(COMM comm, INT color, INT key, COMM_OUT newcomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( comm )) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if ( color < 0 && MPI_UNDEFINED != color ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + + if ( NULL == newcomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = ompi_comm_split ( (ompi_communicator_t*)comm, color, key, + (ompi_communicator_t**)newcomm, false); + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_split_type.c b/ompi/mpi/c/comm_split_type.c deleted file mode 100644 index 3af3087eded..00000000000 --- a/ompi/mpi/c/comm_split_type.c +++ /dev/null @@ -1,136 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017-2022 IBM Corporation. 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/info/info.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_split_type = PMPI_Comm_split_type -#endif -#define MPI_Comm_split_type PMPI_Comm_split_type -#endif - -static const char FUNC_NAME[] = "MPI_Comm_split_type"; - - -int MPI_Comm_split_type(MPI_Comm comm, int split_type, int key, - MPI_Info info, MPI_Comm *newcomm) { - - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( comm )) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - } - - if ( MPI_COMM_TYPE_SHARED != split_type && // Same as OMPI_COMM_TYPE_NODE - MPI_COMM_TYPE_HW_UNGUIDED != split_type && - MPI_COMM_TYPE_HW_GUIDED != split_type && - OMPI_COMM_TYPE_CLUSTER != split_type && - OMPI_COMM_TYPE_CU != split_type && - OMPI_COMM_TYPE_HOST != split_type && - OMPI_COMM_TYPE_BOARD != split_type && - OMPI_COMM_TYPE_NODE != split_type && // Same as MPI_COMM_TYPE_SHARED - OMPI_COMM_TYPE_NUMA != split_type && - OMPI_COMM_TYPE_SOCKET != split_type && - OMPI_COMM_TYPE_L3CACHE != split_type && - OMPI_COMM_TYPE_L2CACHE != split_type && - OMPI_COMM_TYPE_L1CACHE != split_type && - OMPI_COMM_TYPE_CORE != split_type && - OMPI_COMM_TYPE_HWTHREAD != split_type && - MPI_UNDEFINED != split_type ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - - if ( NULL == newcomm ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if ( MPI_COMM_TYPE_HW_GUIDED == split_type ) { - int flag; - opal_cstring_t *value = NULL; - - /* MPI_Info is required for this split_type. - * Not an error condition, per MPI 4.0. - */ - if ( MPI_INFO_NULL == info ) { - *newcomm = MPI_COMM_NULL; - rc = MPI_SUCCESS; - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); - } - - /* MPI_Info with key "mpi_hw_resource_type" is required for this split_type. - * Not an error condition, per MPI 4.0. - */ - ompi_info_get(info, "mpi_hw_resource_type", &value, &flag); - if ( !flag ) { - *newcomm = MPI_COMM_NULL; - rc = MPI_SUCCESS; - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); - } - } - - if( (MPI_COMM_SELF == comm) && (MPI_UNDEFINED == split_type) ) { - *newcomm = MPI_COMM_NULL; - rc = MPI_SUCCESS; - } else { - rc = ompi_comm_split_type( (ompi_communicator_t*)comm, split_type, key, &(info->super), - (ompi_communicator_t**)newcomm); - } - OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/comm_split_type.c.in b/ompi/mpi/c/comm_split_type.c.in new file mode 100644 index 00000000000..26f2b39cea9 --- /dev/null +++ b/ompi/mpi/c/comm_split_type.c.in @@ -0,0 +1,128 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017-2022 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_split_type(COMM comm, INT split_type, INT key, + INFO info, COMM_OUT newcomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( comm )) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + } + + if ( MPI_COMM_TYPE_SHARED != split_type && // Same as OMPI_COMM_TYPE_NODE + MPI_COMM_TYPE_HW_UNGUIDED != split_type && + MPI_COMM_TYPE_HW_GUIDED != split_type && + OMPI_COMM_TYPE_CLUSTER != split_type && + OMPI_COMM_TYPE_CU != split_type && + OMPI_COMM_TYPE_HOST != split_type && + OMPI_COMM_TYPE_BOARD != split_type && + OMPI_COMM_TYPE_NODE != split_type && // Same as MPI_COMM_TYPE_SHARED + OMPI_COMM_TYPE_NUMA != split_type && + OMPI_COMM_TYPE_SOCKET != split_type && + OMPI_COMM_TYPE_L3CACHE != split_type && + OMPI_COMM_TYPE_L2CACHE != split_type && + OMPI_COMM_TYPE_L1CACHE != split_type && + OMPI_COMM_TYPE_CORE != split_type && + OMPI_COMM_TYPE_HWTHREAD != split_type && + MPI_UNDEFINED != split_type ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + + if ( NULL == newcomm ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if ( MPI_COMM_TYPE_HW_GUIDED == split_type ) { + int flag; + opal_cstring_t *value = NULL; + + /* MPI_Info is required for this split_type. + * Not an error condition, per MPI 4.0. + */ + if ( MPI_INFO_NULL == info ) { + *newcomm = MPI_COMM_NULL; + rc = MPI_SUCCESS; + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); + } + + /* MPI_Info with key "mpi_hw_resource_type" is required for this split_type. + * Not an error condition, per MPI 4.0. + */ + ompi_info_get(info, "mpi_hw_resource_type", &value, &flag); + if ( !flag ) { + *newcomm = MPI_COMM_NULL; + rc = MPI_SUCCESS; + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); + } + } + + if( (MPI_COMM_SELF == comm) && (MPI_UNDEFINED == split_type) ) { + *newcomm = MPI_COMM_NULL; + rc = MPI_SUCCESS; + } else { + rc = ompi_comm_split_type( (ompi_communicator_t*)comm, split_type, key, &(info->super), + (ompi_communicator_t**)newcomm); + } + OMPI_ERRHANDLER_RETURN ( rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/comm_test_inter.c b/ompi/mpi/c/comm_test_inter.c deleted file mode 100644 index 141a90d3478..00000000000 --- a/ompi/mpi/c/comm_test_inter.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Comm_test_inter = PMPI_Comm_test_inter -#endif -#define MPI_Comm_test_inter PMPI_Comm_test_inter -#endif - -static const char FUNC_NAME[] = "MPI_Comm_test_inter"; - - -int MPI_Comm_test_inter(MPI_Comm comm, int *flag) { - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( comm ) ) { - return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - - if ( NULL == flag ) { - return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - *flag = (comm->c_flags & OMPI_COMM_INTER); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/comm_test_inter.c.in b/ompi/mpi/c/comm_test_inter.c.in new file mode 100644 index 00000000000..51aa348b0f5 --- /dev/null +++ b/ompi/mpi/c/comm_test_inter.c.in @@ -0,0 +1,55 @@ +/* + * Copyright (c) 2004-2007 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-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 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS comm_test_inter(COMM comm, INT_OUT flag) +{ + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( comm )) { + return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + + if ( NULL == flag ){ + return OMPI_ERRHANDLER_INVOKE ( comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + *flag = ( comm->c_flags & OMPI_COMM_INTER ); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/compare_and_swap.c b/ompi/mpi/c/compare_and_swap.c deleted file mode 100644 index 014c31d5c27..00000000000 --- a/ompi/mpi/c/compare_and_swap.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Los Alamos 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Compare_and_swap = PMPI_Compare_and_swap -#endif -#define MPI_Compare_and_swap PMPI_Compare_and_swap -#endif - -static const char FUNC_NAME[] = "MPI_Compare_and_swap"; - - -int MPI_Compare_and_swap(const void *origin_addr, const void *compare_addr, void *result_addr, - MPI_Datatype datatype, int target_rank, MPI_Aint target_disp, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1); - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; - - rc = win->w_osc_module->osc_compare_and_swap(origin_addr, compare_addr, result_addr, - datatype, target_rank, target_disp, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/compare_and_swap.c.in b/ompi/mpi/c/compare_and_swap.c.in new file mode 100644 index 00000000000..5dc5e94e524 --- /dev/null +++ b/ompi/mpi/c/compare_and_swap.c.in @@ -0,0 +1,67 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" + +PROTOTYPE ERROR_CLASS compare_and_swap(BUFFER origin_addr, BUFFER compare_addr, BUFFER_OUT result_addr, + DATATYPE datatype, INT target_rank, AINT target_disp, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1); + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; + + rc = win->w_osc_module->osc_compare_and_swap(origin_addr, compare_addr, result_addr, + datatype, target_rank, target_disp, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/dims_create.c b/ompi/mpi/c/dims_create.c deleted file mode 100644 index 132feab54ba..00000000000 --- a/ompi/mpi/c/dims_create.c +++ /dev/null @@ -1,253 +0,0 @@ -/* - * 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-2014 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) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014 Intel, Inc. All rights reserved - * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015-2016 Research Organization for Information Science - * and Technology (RIST). 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Dims_create = PMPI_Dims_create -#endif -#define MPI_Dims_create PMPI_Dims_create -#endif - -static const char FUNC_NAME[] = "MPI_Dims_create"; - -/* static functions */ -static int assignnodes(int ndim, int nfactor, int *pfacts,int **pdims); -static int getfactors(int num, int *nfators, int **factors); - - -/* - * This is a utility function, no need to have anything in the lower - * layer for this at all - */ -int MPI_Dims_create(int nnodes, int ndims, int dims[]) -{ - int i; - int freeprocs; - int freedims; - int nfactors; - int *factors; - int *procs; - int *p; - int err; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (0 > ndims) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, - MPI_ERR_DIMS, FUNC_NAME); - } - - if ((0 != ndims) && (NULL == dims)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, - MPI_ERR_ARG, FUNC_NAME); - } - - if (1 > nnodes) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, - MPI_ERR_DIMS, FUNC_NAME); - } - } - - /* Get # of free-to-be-assigned processes and # of free dimensions */ - freeprocs = nnodes; - freedims = 0; - for (i = 0, p = dims; i < ndims; ++i,++p) { - if (*p == 0) { - ++freedims; - } else if ((*p < 0) || ((nnodes % *p) != 0)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_DIMS, - FUNC_NAME); - } else { - freeprocs /= *p; - } - } - - if (freedims == 0) { - if (freeprocs == 1) { - return MPI_SUCCESS; - } - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_DIMS, - FUNC_NAME); - } - - if (freeprocs == 1) { - for (i = 0; i < ndims; ++i, ++dims) { - if (*dims == 0) { - *dims = 1; - } - } - return MPI_SUCCESS; - } - - /* Factor the number of free processes */ - if (MPI_SUCCESS != (err = getfactors(freeprocs, &nfactors, &factors))) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(err, - FUNC_NAME); - } - - /* Assign free processes to free dimensions */ - if (MPI_SUCCESS != (err = assignnodes(freedims, nfactors, factors, &procs))) { - free(factors); - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(err, - FUNC_NAME); - } - - /* Return assignment results */ - p = procs; - for (i = 0; i < ndims; ++i, ++dims) { - if (*dims == 0) { - *dims = *p++; - } - } - - free((char *) factors); - free((char *) procs); - - /* all done */ - return MPI_SUCCESS; -} - -/* - * assignnodes - * - * Function: - assign processes to dimensions - * - get "best-balanced" grid - * - greedy bin-packing algorithm used - * - sort dimensions in decreasing order - * - dimensions array dynamically allocated - * Accepts: - # of dimensions - * - # of prime factors - * - array of prime factors - * - ptr to array of dimensions (returned value) - * Returns: - 0 or ERROR - */ -static int -assignnodes(int ndim, int nfactor, int *pfacts, int **pdims) -{ - int *bins; - int i, j; - int n; - int f; - int *p; - int *pmin; - - if (0 >= ndim) { - return MPI_ERR_DIMS; - } - - /* Allocate and initialize the bins */ - bins = (int *) malloc((unsigned) ndim * sizeof(int)); - if (NULL == bins) { - return MPI_ERR_NO_MEM; - } - *pdims = bins; - - for (i = 0, p = bins; i < ndim; ++i, ++p) { - *p = 1; - } - - /* Loop assigning factors from the highest to the lowest */ - for (j = nfactor - 1; j >= 0; --j) { - f = pfacts[j]; - /* Assign a factor to the smallest bin */ - pmin = bins; - for (i = 1, p = pmin + 1; i < ndim; ++i, ++p) { - if (*p < *pmin) { - pmin = p; - } - } - *pmin *= f; - } - - /* Sort dimensions in decreasing order (O(n^2) for now) */ - for (i = 0, pmin = bins; i < ndim - 1; ++i, ++pmin) { - for (j = i + 1, p = pmin + 1; j < ndim; ++j, ++p) { - if (*p > *pmin) { - n = *p; - *p = *pmin; - *pmin = n; - } - } - } - - return MPI_SUCCESS; -} - -/* - * getfactors - * - * Function: - factorize a number - * Accepts: - number - * - # prime factors - * - array of prime factors - * Returns: - MPI_SUCCESS or ERROR - */ -static int -getfactors(int num, int *nfactors, int **factors) { - int size; - int d; - int i; - int sqrtnum; - - if(num < 2) { - (*nfactors) = 0; - (*factors) = NULL; - return MPI_SUCCESS; - } - /* Allocate the array of prime factors which cannot exceed log_2(num) entries */ - sqrtnum = ceil(sqrt(num)); - size = ceil(log(num) / log(2)); - *factors = (int *) malloc((unsigned) size * sizeof(int)); - - i = 0; - /* determine all occurrences of factor 2 */ - while((num % 2) == 0) { - num /= 2; - (*factors)[i++] = 2; - } - /* determine all occurrences of uneven prime numbers up to sqrt(num) */ - d = 3; - for(d = 3; (num > 1) && (d <= sqrtnum); d += 2) { - while((num % d) == 0) { - num /= d; - (*factors)[i++] = d; - } - } - /* as we looped only up to sqrt(num) one factor > sqrt(num) may be left over */ - if(num != 1) { - (*factors)[i++] = num; - } - (*nfactors) = i; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/dims_create.c.in b/ompi/mpi/c/dims_create.c.in new file mode 100644 index 00000000000..a669173e085 --- /dev/null +++ b/ompi/mpi/c/dims_create.c.in @@ -0,0 +1,242 @@ +/* + * 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-2014 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) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014 Intel, Inc. All rights reserved + * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2016 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +/* static functions */ +static int assignnodes(int ndim, int nfactor, int *pfacts,int **pdims); +static int getfactors(int num, int *nfators, int **factors); + +/* + * assignnodes + * + * Function: - assign processes to dimensions + * - get "best-balanced" grid + * - greedy bin-packing algorithm used + * - sort dimensions in decreasing order + * - dimensions array dynamically allocated + * Accepts: - # of dimensions + * - # of prime factors + * - array of prime factors + * - ptr to array of dimensions (returned value) + * Returns: - 0 or ERROR + */ +static int assignnodes(int ndim, int nfactor, int *pfacts, int **pdims) +{ + int *bins; + int i, j; + int n; + int f; + int *p; + int *pmin; + + if (0 >= ndim) { + return MPI_ERR_DIMS; + } + + /* Allocate and initialize the bins */ + bins = (int *) malloc((unsigned) ndim * sizeof(int)); + if (NULL == bins) { + return MPI_ERR_NO_MEM; + } + *pdims = bins; + + for (i = 0, p = bins; i < ndim; ++i, ++p) { + *p = 1; + } + + /* Loop assigning factors from the highest to the lowest */ + for (j = nfactor - 1; j >= 0; --j) { + f = pfacts[j]; + /* Assign a factor to the smallest bin */ + pmin = bins; + for (i = 1, p = pmin + 1; i < ndim; ++i, ++p) { + if (*p < *pmin) { + pmin = p; + } + } + *pmin *= f; + } + + /* Sort dimensions in decreasing order (O(n^2) for now) */ + for (i = 0, pmin = bins; i < ndim - 1; ++i, ++pmin) { + for (j = i + 1, p = pmin + 1; j < ndim; ++j, ++p) { + if (*p > *pmin) { + n = *p; + *p = *pmin; + *pmin = n; + } + } + } + + return MPI_SUCCESS; +} + +/* + * getfactors + * + * Function: - factorize a number + * Accepts: - number + * - # prime factors + * - array of prime factors + * Returns: - MPI_SUCCESS or ERROR + */ +static int getfactors(int num, int *nfactors, int **factors) { + int size; + int d; + int i; + int sqrtnum; + + if(num < 2) { + (*nfactors) = 0; + (*factors) = NULL; + return MPI_SUCCESS; + } + /* Allocate the array of prime factors which cannot exceed log_2(num) entries */ + sqrtnum = ceil(sqrt(num)); + size = ceil(log(num) / log(2)); + *factors = (int *) malloc((unsigned) size * sizeof(int)); + + i = 0; + /* determine all occurrences of factor 2 */ + while((num % 2) == 0) { + num /= 2; + (*factors)[i++] = 2; + } + /* determine all occurrences of uneven prime numbers up to sqrt(num) */ + d = 3; + for(d = 3; (num > 1) && (d <= sqrtnum); d += 2) { + while((num % d) == 0) { + num /= d; + (*factors)[i++] = d; + } + } + /* as we looped only up to sqrt(num) one factor > sqrt(num) may be left over */ + if(num != 1) { + (*factors)[i++] = num; + } + (*nfactors) = i; + return MPI_SUCCESS; +} + +/* + * This is a utility function, no need to have anything in the lower + * layer for this at all + */ +PROTOTYPE ERROR_CLASS dims_create(INT nnodes, INT ndims, INT_OUT dims) +{ + int i; + int freeprocs; + int freedims; + int nfactors; + int *factors; + int *procs; + int *p; + int err; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (0 > ndims) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, + MPI_ERR_DIMS, FUNC_NAME); + } + + if ((0 != ndims) && (NULL == dims)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, + MPI_ERR_ARG, FUNC_NAME); + } + + if (1 > nnodes) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, + MPI_ERR_DIMS, FUNC_NAME); + } + } + + /* Get # of free-to-be-assigned processes and # of free dimensions */ + freeprocs = nnodes; + freedims = 0; + for (i = 0, p = dims; i < ndims; ++i,++p) { + if (*p == 0) { + ++freedims; + } else if ((*p < 0) || ((nnodes % *p) != 0)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_DIMS, + FUNC_NAME); + } else { + freeprocs /= *p; + } + } + + if (freedims == 0) { + if (freeprocs == 1) { + return MPI_SUCCESS; + } + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_DIMS, + FUNC_NAME); + } + + if (freeprocs == 1) { + for (i = 0; i < ndims; ++i, ++dims) { + if (*dims == 0) { + *dims = 1; + } + } + return MPI_SUCCESS; + } + /* Factor the number of free processes */ + if (MPI_SUCCESS != (err = getfactors(freeprocs, &nfactors, &factors))) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(err, + FUNC_NAME); + } + + /* Assign free processes to free dimensions */ + if (MPI_SUCCESS != (err = assignnodes(freedims, nfactors, factors, &procs))) { + free(factors); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(err, + FUNC_NAME); + } + + /* Return assignment results */ + p = procs; + for (i = 0; i < ndims; ++i, ++dims) { + if (*dims == 0) { + *dims = *p++; + } + } + + free((char *) factors); + free((char *) procs); + + /* all done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/dist_graph_create.c b/ompi/mpi/c/dist_graph_create.c deleted file mode 100644 index 22234916a1d..00000000000 --- a/ompi/mpi/c/dist_graph_create.c +++ /dev/null @@ -1,107 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2012-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Dist_graph_create = PMPI_Dist_graph_create -#endif -#define MPI_Dist_graph_create PMPI_Dist_graph_create -#endif - -static const char FUNC_NAME[] = "MPI_Dist_graph_create"; - -int MPI_Dist_graph_create(MPI_Comm comm_old, int n, const int sources[], - const int degrees[], const int destinations[], const int weights[], - MPI_Info info, int reorder, MPI_Comm * newcomm) -{ - mca_topo_base_module_t* topo; - int i, j, index, err, comm_size; - - MEMCHECKER( - memchecker_comm(comm_old); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm_old)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (OMPI_COMM_IS_INTER(comm_old)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (n < 0 || NULL == newcomm) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, FUNC_NAME); - } else if (n > 0 && (NULL == sources || NULL == degrees || - NULL == destinations || NULL == weights)) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, FUNC_NAME); - } - /* Ensure the arrays are full of valid-valued integers */ - comm_size = ompi_comm_size(comm_old); - for( i = index = 0; i < n; ++i ) { - if (((sources[i] < 0) && (sources[i] != MPI_PROC_NULL)) || sources[i] >= comm_size) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - FUNC_NAME); - } else if (degrees[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - FUNC_NAME); - } - for( j = 0; j < degrees[i]; ++j ) { - if (((destinations[index] < 0) && (destinations[index] != MPI_PROC_NULL)) || destinations[index] >= comm_size) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - FUNC_NAME); - } else if (MPI_UNWEIGHTED != weights && weights[index] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - FUNC_NAME); - } - index++; - } - } - } - - /* Ensure there is a topo attached to this communicator */ - if(OMPI_SUCCESS != (err = mca_topo_base_comm_select(comm_old, NULL, - &topo, OMPI_COMM_DIST_GRAPH))) { - return OMPI_ERRHANDLER_INVOKE(comm_old, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm_old, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); - } -#endif - - err = topo->topo.dist_graph.dist_graph_create(topo, comm_old, n, sources, degrees, - destinations, weights, &(info->super), - reorder, newcomm); - OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/dist_graph_create.c.in b/ompi/mpi/c/dist_graph_create.c.in new file mode 100644 index 00000000000..693ffb8ac8d --- /dev/null +++ b/ompi/mpi/c/dist_graph_create.c.in @@ -0,0 +1,100 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2012-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" + +PROTOTYPE ERROR_CLASS dist_graph_create(COMM comm_old, INT n, INT_ARRAY sources, + INT_ARRAY degrees, INT_ARRAY destinations, INT_ARRAY weights, + INFO info, INT reorder, COMM_OUT newcomm) +{ + mca_topo_base_module_t* topo; + int i, j, index, err, comm_size; + + MEMCHECKER( + memchecker_comm(comm_old); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm_old)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (OMPI_COMM_IS_INTER(comm_old)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (n < 0 || NULL == newcomm) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, FUNC_NAME); + } else if (n > 0 && (NULL == sources || NULL == degrees || + NULL == destinations || NULL == weights)) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, FUNC_NAME); + } + /* Ensure the arrays are full of valid-valued integers */ + comm_size = ompi_comm_size(comm_old); + for( i = index = 0; i < n; ++i ) { + if (((sources[i] < 0) && (sources[i] != MPI_PROC_NULL)) || sources[i] >= comm_size) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + FUNC_NAME); + } else if (degrees[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + FUNC_NAME); + } + for( j = 0; j < degrees[i]; ++j ) { + if (((destinations[index] < 0) && (destinations[index] != MPI_PROC_NULL)) || destinations[index] >= comm_size) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + FUNC_NAME); + } else if (MPI_UNWEIGHTED != weights && weights[index] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + FUNC_NAME); + } + index++; + } + } + } + + /* Ensure there is a topo attached to this communicator */ + if(OMPI_SUCCESS != (err = mca_topo_base_comm_select(comm_old, NULL, + &topo, OMPI_COMM_DIST_GRAPH))) { + return OMPI_ERRHANDLER_INVOKE(comm_old, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm_old, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); + } +#endif + + err = topo->topo.dist_graph.dist_graph_create(topo, comm_old, n, sources, degrees, + destinations, weights, &(info->super), + reorder, newcomm); + OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/dist_graph_create_adjacent.c b/ompi/mpi/c/dist_graph_create_adjacent.c deleted file mode 100644 index a21070b214d..00000000000 --- a/ompi/mpi/c/dist_graph_create_adjacent.c +++ /dev/null @@ -1,119 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2008 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2011-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2014 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * Author(s): Torsten Hoefler - * - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Dist_graph_create_adjacent = PMPI_Dist_graph_create_adjacent -#endif -#define MPI_Dist_graph_create_adjacent PMPI_Dist_graph_create_adjacent -#endif - -static const char FUNC_NAME[] = "MPI_Dist_graph_create_adjacent"; - - -int MPI_Dist_graph_create_adjacent(MPI_Comm comm_old, - int indegree, const int sources[], - const int sourceweights[], int outdegree, - const int destinations[], const int destweights[], - MPI_Info info, int reorder, - MPI_Comm *comm_dist_graph) -{ - mca_topo_base_module_t* topo; - int i, comm_size, err; - - MEMCHECKER( - memchecker_comm(comm_old); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm_old)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (OMPI_COMM_IS_INTER(comm_old)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (indegree < 0 || outdegree < 0 || NULL == comm_dist_graph) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - "MPI_Dist_graph_create_adjacent negative degree"); - } else if ((indegree > 0 && - (NULL == sources || NULL == sourceweights)) || - (outdegree > 0 && - (NULL == destinations || NULL == destweights))) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, "MPI_Dist_graph_create_adjacent mismatched sources or destinations"); - } - comm_size = ompi_comm_size(comm_old); - for (i = 0; i < indegree; ++i) { - if (((sources[i] < 0) && (sources[i] != MPI_PROC_NULL)) || sources[i] >= comm_size) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - "MPI_Dist_graph_create_adjacent invalid sources"); - } else if (MPI_UNWEIGHTED != sourceweights && sourceweights[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - "MPI_Dist_graph_create_adjacent invalid sourceweights"); - } - } - for (i = 0; i < outdegree; ++i) { - if (((destinations[i] < 0) && (destinations[i] != MPI_PROC_NULL)) || destinations[i] >= comm_size) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - "MPI_Dist_graph_create_adjacent invalid destinations"); - } else if (MPI_UNWEIGHTED != destweights && destweights[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, - "MPI_Dist_graph_create_adjacent invalid destweights"); - } - } - } - - /* Ensure there is a topo attached to this communicator */ - if(OMPI_SUCCESS != (err = mca_topo_base_comm_select(comm_old, NULL, - &topo, OMPI_COMM_DIST_GRAPH))) { - return OMPI_ERRHANDLER_INVOKE(comm_old, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm_old, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); - } -#endif - - err = topo->topo.dist_graph.dist_graph_create_adjacent(topo, comm_old, indegree, - sources, sourceweights, outdegree, - destinations, destweights, &(info->super), - reorder, comm_dist_graph); - OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/dist_graph_create_adjacent.c.in b/ompi/mpi/c/dist_graph_create_adjacent.c.in new file mode 100644 index 00000000000..3423f7dd607 --- /dev/null +++ b/ompi/mpi/c/dist_graph_create_adjacent.c.in @@ -0,0 +1,111 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2008 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2011-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * Author(s): Torsten Hoefler + * + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" + +PROTOTYPE ERROR_CLASS dist_graph_create_adjacent(COMM comm_old, + INT indegree, INT_ARRAY sources, + INT_ARRAY sourceweights, INT outdegree, + INT_ARRAY destinations, INT_ARRAY destweights, + INFO info, INT reorder, + COMM_OUT comm_dist_graph) +{ + mca_topo_base_module_t* topo; + int i, comm_size, err; + + MEMCHECKER( + memchecker_comm(comm_old); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm_old)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (OMPI_COMM_IS_INTER(comm_old)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (indegree < 0 || outdegree < 0 || NULL == comm_dist_graph) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + "MPI_Dist_graph_create_adjacent negative degree"); + } else if ((indegree > 0 && + (NULL == sources || NULL == sourceweights)) || + (outdegree > 0 && + (NULL == destinations || NULL == destweights))) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, "MPI_Dist_graph_create_adjacent mismatched sources or destinations"); + } + comm_size = ompi_comm_size(comm_old); + for (i = 0; i < indegree; ++i) { + if (((sources[i] < 0) && (sources[i] != MPI_PROC_NULL)) || sources[i] >= comm_size) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + "MPI_Dist_graph_create_adjacent invalid sources"); + } else if (MPI_UNWEIGHTED != sourceweights && sourceweights[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + "MPI_Dist_graph_create_adjacent invalid sourceweights"); + } + } + for (i = 0; i < outdegree; ++i) { + if (((destinations[i] < 0) && (destinations[i] != MPI_PROC_NULL)) || destinations[i] >= comm_size) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + "MPI_Dist_graph_create_adjacent invalid destinations"); + } else if (MPI_UNWEIGHTED != destweights && destweights[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm_old, MPI_ERR_ARG, + "MPI_Dist_graph_create_adjacent invalid destweights"); + } + } + } + + /* Ensure there is a topo attached to this communicator */ + if(OMPI_SUCCESS != (err = mca_topo_base_comm_select(comm_old, NULL, + &topo, OMPI_COMM_DIST_GRAPH))) { + return OMPI_ERRHANDLER_INVOKE(comm_old, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(comm_old, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); + } +#endif + + err = topo->topo.dist_graph.dist_graph_create_adjacent(topo, comm_old, indegree, + sources, sourceweights, outdegree, + destinations, destweights, &(info->super), + reorder, comm_dist_graph); + OMPI_ERRHANDLER_RETURN(err, comm_old, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/dist_graph_neighbors.c b/ompi/mpi/c/dist_graph_neighbors.c deleted file mode 100644 index bbe86ce189b..00000000000 --- a/ompi/mpi/c/dist_graph_neighbors.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2008 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2012-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Dist_graph_neighbors = PMPI_Dist_graph_neighbors -#endif -#define MPI_Dist_graph_neighbors PMPI_Dist_graph_neighbors -#endif - -static const char FUNC_NAME[] = "MPI_Dist_graph_neighbors"; - - -int MPI_Dist_graph_neighbors(MPI_Comm comm, int maxindegree, - int sources[], int sourceweights[], - int maxoutdegree, int destinations[], - int destweights[]) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (maxindegree < 0 || maxoutdegree < 0 || - (maxindegree > 0 && - (NULL == sources || NULL == sourceweights)) || - (maxoutdegree > 0 && - (NULL == destinations || NULL == destweights))) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_DIST_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.dist_graph.dist_graph_neighbors(comm, maxindegree, - sources, sourceweights, maxoutdegree, - destinations, destweights); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/dist_graph_neighbors.c.in b/ompi/mpi/c/dist_graph_neighbors.c.in new file mode 100644 index 00000000000..29c9427e5b1 --- /dev/null +++ b/ompi/mpi/c/dist_graph_neighbors.c.in @@ -0,0 +1,65 @@ +/* + * Copyright (c) 2008 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2012-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * Additional copyrights may follow + * + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" + +PROTOTYPE ERROR_CLASS dist_graph_neighbors(COMM comm, INT maxindegree, + INT_OUT sources, INT_OUT sourceweights, + INT maxoutdegree, INT_OUT destinations, + INT_OUT destweights) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (maxindegree < 0 || maxoutdegree < 0 || + (maxindegree > 0 && + (NULL == sources || NULL == sourceweights)) || + (maxoutdegree > 0 && + (NULL == destinations || NULL == destweights))) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_DIST_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.dist_graph.dist_graph_neighbors(comm, maxindegree, + sources, sourceweights, maxoutdegree, + destinations, destweights); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/dist_graph_neighbors_count.c b/ompi/mpi/c/dist_graph_neighbors_count.c deleted file mode 100644 index 3a9f8c75d57..00000000000 --- a/ompi/mpi/c/dist_graph_neighbors_count.c +++ /dev/null @@ -1,68 +0,0 @@ -/* - * Copyright (c) 2008 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2011-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - */ -#include -#include - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Dist_graph_neighbors_count = PMPI_Dist_graph_neighbors_count -#endif -#define MPI_Dist_graph_neighbors_count PMPI_Dist_graph_neighbors_count -#endif - -static const char FUNC_NAME[] = "MPI_Dist_graph_neighbors_count"; - - -int MPI_Dist_graph_neighbors_count(MPI_Comm comm, int *inneighbors, - int *outneighbors, int *weighted) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (NULL == inneighbors || NULL == outneighbors || - NULL == weighted) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_DIST_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - err = comm->c_topo->topo.dist_graph.dist_graph_neighbors_count(comm, inneighbors, - outneighbors, weighted); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/dist_graph_neighbors_count.c.in b/ompi/mpi/c/dist_graph_neighbors_count.c.in new file mode 100644 index 00000000000..51e3843a337 --- /dev/null +++ b/ompi/mpi/c/dist_graph_neighbors_count.c.in @@ -0,0 +1,60 @@ +/* + * Copyright (c) 2008 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2011-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * Additional copyrights may follow + * + */ +#include +#include + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" + +PROTOTYPE ERROR_CLASS dist_graph_neighbors_count(COMM comm, INT_OUT inneighbors, + INT_OUT outneighbors, INT_OUT weighted) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (NULL == inneighbors || NULL == outneighbors || + NULL == weighted) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_DIST_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + err = comm->c_topo->topo.dist_graph.dist_graph_neighbors_count(comm, inneighbors, + outneighbors, weighted); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/errhandler_c2f.c b/ompi/mpi/c/errhandler_c2f.c deleted file mode 100644 index 7abd3116f81..00000000000 --- a/ompi/mpi/c/errhandler_c2f.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 2006-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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Errhandler_c2f = PMPI_Errhandler_c2f -#endif -#define MPI_Errhandler_c2f PMPI_Errhandler_c2f -#endif - -static const char FUNC_NAME[] __opal_attribute_unused__ = "MPI_Errhandler_c2f"; - - -MPI_Fint MPI_Errhandler_c2f(MPI_Errhandler errhandler) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - /* mapping an invalid handle to a null handle */ - if (NULL == errhandler) { - return OMPI_INT_2_FINT(-1); - } - } - - - return OMPI_INT_2_FINT(errhandler->eh_f_to_c_index); -} diff --git a/ompi/mpi/c/errhandler_c2f.c.in b/ompi/mpi/c/errhandler_c2f.c.in new file mode 100644 index 00000000000..b563a49c333 --- /dev/null +++ b/ompi/mpi/c/errhandler_c2f.c.in @@ -0,0 +1,44 @@ +/* + * Copyright (c) 2004-2007 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE FINT errhandler_c2f(ERRHANDLER errhandler) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + /* mapping an invalid handle to a null handle */ + if (NULL == errhandler) { + return OMPI_INT_2_FINT(-1); + } + } + + + return OMPI_INT_2_FINT(errhandler->eh_f_to_c_index); +} diff --git a/ompi/mpi/c/errhandler_f2c.c b/ompi/mpi/c/errhandler_f2c.c deleted file mode 100644 index 8ec5dd2527e..00000000000 --- a/ompi/mpi/c/errhandler_f2c.c +++ /dev/null @@ -1,82 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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) 2020-2021 Triad National Security, LLC. - * All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Errhandler_f2c = PMPI_Errhandler_f2c -#endif -#define MPI_Errhandler_f2c PMPI_Errhandler_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Errhandler_f2c"; - - -MPI_Errhandler MPI_Errhandler_f2c(MPI_Fint errhandler_f) -{ - int eh_index = OMPI_FINT_2_INT(errhandler_f); - MPI_Errhandler c_err_handler; - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - /* - * special cases for MPI_ERRORS_ARE_FATAL and MPI_ERRORS_RETURN - - * needed for MPI 4.0 - */ - - switch(eh_index) { - case OMPI_ERRHANDLER_NULL_FORTRAN: - c_err_handler = MPI_ERRHANDLER_NULL; - break; - case OMPI_ERRORS_ARE_FATAL_FORTRAN: - c_err_handler = MPI_ERRORS_ARE_FATAL; - break; - case OMPI_ERRORS_RETURN_FORTRAN: - c_err_handler = MPI_ERRORS_RETURN; - break; - default: - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - if (eh_index < 0 || - eh_index >= - opal_pointer_array_get_size(&ompi_errhandler_f_to_c_table)) { - c_err_handler = NULL; - } else { - c_err_handler = (MPI_Errhandler)opal_pointer_array_get_item(&ompi_errhandler_f_to_c_table, - eh_index); - } - break; - } - - return c_err_handler; -} diff --git a/ompi/mpi/c/errhandler_f2c.c.in b/ompi/mpi/c/errhandler_f2c.c.in new file mode 100644 index 00000000000..464ad3cf337 --- /dev/null +++ b/ompi/mpi/c/errhandler_f2c.c.in @@ -0,0 +1,72 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2020-2024 Triad National Security, LLC. + * All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE ERRHANDLER errhandler_f2c(FINT errhandler_f) +{ + int eh_index = OMPI_FINT_2_INT(errhandler_f); + MPI_Errhandler c_err_handler; + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + /* + * special cases for MPI_ERRORS_ARE_FATAL and MPI_ERRORS_RETURN - + * needed for MPI 4.0 + */ + + switch(eh_index) { + case OMPI_ERRHANDLER_NULL_FORTRAN: + c_err_handler = MPI_ERRHANDLER_NULL; + break; + case OMPI_ERRORS_ARE_FATAL_FORTRAN: + c_err_handler = MPI_ERRORS_ARE_FATAL; + break; + case OMPI_ERRORS_RETURN_FORTRAN: + c_err_handler = MPI_ERRORS_RETURN; + break; + default: + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + if (eh_index < 0 || + eh_index >= + opal_pointer_array_get_size(&ompi_errhandler_f_to_c_table)) { + c_err_handler = NULL; + } else { + c_err_handler = (MPI_Errhandler)opal_pointer_array_get_item(&ompi_errhandler_f_to_c_table, + eh_index); + } + break; + } + + return c_err_handler; +} diff --git a/ompi/mpi/c/errhandler_free.c b/ompi/mpi/c/errhandler_free.c deleted file mode 100644 index 2e5a3c6997a..00000000000 --- a/ompi/mpi/c/errhandler_free.c +++ /dev/null @@ -1,79 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Errhandler_free = PMPI_Errhandler_free -#endif -#define MPI_Errhandler_free PMPI_Errhandler_free -#endif - -static const char FUNC_NAME[] __opal_attribute_unused__ = "MPI_Errhandler_free"; - - -int MPI_Errhandler_free(MPI_Errhandler *errhandler) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - /* Raise an MPI exception if we got NULL or if we got an intrinsic - *and* the reference count is 1 (meaning that this FREE would - actually free the underlying intrinsic object). This is ugly - but necessary -- see below. */ - if (NULL == errhandler || - (ompi_errhandler_is_intrinsic(*errhandler) && - 1 == (*errhandler)->super.obj_reference_count)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - "MPI_Errhandler_free"); - } - } - - /* Return the errhandler. According to MPI-2 errata, any errhandler - obtained by MPI_*_GET_ERRHANDLER or MPI_ERRHANDLER_GET must also - be freed by MPI_ERRHANDLER_FREE (including intrinsic error - handlers). For example, this is valid: - - int main() { - MPI_Errhandler errhdl; - MPI_Init(NULL, NULL); - MPI_Comm_get_errhandler(MPI_COMM_WORLD, &errhdl); - MPI_Errhandler_free(&errhdl); - MPI_Finalize(); - return 0; - } - - So decrease the refcount here. */ - - ompi_errhandler_free (*errhandler); - *errhandler = MPI_ERRHANDLER_NULL; - - /* All done */ - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/errhandler_free.c.in b/ompi/mpi/c/errhandler_free.c.in new file mode 100644 index 00000000000..8f888f1965e --- /dev/null +++ b/ompi/mpi/c/errhandler_free.c.in @@ -0,0 +1,69 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS errhandler_free(ERRHANDLER_OUT errhandler) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + /* Raise an MPI exception if we got NULL or if we got an intrinsic + *and* the reference count is 1 (meaning that this FREE would + actually free the underlying intrinsic object). This is ugly + but necessary -- see below. */ + if (NULL == errhandler || + (ompi_errhandler_is_intrinsic(*errhandler) && + 1 == (*errhandler)->super.obj_reference_count)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + "MPI_Errhandler_free"); + } + } + + /* Return the errhandler. According to MPI-2 errata, any errhandler + obtained by MPI_*_GET_ERRHANDLER or MPI_ERRHANDLER_GET must also + be freed by MPI_ERRHANDLER_FREE (including intrinsic error + handlers). For example, this is valid: + + int main() { + MPI_Errhandler errhdl; + MPI_Init(NULL, NULL); + MPI_Comm_get_errhandler(MPI_COMM_WORLD, &errhdl); + MPI_Errhandler_free(&errhdl); + MPI_Finalize(); + return 0; + } + + So decrease the refcount here. */ + + ompi_errhandler_free (*errhandler); + *errhandler = MPI_ERRHANDLER_NULL; + + /* All done */ + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/error_class.c b/ompi/mpi/c/error_class.c deleted file mode 100644 index a1e3c87144a..00000000000 --- a/ompi/mpi/c/error_class.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/errhandler/errcode.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Error_class = PMPI_Error_class -#endif -#define MPI_Error_class PMPI_Error_class -#endif - -static const char FUNC_NAME[] = "MPI_Error_class"; - - -int MPI_Error_class(int errorcode, int *errorclass) -{ - int ret; - - /* make sure the infrastructure is initialized */ - ret = ompi_mpi_instance_retain (); - if (OPAL_UNLIKELY(OMPI_SUCCESS != ret)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); - } - - if ( MPI_PARAM_CHECK ) { - if ( ompi_mpi_errcode_is_invalid(errorcode)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - - *errorclass = ompi_mpi_errcode_get_class(errorcode); - ompi_mpi_instance_release (); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/error_class.c.in b/ompi/mpi/c/error_class.c.in new file mode 100644 index 00000000000..28a3116126b --- /dev/null +++ b/ompi/mpi/c/error_class.c.in @@ -0,0 +1,53 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" + +PROTOTYPE ERROR_CLASS error_class(INT errorcode, INT_OUT errorclass) +{ + int ret; + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + if (OPAL_UNLIKELY(OMPI_SUCCESS != ret)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); + } + + if ( MPI_PARAM_CHECK ) { + if ( ompi_mpi_errcode_is_invalid(errorcode)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + + *errorclass = ompi_mpi_errcode_get_class(errorcode); + ompi_mpi_instance_release (); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/error_string.c b/ompi/mpi/c/error_string.c deleted file mode 100644 index f3a12b6ce91..00000000000 --- a/ompi/mpi/c/error_string.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Cisco Systems, Inc. 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 "opal/util/string_copy.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/errhandler/errcode.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Error_string = PMPI_Error_string -#endif -#define MPI_Error_string PMPI_Error_string -#endif - -static const char FUNC_NAME[] = "MPI_Error_string"; - - -int MPI_Error_string(int errorcode, char *string, int *resultlen) -{ - int ret; - char *tmpstring; - - /* make sure the infrastructure is initialized */ - ret = ompi_mpi_instance_retain (); - if (OPAL_UNLIKELY(OMPI_SUCCESS != ret)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, - FUNC_NAME); - } - - if ( MPI_PARAM_CHECK ) { - if ( ompi_mpi_errcode_is_invalid(errorcode)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - tmpstring = ompi_mpi_errnum_get_string (errorcode); - opal_string_copy(string, tmpstring, MPI_MAX_ERROR_STRING); - *resultlen = (int)strlen(string); - - ompi_mpi_instance_release(); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/error_string.c.in b/ompi/mpi/c/error_string.c.in new file mode 100644 index 00000000000..0b3bf36edbe --- /dev/null +++ b/ompi/mpi/c/error_string.c.in @@ -0,0 +1,62 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/util/string_copy.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/errhandler/errcode.h" + +PROTOTYPE ERROR_CLASS error_string(INT errorcode, STRING_OUT string, + INT_OUT resultlen) +{ + int ret; + char *tmpstring; + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + if (OPAL_UNLIKELY(OMPI_SUCCESS != ret)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, + FUNC_NAME); + } + + if ( MPI_PARAM_CHECK ) { + if ( ompi_mpi_errcode_is_invalid(errorcode)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + tmpstring = ompi_mpi_errnum_get_string (errorcode); + opal_string_copy(string, tmpstring, MPI_MAX_ERROR_STRING); + *resultlen = (int)strlen(string); + + ompi_mpi_instance_release(); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/exscan.c b/ompi/mpi/c/exscan.c deleted file mode 100644 index 812812a97b6..00000000000 --- a/ompi/mpi/c/exscan.c +++ /dev/null @@ -1,114 +0,0 @@ -/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Exscan = PMPI_Exscan -#endif -#define MPI_Exscan PMPI_Exscan -#endif - -static const char FUNC_NAME[] = "MPI_Exscan"; - - -int MPI_Exscan(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_EXSCAN, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - if (MPI_IN_PLACE != sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation -- same checks for intracommunicators - and intercommunicators */ - else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? (MPI says that reductions have to - have a count of at least 1, but at least IMB calls reduce with - a count of 0 -- blah!) */ - - if (0 == count) { - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - OBJ_RETAIN(op); - err = comm->c_coll->coll_exscan(sendbuf, recvbuf, count, - datatype, op, comm, - comm->c_coll->coll_exscan_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/exscan.c.in b/ompi/mpi/c/exscan.c.in new file mode 100644 index 00000000000..0268810658c --- /dev/null +++ b/ompi/mpi/c/exscan.c.in @@ -0,0 +1,106 @@ +/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS exscan(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_EXSCAN, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + if (MPI_IN_PLACE != sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation -- same checks for intracommunicators + and intercommunicators */ + else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? (MPI says that reductions have to + have a count of at least 1, but at least IMB calls reduce with + a count of 0 -- blah!) */ + + if (0 == count) { + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + OBJ_RETAIN(op); + err = comm->c_coll->coll_exscan(sendbuf, recvbuf, count, + datatype, op, comm, + comm->c_coll->coll_exscan_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/exscan_init.c b/ompi/mpi/c/exscan_init.c deleted file mode 100644 index 9c18eade276..00000000000 --- a/ompi/mpi/c/exscan_init.c +++ /dev/null @@ -1,92 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Exscan_init = PMPI_Exscan_init -#endif -#define MPI_Exscan_init PMPI_Exscan_init -#endif - -static const char FUNC_NAME[] = "MPI_Exscan_init"; - - -int MPI_Exscan_init(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_EXSCAN_INIT, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation -- same checks for intracommunicators - and intercommunicators */ - else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_exscan_init(sendbuf, recvbuf, count, - datatype, op, comm, info, request, - comm->c_coll->coll_exscan_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/exscan_init.c.in b/ompi/mpi/c/exscan_init.c.in new file mode 100644 index 00000000000..7f155d78fe0 --- /dev/null +++ b/ompi/mpi/c/exscan_init.c.in @@ -0,0 +1,84 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS exscan_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_EXSCAN_INIT, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation -- same checks for intracommunicators + and intercommunicators */ + else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_exscan_init(sendbuf, recvbuf, count, + datatype, op, comm, info, request, + comm->c_coll->coll_exscan_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/fetch_and_op.c b/ompi/mpi/c/fetch_and_op.c deleted file mode 100644 index 47d61e403d2..00000000000 --- a/ompi/mpi/c/fetch_and_op.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2015 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Fetch_and_op = PMPI_Fetch_and_op -#endif -#define MPI_Fetch_and_op PMPI_Fetch_and_op -#endif - -static const char FUNC_NAME[] = "MPI_Fetch_and_op"; - - -int MPI_Fetch_and_op(const void *origin_addr, void *result_addr, MPI_Datatype datatype, - int target_rank, MPI_Aint target_disp, MPI_Op op, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1); - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; - - rc = win->w_osc_module->osc_fetch_and_op(origin_addr, result_addr, datatype, - target_rank, target_disp, op, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/fetch_and_op.c.in b/ompi/mpi/c/fetch_and_op.c.in new file mode 100644 index 00000000000..5d26f2ca187 --- /dev/null +++ b/ompi/mpi/c/fetch_and_op.c.in @@ -0,0 +1,66 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" + +PROTOTYPE ERROR_CLASS fetch_and_op(BUFFER origin_addr, BUFFER_OUT result_addr, DATATYPE datatype, + INT target_rank, AINT target_disp, OP op, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, datatype, 1); + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; + + rc = win->w_osc_module->osc_fetch_and_op(origin_addr, result_addr, datatype, + target_rank, target_disp, op, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_c2f.c b/ompi/mpi/c/file_c2f.c deleted file mode 100644 index 3ba4d40c5c9..00000000000 --- a/ompi/mpi/c/file_c2f.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_c2f = PMPI_File_c2f -#endif -#define MPI_File_c2f PMPI_File_c2f -#endif - -static const char FUNC_NAME[] = "MPI_File_c2f"; - - -MPI_Fint MPI_File_c2f(MPI_File file) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that ompi_file_invalid() explicitly checks for - MPI_FILE_NULL, but MPI_FILE_C2F is supposed to treat - MPI_FILE_NULL as a valid file (and therefore return a valid - Fortran handle for it). Hence, this function should not - return an error if MPI_FILE_NULL is passed in. - - See a big comment in ompi/communicator/communicator.h about - this. */ - if (ompi_file_invalid(file) && MPI_FILE_NULL != file) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(file->f_f_to_c_index); -} diff --git a/ompi/mpi/c/file_c2f.c.in b/ompi/mpi/c/file_c2f.c.in new file mode 100644 index 00000000000..509c0216aac --- /dev/null +++ b/ompi/mpi/c/file_c2f.c.in @@ -0,0 +1,51 @@ +/* + * Copyright (c) 2004-2007 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) 2006-2012 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/file/file.h" + +PROTOTYPE FINT file_c2f(FILE file) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that ompi_file_invalid() explicitly checks for + MPI_FILE_NULL, but MPI_FILE_C2F is supposed to treat + MPI_FILE_NULL as a valid file (and therefore return a valid + Fortran handle for it). Hence, this function should not + return an error if MPI_FILE_NULL is passed in. + + See a big comment in ompi/communicator/communicator.h about + this. */ + if (ompi_file_invalid(file) && MPI_FILE_NULL != file) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(file->f_f_to_c_index); +} diff --git a/ompi/mpi/c/file_call_errhandler.c b/ompi/mpi/c/file_call_errhandler.c deleted file mode 100644 index 64f2336f7de..00000000000 --- a/ompi/mpi/c/file_call_errhandler.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_call_errhandler = PMPI_File_call_errhandler -#endif -#define MPI_File_call_errhandler PMPI_File_call_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_File_call_errhandler"; - - -int MPI_File_call_errhandler(MPI_File fh, int errorcode) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == fh || - MPI_FILE_NULL == fh) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - /* Invoke the errhandler */ - OMPI_ERRHANDLER_INVOKE(fh, errorcode, FUNC_NAME); - - /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ - return MPI_SUCCESS; - -} diff --git a/ompi/mpi/c/file_call_errhandler.c.in b/ompi/mpi/c/file_call_errhandler.c.in new file mode 100644 index 00000000000..830e3eefc6d --- /dev/null +++ b/ompi/mpi/c/file_call_errhandler.c.in @@ -0,0 +1,49 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_call_errhandler(FILE fh, INT errorcode) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == fh || + MPI_FILE_NULL == fh) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Invoke the errhandler */ + OMPI_ERRHANDLER_INVOKE(fh, errorcode, FUNC_NAME); + + /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ + return MPI_SUCCESS; + +} diff --git a/ompi/mpi/c/file_close.c b/ompi/mpi/c/file_close.c deleted file mode 100644 index 15e3629ca6b..00000000000 --- a/ompi/mpi/c/file_close.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_close = PMPI_File_close -#endif -#define MPI_File_close PMPI_File_close -#endif - -static const char FUNC_NAME[] = "MPI_File_close"; - - -int MPI_File_close(MPI_File *fh) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that MPI-2:9.7 (p265) says that errors in - MPI_FILE_CLOSE should invoke the default error handler on - MPI_FILE_NULL */ - - if (NULL == fh || ompi_file_invalid(*fh)) { - return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, MPI_ERR_FILE, - FUNC_NAME); - } - } - - /* Release the MPI_File; the destructor releases the component, - zeroes out fields, etc. */ - - rc = ompi_file_close(fh); - OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_close.c.in b/ompi/mpi/c/file_close.c.in new file mode 100644 index 00000000000..4111c6a3026 --- /dev/null +++ b/ompi/mpi/c/file_close.c.in @@ -0,0 +1,52 @@ +/* + * Copyright (c) 2004-2007 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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_close(FILE_OUT fh) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that MPI-2:9.7 (p265) says that errors in + MPI_FILE_CLOSE should invoke the default error handler on + MPI_FILE_NULL */ + + if (NULL == fh || ompi_file_invalid(*fh)) { + return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, MPI_ERR_FILE, + FUNC_NAME); + } + } + + /* Release the MPI_File; the destructor releases the component, + zeroes out fields, etc. */ + + rc = ompi_file_close(fh); + OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_create_errhandler.c b/ompi/mpi/c/file_create_errhandler.c deleted file mode 100644 index 4041d00b658..00000000000 --- a/ompi/mpi/c/file_create_errhandler.c +++ /dev/null @@ -1,70 +0,0 @@ -/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_create_errhandler = PMPI_File_create_errhandler -#endif -#define MPI_File_create_errhandler PMPI_File_create_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_File_create_errhandler"; - - -int MPI_File_create_errhandler (MPI_File_errhandler_function *function, - MPI_Errhandler *errhandler) { - int err = MPI_SUCCESS; - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == function || - NULL == errhandler) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - "MPI_File_create_errhandler"); - } - } - - /* Create and cache the errhandler. Sets a refcount of 1. */ - - *errhandler = - ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_FILE, - (ompi_errhandler_generic_handler_fn_t*) function, - OMPI_ERRHANDLER_LANG_C); - if (NULL == *errhandler) { - err = MPI_ERR_INTERN; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, - "MPI_File_create_errhandler"); -} diff --git a/ompi/mpi/c/file_create_errhandler.c.in b/ompi/mpi/c/file_create_errhandler.c.in new file mode 100644 index 00000000000..f5040e98a12 --- /dev/null +++ b/ompi/mpi/c/file_create_errhandler.c.in @@ -0,0 +1,61 @@ +/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_create_errhandler (FILE_ERRHANDLER_FUNCTION function, + ERRHANDLER_OUT errhandler) +{ + int err = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == function || + NULL == errhandler) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + "MPI_File_create_errhandler"); + } + } + + /* Create and cache the errhandler. Sets a refcount of 1. */ + + *errhandler = + ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_FILE, + (ompi_errhandler_generic_handler_fn_t*) function, + OMPI_ERRHANDLER_LANG_C); + if (NULL == *errhandler) { + err = MPI_ERR_INTERN; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, + "MPI_File_create_errhandler"); +} diff --git a/ompi/mpi/c/file_delete.c b/ompi/mpi/c/file_delete.c deleted file mode 100644 index d666544b880..00000000000 --- a/ompi/mpi/c/file_delete.c +++ /dev/null @@ -1,82 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_delete = PMPI_File_delete -#endif -#define MPI_File_delete PMPI_File_delete -#endif - -static const char FUNC_NAME[] = "MPI_File_delete"; - - -int MPI_File_delete(const char *filename, MPI_Info info) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == info || ompi_info_is_freed(info)) { - rc = MPI_ERR_INFO; - } else if (NULL == filename) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME); - } - - /* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) says that - errors in MPI_FILE_OPEN (before the file handle is created) - should invoke the default error handler on MPI_FILE_NULL. - Hence, if we get a file handle out of ompi_file_open(), invoke - the error handler on that. If not, invoke the error handler on - MPI_FILE_NULL. */ - - /* The io framework is only initialized lazily. If it hasn't - already been initialized, do so now (note that MPI_FILE_OPEN - and MPI_FILE_DELETE are the only two places that it will be - initialized). We might want to add a check to see if the - framework is open instead of just incrementing the open count. */ - - if (OMPI_SUCCESS != (rc = mca_base_framework_open(&ompi_io_base_framework, 0))) { - return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); - } - - /* Since there is no MPI_File handle associated with this - function, the MCA has to do a selection and perform the - action */ - rc = mca_io_base_delete(filename, &(info->super)); - OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_delete.c.in b/ompi/mpi/c/file_delete.c.in new file mode 100644 index 00000000000..f85442b50c4 --- /dev/null +++ b/ompi/mpi/c/file_delete.c.in @@ -0,0 +1,74 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/base.h" + +PROTOTYPE ERROR_CLASS file_delete(STRING filename, INFO info) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == info || ompi_info_is_freed(info)) { + rc = MPI_ERR_INFO; + } else if (NULL == filename) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME); + } + + /* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) says that + errors in MPI_FILE_OPEN (before the file handle is created) + should invoke the default error handler on MPI_FILE_NULL. + Hence, if we get a file handle out of ompi_file_open(), invoke + the error handler on that. If not, invoke the error handler on + MPI_FILE_NULL. */ + + /* The io framework is only initialized lazily. If it hasn't + already been initialized, do so now (note that MPI_FILE_OPEN + and MPI_FILE_DELETE are the only two places that it will be + initialized). We might want to add a check to see if the + framework is open instead of just incrementing the open count. */ + + if (OMPI_SUCCESS != (rc = mca_base_framework_open(&ompi_io_base_framework, 0))) { + return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); + } + + /* Since there is no MPI_File handle associated with this + function, the MCA has to do a selection and perform the + action */ + rc = mca_io_base_delete(filename, &(info->super)); + OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_f2c.c b/ompi/mpi/c/file_f2c.c deleted file mode 100644 index 3640a2a9ae5..00000000000 --- a/ompi/mpi/c/file_f2c.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_f2c = PMPI_File_f2c -#endif -#define MPI_File_f2c PMPI_File_f2c -#endif - -static const char FUNC_NAME[] = "MPI_File_f2c"; - - -MPI_File MPI_File_f2c(MPI_Fint file_f) -{ - int file_index = OMPI_FINT_2_INT(file_f); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (file_index < 0 || - file_index >= - opal_pointer_array_get_size(&ompi_file_f_to_c_table)) { - return NULL; - } - - return (MPI_File)opal_pointer_array_get_item(&ompi_file_f_to_c_table, file_index); -} diff --git a/ompi/mpi/c/file_f2c.c.in b/ompi/mpi/c/file_f2c.c.in new file mode 100644 index 00000000000..283f1ff497d --- /dev/null +++ b/ompi/mpi/c/file_f2c.c.in @@ -0,0 +1,52 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/file/file.h" + +PROTOTYPE FILE file_f2c(FINT file_f) +{ + int file_index = OMPI_FINT_2_INT(file_f); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (file_index < 0 || + file_index >= + opal_pointer_array_get_size(&ompi_file_f_to_c_table)) { + return NULL; + } + + return (MPI_File)opal_pointer_array_get_item(&ompi_file_f_to_c_table, file_index); +} diff --git a/ompi/mpi/c/file_get_amode.c b/ompi/mpi/c/file_get_amode.c deleted file mode 100644 index 7c930402090..00000000000 --- a/ompi/mpi/c/file_get_amode.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_amode = PMPI_File_get_amode -#endif -#define MPI_File_get_amode PMPI_File_get_amode -#endif - -static const char FUNC_NAME[] = "MPI_File_get_amode"; - - -int MPI_File_get_amode(MPI_File fh, int *amode) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == amode) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_amode(fh, amode); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_amode.c.in b/ompi/mpi/c/file_get_amode.c.in new file mode 100644 index 00000000000..8fac4fbb98d --- /dev/null +++ b/ompi/mpi/c/file_get_amode.c.in @@ -0,0 +1,63 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_amode(FILE fh, INT_OUT amode) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == amode) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_amode(fh, amode); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_atomicity.c b/ompi/mpi/c/file_get_atomicity.c deleted file mode 100644 index 52929660b71..00000000000 --- a/ompi/mpi/c/file_get_atomicity.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_atomicity = PMPI_File_get_atomicity -#endif -#define MPI_File_get_atomicity PMPI_File_get_atomicity -#endif - -static const char FUNC_NAME[] = "MPI_File_get_atomicity"; - - -int MPI_File_get_atomicity(MPI_File fh, int *flag) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == flag) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_atomicity(fh, flag); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_atomicity.c.in b/ompi/mpi/c/file_get_atomicity.c.in new file mode 100644 index 00000000000..904e7875b18 --- /dev/null +++ b/ompi/mpi/c/file_get_atomicity.c.in @@ -0,0 +1,63 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_atomicity(FILE fh, INT_OUT flag) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == flag) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_atomicity(fh, flag); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_byte_offset.c b/ompi/mpi/c/file_get_byte_offset.c deleted file mode 100644 index fb9713aaba9..00000000000 --- a/ompi/mpi/c/file_get_byte_offset.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_byte_offset = PMPI_File_get_byte_offset -#endif -#define MPI_File_get_byte_offset PMPI_File_get_byte_offset -#endif - -static const char FUNC_NAME[] = "MPI_File_get_byte_offset"; - - -int MPI_File_get_byte_offset(MPI_File fh, MPI_Offset offset, - MPI_Offset *disp) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == disp) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_byte_offset(fh, offset, disp); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_byte_offset.c.in b/ompi/mpi/c/file_get_byte_offset.c.in new file mode 100644 index 00000000000..c86572ee5de --- /dev/null +++ b/ompi/mpi/c/file_get_byte_offset.c.in @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_byte_offset(FILE fh, OFFSET offset, + OFFSET_OUT disp) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == disp) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_byte_offset(fh, offset, disp); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_errhandler.c b/ompi/mpi/c/file_get_errhandler.c deleted file mode 100644 index 8836ec16b62..00000000000 --- a/ompi/mpi/c/file_get_errhandler.c +++ /dev/null @@ -1,80 +0,0 @@ -/* -*- 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-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 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) 2020 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_errhandler = PMPI_File_get_errhandler -#endif -#define MPI_File_get_errhandler PMPI_File_get_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_File_get_errhandler"; - - -int MPI_File_get_errhandler( MPI_File file, MPI_Errhandler *errhandler) -{ - int ret = MPI_SUCCESS; - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) explicitly - says that you are allowed to set the error handler on - MPI_FILE_NULL */ - - if (NULL == file) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_FILE, - "MPI_File_get_errhandler"); - } else if (NULL == errhandler) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - "MPI_File_get_errhandler"); - } - } - - OPAL_THREAD_LOCK(&file->f_lock); - /* Retain the errhandler, corresponding to object refcount - decrease in errhandler_free.c. */ - *errhandler = file->error_handler; - OBJ_RETAIN(file->error_handler); - OPAL_THREAD_UNLOCK(&file->f_lock); - - /* make sure the infrastructure is initialized */ - ret = ompi_mpi_instance_retain (); - - /* All done */ - - return ret; -} diff --git a/ompi/mpi/c/file_get_errhandler.c.in b/ompi/mpi/c/file_get_errhandler.c.in new file mode 100644 index 00000000000..8940b77bb3b --- /dev/null +++ b/ompi/mpi/c/file_get_errhandler.c.in @@ -0,0 +1,70 @@ +/* -*- 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-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 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) 2020-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_errhandler(FILE file, ERRHANDLER_OUT errhandler) +{ + int ret = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that MPI-2:9.7 (p265 in the ps; 261 in the pdf) explicitly + says that you are allowed to set the error handler on + MPI_FILE_NULL */ + + if (NULL == file) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_FILE, + "MPI_File_get_errhandler"); + } else if (NULL == errhandler) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + "MPI_File_get_errhandler"); + } + } + + OPAL_THREAD_LOCK(&file->f_lock); + /* Retain the errhandler, corresponding to object refcount + decrease in errhandler_free.c. */ + *errhandler = file->error_handler; + OBJ_RETAIN(file->error_handler); + OPAL_THREAD_UNLOCK(&file->f_lock); + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + + /* All done */ + + return ret; +} diff --git a/ompi/mpi/c/file_get_group.c b/ompi/mpi/c/file_get_group.c deleted file mode 100644 index 3e09186377b..00000000000 --- a/ompi/mpi/c/file_get_group.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_group = PMPI_File_get_group -#endif -#define MPI_File_get_group PMPI_File_get_group -#endif - -static const char FUNC_NAME[] = "MPI_File_get_group"; - - -int MPI_File_get_group(MPI_File fh, MPI_Group *group) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == group) { - rc = MPI_ERR_GROUP; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Does not need to invoke a back-end io function */ - - rc = ompi_comm_group (fh->f_comm, group); - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_group.c.in b/ompi/mpi/c/file_get_group.c.in new file mode 100644 index 00000000000..cb2ef7ebdf5 --- /dev/null +++ b/ompi/mpi/c/file_get_group.c.in @@ -0,0 +1,51 @@ +/* + * Copyright (c) 2004-2007 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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_group(FILE fh, GROUP_OUT group) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == group) { + rc = MPI_ERR_GROUP; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Does not need to invoke a back-end io function */ + + rc = ompi_comm_group (fh->f_comm, group); + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_info.c b/ompi/mpi/c/file_get_info.c deleted file mode 100644 index 429da4af303..00000000000 --- a/ompi/mpi/c/file_get_info.c +++ /dev/null @@ -1,92 +0,0 @@ -/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2019 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_info = PMPI_File_get_info -#endif -#define MPI_File_get_info PMPI_File_get_info -#endif - -static const char FUNC_NAME[] = "MPI_File_get_info"; - - -int MPI_File_get_info(MPI_File fh, MPI_Info *info_used) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == info_used) { - return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO, FUNC_NAME); - } - if (ompi_file_invalid(fh)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - } - -// Some components we're still letting handle info internally, eg romio321. -// Components that want to handle it themselves will fill in the get/set -// info function pointers, components that don't will use NULL. - if (fh->f_io_selected_module.v3_0_0.io_module_file_get_info != NULL) { - int rc; - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_info(fh, info_used); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); - } - - if (NULL == fh->super.s_info) { - /* - * Setup any defaults if MPI_Win_set_info was never called - */ - opal_infosubscribe_change_info(&fh->super, &MPI_INFO_NULL->super); - } - - - *info_used = ompi_info_allocate (); - if (NULL == *info_used) { - return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_NO_MEM, FUNC_NAME); - } - opal_info_t *opal_info_used = &(*info_used)->super; - - opal_info_dup_public(fh->super.s_info, &opal_info_used); - - return OMPI_SUCCESS; -} diff --git a/ompi/mpi/c/file_get_info.c.in b/ompi/mpi/c/file_get_info.c.in new file mode 100644 index 00000000000..9d158e11bc3 --- /dev/null +++ b/ompi/mpi/c/file_get_info.c.in @@ -0,0 +1,82 @@ +/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2019 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_info(FILE fh, INFO_OUT info_used) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == info_used) { + return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO, FUNC_NAME); + } + if (ompi_file_invalid(fh)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + } + +// Some components we're still letting handle info internally, eg romio321. +// Components that want to handle it themselves will fill in the get/set +// info function pointers, components that don't will use NULL. + if (fh->f_io_selected_module.v3_0_0.io_module_file_get_info != NULL) { + int rc; + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_info(fh, info_used); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); + } + + if (NULL == fh->super.s_info) { + /* + * Setup any defaults if MPI_Win_set_info was never called + */ + opal_infosubscribe_change_info(&fh->super, &MPI_INFO_NULL->super); + } + + + *info_used = ompi_info_allocate (); + if (NULL == *info_used) { + return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_NO_MEM, FUNC_NAME); + } + opal_info_t *opal_info_used = &(*info_used)->super; + + opal_info_dup_public(fh->super.s_info, &opal_info_used); + + return OMPI_SUCCESS; +} diff --git a/ompi/mpi/c/file_get_position.c b/ompi/mpi/c/file_get_position.c deleted file mode 100644 index c5627f43c6d..00000000000 --- a/ompi/mpi/c/file_get_position.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_position = PMPI_File_get_position -#endif -#define MPI_File_get_position PMPI_File_get_position -#endif - -static const char FUNC_NAME[] = "MPI_File_get_position"; - - -int MPI_File_get_position(MPI_File fh, MPI_Offset *offset) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == offset) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_position(fh, offset); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_position.c.in b/ompi/mpi/c/file_get_position.c.in new file mode 100644 index 00000000000..ff36d078fab --- /dev/null +++ b/ompi/mpi/c/file_get_position.c.in @@ -0,0 +1,63 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_position(FILE fh, OFFSET_OUT offset) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == offset) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_position(fh, offset); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_position_shared.c b/ompi/mpi/c/file_get_position_shared.c deleted file mode 100644 index b094a002a72..00000000000 --- a/ompi/mpi/c/file_get_position_shared.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_position_shared = PMPI_File_get_position_shared -#endif -#define MPI_File_get_position_shared PMPI_File_get_position_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_get_position_shared"; - - -int MPI_File_get_position_shared(MPI_File fh, MPI_Offset *offset) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == offset) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_position_shared(fh, offset); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_position_shared.c.in b/ompi/mpi/c/file_get_position_shared.c.in new file mode 100644 index 00000000000..588d2d0bbcc --- /dev/null +++ b/ompi/mpi/c/file_get_position_shared.c.in @@ -0,0 +1,63 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_position_shared(FILE fh, OFFSET_OUT offset) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == offset) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_position_shared(fh, offset); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_size.c b/ompi/mpi/c/file_get_size.c deleted file mode 100644 index db361fb8adf..00000000000 --- a/ompi/mpi/c/file_get_size.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_size = PMPI_File_get_size -#endif -#define MPI_File_get_size PMPI_File_get_size -#endif - -static const char FUNC_NAME[] = "MPI_File_get_size"; - - -int MPI_File_get_size(MPI_File fh, MPI_Offset *size) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == size) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_size(fh, size); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_size.c.in b/ompi/mpi/c/file_get_size.c.in new file mode 100644 index 00000000000..5fee0729b53 --- /dev/null +++ b/ompi/mpi/c/file_get_size.c.in @@ -0,0 +1,63 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_size(FILE fh, OFFSET_OUT size) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == size) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_size(fh, size); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_type_extent.c b/ompi/mpi/c/file_get_type_extent.c deleted file mode 100644 index 3fded0c207d..00000000000 --- a/ompi/mpi/c/file_get_type_extent.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_type_extent = PMPI_File_get_type_extent -#endif -#define MPI_File_get_type_extent PMPI_File_get_type_extent -#endif - -static const char FUNC_NAME[] = "MPI_File_get_type_extent"; - - -int MPI_File_get_type_extent(MPI_File fh, MPI_Datatype datatype, - MPI_Aint *extent) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == extent) { - rc = MPI_ERR_ARG; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, 1); - } - - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_type_extent(fh, datatype, extent); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_type_extent.c.in b/ompi/mpi/c/file_get_type_extent.c.in new file mode 100644 index 00000000000..09748110e11 --- /dev/null +++ b/ompi/mpi/c/file_get_type_extent.c.in @@ -0,0 +1,74 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_get_type_extent(FILE fh, DATATYPE datatype, + AINT_COUNT_OUT extent) +{ + int rc; + MPI_Aint tmp_extent = 0; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == extent) { + rc = MPI_ERR_ARG; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, 1); + } + + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_type_extent(fh, datatype, &tmp_extent); + *extent = tmp_extent; + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_get_view.c b/ompi/mpi/c/file_get_view.c deleted file mode 100644 index e02b44d0c3f..00000000000 --- a/ompi/mpi/c/file_get_view.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_get_view = PMPI_File_get_view -#endif -#define MPI_File_get_view PMPI_File_get_view -#endif - -static const char FUNC_NAME[] = "MPI_File_get_view"; - - -int MPI_File_get_view(MPI_File fh, MPI_Offset *disp, - MPI_Datatype *etype, - MPI_Datatype *filetype, char *datarep) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (NULL == etype || NULL == filetype) { - rc = MPI_ERR_TYPE; - } else if (NULL == disp || NULL == datarep) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_get_view(fh, disp, etype, filetype, datarep); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_get_view.c.in b/ompi/mpi/c/file_get_view.c.in new file mode 100644 index 00000000000..52f8c2e2cd6 --- /dev/null +++ b/ompi/mpi/c/file_get_view.c.in @@ -0,0 +1,66 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_get_view(FILE fh, OFFSET_OUT disp, DATATYPE_OUT etype, + DATATYPE_OUT filetype, STRING_OUT datarep) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (NULL == etype || NULL == filetype) { + rc = MPI_ERR_TYPE; + } else if (NULL == disp || NULL == datarep) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_get_view(fh, disp, etype, filetype, datarep); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iread.c b/ompi/mpi/c/file_iread.c deleted file mode 100644 index a03dc360cd5..00000000000 --- a/ompi/mpi/c/file_iread.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iread = PMPI_File_iread -#endif -#define MPI_File_iread PMPI_File_iread -#endif - -static const char FUNC_NAME[] = "MPI_File_iread"; - - -int MPI_File_iread(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iread(fh, buf, count, datatype, request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iread.c.in b/ompi/mpi/c/file_iread.c.in new file mode 100644 index 00000000000..792d9204fd2 --- /dev/null +++ b/ompi/mpi/c/file_iread.c.in @@ -0,0 +1,74 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iread(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iread(fh, buf, count, datatype, request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iread_all.c b/ompi/mpi/c/file_iread_all.c deleted file mode 100644 index 3e2534b2742..00000000000 --- a/ompi/mpi/c/file_iread_all.c +++ /dev/null @@ -1,91 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2015 University of Houston. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iread_all = PMPI_File_iread_all -#endif -#define MPI_File_iread_all PMPI_File_iread_all -#endif - -static const char FUNC_NAME[] = "MPI_File_iread_all"; - - -int MPI_File_iread_all(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iread_all) ) { - rc = MPI_ERR_UNSUPPORTED_OPERATION; - } - else { - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iread_all(fh, buf, count, datatype, request); - } - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iread_all.c.in b/ompi/mpi/c/file_iread_all.c.in new file mode 100644 index 00000000000..2e65290dd6d --- /dev/null +++ b/ompi/mpi/c/file_iread_all.c.in @@ -0,0 +1,81 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2015 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iread_all(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iread_all) ) { + rc = MPI_ERR_UNSUPPORTED_OPERATION; + } + else { + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iread_all(fh, buf, count, datatype, request); + } + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iread_at.c b/ompi/mpi/c/file_iread_at.c deleted file mode 100644 index 902154d3fd2..00000000000 --- a/ompi/mpi/c/file_iread_at.c +++ /dev/null @@ -1,86 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iread_at = PMPI_File_iread_at -#endif -#define MPI_File_iread_at PMPI_File_iread_at -#endif - -static const char FUNC_NAME[] = "MPI_File_iread_at"; - - -int MPI_File_iread_at(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iread_at(fh, offset, buf, count, datatype, - request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iread_at.c.in b/ompi/mpi/c/file_iread_at.c.in new file mode 100644 index 00000000000..f62d07eeab5 --- /dev/null +++ b/ompi/mpi/c/file_iread_at.c.in @@ -0,0 +1,76 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iread_at(FILE fh, OFFSET offset, BUFFER_OUT buf, + COUNT count, DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iread_at(fh, offset, buf, count, datatype, + request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iread_at_all.c b/ompi/mpi/c/file_iread_at_all.c deleted file mode 100644 index 3e0c5cfca59..00000000000 --- a/ompi/mpi/c/file_iread_at_all.c +++ /dev/null @@ -1,93 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2015 University of Houston. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iread_at_all = PMPI_File_iread_at_all -#endif -#define MPI_File_iread_at_all PMPI_File_iread_at_all -#endif - -static const char FUNC_NAME[] = "MPI_File_iread_at_all"; - - -int MPI_File_iread_at_all(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iread_at_all) ) { - rc = MPI_ERR_UNSUPPORTED_OPERATION; - } - else { - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iread_at_all(fh, offset, buf, count, datatype, - request); - } - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iread_at_all.c.in b/ompi/mpi/c/file_iread_at_all.c.in new file mode 100644 index 00000000000..6613a85e1ff --- /dev/null +++ b/ompi/mpi/c/file_iread_at_all.c.in @@ -0,0 +1,83 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2015 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iread_at_all(FILE fh, OFFSET offset, BUFFER_OUT buf, + COUNT count, DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iread_at_all) ) { + rc = MPI_ERR_UNSUPPORTED_OPERATION; + } + else { + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iread_at_all(fh, offset, buf, count, datatype, + request); + } + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iread_shared.c b/ompi/mpi/c/file_iread_shared.c deleted file mode 100644 index f789561752f..00000000000 --- a/ompi/mpi/c/file_iread_shared.c +++ /dev/null @@ -1,85 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iread_shared = PMPI_File_iread_shared -#endif -#define MPI_File_iread_shared PMPI_File_iread_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_iread_shared"; - - -int MPI_File_iread_shared(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iread_shared(fh, buf, count, datatype, request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iread_shared.c.in b/ompi/mpi/c/file_iread_shared.c.in new file mode 100644 index 00000000000..9c17a98c25a --- /dev/null +++ b/ompi/mpi/c/file_iread_shared.c.in @@ -0,0 +1,75 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iread_shared(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iread_shared(fh, buf, count, datatype, request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iwrite.c b/ompi/mpi/c/file_iwrite.c deleted file mode 100644 index 834271cd589..00000000000 --- a/ompi/mpi/c/file_iwrite.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iwrite = PMPI_File_iwrite -#endif -#define MPI_File_iwrite PMPI_File_iwrite -#endif - -static const char FUNC_NAME[] = "MPI_File_iwrite"; - - -int MPI_File_iwrite(MPI_File fh, const void *buf, int count, MPI_Datatype - datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iwrite(fh, buf, count, datatype, request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iwrite.c.in b/ompi/mpi/c/file_iwrite.c.in new file mode 100644 index 00000000000..dd6c3819b86 --- /dev/null +++ b/ompi/mpi/c/file_iwrite.c.in @@ -0,0 +1,78 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iwrite(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iwrite(fh, buf, count, datatype, request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iwrite_all.c b/ompi/mpi/c/file_iwrite_all.c deleted file mode 100644 index 900a1d49082..00000000000 --- a/ompi/mpi/c/file_iwrite_all.c +++ /dev/null @@ -1,95 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 University of Houston. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iwrite_all = PMPI_File_iwrite_all -#endif -#define MPI_File_iwrite_all PMPI_File_iwrite_all -#endif - -static const char FUNC_NAME[] = "MPI_File_iwrite_all"; - - -int MPI_File_iwrite_all(MPI_File fh, const void *buf, int count, MPI_Datatype - datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iwrite_all) ) { - rc = MPI_ERR_UNSUPPORTED_OPERATION; - } - else { - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iwrite_all(fh, buf, count, datatype, request); - } - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iwrite_all.c.in b/ompi/mpi/c/file_iwrite_all.c.in new file mode 100644 index 00000000000..d543bf76855 --- /dev/null +++ b/ompi/mpi/c/file_iwrite_all.c.in @@ -0,0 +1,85 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iwrite_all(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iwrite_all) ) { + rc = MPI_ERR_UNSUPPORTED_OPERATION; + } + else { + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iwrite_all(fh, buf, count, datatype, request); + } + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iwrite_at.c b/ompi/mpi/c/file_iwrite_at.c deleted file mode 100644 index bf6ad3b6a4c..00000000000 --- a/ompi/mpi/c/file_iwrite_at.c +++ /dev/null @@ -1,91 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iwrite_at = PMPI_File_iwrite_at -#endif -#define MPI_File_iwrite_at PMPI_File_iwrite_at -#endif - -static const char FUNC_NAME[] = "MPI_File_iwrite_at"; - - -int MPI_File_iwrite_at(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype, - MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iwrite_at(fh, offset, buf, count, datatype, - request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iwrite_at.c.in b/ompi/mpi/c/file_iwrite_at.c.in new file mode 100644 index 00000000000..2b0d05b851c --- /dev/null +++ b/ompi/mpi/c/file_iwrite_at.c.in @@ -0,0 +1,81 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iwrite_at(FILE fh, OFFSET offset, BUFFER buf, + COUNT count, DATATYPE datatype, + REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iwrite_at(fh, offset, buf, count, datatype, + request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iwrite_at_all.c b/ompi/mpi/c/file_iwrite_at_all.c deleted file mode 100644 index e682f7902fd..00000000000 --- a/ompi/mpi/c/file_iwrite_at_all.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 University of Houston. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iwrite_at_all = PMPI_File_iwrite_at_all -#endif -#define MPI_File_iwrite_at_all PMPI_File_iwrite_at_all -#endif - -static const char FUNC_NAME[] = "MPI_File_iwrite_at_all"; - - -int MPI_File_iwrite_at_all(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype, - MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iwrite_at_all) ) { - rc = MPI_ERR_UNSUPPORTED_OPERATION; - } - else { - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iwrite_at_all(fh, offset, buf, count, datatype, - request); - } - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iwrite_at_all.c.in b/ompi/mpi/c/file_iwrite_at_all.c.in new file mode 100644 index 00000000000..d11c109f4d4 --- /dev/null +++ b/ompi/mpi/c/file_iwrite_at_all.c.in @@ -0,0 +1,88 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 University of Houston. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iwrite_at_all(FILE fh, OFFSET offset, BUFFER buf, + COUNT count, DATATYPE datatype, + REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + if( OPAL_UNLIKELY(NULL == fh->f_io_selected_module.v3_0_0.io_module_file_iwrite_at_all) ) { + rc = MPI_ERR_UNSUPPORTED_OPERATION; + } + else { + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iwrite_at_all(fh, offset, buf, count, datatype, + request); + } + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_iwrite_shared.c b/ompi/mpi/c/file_iwrite_shared.c deleted file mode 100644 index 23b7963d337..00000000000 --- a/ompi/mpi/c/file_iwrite_shared.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/io_base_request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_iwrite_shared = PMPI_File_iwrite_shared -#endif -#define MPI_File_iwrite_shared PMPI_File_iwrite_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_iwrite_shared"; - - -int MPI_File_iwrite_shared(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype, MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_iwrite_shared(fh, buf, count, datatype, request); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_iwrite_shared.c.in b/ompi/mpi/c/file_iwrite_shared.c.in new file mode 100644 index 00000000000..4c0bb039391 --- /dev/null +++ b/ompi/mpi/c/file_iwrite_shared.c.in @@ -0,0 +1,78 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/io_base_request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_iwrite_shared(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_iwrite_shared(fh, buf, count, datatype, request); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_open.c b/ompi/mpi/c/file_open.c deleted file mode 100644 index 204e92e9e44..00000000000 --- a/ompi/mpi/c/file_open.c +++ /dev/null @@ -1,113 +0,0 @@ -/* -*- 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) 2013 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 University of Houston. All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/file/file.h" -#include "ompi/mca/io/io.h" -#include "ompi/mca/io/base/base.h" -#include "ompi/memchecker.h" - - -extern opal_mutex_t ompi_mpi_file_bootstrap_mutex; - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_open = PMPI_File_open -#endif -#define MPI_File_open PMPI_File_open -#endif - -static const char FUNC_NAME[] = "MPI_File_open"; - - -int MPI_File_open(MPI_Comm comm, const char *filename, int amode, - MPI_Info info, MPI_File *fh) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } else if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - - } - - /* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) says that - errors in MPI_FILE_OPEN (before the file handle is created) - should invoke the default error handler on MPI_FILE_NULL. - Hence, if we get a file handle out of ompi_file_open(), invoke - the error handler on that. If not, invoke the error handler on - MPI_FILE_NULL. */ - - /* The io framework is only initialized lazily. If it hasn't - already been initialized, do so now (note that MPI_FILE_OPEN - and MPI_FILE_DELETE are the only two places that it will be - initialized). */ - - /* For multi-threaded scenarios, initializing the file i/o - framework and mca infrastructure needs to be protected - by a mutex, similarly to the other frameworks in - ompi/runtime/ompi_mpi_init.c - */ - - opal_mutex_lock(&ompi_mpi_file_bootstrap_mutex); - - rc = mca_base_framework_open(&ompi_io_base_framework, 0); - if (OMPI_SUCCESS != rc) { - opal_mutex_unlock(&ompi_mpi_file_bootstrap_mutex); - return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); - } - opal_mutex_unlock(&ompi_mpi_file_bootstrap_mutex); - - /* Create an empty MPI_File handle */ - - *fh = MPI_FILE_NULL; - rc = ompi_file_open(comm, filename, amode, &(info->super), fh); - - /* Creating the file handle also selects a component to use, - creates a module, and calls file_open() on the module. So - we're good to go. */ - OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_open.c.in b/ompi/mpi/c/file_open.c.in new file mode 100644 index 00000000000..a6278068471 --- /dev/null +++ b/ompi/mpi/c/file_open.c.in @@ -0,0 +1,104 @@ +/* -*- 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) 2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 University of Houston. All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/file/file.h" +#include "ompi/mca/io/io.h" +#include "ompi/mca/io/base/base.h" +#include "ompi/memchecker.h" + +extern opal_mutex_t ompi_mpi_file_bootstrap_mutex; + +PROTOTYPE ERROR_CLASS file_open(COMM comm, STRING filename, INT amode, + INFO info, FILE_OUT fh) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } else if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + + } + + /* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) says that + errors in MPI_FILE_OPEN (before the file handle is created) + should invoke the default error handler on MPI_FILE_NULL. + Hence, if we get a file handle out of ompi_file_open(), invoke + the error handler on that. If not, invoke the error handler on + MPI_FILE_NULL. */ + + /* The io framework is only initialized lazily. If it hasn't + already been initialized, do so now (note that MPI_FILE_OPEN + and MPI_FILE_DELETE are the only two places that it will be + initialized). */ + + /* For multi-threaded scenarios, initializing the file i/o + framework and mca infrastructure needs to be protected + by a mutex, similarly to the other frameworks in + ompi/runtime/ompi_mpi_init.c + */ + + opal_mutex_lock(&ompi_mpi_file_bootstrap_mutex); + + rc = mca_base_framework_open(&ompi_io_base_framework, 0); + if (OMPI_SUCCESS != rc) { + opal_mutex_unlock(&ompi_mpi_file_bootstrap_mutex); + return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); + } + opal_mutex_unlock(&ompi_mpi_file_bootstrap_mutex); + + /* Create an empty MPI_File handle */ + + *fh = MPI_FILE_NULL; + rc = ompi_file_open(comm, filename, amode, &(info->super), fh); + + /* Creating the file handle also selects a component to use, + creates a module, and calls file_open() on the module. So + we're good to go. */ + OMPI_ERRHANDLER_RETURN(rc, *fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_preallocate.c b/ompi/mpi/c/file_preallocate.c deleted file mode 100644 index 52cc788920d..00000000000 --- a/ompi/mpi/c/file_preallocate.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_preallocate = PMPI_File_preallocate -#endif -#define MPI_File_preallocate PMPI_File_preallocate -#endif - -static const char FUNC_NAME[] = "MPI_File_preallocate"; - - -int MPI_File_preallocate(MPI_File fh, MPI_Offset size) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_preallocate(fh, size); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_preallocate.c.in b/ompi/mpi/c/file_preallocate.c.in new file mode 100644 index 00000000000..f188738045f --- /dev/null +++ b/ompi/mpi/c/file_preallocate.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_preallocate(FILE fh, OFFSET size) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_preallocate(fh, size); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read.c b/ompi/mpi/c/file_read.c deleted file mode 100644 index bd37a74b31b..00000000000 --- a/ompi/mpi/c/file_read.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read = PMPI_File_read -#endif -#define MPI_File_read PMPI_File_read -#endif - -static const char FUNC_NAME[] = "MPI_File_read"; - - -int MPI_File_read(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read.c.in b/ompi/mpi/c/file_read.c.in new file mode 100644 index 00000000000..5346df22d4d --- /dev/null +++ b/ompi/mpi/c/file_read.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS File_read(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_all.c b/ompi/mpi/c/file_read_all.c deleted file mode 100644 index 3c793349533..00000000000 --- a/ompi/mpi/c/file_read_all.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_all = PMPI_File_read_all -#endif -#define MPI_File_read_all PMPI_File_read_all -#endif - -static const char FUNC_NAME[] = "MPI_File_read_all"; - - -int MPI_File_read_all(MPI_File fh, void *buf, int count, MPI_Datatype - datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_all(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_all.c.in b/ompi/mpi/c/file_read_all.c.in new file mode 100644 index 00000000000..3407258cadd --- /dev/null +++ b/ompi/mpi/c/file_read_all.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_all(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_all(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_all_begin.c b/ompi/mpi/c/file_read_all_begin.c deleted file mode 100644 index deea6d4e50b..00000000000 --- a/ompi/mpi/c/file_read_all_begin.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_all_begin = PMPI_File_read_all_begin -#endif -#define MPI_File_read_all_begin PMPI_File_read_all_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_read_all_begin"; - - -int MPI_File_read_all_begin(MPI_File fh, void *buf, int count, - MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_all_begin(fh, buf, count, datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_all_begin.c.in b/ompi/mpi/c/file_read_all_begin.c.in new file mode 100644 index 00000000000..58552037653 --- /dev/null +++ b/ompi/mpi/c/file_read_all_begin.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_all_begin(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_all_begin(fh, buf, count, datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_all_end.c b/ompi/mpi/c/file_read_all_end.c deleted file mode 100644 index ed3ac7e2728..00000000000 --- a/ompi/mpi/c/file_read_all_end.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_all_end = PMPI_File_read_all_end -#endif -#define MPI_File_read_all_end PMPI_File_read_all_end -#endif - -static const char FUNC_NAME[] = "MPI_File_read_all_end"; - - -int MPI_File_read_all_end(MPI_File fh, void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_all_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_all_end.c.in b/ompi/mpi/c/file_read_all_end.c.in new file mode 100644 index 00000000000..c038aa710fc --- /dev/null +++ b/ompi/mpi/c/file_read_all_end.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_read_all_end(FILE fh, BUFFER_OUT buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_all_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_at.c b/ompi/mpi/c/file_read_at.c deleted file mode 100644 index 8bc1696ca37..00000000000 --- a/ompi/mpi/c/file_read_at.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_at = PMPI_File_read_at -#endif -#define MPI_File_read_at PMPI_File_read_at -#endif - -static const char FUNC_NAME[] = "MPI_File_read_at"; - - -int MPI_File_read_at(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_at(fh, offset, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_at.c.in b/ompi/mpi/c/file_read_at.c.in new file mode 100644 index 00000000000..37a2e1b86e8 --- /dev/null +++ b/ompi/mpi/c/file_read_at.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_at(FILE fh, OFFSET offset, BUFFER_OUT buf, + COUNT count, DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_at(fh, offset, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_at_all.c b/ompi/mpi/c/file_read_at_all.c deleted file mode 100644 index 16d4d691d0a..00000000000 --- a/ompi/mpi/c/file_read_at_all.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_at_all = PMPI_File_read_at_all -#endif -#define MPI_File_read_at_all PMPI_File_read_at_all -#endif - -static const char FUNC_NAME[] = "MPI_File_read_at_all"; - - -int MPI_File_read_at_all(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype, - MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_at_all(fh, offset, buf, count, datatype, - status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_at_all.c.in b/ompi/mpi/c/file_read_at_all.c.in new file mode 100644 index 00000000000..504fdd490b9 --- /dev/null +++ b/ompi/mpi/c/file_read_at_all.c.in @@ -0,0 +1,74 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_at_all(FILE fh, OFFSET offset, BUFFER_OUT buf, + COUNT count, DATATYPE datatype, + STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_at_all(fh, offset, buf, count, datatype, + status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_at_all_begin.c b/ompi/mpi/c/file_read_at_all_begin.c deleted file mode 100644 index 45f173f1a1f..00000000000 --- a/ompi/mpi/c/file_read_at_all_begin.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_at_all_begin = PMPI_File_read_at_all_begin -#endif -#define MPI_File_read_at_all_begin PMPI_File_read_at_all_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_read_at_all_begin"; - - -int MPI_File_read_at_all_begin(MPI_File fh, MPI_Offset offset, void *buf, - int count, MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_at_all_begin(fh, offset, buf, count, datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_at_all_begin.c.in b/ompi/mpi/c/file_read_at_all_begin.c.in new file mode 100644 index 00000000000..8ea532e3473 --- /dev/null +++ b/ompi/mpi/c/file_read_at_all_begin.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_at_all_begin(FILE fh, OFFSET offset, BUFFER_OUT buf, + COUNT count, DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_at_all_begin(fh, offset, buf, count, datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_at_all_end.c b/ompi/mpi/c/file_read_at_all_end.c deleted file mode 100644 index 2213bb0c87e..00000000000 --- a/ompi/mpi/c/file_read_at_all_end.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_at_all_end = PMPI_File_read_at_all_end -#endif -#define MPI_File_read_at_all_end PMPI_File_read_at_all_end -#endif - -static const char FUNC_NAME[] = "MPI_File_read_at_all_end"; - - -int MPI_File_read_at_all_end(MPI_File fh, void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_at_all_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_at_all_end.c.in b/ompi/mpi/c/file_read_at_all_end.c.in new file mode 100644 index 00000000000..54584aaa78c --- /dev/null +++ b/ompi/mpi/c/file_read_at_all_end.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_read_at_all_end(FILE fh, BUFFER_OUT buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_at_all_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_ordered.c b/ompi/mpi/c/file_read_ordered.c deleted file mode 100644 index befcc3736c9..00000000000 --- a/ompi/mpi/c/file_read_ordered.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_ordered = PMPI_File_read_ordered -#endif -#define MPI_File_read_ordered PMPI_File_read_ordered -#endif - -static const char FUNC_NAME[] = "MPI_File_read_ordered"; - - -int MPI_File_read_ordered(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_ordered(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_ordered.c.in b/ompi/mpi/c/file_read_ordered.c.in new file mode 100644 index 00000000000..4a38fa16749 --- /dev/null +++ b/ompi/mpi/c/file_read_ordered.c.in @@ -0,0 +1,67 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" + +PROTOTYPE ERROR_CLASS file_read_ordered(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_ordered(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_ordered_begin.c b/ompi/mpi/c/file_read_ordered_begin.c deleted file mode 100644 index 05c00564aa5..00000000000 --- a/ompi/mpi/c/file_read_ordered_begin.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_ordered_begin = PMPI_File_read_ordered_begin -#endif -#define MPI_File_read_ordered_begin PMPI_File_read_ordered_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_read_ordered_begin"; - - -int MPI_File_read_ordered_begin(MPI_File fh, void *buf, int count, - MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_ordered_begin(fh, buf, count, datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_ordered_begin.c.in b/ompi/mpi/c/file_read_ordered_begin.c.in new file mode 100644 index 00000000000..c1f0e6dfba8 --- /dev/null +++ b/ompi/mpi/c/file_read_ordered_begin.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_ordered_begin(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_ordered_begin(fh, buf, count, datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_ordered_end.c b/ompi/mpi/c/file_read_ordered_end.c deleted file mode 100644 index 288ed2ad191..00000000000 --- a/ompi/mpi/c/file_read_ordered_end.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_ordered_end = PMPI_File_read_ordered_end -#endif -#define MPI_File_read_ordered_end PMPI_File_read_ordered_end -#endif - -static const char FUNC_NAME[] = "MPI_File_read_ordered_end"; - - -int MPI_File_read_ordered_end(MPI_File fh, void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_ordered_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_ordered_end.c.in b/ompi/mpi/c/file_read_ordered_end.c.in new file mode 100644 index 00000000000..4ef9e623ba7 --- /dev/null +++ b/ompi/mpi/c/file_read_ordered_end.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_read_ordered_end(FILE fh, BUFFER_OUT buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_ordered_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_read_shared.c b/ompi/mpi/c/file_read_shared.c deleted file mode 100644 index 98d180da343..00000000000 --- a/ompi/mpi/c/file_read_shared.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_read_shared = PMPI_File_read_shared -#endif -#define MPI_File_read_shared PMPI_File_read_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_read_shared"; - - -int MPI_File_read_shared(MPI_File fh, void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_read_shared(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_read_shared.c.in b/ompi/mpi/c/file_read_shared.c.in new file mode 100644 index 00000000000..b473851aff0 --- /dev/null +++ b/ompi/mpi/c/file_read_shared.c.in @@ -0,0 +1,72 @@ +/* + * Copyright (c) 2004-2007 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-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) 2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_read_shared(FILE fh, BUFFER_OUT buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_read_shared(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_seek.c b/ompi/mpi/c/file_seek.c deleted file mode 100644 index 450d5f2a5f2..00000000000 --- a/ompi/mpi/c/file_seek.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_seek = PMPI_File_seek -#endif -#define MPI_File_seek PMPI_File_seek -#endif - -static const char FUNC_NAME[] = "MPI_File_seek"; - - -int MPI_File_seek(MPI_File fh, MPI_Offset offset, int whence) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (MPI_SEEK_SET != whence && MPI_SEEK_CUR != whence && - MPI_SEEK_END != whence) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_seek(fh, offset, whence); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_seek.c.in b/ompi/mpi/c/file_seek.c.in new file mode 100644 index 00000000000..697940771b1 --- /dev/null +++ b/ompi/mpi/c/file_seek.c.in @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_seek(FILE fh, OFFSET offset, INT whence) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (MPI_SEEK_SET != whence && MPI_SEEK_CUR != whence && + MPI_SEEK_END != whence) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_seek(fh, offset, whence); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_seek_shared.c b/ompi/mpi/c/file_seek_shared.c deleted file mode 100644 index 6e5150eca88..00000000000 --- a/ompi/mpi/c/file_seek_shared.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_seek_shared = PMPI_File_seek_shared -#endif -#define MPI_File_seek_shared PMPI_File_seek_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_seek_shared"; - - -int MPI_File_seek_shared(MPI_File fh, MPI_Offset offset, int whence) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else if (MPI_SEEK_SET != whence && MPI_SEEK_CUR != whence && - MPI_SEEK_END != whence) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_seek_shared(fh, offset, whence); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_seek_shared.c.in b/ompi/mpi/c/file_seek_shared.c.in new file mode 100644 index 00000000000..e2caa35bb0f --- /dev/null +++ b/ompi/mpi/c/file_seek_shared.c.in @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_seek_shared(FILE fh, OFFSET offset, INT whence) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else if (MPI_SEEK_SET != whence && MPI_SEEK_CUR != whence && + MPI_SEEK_END != whence) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_seek_shared(fh, offset, whence); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_set_atomicity.c b/ompi/mpi/c/file_set_atomicity.c deleted file mode 100644 index cab58c335e7..00000000000 --- a/ompi/mpi/c/file_set_atomicity.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_set_atomicity = PMPI_File_set_atomicity -#endif -#define MPI_File_set_atomicity PMPI_File_set_atomicity -#endif - -static const char FUNC_NAME[] = "MPI_File_set_atomicity"; - - -int MPI_File_set_atomicity(MPI_File fh, int flag) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_set_atomicity(fh, flag); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_set_atomicity.c.in b/ompi/mpi/c/file_set_atomicity.c.in new file mode 100644 index 00000000000..bb80f922813 --- /dev/null +++ b/ompi/mpi/c/file_set_atomicity.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_set_atomicity(FILE fh, INT flag) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_set_atomicity(fh, flag); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_set_errhandler.c b/ompi/mpi/c/file_set_errhandler.c deleted file mode 100644 index 7590ab6c853..00000000000 --- a/ompi/mpi/c/file_set_errhandler.c +++ /dev/null @@ -1,78 +0,0 @@ -/* -*- 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-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 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_set_errhandler = PMPI_File_set_errhandler -#endif -#define MPI_File_set_errhandler PMPI_File_set_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_File_set_errhandler"; - - -int MPI_File_set_errhandler( MPI_File file, MPI_Errhandler errhandler) -{ - MPI_Errhandler tmp; - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) - explicitly says that you are allowed to set the error - handler on MPI_FILE_NULL */ - - if (NULL == file) { - return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, MPI_ERR_FILE, - FUNC_NAME); - } else if (NULL == errhandler || - MPI_ERRHANDLER_NULL == errhandler || - (OMPI_ERRHANDLER_TYPE_FILE != errhandler->eh_mpi_object_type && - OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { - return OMPI_ERRHANDLER_INVOKE(file, MPI_ERR_ARG, FUNC_NAME); - } - } - - /* Prepare the new error handler */ - OBJ_RETAIN(errhandler); - - OPAL_THREAD_LOCK(&file->f_lock); - /* Ditch the old errhandler, and decrement its refcount. */ - tmp = file->error_handler; - file->error_handler = errhandler; - OBJ_RELEASE(tmp); - OPAL_THREAD_UNLOCK(&file->f_lock); - - /* All done */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/file_set_errhandler.c.in b/ompi/mpi/c/file_set_errhandler.c.in new file mode 100644 index 00000000000..12edd9c65b2 --- /dev/null +++ b/ompi/mpi/c/file_set_errhandler.c.in @@ -0,0 +1,70 @@ +/* -*- 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-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 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_set_errhandler(FILE file, ERRHANDLER errhandler) +{ + MPI_Errhandler tmp; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that MPI-2:9.7 (p265 in the ps; p261 in the pdf) + explicitly says that you are allowed to set the error + handler on MPI_FILE_NULL */ + + if (NULL == file) { + return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, MPI_ERR_FILE, + FUNC_NAME); + } else if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + (OMPI_ERRHANDLER_TYPE_FILE != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return OMPI_ERRHANDLER_INVOKE(file, MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Prepare the new error handler */ + OBJ_RETAIN(errhandler); + + OPAL_THREAD_LOCK(&file->f_lock); + /* Ditch the old errhandler, and decrement its refcount. */ + tmp = file->error_handler; + file->error_handler = errhandler; + OBJ_RELEASE(tmp); + OPAL_THREAD_UNLOCK(&file->f_lock); + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/file_set_info.c b/ompi/mpi/c/file_set_info.c deleted file mode 100644 index 530c92f47c2..00000000000 --- a/ompi/mpi/c/file_set_info.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * 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-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 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2019 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/communicator/communicator.h" -#include "opal/util/info_subscriber.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_set_info = PMPI_File_set_info -#endif -#define MPI_File_set_info PMPI_File_set_info -#endif - -static const char FUNC_NAME[] = "MPI_File_set_info"; - - -int MPI_File_set_info(MPI_File fh, MPI_Info info) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_file_invalid(fh)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_FILE, FUNC_NAME); - } - - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO, - FUNC_NAME); - } - } - -// Some components we're still letting handle info internally, eg romio321. -// Components that want to handle it themselves will fill in the get/set -// info function pointers, components that don't will use NULL. - if (fh->f_io_selected_module.v3_0_0.io_module_file_set_info != NULL) { - int rc; - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_set_info(fh, info); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); - } - - ret = opal_infosubscribe_change_info(&fh->super, &info->super); - - OMPI_ERRHANDLER_RETURN(ret, fh, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_set_info.c.in b/ompi/mpi/c/file_set_info.c.in new file mode 100644 index 00000000000..6d0d9eb5225 --- /dev/null +++ b/ompi/mpi/c/file_set_info.c.in @@ -0,0 +1,74 @@ +/* + * 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-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 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2019 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/communicator/communicator.h" +#include "opal/util/info_subscriber.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_set_info(FILE fh, INFO info) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_file_invalid(fh)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_FILE, FUNC_NAME); + } + + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(fh, MPI_ERR_INFO, + FUNC_NAME); + } + } + +// Some components we're still letting handle info internally, eg romio321. +// Components that want to handle it themselves will fill in the get/set +// info function pointers, components that don't will use NULL. + if (fh->f_io_selected_module.v3_0_0.io_module_file_set_info != NULL) { + int rc; + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_set_info(fh, info); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); + } + + ret = opal_infosubscribe_change_info(&fh->super, &info->super); + + OMPI_ERRHANDLER_RETURN(ret, fh, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_set_size.c b/ompi/mpi/c/file_set_size.c deleted file mode 100644 index 13103eefa61..00000000000 --- a/ompi/mpi/c/file_set_size.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_set_size = PMPI_File_set_size -#endif -#define MPI_File_set_size PMPI_File_set_size -#endif - -static const char FUNC_NAME[] = "MPI_File_set_size"; - - -int MPI_File_set_size(MPI_File fh, MPI_Offset size) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_set_size(fh, size); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_set_size.c.in b/ompi/mpi/c/file_set_size.c.in new file mode 100644 index 00000000000..ebd426bcf94 --- /dev/null +++ b/ompi/mpi/c/file_set_size.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_set_size(FILE fh, OFFSET size) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_set_size(fh, size); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_set_view.c b/ompi/mpi/c/file_set_view.c deleted file mode 100644 index 5b91314ab10..00000000000 --- a/ompi/mpi/c/file_set_view.c +++ /dev/null @@ -1,92 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/info/info.h" -#include "ompi/file/file.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_set_view = PMPI_File_set_view -#endif -#define MPI_File_set_view PMPI_File_set_view -#endif - -static const char FUNC_NAME[] = "MPI_File_set_view"; - - -int MPI_File_set_view(MPI_File fh, MPI_Offset disp, MPI_Datatype etype, - MPI_Datatype filetype, const char *datarep, MPI_Info info) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(etype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } else { - OMPI_CHECK_DATATYPE_FOR_VIEW(rc, etype, 0); - if (MPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_VIEW(rc, filetype, 0); - } - } - if ( NULL == datarep) { - rc = MPI_ERR_UNSUPPORTED_DATAREP; - fh = MPI_FILE_NULL; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_set_view(fh, disp, etype, filetype, datarep, &(info->super)); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_set_view.c.in b/ompi/mpi/c/file_set_view.c.in new file mode 100644 index 00000000000..79ac5c04353 --- /dev/null +++ b/ompi/mpi/c/file_set_view.c.in @@ -0,0 +1,82 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/info/info.h" +#include "ompi/file/file.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_set_view(FILE fh, OFFSET disp, DATATYPE etype, + DATATYPE filetype, STRING datarep, INFO info) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(etype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } else { + OMPI_CHECK_DATATYPE_FOR_VIEW(rc, etype, 0); + if (MPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_VIEW(rc, filetype, 0); + } + } + if ( NULL == datarep) { + rc = MPI_ERR_UNSUPPORTED_DATAREP; + fh = MPI_FILE_NULL; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_set_view(fh, disp, etype, filetype, datarep, &(info->super)); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_sync.c b/ompi/mpi/c/file_sync.c deleted file mode 100644 index 57d2db8dd09..00000000000 --- a/ompi/mpi/c/file_sync.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_sync = PMPI_File_sync -#endif -#define MPI_File_sync PMPI_File_sync -#endif - -static const char FUNC_NAME[] = "MPI_File_sync"; - - -int MPI_File_sync(MPI_File fh) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - rc = MPI_ERR_FILE; - fh = MPI_FILE_NULL; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_sync(fh); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_sync.c.in b/ompi/mpi/c/file_sync.c.in new file mode 100644 index 00000000000..e8c37ca17cd --- /dev/null +++ b/ompi/mpi/c/file_sync.c.in @@ -0,0 +1,61 @@ +/* + * Copyright (c) 2004-2007 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 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_sync(FILE fh) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + rc = MPI_ERR_FILE; + fh = MPI_FILE_NULL; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_sync(fh); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write.c b/ompi/mpi/c/file_write.c deleted file mode 100644 index 7a4784c2338..00000000000 --- a/ompi/mpi/c/file_write.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write = PMPI_File_write -#endif -#define MPI_File_write PMPI_File_write -#endif - -static const char FUNC_NAME[] = "MPI_File_write"; - - -int MPI_File_write(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write.c.in b/ompi/mpi/c/file_write.c.in new file mode 100644 index 00000000000..0f737e7f667 --- /dev/null +++ b/ompi/mpi/c/file_write.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_all.c b/ompi/mpi/c/file_write_all.c deleted file mode 100644 index 9d809ef95ee..00000000000 --- a/ompi/mpi/c/file_write_all.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_all = PMPI_File_write_all -#endif -#define MPI_File_write_all PMPI_File_write_all -#endif - -static const char FUNC_NAME[] = "MPI_File_write_all"; - - -int MPI_File_write_all(MPI_File fh, const void *buf, int count, MPI_Datatype - datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_all(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_all.c.in b/ompi/mpi/c/file_write_all.c.in new file mode 100644 index 00000000000..ace251e326e --- /dev/null +++ b/ompi/mpi/c/file_write_all.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_all(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_all(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_all_begin.c b/ompi/mpi/c/file_write_all_begin.c deleted file mode 100644 index 825a8e2d150..00000000000 --- a/ompi/mpi/c/file_write_all_begin.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_all_begin = PMPI_File_write_all_begin -#endif -#define MPI_File_write_all_begin PMPI_File_write_all_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_write_all_begin"; - - -int MPI_File_write_all_begin(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_all_begin(fh, buf, count, datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_all_begin.c.in b/ompi/mpi/c/file_write_all_begin.c.in new file mode 100644 index 00000000000..2ee5280b860 --- /dev/null +++ b/ompi/mpi/c/file_write_all_begin.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_all_begin(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_all_begin(fh, buf, count, datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_all_end.c b/ompi/mpi/c/file_write_all_end.c deleted file mode 100644 index 3314a314685..00000000000 --- a/ompi/mpi/c/file_write_all_end.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_all_end = PMPI_File_write_all_end -#endif -#define MPI_File_write_all_end PMPI_File_write_all_end -#endif - -static const char FUNC_NAME[] = "MPI_File_write_all_end"; - - -int MPI_File_write_all_end(MPI_File fh, const void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_all_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_all_end.c.in b/ompi/mpi/c/file_write_all_end.c.in new file mode 100644 index 00000000000..31f3fa70750 --- /dev/null +++ b/ompi/mpi/c/file_write_all_end.c.in @@ -0,0 +1,64 @@ +/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_write_all_end(FILE fh, BUFFER buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_all_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_at.c b/ompi/mpi/c/file_write_at.c deleted file mode 100644 index 4e4a85d0081..00000000000 --- a/ompi/mpi/c/file_write_at.c +++ /dev/null @@ -1,87 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_at = PMPI_File_write_at -#endif -#define MPI_File_write_at PMPI_File_write_at -#endif - -static const char FUNC_NAME[] = "MPI_File_write_at"; - - -int MPI_File_write_at(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype, - MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_at(fh, offset, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_at.c.in b/ompi/mpi/c/file_write_at.c.in new file mode 100644 index 00000000000..517046900f2 --- /dev/null +++ b/ompi/mpi/c/file_write_at.c.in @@ -0,0 +1,77 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_at(FILE fh, OFFSET offset, BUFFER buf, + COUNT count, DATATYPE datatype, + STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_at(fh, offset, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_at_all.c b/ompi/mpi/c/file_write_at_all.c deleted file mode 100644 index b92072861d0..00000000000 --- a/ompi/mpi/c/file_write_at_all.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_at_all = PMPI_File_write_at_all -#endif -#define MPI_File_write_at_all PMPI_File_write_at_all -#endif - -static const char FUNC_NAME[] = "MPI_File_write_at_all"; - - -int MPI_File_write_at_all(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype, - MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_at_all(fh, offset, buf, count, datatype, - status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_at_all.c.in b/ompi/mpi/c/file_write_at_all.c.in new file mode 100644 index 00000000000..8bfe767c6fe --- /dev/null +++ b/ompi/mpi/c/file_write_at_all.c.in @@ -0,0 +1,78 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_at_all(FILE fh, OFFSET offset, BUFFER buf, + COUNT count, DATATYPE datatype, + STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_at_all(fh, offset, buf, count, datatype, + status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_at_all_begin.c b/ompi/mpi/c/file_write_at_all_begin.c deleted file mode 100644 index e8fdf357407..00000000000 --- a/ompi/mpi/c/file_write_at_all_begin.c +++ /dev/null @@ -1,87 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_at_all_begin = PMPI_File_write_at_all_begin -#endif -#define MPI_File_write_at_all_begin PMPI_File_write_at_all_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_write_at_all_begin"; - - -int MPI_File_write_at_all_begin(MPI_File fh, MPI_Offset offset, const void *buf, - int count, MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_at_all_begin(fh, offset, buf, count, - datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_at_all_begin.c.in b/ompi/mpi/c/file_write_at_all_begin.c.in new file mode 100644 index 00000000000..90e487d816d --- /dev/null +++ b/ompi/mpi/c/file_write_at_all_begin.c.in @@ -0,0 +1,77 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_at_all_begin(FILE fh, OFFSET offset, BUFFER buf, + COUNT count, DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_at_all_begin(fh, offset, buf, count, + datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_at_all_end.c b/ompi/mpi/c/file_write_at_all_end.c deleted file mode 100644 index e20d4a9cf34..00000000000 --- a/ompi/mpi/c/file_write_at_all_end.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_at_all_end = PMPI_File_write_at_all_end -#endif -#define MPI_File_write_at_all_end PMPI_File_write_at_all_end -#endif - -static const char FUNC_NAME[] = "MPI_File_write_at_all_end"; - - -int MPI_File_write_at_all_end(MPI_File fh, const void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_at_all_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_at_all_end.c.in b/ompi/mpi/c/file_write_at_all_end.c.in new file mode 100644 index 00000000000..e4c372974f3 --- /dev/null +++ b/ompi/mpi/c/file_write_at_all_end.c.in @@ -0,0 +1,64 @@ +/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_write_at_all_end(FILE fh, BUFFER buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_at_all_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_ordered.c b/ompi/mpi/c/file_write_ordered.c deleted file mode 100644 index e84f5f64774..00000000000 --- a/ompi/mpi/c/file_write_ordered.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_ordered = PMPI_File_write_ordered -#endif -#define MPI_File_write_ordered PMPI_File_write_ordered -#endif - -static const char FUNC_NAME[] = "MPI_File_write_ordered"; - - -int MPI_File_write_ordered(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_ordered(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_ordered.c.in b/ompi/mpi/c/file_write_ordered.c.in new file mode 100644 index 00000000000..6b9b1a42e35 --- /dev/null +++ b/ompi/mpi/c/file_write_ordered.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_ordered(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_ordered(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_ordered_begin.c b/ompi/mpi/c/file_write_ordered_begin.c deleted file mode 100644 index 2d26f17f0c3..00000000000 --- a/ompi/mpi/c/file_write_ordered_begin.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_ordered_begin = PMPI_File_write_ordered_begin -#endif -#define MPI_File_write_ordered_begin PMPI_File_write_ordered_begin -#endif - -static const char FUNC_NAME[] = "MPI_File_write_ordered_begin"; - - -int MPI_File_write_ordered_begin(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_ordered_begin(fh, buf, count, datatype); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_ordered_begin.c.in b/ompi/mpi/c/file_write_ordered_begin.c.in new file mode 100644 index 00000000000..68ce2c2fe62 --- /dev/null +++ b/ompi/mpi/c/file_write_ordered_begin.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_ordered_begin(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_ordered_begin(fh, buf, count, datatype); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_ordered_end.c b/ompi/mpi/c/file_write_ordered_end.c deleted file mode 100644 index b13b50862b4..00000000000 --- a/ompi/mpi/c/file_write_ordered_end.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_ordered_end = PMPI_File_write_ordered_end -#endif -#define MPI_File_write_ordered_end PMPI_File_write_ordered_end -#endif - -static const char FUNC_NAME[] = "MPI_File_write_ordered_end"; - - -int MPI_File_write_ordered_end(MPI_File fh, const void *buf, MPI_Status *status) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_ordered_end(fh, buf, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_ordered_end.c.in b/ompi/mpi/c/file_write_ordered_end.c.in new file mode 100644 index 00000000000..d2c95c5bcf5 --- /dev/null +++ b/ompi/mpi/c/file_write_ordered_end.c.in @@ -0,0 +1,64 @@ +/* -*- 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-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 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS file_write_ordered_end(FILE fh, BUFFER buf, STATUS_OUT status) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_ordered_end(fh, buf, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/file_write_shared.c b/ompi/mpi/c/file_write_shared.c deleted file mode 100644 index db4a1c871c8..00000000000 --- a/ompi/mpi/c/file_write_shared.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/file/file.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_File_write_shared = PMPI_File_write_shared -#endif -#define MPI_File_write_shared PMPI_File_write_shared -#endif - -static const char FUNC_NAME[] = "MPI_File_write_shared"; - - -int MPI_File_write_shared(MPI_File fh, const void *buf, int count, - MPI_Datatype datatype, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_file_invalid(fh)) { - fh = MPI_FILE_NULL; - rc = MPI_ERR_FILE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); - } - OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - - switch (fh->f_io_version) { - case MCA_IO_BASE_V_3_0_0: - rc = fh->f_io_selected_module.v3_0_0. - io_module_file_write_shared(fh, buf, count, datatype, status); - break; - - default: - rc = MPI_ERR_INTERN; - break; - } - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/file_write_shared.c.in b/ompi/mpi/c/file_write_shared.c.in new file mode 100644 index 00000000000..be4183cfe70 --- /dev/null +++ b/ompi/mpi/c/file_write_shared.c.in @@ -0,0 +1,76 @@ +/* -*- 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-2005 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) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/file/file.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS file_write_shared(FILE fh, BUFFER buf, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_file_invalid(fh)) { + fh = MPI_FILE_NULL; + rc = MPI_ERR_FILE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, count); + } + OMPI_ERRHANDLER_CHECK(rc, fh, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + + switch (fh->f_io_version) { + case MCA_IO_BASE_V_3_0_0: + rc = fh->f_io_selected_module.v3_0_0. + io_module_file_write_shared(fh, buf, count, datatype, status); + break; + + default: + rc = MPI_ERR_INTERN; + break; + } + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, fh, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/finalize.c b/ompi/mpi/c/finalize.c deleted file mode 100644 index be7989261ba..00000000000 --- a/ompi/mpi/c/finalize.c +++ /dev/null @@ -1,53 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2018 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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Finalize = PMPI_Finalize -#endif -#define MPI_Finalize PMPI_Finalize -#endif - -static const char FUNC_NAME[] = "MPI_Finalize"; - - -int MPI_Finalize(void) -{ - /* If --with-spc and ompi_mpi_spc_dump_enabled were specified, print - * all of the final SPC values aggregated across the whole MPI run. - * Also, free all SPC memory. - */ - SPC_FINI(); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Pretty simple */ - - return ompi_mpi_finalize(); -} diff --git a/ompi/mpi/c/finalize.c.in b/ompi/mpi/c/finalize.c.in new file mode 100644 index 00000000000..d260e699510 --- /dev/null +++ b/ompi/mpi/c/finalize.c.in @@ -0,0 +1,45 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2018 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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS finalize() +{ + /* If --with-spc and ompi_mpi_spc_dump_enabled were specified, print + * all of the final SPC values aggregated across the whole MPI run. + * Also, free all SPC memory. + */ + SPC_FINI(); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Pretty simple */ + + return ompi_mpi_finalize(); +} diff --git a/ompi/mpi/c/finalized.c b/ompi/mpi/c/finalized.c deleted file mode 100644 index 514e91b3b25..00000000000 --- a/ompi/mpi/c/finalized.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2015 Intel, Inc. All rights reserved - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/hook/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Finalized = PMPI_Finalized -#endif -#define MPI_Finalized PMPI_Finalized -#endif - -static const char FUNC_NAME[] = "MPI_Finalized"; - - -int MPI_Finalized(int *flag) -{ - ompi_hook_base_mpi_finalized_top(flag); - - int32_t state = ompi_mpi_state; - - if (MPI_PARAM_CHECK) { - if (NULL == flag) { - - /* If we have an error, the action that we take depends on - whether we're currently (after MPI_Init and before - MPI_Finalize) or not */ - - if (state >= OMPI_MPI_STATE_INIT_COMPLETED && - state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - /* We have no MPI object here so call ompi_errhandle_invoke - * directly */ - return ompi_errhandler_invoke(NULL, NULL, -1, - ompi_errcode_get_mpi_code(MPI_ERR_ARG), - FUNC_NAME); - } - } - } - - *flag = (state >= OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT); - - ompi_hook_base_mpi_finalized_bottom(flag); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/finalized.c.in b/ompi/mpi/c/finalized.c.in new file mode 100644 index 00000000000..76abbbf4eb4 --- /dev/null +++ b/ompi/mpi/c/finalized.c.in @@ -0,0 +1,65 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2015 Intel, Inc. All rights reserved + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/hook/base/base.h" + +PROTOTYPE ERROR_CLASS finalized(INT_OUT flag) +{ + ompi_hook_base_mpi_finalized_top(flag); + + int32_t state = ompi_mpi_state; + + if (MPI_PARAM_CHECK) { + if (NULL == flag) { + + /* If we have an error, the action that we take depends on + whether we're currently (after MPI_Init and before + MPI_Finalize) or not */ + + if (state >= OMPI_MPI_STATE_INIT_COMPLETED && + state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + /* We have no MPI object here so call ompi_errhandle_invoke + * directly */ + return ompi_errhandler_invoke(NULL, NULL, -1, + ompi_errcode_get_mpi_code(MPI_ERR_ARG), + FUNC_NAME); + } + } + } + + *flag = (state >= OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT); + + ompi_hook_base_mpi_finalized_bottom(flag); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/free_mem.c b/ompi/mpi/c/free_mem.c deleted file mode 100644 index 5c0bbc4eb6a..00000000000 --- a/ompi/mpi/c/free_mem.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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-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) 2007-2020 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "opal/mca/mpool/mpool.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Free_mem = PMPI_Free_mem -#endif -#define MPI_Free_mem PMPI_Free_mem -#endif - -static const char FUNC_NAME[] = "MPI_Free_mem"; - - -int MPI_Free_mem(void *baseptr) -{ - /* Per these threads: - - https://www.open-mpi.org/community/lists/devel/2007/07/1977.php - https://www.open-mpi.org/community/lists/devel/2007/07/1979.php - - If you call MPI_ALLOC_MEM with a size of 0, you get NULL - back. So don't consider a NULL==baseptr an error. */ - if (NULL != baseptr && OMPI_SUCCESS != mca_mpool_base_free(baseptr)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); - } - - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/free_mem.c.in b/ompi/mpi/c/free_mem.c.in new file mode 100644 index 00000000000..fa68d9fb67f --- /dev/null +++ b/ompi/mpi/c/free_mem.c.in @@ -0,0 +1,49 @@ +/* + * 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-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) 2007-2020 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "opal/mca/mpool/mpool.h" + +PROTOTYPE ERROR_CLASS free_mem(BUFFER_OUT baseptr) +{ + /* Per these threads: + + https://www.open-mpi.org/community/lists/devel/2007/07/1977.php + https://www.open-mpi.org/community/lists/devel/2007/07/1979.php + + If you call MPI_ALLOC_MEM with a size of 0, you get NULL + back. So don't consider a NULL==baseptr an error. */ + if (NULL != baseptr && OMPI_SUCCESS != mca_mpool_base_free(baseptr)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/gather.c b/ompi/mpi/c/gather.c deleted file mode 100644 index 0e8227cbc16..00000000000 --- a/ompi/mpi/c/gather.c +++ /dev/null @@ -1,204 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Gather = PMPI_Gather -#endif -#define MPI_Gather PMPI_Gather -#endif - -static const char FUNC_NAME[] = "MPI_Gather"; - - -int MPI_Gather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_GATHER, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? */ - - if ((0 == sendcount && MPI_ROOT != root && - (ompi_comm_rank(comm) != root || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE != sendbuf))) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf && - 0 == recvcount) || - (0 == recvcount && (MPI_ROOT == root || MPI_PROC_NULL == root))) { - return MPI_SUCCESS; - } - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_gather(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, - comm->c_coll->coll_gather_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/gather.c.in b/ompi/mpi/c/gather.c.in new file mode 100644 index 00000000000..0cef27ae84f --- /dev/null +++ b/ompi/mpi/c/gather.c.in @@ -0,0 +1,196 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS gather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_GATHER, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? */ + + if ((0 == sendcount && MPI_ROOT != root && + (ompi_comm_rank(comm) != root || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE != sendbuf))) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf && + 0 == recvcount) || + (0 == recvcount && (MPI_ROOT == root || MPI_PROC_NULL == root))) { + return MPI_SUCCESS; + } + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_gather(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, + comm->c_coll->coll_gather_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/gather_init.c b/ompi/mpi/c/gather_init.c deleted file mode 100644 index 2539fdcdc1f..00000000000 --- a/ompi/mpi/c/gather_init.c +++ /dev/null @@ -1,202 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Gather_init = PMPI_Gather_init -#endif -#define MPI_Gather_init PMPI_Gather_init -#endif - -static const char FUNC_NAME[] = "MPI_Gather_init"; - - -int MPI_Gather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_GATHER_INIT, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_gather_init(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, info, request, - comm->c_coll->coll_gather_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == sendbuf) { - sendtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - recvtype = NULL; - } - } else { - if (MPI_ROOT == root) { - sendtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - recvtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/gather_init.c.in b/ompi/mpi/c/gather_init.c.in new file mode 100644 index 00000000000..97ae216e7eb --- /dev/null +++ b/ompi/mpi/c/gather_init.c.in @@ -0,0 +1,194 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS gather_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_GATHER_INIT, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_gather_init(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, info, request, + comm->c_coll->coll_gather_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == sendbuf) { + sendtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + recvtype = NULL; + } + } else { + if (MPI_ROOT == root) { + sendtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + recvtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/gatherv.c b/ompi/mpi/c/gatherv.c deleted file mode 100644 index eba4803d945..00000000000 --- a/ompi/mpi/c/gatherv.c +++ /dev/null @@ -1,222 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2016 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Gatherv = PMPI_Gatherv -#endif -#define MPI_Gatherv PMPI_Gatherv -#endif - -static const char FUNC_NAME[] = "MPI_Gatherv"; - - -int MPI_Gatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, int root, MPI_Comm comm) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_GATHERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_gatherv(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcounts_desc, displs_desc, - recvtype, root, comm, - comm->c_coll->coll_gatherv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/gatherv.c.in b/ompi/mpi/c/gatherv.c.in new file mode 100644 index 00000000000..835243d3437 --- /dev/null +++ b/ompi/mpi/c/gatherv.c.in @@ -0,0 +1,214 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2016 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS gatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, INT root, COMM comm) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_GATHERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_gatherv(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcounts_desc, displs_desc, + recvtype, root, comm, + comm->c_coll->coll_gatherv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/gatherv_init.c b/ompi/mpi/c/gatherv_init.c deleted file mode 100644 index 77fe3018614..00000000000 --- a/ompi/mpi/c/gatherv_init.c +++ /dev/null @@ -1,231 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Gatherv_init = PMPI_Gatherv_init -#endif -#define MPI_Gatherv_init PMPI_Gatherv_init -#endif - -static const char FUNC_NAME[] = "MPI_Gatherv_init"; - - -int MPI_Gatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, int root, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_GATHERV_INIT, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - } - - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_gatherv_init(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcounts_desc, displs_desc, recvtype, - root, comm, info, request, - comm->c_coll->coll_gatherv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == sendbuf) { - sendtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - recvtype = NULL; - } - } else { - if (MPI_ROOT == root) { - sendtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - recvtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/gatherv_init.c.in b/ompi/mpi/c/gatherv_init.c.in new file mode 100644 index 00000000000..afb89860f24 --- /dev/null +++ b/ompi/mpi/c/gatherv_init.c.in @@ -0,0 +1,223 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS gatherv_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, INT root, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_GATHERV_INIT, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + } + + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_gatherv_init(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcounts_desc, displs_desc, recvtype, + root, comm, info, request, + comm->c_coll->coll_gatherv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == sendbuf) { + sendtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + recvtype = NULL; + } + } else { + if (MPI_ROOT == root) { + sendtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + recvtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/get.c b/ompi/mpi/c/get.c deleted file mode 100644 index d378012cfc4..00000000000 --- a/ompi/mpi/c/get.c +++ /dev/null @@ -1,83 +0,0 @@ -/* -*- 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 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get = PMPI_Get -#endif -#define MPI_Get PMPI_Get -#endif - -static const char FUNC_NAME[] = "MPI_Get"; - - -int MPI_Get(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) -{ - int rc; - - SPC_RECORD(OMPI_SPC_GET, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; - - rc = win->w_osc_module->osc_get(origin_addr, origin_count, origin_datatype, - target_rank, target_disp, target_count, - target_datatype, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/get.c.in b/ompi/mpi/c/get.c.in new file mode 100644 index 00000000000..f8aa7674680 --- /dev/null +++ b/ompi/mpi/c/get.c.in @@ -0,0 +1,75 @@ +/* -*- 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 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS get(BUFFER_OUT origin_addr, COUNT origin_count, + DATATYPE origin_datatype, INT target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win) +{ + int rc; + + SPC_RECORD(OMPI_SPC_GET, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; + + rc = win->w_osc_module->osc_get(origin_addr, origin_count, origin_datatype, + target_rank, target_disp, target_count, + target_datatype, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/get_accumulate.c b/ompi/mpi/c/get_accumulate.c deleted file mode 100644 index ad889ee76c9..00000000000 --- a/ompi/mpi/c/get_accumulate.c +++ /dev/null @@ -1,147 +0,0 @@ -/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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 -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/op/op.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_accumulate = PMPI_Get_accumulate -#endif -#define MPI_Get_accumulate PMPI_Get_accumulate -#endif - -static const char FUNC_NAME[] = "MPI_Get_accumulate"; - -int MPI_Get_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, - void *result_addr, int result_count, MPI_Datatype result_datatype, - int target_rank, MPI_Aint target_disp, int target_count, - MPI_Datatype target_datatype, MPI_Op op, MPI_Win win) -{ - int rc; - ompi_win_t *ompi_win = (ompi_win_t*) win; - - MEMCHECKER( - memchecker_datatype(origin_datatype); - memchecker_datatype(target_datatype); - memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (MPI_OP_NULL == op) { - rc = MPI_ERR_OP; - } else if (!ompi_op_is_intrinsic(op)) { - rc = MPI_ERR_OP; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - /* the origin datatype is meaningless when using MPI_OP_NO_OP */ - if (&ompi_mpi_op_no_op.op != op) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - } else { - rc = OMPI_SUCCESS; - } - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - if (OMPI_SUCCESS == rc) { - /* While technically the standard probably requires that the - datatypes used with MPI_REPLACE conform to all the rules - for other reduction operators, we don't require such - behavior, as checking for it is expensive here and we don't - care in implementation.. */ - if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { - ompi_datatype_t *op_check_dt, *origin_check_dt; - char *msg; - - /* GET_ACCUMULATE, unlike REDUCE, can use with derived - datatypes with predefinied operations, with some - restrictions outlined in MPI-3:11.3.4. The derived - datatype must be composed entirely from one predefined - datatype (so you can do all the construction you want, - but at the bottom, you can only use one datatype, say, - MPI_INT). If the datatype at the target isn't - predefined, then make sure it's composed of only one - datatype, and check that datatype against - ompi_op_is_valid(). */ - origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); - op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); - - if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { - OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); - } - - /* check to make sure primitive type is valid for - reduction. Should do this on the target, but - then can't get the errcode back for this - call */ - if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); - free(msg); - return ret; - } - } - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - return MPI_SUCCESS; - } - - rc = ompi_win->w_osc_module->osc_get_accumulate(origin_addr, - origin_count, - origin_datatype, - result_addr, - result_count, - result_datatype, - target_rank, - target_disp, - target_count, - target_datatype, - op, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/get_accumulate.c.in b/ompi/mpi/c/get_accumulate.c.in new file mode 100644 index 00000000000..9bcc26b1b3b --- /dev/null +++ b/ompi/mpi/c/get_accumulate.c.in @@ -0,0 +1,140 @@ +/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/op/op.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS get_accumulate(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + BUFFER_OUT result_addr, COUNT result_count, DATATYPE result_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win) +{ + int rc; + ompi_win_t *ompi_win = (ompi_win_t*) win; + + MEMCHECKER( + memchecker_datatype(origin_datatype); + memchecker_datatype(target_datatype); + memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (MPI_OP_NULL == op) { + rc = MPI_ERR_OP; + } else if (!ompi_op_is_intrinsic(op)) { + rc = MPI_ERR_OP; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + /* the origin datatype is meaningless when using MPI_OP_NO_OP */ + if (&ompi_mpi_op_no_op.op != op) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + } else { + rc = OMPI_SUCCESS; + } + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + if (OMPI_SUCCESS == rc) { + /* While technically the standard probably requires that the + datatypes used with MPI_REPLACE conform to all the rules + for other reduction operators, we don't require such + behavior, as checking for it is expensive here and we don't + care in implementation.. */ + if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { + ompi_datatype_t *op_check_dt, *origin_check_dt; + char *msg; + + /* GET_ACCUMULATE, unlike REDUCE, can use with derived + datatypes with predefinied operations, with some + restrictions outlined in MPI-3:11.3.4. The derived + datatype must be composed entirely from one predefined + datatype (so you can do all the construction you want, + but at the bottom, you can only use one datatype, say, + MPI_INT). If the datatype at the target isn't + predefined, then make sure it's composed of only one + datatype, and check that datatype against + ompi_op_is_valid(). */ + origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); + op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); + + if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { + OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); + } + + /* check to make sure primitive type is valid for + reduction. Should do this on the target, but + then can't get the errcode back for this + call */ + if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); + free(msg); + return ret; + } + } + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + return MPI_SUCCESS; + } + + rc = ompi_win->w_osc_module->osc_get_accumulate(origin_addr, + origin_count, + origin_datatype, + result_addr, + result_count, + result_datatype, + target_rank, + target_disp, + target_count, + target_datatype, + op, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/get_address.c b/ompi/mpi/c/get_address.c deleted file mode 100644 index 0b934b2b751..00000000000 --- a/ompi/mpi/c/get_address.c +++ /dev/null @@ -1,51 +0,0 @@ -/* -*- 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-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) 2013-2016 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_address = PMPI_Get_address -#endif -#define MPI_Get_address PMPI_Get_address -#endif - -static const char FUNC_NAME[] = "MPI_Get_address"; - - -int MPI_Get_address(const void *location, MPI_Aint *address) -{ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == address) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - *address = (MPI_Aint)location; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/get_address.c.in b/ompi/mpi/c/get_address.c.in new file mode 100644 index 00000000000..3aba3b67427 --- /dev/null +++ b/ompi/mpi/c/get_address.c.in @@ -0,0 +1,43 @@ +/* -*- 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-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) 2013-2016 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS get_address(BUFFER location, AINT_OUT address) +{ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == address) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + *address = (MPI_Aint)location; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/get_count.c b/ompi/mpi/c/get_count.c deleted file mode 100644 index d2321a1dcc0..00000000000 --- a/ompi/mpi/c/get_count.c +++ /dev/null @@ -1,83 +0,0 @@ -/* -*- 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) 2010 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_count = PMPI_Get_count -#endif -#define MPI_Get_count PMPI_Get_count -#endif - -static const char FUNC_NAME[] = "MPI_Get_count"; - - -int MPI_Get_count(const MPI_Status *status, MPI_Datatype datatype, int *count) -{ - size_t size = 0, internal_count; - int rc = MPI_SUCCESS; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - memchecker_datatype(datatype); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, 1); - - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if( ompi_datatype_type_size( datatype, &size ) == MPI_SUCCESS ) { - if( size == 0 ) { - *count = 0; - } else { - internal_count = status->_ucount / size; /* count the number of complete datatypes */ - if( (internal_count * size) != status->_ucount || - internal_count > ((size_t) INT_MAX) ) { - *count = MPI_UNDEFINED; - } else { - *count = (int)internal_count; - } - } - } - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/get_count.c.in b/ompi/mpi/c/get_count.c.in new file mode 100644 index 00000000000..c2daea1543e --- /dev/null +++ b/ompi/mpi/c/get_count.c.in @@ -0,0 +1,75 @@ +/* -*- 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) 2010 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS get_count(STATUS status, DATATYPE datatype, COUNT_OUT count) +{ + size_t size = 0, internal_count; + int rc = MPI_SUCCESS; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + memchecker_datatype(datatype); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, 1); + + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if( ompi_datatype_type_size( datatype, &size ) == MPI_SUCCESS ) { + if( size == 0 ) { + *count = 0; + } else { + internal_count = status->_ucount / size; /* count the number of complete datatypes */ + if( (internal_count * size) != status->_ucount || + internal_count > ((size_t) INT_MAX) ) { + *count = MPI_UNDEFINED; + } else { + *count = (int)internal_count; + } + } + } + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/get_elements.c b/ompi/mpi/c/get_elements.c deleted file mode 100644 index 3789c96f5ca..00000000000 --- a/ompi/mpi/c/get_elements.c +++ /dev/null @@ -1,90 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_elements = PMPI_Get_elements -#endif -#define MPI_Get_elements PMPI_Get_elements -#endif - -static const char FUNC_NAME[] = "MPI_Get_elements"; - -int MPI_Get_elements(const MPI_Status *status, MPI_Datatype datatype, int *count) -{ - size_t internal_count; - int ret; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - memchecker_datatype(datatype); - } - ); - - if (MPI_PARAM_CHECK) { - int err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || MPI_STATUSES_IGNORE == status || - MPI_STATUS_IGNORE == status || NULL == count) { - err = MPI_ERR_ARG; - } else if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - err = MPI_ERR_TYPE; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(err, datatype, 1); - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); - } - - ret = ompi_datatype_get_elements (datatype, status->_ucount, &internal_count); - if (OMPI_SUCCESS == ret || OMPI_ERR_VALUE_OUT_OF_BOUNDS == ret) { - if (OMPI_SUCCESS == ret && internal_count <= INT_MAX) { - *count = internal_count; - } else { - /* If we have more elements that we can represent with a signed int then we must - * set count to MPI_UNDEFINED (MPI 3.0). - */ - *count = MPI_UNDEFINED; - } - - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/get_elements.c.in b/ompi/mpi/c/get_elements.c.in new file mode 100644 index 00000000000..49483f92f5d --- /dev/null +++ b/ompi/mpi/c/get_elements.c.in @@ -0,0 +1,82 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS Get_elements(STATUS status, DATATYPE datatype, COUNT_OUT count) +{ + size_t internal_count; + int ret; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + memchecker_datatype(datatype); + } + ); + + if (MPI_PARAM_CHECK) { + int err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || MPI_STATUSES_IGNORE == status || + MPI_STATUS_IGNORE == status || NULL == count) { + err = MPI_ERR_ARG; + } else if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + err = MPI_ERR_TYPE; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(err, datatype, 1); + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); + } + + ret = ompi_datatype_get_elements (datatype, status->_ucount, &internal_count); + if (OMPI_SUCCESS == ret || OMPI_ERR_VALUE_OUT_OF_BOUNDS == ret) { + if (OMPI_SUCCESS == ret && internal_count <= INT_MAX) { + *count = internal_count; + } else { + /* If we have more elements that we can represent with a signed int then we must + * set count to MPI_UNDEFINED (MPI 3.0). + */ + *count = MPI_UNDEFINED; + } + + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/get_elements_x.c b/ompi/mpi/c/get_elements_x.c deleted file mode 100644 index 3224d0f1cce..00000000000 --- a/ompi/mpi/c/get_elements_x.c +++ /dev/null @@ -1,90 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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 -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_elements_x = PMPI_Get_elements_x -#endif -#define MPI_Get_elements_x PMPI_Get_elements_x -#endif - -static const char FUNC_NAME[] = "MPI_Get_elements_x"; - -int MPI_Get_elements_x(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *count) -{ - size_t internal_count; - int ret; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - memchecker_datatype(datatype); - } - ); - - if (MPI_PARAM_CHECK) { - int err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || MPI_STATUSES_IGNORE == status || - MPI_STATUS_IGNORE == status || NULL == count) { - err = MPI_ERR_ARG; - } else if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - err = MPI_ERR_TYPE; - } else { - OMPI_CHECK_DATATYPE_FOR_RECV(err, datatype, 1); - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); - } - - ret = ompi_datatype_get_elements (datatype, status->_ucount, &internal_count); - if (OMPI_SUCCESS == ret || OMPI_ERR_VALUE_OUT_OF_BOUNDS == ret) { - if (OMPI_SUCCESS == ret && internal_count <= (size_t) SSIZE_MAX) { - *count = internal_count; - } else { - /* If we have more elements that we can represent with an MPI_Count then we must - * set count to MPI_UNDEFINED (MPI 3.0). - */ - *count = MPI_UNDEFINED; - } - - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/get_elements_x.c.in b/ompi/mpi/c/get_elements_x.c.in new file mode 100644 index 00000000000..d301f1336b2 --- /dev/null +++ b/ompi/mpi/c/get_elements_x.c.in @@ -0,0 +1,83 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS get_elements_x(STATUS status, DATATYPE datatype, ELEMENT_COUNT count) +{ + size_t internal_count; + int ret; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + memchecker_datatype(datatype); + } + ); + + if (MPI_PARAM_CHECK) { + int err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || MPI_STATUSES_IGNORE == status || + MPI_STATUS_IGNORE == status || NULL == count) { + err = MPI_ERR_ARG; + } else if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + err = MPI_ERR_TYPE; + } else { + OMPI_CHECK_DATATYPE_FOR_RECV(err, datatype, 1); + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); + } + + ret = ompi_datatype_get_elements (datatype, status->_ucount, &internal_count); + if (OMPI_SUCCESS == ret || OMPI_ERR_VALUE_OUT_OF_BOUNDS == ret) { + if (OMPI_SUCCESS == ret && internal_count <= (size_t) SSIZE_MAX) { + *count = internal_count; + } else { + /* If we have more elements that we can represent with an MPI_Count then we must + * set count to MPI_UNDEFINED (MPI 3.0). + */ + *count = MPI_UNDEFINED; + } + + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/get_library_version.c b/ompi/mpi/c/get_library_version.c deleted file mode 100644 index cb82d91c108..00000000000 --- a/ompi/mpi/c/get_library_version.c +++ /dev/null @@ -1,124 +0,0 @@ -/* - * 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-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) 2014-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Intel, 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_library_version = PMPI_Get_library_version -#endif -#define MPI_Get_library_version PMPI_Get_library_version -#endif - -static const char FUNC_NAME[] = "MPI_Get_library_version"; - - -int MPI_Get_library_version(char *version, int *resultlen) -{ - int len_left; - char *ptr, tmp[MPI_MAX_LIBRARY_VERSION_STRING]; - - if (MPI_PARAM_CHECK) { - /* Per MPI-3, this function can be invoked before - MPI_INIT, so we don't invoke the normal - MPI_ERR_INIT_FINALIZE() macro here */ - - if (NULL == version || NULL == resultlen) { - /* Note that we have to check and see if we have - previously called MPI_INIT or not. If so, use the - normal OMPI_ERRHANDLER_INVOKE, because the user may - have changed the default errhandler on MPI_COMM_WORLD. - If we have not invoked MPI_INIT, then just abort - (i.e., use a NULL communicator, which will end up at the - default errhandler, which is abort). */ - - int32_t state = ompi_mpi_state; - if (state >= OMPI_MPI_STATE_INIT_COMPLETED && - state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - /* We have no MPI object here so call ompi_errhandle_invoke - * directly */ - return ompi_errhandler_invoke(NULL, NULL, -1, - ompi_errcode_get_mpi_code(MPI_ERR_ARG), - FUNC_NAME); - } - } - } - - /* First write to a tmp variable so that we can write to *all* the - chars (MPI-3 says that we can only write resultlen chars to the - output string) */ - ptr = tmp; - len_left = sizeof(tmp); - memset(tmp, 0, MPI_MAX_LIBRARY_VERSION_STRING); - - snprintf(tmp, MPI_MAX_LIBRARY_VERSION_STRING, "Open MPI v%d.%d.%d", - OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION, OMPI_RELEASE_VERSION); - ptr += strlen(tmp); - len_left -= strlen(tmp); - - if (strlen(OMPI_GREEK_VERSION) > 0) { - snprintf(ptr, len_left, "%s", OMPI_GREEK_VERSION); - ptr = tmp + strlen(tmp); - len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); - } - - /* Package name */ - if (strlen(OPAL_PACKAGE_STRING) > 0) { - snprintf(ptr, len_left, ", package: %s", OPAL_PACKAGE_STRING); - ptr = tmp + strlen(tmp); - len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); - } - - /* Ident string */ - if (strlen(OMPI_IDENT_STRING) > 0) { - snprintf(ptr, len_left, ", ident: %s", OMPI_IDENT_STRING); - ptr = tmp + strlen(tmp); - len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); - } - - /* Repository revision */ - if (strlen(OMPI_REPO_REV) > 0) { - snprintf(ptr, len_left, ", repo rev: %s", OMPI_REPO_REV); - ptr = tmp + strlen(tmp); - len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); - } - - /* Release date */ - if (strlen(OMPI_RELEASE_DATE) > 0) { - snprintf(ptr, len_left, ", %s", OMPI_RELEASE_DATE); - ptr = tmp + strlen(tmp); - len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); - } - - memcpy(version, tmp, strlen(tmp) + 1); - *resultlen = strlen(tmp) + 1; - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/get_library_version.c.in b/ompi/mpi/c/get_library_version.c.in new file mode 100644 index 00000000000..b8e02e10a7d --- /dev/null +++ b/ompi/mpi/c/get_library_version.c.in @@ -0,0 +1,116 @@ +/* + * 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-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) 2014-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Intel, Inc. All rights reserved + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS get_library_version(STRING_OUT version, INT_OUT resultlen) +{ + int len_left; + char *ptr, tmp[MPI_MAX_LIBRARY_VERSION_STRING]; + + if (MPI_PARAM_CHECK) { + /* Per MPI-3, this function can be invoked before + MPI_INIT, so we don't invoke the normal + MPI_ERR_INIT_FINALIZE() macro here */ + + if (NULL == version || NULL == resultlen) { + /* Note that we have to check and see if we have + previously called MPI_INIT or not. If so, use the + normal OMPI_ERRHANDLER_INVOKE, because the user may + have changed the default errhandler on MPI_COMM_WORLD. + If we have not invoked MPI_INIT, then just abort + (i.e., use a NULL communicator, which will end up at the + default errhandler, which is abort). */ + + int32_t state = ompi_mpi_state; + if (state >= OMPI_MPI_STATE_INIT_COMPLETED && + state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + /* We have no MPI object here so call ompi_errhandle_invoke + * directly */ + return ompi_errhandler_invoke(NULL, NULL, -1, + ompi_errcode_get_mpi_code(MPI_ERR_ARG), + FUNC_NAME); + } + } + } + + /* First write to a tmp variable so that we can write to *all* the + chars (MPI-3 says that we can only write resultlen chars to the + output string) */ + ptr = tmp; + len_left = sizeof(tmp); + memset(tmp, 0, MPI_MAX_LIBRARY_VERSION_STRING); + + snprintf(tmp, MPI_MAX_LIBRARY_VERSION_STRING, "Open MPI v%d.%d.%d", + OMPI_MAJOR_VERSION, OMPI_MINOR_VERSION, OMPI_RELEASE_VERSION); + ptr += strlen(tmp); + len_left -= strlen(tmp); + + if (strlen(OMPI_GREEK_VERSION) > 0) { + snprintf(ptr, len_left, "%s", OMPI_GREEK_VERSION); + ptr = tmp + strlen(tmp); + len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); + } + + /* Package name */ + if (strlen(OPAL_PACKAGE_STRING) > 0) { + snprintf(ptr, len_left, ", package: %s", OPAL_PACKAGE_STRING); + ptr = tmp + strlen(tmp); + len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); + } + + /* Ident string */ + if (strlen(OMPI_IDENT_STRING) > 0) { + snprintf(ptr, len_left, ", ident: %s", OMPI_IDENT_STRING); + ptr = tmp + strlen(tmp); + len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); + } + + /* Repository revision */ + if (strlen(OMPI_REPO_REV) > 0) { + snprintf(ptr, len_left, ", repo rev: %s", OMPI_REPO_REV); + ptr = tmp + strlen(tmp); + len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); + } + + /* Release date */ + if (strlen(OMPI_RELEASE_DATE) > 0) { + snprintf(ptr, len_left, ", %s", OMPI_RELEASE_DATE); + ptr = tmp + strlen(tmp); + len_left = MPI_MAX_LIBRARY_VERSION_STRING - strlen(tmp); + } + + memcpy(version, tmp, strlen(tmp) + 1); + *resultlen = strlen(tmp) + 1; + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/get_processor_name.c b/ompi/mpi/c/get_processor_name.c deleted file mode 100644 index c76fd6dcdd3..00000000000 --- a/ompi/mpi/c/get_processor_name.c +++ /dev/null @@ -1,72 +0,0 @@ -/* - * 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-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-2008 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 -#ifdef HAVE_UNISTD_H -#include -#endif -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_processor_name = PMPI_Get_processor_name -#endif -#define MPI_Get_processor_name PMPI_Get_processor_name -#endif - -static const char FUNC_NAME[] = "MPI_Get_processor_name"; - - -int MPI_Get_processor_name(char *name, int *resultlen) -{ - if ( MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ( NULL == name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == resultlen ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* A simple implementation of this function using gethostname. - - Note that MPI-2.1 requires: - - terminating the string with a \0 - - name[*resultlen] == '\0' - - and therefore (*resultlen) cannot be > (MPI_MAX_PROCESSOR_NAME-1) - - Guard against gethostname() returning a *really long* hostname - and not null-terminating the string. The Fortran API version - will pad to the right if necessary. */ - gethostname(name, (MPI_MAX_PROCESSOR_NAME - 1)); - name[MPI_MAX_PROCESSOR_NAME - 1] = '\0'; - *resultlen = (int) strlen(name); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/get_processor_name.c.in b/ompi/mpi/c/get_processor_name.c.in new file mode 100644 index 00000000000..9902a653e8f --- /dev/null +++ b/ompi/mpi/c/get_processor_name.c.in @@ -0,0 +1,64 @@ +/* + * 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-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-2008 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#ifdef HAVE_UNISTD_H +#include +#endif +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS get_processor_name(STRING_OUT name, INT_OUT resultlen) +{ + if ( MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ( NULL == name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == resultlen ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* A simple implementation of this function using gethostname. + + Note that MPI-2.1 requires: + - terminating the string with a \0 + - name[*resultlen] == '\0' + - and therefore (*resultlen) cannot be > (MPI_MAX_PROCESSOR_NAME-1) + + Guard against gethostname() returning a *really long* hostname + and not null-terminating the string. The Fortran API version + will pad to the right if necessary. */ + gethostname(name, (MPI_MAX_PROCESSOR_NAME - 1)); + name[MPI_MAX_PROCESSOR_NAME - 1] = '\0'; + *resultlen = (int) strlen(name); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/get_version.c b/ompi/mpi/c/get_version.c deleted file mode 100644 index 181e84987f0..00000000000 --- a/ompi/mpi/c/get_version.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Intel, Inc. All rights reserved - * Copyright (c) 2018 Cisco Systems, 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Get_version = PMPI_Get_version -#endif -#define MPI_Get_version PMPI_Get_version -#endif - -static const char FUNC_NAME[] = "MPI_Get_version"; - - -int MPI_Get_version(int *version, int *subversion) -{ - if (MPI_PARAM_CHECK) { - /* Per MPI-2:3.1, this function can be invoked before - MPI_INIT, so we don't invoke the normal - MPI_ERR_INIT_FINALIZE() macro here */ - - if (NULL == version || NULL == subversion) { - /* Note that we have to check and see if we have - previously called MPI_INIT or not. If so, use the - normal OMPI_ERRHANDLER_INVOKE, because the user may - have changed the default errhandler on MPI_COMM_WORLD. - If we have not invoked MPI_INIT, then just abort - (i.e., use a NULL communicator, which will end up at the - default errhandler, which is abort). */ - - int32_t state = ompi_mpi_state; - if (state >= OMPI_MPI_STATE_INIT_COMPLETED && - state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - /* We have no MPI object here so call ompi_errhandle_invoke - * directly */ - return ompi_errhandler_invoke(NULL, NULL, -1, - ompi_errcode_get_mpi_code(MPI_ERR_ARG), - FUNC_NAME); - } - } - } - - /* According to the MPI-2 specification */ - - *version = MPI_VERSION; - *subversion = MPI_SUBVERSION; - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/get_version.c.in b/ompi/mpi/c/get_version.c.in new file mode 100644 index 00000000000..88abe13653c --- /dev/null +++ b/ompi/mpi/c/get_version.c.in @@ -0,0 +1,70 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Intel, Inc. All rights reserved + * Copyright (c) 2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS get_version(INT_OUT version, INT_OUT subversion) +{ + if (MPI_PARAM_CHECK) { + /* Per MPI-2:3.1, this function can be invoked before + MPI_INIT, so we don't invoke the normal + MPI_ERR_INIT_FINALIZE() macro here */ + + if (NULL == version || NULL == subversion) { + /* Note that we have to check and see if we have + previously called MPI_INIT or not. If so, use the + normal OMPI_ERRHANDLER_INVOKE, because the user may + have changed the default errhandler on MPI_COMM_WORLD. + If we have not invoked MPI_INIT, then just abort + (i.e., use a NULL communicator, which will end up at the + default errhandler, which is abort). */ + + int32_t state = ompi_mpi_state; + if (state >= OMPI_MPI_STATE_INIT_COMPLETED && + state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + /* We have no MPI object here so call ompi_errhandle_invoke + * directly */ + return ompi_errhandler_invoke(NULL, NULL, -1, + ompi_errcode_get_mpi_code(MPI_ERR_ARG), + FUNC_NAME); + } + } + } + + /* According to the MPI-2 specification */ + + *version = MPI_VERSION; + *subversion = MPI_SUBVERSION; + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/graph_create.c b/ompi/mpi/c/graph_create.c deleted file mode 100644 index c01aed97cc1..00000000000 --- a/ompi/mpi/c/graph_create.c +++ /dev/null @@ -1,125 +0,0 @@ -/* -*- 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graph_create = PMPI_Graph_create -#endif -#define MPI_Graph_create PMPI_Graph_create -#endif - -static const char FUNC_NAME[] = "MPI_Graph_create"; - - -int MPI_Graph_create(MPI_Comm old_comm, int nnodes, const int indx[], - const int edges[], int reorder, MPI_Comm *comm_graph) -{ - mca_topo_base_module_t* topo; - int err; - - MEMCHECKER( - memchecker_comm(old_comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(old_comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } else if (OMPI_COMM_IS_INTER(old_comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - if (nnodes < 0) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } else if (nnodes >= 1 && ((NULL == indx) || (NULL == edges))) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } - - if (nnodes > ompi_comm_size(old_comm)) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* MPI-2.1 7.5.3 states that if nnodes == 0, all processes should - get MPI_COMM_NULL */ - if (0 == nnodes) { - *comm_graph = MPI_COMM_NULL; - return MPI_SUCCESS; - } - if( nnodes > old_comm->c_local_group->grp_proc_count ) { - return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, - FUNC_NAME); - } - - /* - * everything seems to be alright with the communicator, we can go - * ahead and select a topology module for this purpose and create - * the new graph communicator - */ - if (OMPI_SUCCESS != (err = mca_topo_base_comm_select(old_comm, - NULL, - &topo, - OMPI_COMM_GRAPH))) { - return err; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(old_comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, old_comm, err, FUNC_NAME); - } -#endif - - /* Now let that topology module rearrange procs/ranks if it wants to */ - err = topo->topo.graph.graph_create(topo, old_comm, - nnodes, indx, edges, - (0 == reorder) ? false : true, comm_graph); - if (MPI_SUCCESS != err) { - OBJ_RELEASE(topo); - return OMPI_ERRHANDLER_INVOKE(old_comm, err, FUNC_NAME); - } - - /* All done */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/graph_create.c.in b/ompi/mpi/c/graph_create.c.in new file mode 100644 index 00000000000..e4b1fb4f04c --- /dev/null +++ b/ompi/mpi/c/graph_create.c.in @@ -0,0 +1,117 @@ +/* -*- 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/base/base.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graph_create(COMM old_comm, INT nnodes, INT_ARRAY indx, + INT_ARRAY edges, INT reorder, COMM_OUT comm_graph) +{ + mca_topo_base_module_t* topo; + int err; + + MEMCHECKER( + memchecker_comm(old_comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(old_comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } else if (OMPI_COMM_IS_INTER(old_comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + if (nnodes < 0) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } else if (nnodes >= 1 && ((NULL == indx) || (NULL == edges))) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } + + if (nnodes > ompi_comm_size(old_comm)) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* MPI-2.1 7.5.3 states that if nnodes == 0, all processes should + get MPI_COMM_NULL */ + if (0 == nnodes) { + *comm_graph = MPI_COMM_NULL; + return MPI_SUCCESS; + } + if( nnodes > old_comm->c_local_group->grp_proc_count ) { + return OMPI_ERRHANDLER_INVOKE (old_comm, MPI_ERR_ARG, + FUNC_NAME); + } + + /* + * everything seems to be alright with the communicator, we can go + * ahead and select a topology module for this purpose and create + * the new graph communicator + */ + if (OMPI_SUCCESS != (err = mca_topo_base_comm_select(old_comm, + NULL, + &topo, + OMPI_COMM_GRAPH))) { + return err; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(old_comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, old_comm, err, FUNC_NAME); + } +#endif + + /* Now let that topology module rearrange procs/ranks if it wants to */ + err = topo->topo.graph.graph_create(topo, old_comm, + nnodes, indx, edges, + (0 == reorder) ? false : true, comm_graph); + if (MPI_SUCCESS != err) { + OBJ_RELEASE(topo); + return OMPI_ERRHANDLER_INVOKE(old_comm, err, FUNC_NAME); + } + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/graph_get.c b/ompi/mpi/c/graph_get.c deleted file mode 100644 index c96d5027d42..00000000000 --- a/ompi/mpi/c/graph_get.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graph_get = PMPI_Graph_get -#endif -#define MPI_Graph_get PMPI_Graph_get -#endif - -static const char FUNC_NAME[] = "MPI_Graph_get"; - - -int MPI_Graph_get(MPI_Comm comm, int maxindx, int maxedges, - int indx[], int edges[]) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (0 > maxindx || 0 > maxedges || NULL == indx || NULL == edges) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - /* call the function */ - err = comm->c_topo->topo.graph.graph_get(comm, maxindx, maxedges, indx, edges); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/graph_get.c.in b/ompi/mpi/c/graph_get.c.in new file mode 100644 index 00000000000..ce61cc8a3c4 --- /dev/null +++ b/ompi/mpi/c/graph_get.c.in @@ -0,0 +1,69 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graph_get(COMM comm, INT maxindx, INT maxedges, + INT_OUT indx, INT_OUT edges) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (0 > maxindx || 0 > maxedges || NULL == indx || NULL == edges) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + /* call the function */ + err = comm->c_topo->topo.graph.graph_get(comm, maxindx, maxedges, indx, edges); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/graph_map.c b/ompi/mpi/c/graph_map.c deleted file mode 100644 index 8088b2f3483..00000000000 --- a/ompi/mpi/c/graph_map.c +++ /dev/null @@ -1,81 +0,0 @@ -/* -*- 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-2013 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graph_map = PMPI_Graph_map -#endif -#define MPI_Graph_map PMPI_Graph_map -#endif - -static const char FUNC_NAME[] = "MPI_Graph_map"; - - -int MPI_Graph_map(MPI_Comm comm, int nnodes, const int indx[], const int edges[], - int *newrank) -{ - int err = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (1 > nnodes || NULL == indx || NULL == edges || NULL == newrank) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if(!OMPI_COMM_IS_GRAPH(comm)) { - /* In case the communicator has no topo-module attached to - it, we just return the "default" value suggested by MPI: - newrank = rank */ - *newrank = ompi_comm_rank(comm); - } else { - err = comm->c_topo->topo.graph.graph_map(comm, nnodes, indx, edges, newrank); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/graph_map.c.in b/ompi/mpi/c/graph_map.c.in new file mode 100644 index 00000000000..d82a346f83b --- /dev/null +++ b/ompi/mpi/c/graph_map.c.in @@ -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-2013 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graph_map(COMM comm, INT nnodes, INT_ARRAY indx, INT_ARRAY edges, + INT_OUT newrank) +{ + int err = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (1 > nnodes || NULL == indx || NULL == edges || NULL == newrank) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if(!OMPI_COMM_IS_GRAPH(comm)) { + /* In case the communicator has no topo-module attached to + it, we just return the "default" value suggested by MPI: + newrank = rank */ + *newrank = ompi_comm_rank(comm); + } else { + err = comm->c_topo->topo.graph.graph_map(comm, nnodes, indx, edges, newrank); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/graph_neighbors.c b/ompi/mpi/c/graph_neighbors.c deleted file mode 100644 index 867a841baa0..00000000000 --- a/ompi/mpi/c/graph_neighbors.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graph_neighbors = PMPI_Graph_neighbors -#endif -#define MPI_Graph_neighbors PMPI_Graph_neighbors -#endif - -static const char FUNC_NAME[] = "MPI_Graph_neighbors"; - - -int MPI_Graph_neighbors(MPI_Comm comm, int rank, int maxneighbors, - int neighbors[]) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ((0 > maxneighbors) || ((0 < maxneighbors) && NULL == neighbors)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - /* call the function */ - err = comm->c_topo->topo.graph.graph_neighbors(comm, rank, maxneighbors, neighbors); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/graph_neighbors.c.in b/ompi/mpi/c/graph_neighbors.c.in new file mode 100644 index 00000000000..c5596ed24b4 --- /dev/null +++ b/ompi/mpi/c/graph_neighbors.c.in @@ -0,0 +1,74 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Los Alamos Nat Security, LLC. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graph_neighbors(COMM comm, INT rank, INT maxneighbors, + INT_OUT neighbors) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ((0 > maxneighbors) || ((0 < maxneighbors) && NULL == neighbors)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + /* call the function */ + err = comm->c_topo->topo.graph.graph_neighbors(comm, rank, maxneighbors, neighbors); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/graph_neighbors_count.c b/ompi/mpi/c/graph_neighbors_count.c deleted file mode 100644 index db1fb11dc7c..00000000000 --- a/ompi/mpi/c/graph_neighbors_count.c +++ /dev/null @@ -1,79 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graph_neighbors_count = PMPI_Graph_neighbors_count -#endif -#define MPI_Graph_neighbors_count PMPI_Graph_neighbors_count -#endif - -static const char FUNC_NAME[] = "MPI_Graph_neighbors_count"; - - -int MPI_Graph_neighbors_count(MPI_Comm comm, int rank, int *nneighbors) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, - FUNC_NAME); - } - if (NULL == nneighbors) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.graph.graph_neighbors_count(comm, rank, nneighbors); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/graph_neighbors_count.c.in b/ompi/mpi/c/graph_neighbors_count.c.in new file mode 100644 index 00000000000..752c1deaee0 --- /dev/null +++ b/ompi/mpi/c/graph_neighbors_count.c.in @@ -0,0 +1,71 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graph_neighbors_count(COMM comm, INT rank, INT_OUT nneighbors) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if ((0 > rank) || (rank > ompi_group_size(comm->c_local_group))) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_RANK, + FUNC_NAME); + } + if (NULL == nneighbors) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.graph.graph_neighbors_count(comm, rank, nneighbors); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/graphdims_get.c b/ompi/mpi/c/graphdims_get.c deleted file mode 100644 index 8af76da95ee..00000000000 --- a/ompi/mpi/c/graphdims_get.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Inria. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Graphdims_get = PMPI_Graphdims_get -#endif -#define MPI_Graphdims_get PMPI_Graphdims_get -#endif - -static const char FUNC_NAME[] = "MPI_Graphdims_get"; - - -int MPI_Graphdims_get(MPI_Comm comm, int *nnodes, int *nedges) -{ - int err; - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* check the arguments */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - } - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, - FUNC_NAME); - } - if (NULL == nnodes || NULL == nedges) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (!OMPI_COMM_IS_GRAPH(comm)) { - return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = comm->c_topo->topo.graph.graphdims_get(comm, nnodes, nedges); - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/graphdims_get.c.in b/ompi/mpi/c/graphdims_get.c.in new file mode 100644 index 00000000000..f505040b5f9 --- /dev/null +++ b/ompi/mpi/c/graphdims_get.c.in @@ -0,0 +1,67 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2013 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Inria. 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$ + * + * 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/mca/topo/topo.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS graphdims_get(COMM comm, INT_OUT nnodes, INT_OUT nedges) +{ + int err; + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* check the arguments */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + } + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_COMM, + FUNC_NAME); + } + if (NULL == nnodes || NULL == nedges) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (!OMPI_COMM_IS_GRAPH(comm)) { + return OMPI_ERRHANDLER_INVOKE (comm, MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = comm->c_topo->topo.graph.graphdims_get(comm, nnodes, nedges); + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/grequest_complete.c b/ompi/mpi/c/grequest_complete.c deleted file mode 100644 index 477441af161..00000000000 --- a/ompi/mpi/c/grequest_complete.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/request/grequest.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Grequest_complete = PMPI_Grequest_complete -#endif -#define MPI_Grequest_complete PMPI_Grequest_complete -#endif - -static const char FUNC_NAME[] = "MPI_Grequest_complete"; - - -int MPI_Grequest_complete(MPI_Request request) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_request(&request); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (MPI_REQUEST_NULL == request || NULL == request) { - rc = MPI_ERR_REQUEST; - } else if (OMPI_REQUEST_GEN != request->req_type) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - rc = ompi_grequest_complete(request); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, MPI_ERR_INTERN, FUNC_NAME); -} - diff --git a/ompi/mpi/c/grequest_complete.c.in b/ompi/mpi/c/grequest_complete.c.in new file mode 100644 index 00000000000..8fcf8cf1c1b --- /dev/null +++ b/ompi/mpi/c/grequest_complete.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006 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$ + * + * 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/grequest.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS grequest_complete(REQUEST request) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + memchecker_request(&request); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (MPI_REQUEST_NULL == request || NULL == request) { + rc = MPI_ERR_REQUEST; + } else if (OMPI_REQUEST_GEN != request->req_type) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + rc = ompi_grequest_complete(request); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, MPI_ERR_INTERN, FUNC_NAME); +} + diff --git a/ompi/mpi/c/grequest_start.c b/ompi/mpi/c/grequest_start.c deleted file mode 100644 index 20077d5a027..00000000000 --- a/ompi/mpi/c/grequest_start.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/request/grequest.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Grequest_start = PMPI_Grequest_start -#endif -#define MPI_Grequest_start PMPI_Grequest_start -#endif - -static const char FUNC_NAME[] = "MPI_Grequest_start"; - - -int MPI_Grequest_start(MPI_Grequest_query_function *query_fn, - MPI_Grequest_free_function *free_fn, - MPI_Grequest_cancel_function *cancel_fn, - void *extra_state, MPI_Request *request) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, - FUNC_NAME); - } - } - - rc = ompi_grequest_start(query_fn,free_fn,cancel_fn,extra_state,request); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/grequest_start.c.in b/ompi/mpi/c/grequest_start.c.in new file mode 100644 index 00000000000..75acd2eb372 --- /dev/null +++ b/ompi/mpi/c/grequest_start.c.in @@ -0,0 +1,50 @@ +/* + * 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-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 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$ + * + * 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/grequest.h" + +PROTOTYPE ERROR_CLASS grequest_start(GREQUEST_QUERY_FUNCTION query_fn, + GREQUEST_FREE_FUNCTION free_fn, + GREQUEST_CANCEL_FUNCTION cancel_fn, + BUFFER_OUT extra_state, REQUEST_INOUT request) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, + FUNC_NAME); + } + } + + rc = ompi_grequest_start(query_fn,free_fn,cancel_fn,extra_state,request); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/group_c2f.c b/ompi/mpi/c/group_c2f.c deleted file mode 100644 index 0c4022548ff..00000000000 --- a/ompi/mpi/c/group_c2f.c +++ /dev/null @@ -1,51 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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$ - */ -#include "ompi_config.h" -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_c2f = PMPI_Group_c2f -#endif -#define MPI_Group_c2f PMPI_Group_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Group_c2f"; - - -MPI_Fint MPI_Group_c2f(MPI_Group group) -{ - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if( (NULL == group) ) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(group->grp_f_to_c_index) ; -} diff --git a/ompi/mpi/c/group_c2f.c.in b/ompi/mpi/c/group_c2f.c.in new file mode 100644 index 00000000000..c2251619a90 --- /dev/null +++ b/ompi/mpi/c/group_c2f.c.in @@ -0,0 +1,43 @@ +/* + * Copyright (c) 2004-2007 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) 2006-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/group/group.h" + +PROTOTYPE FINT group_c2f(GROUP group) +{ + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if( (NULL == group) ) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(group->grp_f_to_c_index) ; +} diff --git a/ompi/mpi/c/group_compare.c b/ompi/mpi/c/group_compare.c deleted file mode 100644 index f51230713bb..00000000000 --- a/ompi/mpi/c/group_compare.c +++ /dev/null @@ -1,63 +0,0 @@ -/* - * 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-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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2009 University of Houston. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" -#include "ompi/proc/proc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_compare = PMPI_Group_compare -#endif -#define MPI_Group_compare PMPI_Group_compare -#endif - -static const char FUNC_NAME[] = "MPI_Group_compare"; - - -int MPI_Group_compare(MPI_Group group1, MPI_Group group2, int *result) { - int return_value = MPI_SUCCESS; - - /* check for errors */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if( ( MPI_GROUP_NULL == group1 ) || ( MPI_GROUP_NULL == group2 ) || - (NULL == group1) || (NULL==group2) ){ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } else if (NULL == result) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - return_value = ompi_group_compare((ompi_group_t *)group1, (ompi_group_t *)group2, result); - - return return_value; -} diff --git a/ompi/mpi/c/group_compare.c.in b/ompi/mpi/c/group_compare.c.in new file mode 100644 index 00000000000..728a091396f --- /dev/null +++ b/ompi/mpi/c/group_compare.c.in @@ -0,0 +1,56 @@ +/* + * 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-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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2009 University of Houston. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" +#include "ompi/proc/proc.h" + +PROTOTYPE ERROR_CLASS group_compare(GROUP group1, GROUP group2, INT_OUT result) +{ + int return_value = MPI_SUCCESS; + + /* check for errors */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if( ( MPI_GROUP_NULL == group1 ) || ( MPI_GROUP_NULL == group2 ) || + (NULL == group1) || (NULL==group2) ){ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } else if (NULL == result) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + return_value = ompi_group_compare((ompi_group_t *)group1, (ompi_group_t *)group2, result); + + return return_value; +} diff --git a/ompi/mpi/c/group_difference.c b/ompi/mpi/c/group_difference.c deleted file mode 100644 index 4036b7f61d4..00000000000 --- a/ompi/mpi/c/group_difference.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_difference = PMPI_Group_difference -#endif -#define MPI_Group_difference PMPI_Group_difference -#endif - -static const char FUNC_NAME[] = "MPI_Group_difference"; - - -int MPI_Group_difference(MPI_Group group1, MPI_Group group2, - MPI_Group *new_group) { - int err; - - /* error checking */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if( (MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || - (NULL == group1) || (NULL == group2) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - } - - err = ompi_group_difference ( group1, group2, new_group ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); -} diff --git a/ompi/mpi/c/group_difference.c.in b/ompi/mpi/c/group_difference.c.in new file mode 100644 index 00000000000..c3a1cca2fe0 --- /dev/null +++ b/ompi/mpi/c/group_difference.c.in @@ -0,0 +1,52 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2006 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$ + * + * 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/group/group.h" + +PROTOTYPE ERROR_CLASS group_difference(GROUP group1, GROUP group2, + GROUP_OUT new_group) +{ + int err; + + /* error checking */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if( (MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || + (NULL == group1) || (NULL == group2) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + } + + err = ompi_group_difference ( group1, group2, new_group ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); +} diff --git a/ompi/mpi/c/group_excl.c b/ompi/mpi/c/group_excl.c deleted file mode 100644 index 7280f592ae0..00000000000 --- a/ompi/mpi/c/group_excl.c +++ /dev/null @@ -1,87 +0,0 @@ -/* -*- 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-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 University of Houston. All rights reserved. - * Copyright (c) 2006-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos Nat Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_excl = PMPI_Group_excl -#endif -#define MPI_Group_excl PMPI_Group_excl -#endif - -static const char FUNC_NAME[] = "MPI_Group_excl"; - - -int MPI_Group_excl(MPI_Group group, int n, const int ranks[], - MPI_Group *new_group) -{ - ompi_group_t *group_pointer = (ompi_group_t *)group; - int i, err, group_size; - - group_size = ompi_group_size ( group_pointer); - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* verify that group is valid group */ - if ( (MPI_GROUP_NULL == group) || (NULL == group) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } else if (NULL == ranks && n > 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - - /* check that new group is no larger than old group */ - if ( n > group_size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - - /* check to see if procs are within range */ - for( i=0 ; i < n ; i++ ) { - if( ( 0 > ranks[i] ) || (ranks[i] >= group_size)){ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, - FUNC_NAME ); - } - } - - } /* end if( MPI_PARAM_CHECK ) */ - - if ( n == group_size ) { - *new_group = MPI_GROUP_EMPTY; - OBJ_RETAIN(MPI_GROUP_EMPTY); - return MPI_SUCCESS; - } - - err = ompi_group_excl ( group, n, ranks, new_group ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); -} diff --git a/ompi/mpi/c/group_excl.c.in b/ompi/mpi/c/group_excl.c.in new file mode 100644 index 00000000000..2165594fad1 --- /dev/null +++ b/ompi/mpi/c/group_excl.c.in @@ -0,0 +1,79 @@ +/* -*- 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-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 University of Houston. All rights reserved. + * Copyright (c) 2006-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos Nat Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_excl(GROUP group, INT n, INT_ARRAY ranks, + GROUP_OUT new_group) +{ + ompi_group_t *group_pointer = (ompi_group_t *)group; + int i, err, group_size; + + group_size = ompi_group_size ( group_pointer); + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* verify that group is valid group */ + if ( (MPI_GROUP_NULL == group) || (NULL == group) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } else if (NULL == ranks && n > 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + /* check that new group is no larger than old group */ + if ( n > group_size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + + /* check to see if procs are within range */ + for( i=0 ; i < n ; i++ ) { + if( ( 0 > ranks[i] ) || (ranks[i] >= group_size)){ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, + FUNC_NAME ); + } + } + + } /* end if( MPI_PARAM_CHECK ) */ + + if ( n == group_size ) { + *new_group = MPI_GROUP_EMPTY; + OBJ_RETAIN(MPI_GROUP_EMPTY); + return MPI_SUCCESS; + } + + err = ompi_group_excl ( group, n, ranks, new_group ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); +} diff --git a/ompi/mpi/c/group_f2c.c b/ompi/mpi/c/group_f2c.c deleted file mode 100644 index d6ee5c68f50..00000000000 --- a/ompi/mpi/c/group_f2c.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_f2c = PMPI_Group_f2c -#endif -#define MPI_Group_f2c PMPI_Group_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Group_f2c"; - - -MPI_Group MPI_Group_f2c(MPI_Fint group_f) -{ - int group_index = OMPI_FINT_2_INT(group_f); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (group_index < 0 || - group_index >= - opal_pointer_array_get_size(&ompi_group_f_to_c_table)) { - return NULL; - } - - return (MPI_Group)opal_pointer_array_get_item(&ompi_group_f_to_c_table, group_index); -} diff --git a/ompi/mpi/c/group_f2c.c.in b/ompi/mpi/c/group_f2c.c.in new file mode 100644 index 00000000000..cd328493e95 --- /dev/null +++ b/ompi/mpi/c/group_f2c.c.in @@ -0,0 +1,51 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/group/group.h" + +PROTOTYPE GROUP group_f2c(FINT group_f) +{ + int group_index = OMPI_FINT_2_INT(group_f); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (group_index < 0 || + group_index >= + opal_pointer_array_get_size(&ompi_group_f_to_c_table)) { + return NULL; + } + + return (MPI_Group)opal_pointer_array_get_item(&ompi_group_f_to_c_table, group_index); +} diff --git a/ompi/mpi/c/group_free.c b/ompi/mpi/c/group_free.c deleted file mode 100644 index f0b5788046c..00000000000 --- a/ompi/mpi/c/group_free.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * 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-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-2020 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_free = PMPI_Group_free -#endif -#define MPI_Group_free PMPI_Group_free -#endif - -static const char FUNC_NAME[] = "MPI_Group_free"; - - -int MPI_Group_free(MPI_Group *group) -{ - int ret; - - /* check to make sure we don't free GROUP_NULL. Note that we *do* - allow freeing GROUP_EMPTY after much debate in the OMPI core - group. The final thread about this, and the decision to - support freeing GROUP_EMPTY can be found here: - - https://www.open-mpi.org/community/lists/devel/2007/12/2750.php - - The short version: other MPI's allow it (LAM/MPI, CT6, MPICH2) - probably mainly because the Intel MPI test suite expects it to - happen and there's now several years worth of expected behavior - to allow this behavior. Rather than have to explain every time - why OMPI is the only one who completely adheres to the standard - / fails the intel tests, it seemed easier to just let this one - slide. It's not really that important, after all! */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ((NULL == group) || - (MPI_GROUP_NULL == *group) || (NULL == *group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - - } - - ret = ompi_group_free ( group); - OMPI_ERRHANDLER_NOHANDLE_CHECK(ret, ret, FUNC_NAME); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/group_free.c.in b/ompi/mpi/c/group_free.c.in new file mode 100644 index 00000000000..6fbc3ee6a36 --- /dev/null +++ b/ompi/mpi/c/group_free.c.in @@ -0,0 +1,65 @@ +/* + * 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-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-2020 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$ + * + * 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/group/group.h" + +PROTOTYPE ERROR_CLASS group_free(GROUP_OUT group) +{ + int ret; + + /* check to make sure we don't free GROUP_NULL. Note that we *do* + allow freeing GROUP_EMPTY after much debate in the OMPI core + group. The final thread about this, and the decision to + support freeing GROUP_EMPTY can be found here: + + https://www.open-mpi.org/community/lists/devel/2007/12/2750.php + + The short version: other MPI's allow it (LAM/MPI, CT6, MPICH2) + probably mainly because the Intel MPI test suite expects it to + happen and there's now several years worth of expected behavior + to allow this behavior. Rather than have to explain every time + why OMPI is the only one who completely adheres to the standard + / fails the intel tests, it seemed easier to just let this one + slide. It's not really that important, after all! */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ((NULL == group) || + (MPI_GROUP_NULL == *group) || (NULL == *group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + + } + + ret = ompi_group_free ( group); + OMPI_ERRHANDLER_NOHANDLE_CHECK(ret, ret, FUNC_NAME); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/group_from_session_pset.c b/ompi/mpi/c/group_from_session_pset.c deleted file mode 100644 index 4341a7b3a57..00000000000 --- a/ompi/mpi/c/group_from_session_pset.c +++ /dev/null @@ -1,58 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018 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_Group_from_session_pset = PMPI_Group_from_session_pset -#endif -#define MPI_Group_from_session_pset PMPI_Group_from_session_pset -#endif - -static const char FUNC_NAME[] = "MPI_Group_from_session_pset"; - - -int MPI_Group_from_session_pset (MPI_Session session, const char *pset_name, MPI_Group *newgroup) -{ - int rc; - - if ( MPI_PARAM_CHECK ) { - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } else if (NULL == pset_name || NULL == newgroup) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_group_from_pset (session, pset_name, newgroup); - /* - * if process set was not found, OMPI_ERR_NOT_FOUND is the return value. - * we want to map this to MPI_ERR_ARG but we have to do it manually here - * since the OMPI error to MPI error code code maps this to MPI_ERR_INTERN - */ - if (OMPI_ERR_NOT_FOUND == rc) { - rc = MPI_ERR_ARG; - } - - - OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, - rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/group_from_session_pset.c.in b/ompi/mpi/c/group_from_session_pset.c.in new file mode 100644 index 00000000000..ec7bacc9415 --- /dev/null +++ b/ompi/mpi/c/group_from_session_pset.c.in @@ -0,0 +1,48 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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" + +PROTOTYPE ERROR_CLASS group_from_session_pset (SESSION session, STRING pset_name, GROUP_OUT newgroup) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } else if (NULL == pset_name || NULL == newgroup) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_group_from_pset (session, pset_name, newgroup); + /* + * if process set was not found, OMPI_ERR_NOT_FOUND is the return value. + * we want to map this to MPI_ERR_ARG but we have to do it manually here + * since the OMPI error to MPI error code code maps this to MPI_ERR_INTERN + */ + if (OMPI_ERR_NOT_FOUND == rc) { + rc = MPI_ERR_ARG; + } + + + OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, + rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/group_incl.c b/ompi/mpi/c/group_incl.c deleted file mode 100644 index 7c1fb84531f..00000000000 --- a/ompi/mpi/c/group_incl.c +++ /dev/null @@ -1,87 +0,0 @@ -/* -*- 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-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 University of Houston. All rights reserved. - * Copyright (c) 2006-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_incl = PMPI_Group_incl -#endif -#define MPI_Group_incl PMPI_Group_incl -#endif - -static const char FUNC_NAME[] = "MPI_Group_incl"; - - -int MPI_Group_incl(MPI_Group group, int n, const int ranks[], MPI_Group *new_group) -{ - int i, group_size, err; - ompi_group_t *group_pointer; - - group_pointer = (ompi_group_t *)group; - group_size = ompi_group_size ( group_pointer ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* verify that group is valid group */ - if ( (MPI_GROUP_NULL == group) || ( NULL == group) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } else if (NULL == ranks && n > 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - - /* check that new group is no larger than old group */ - if ( n > group_size ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, - FUNC_NAME); - } - - for (i = 0; i < n; i++) { - if ((ranks[i] < 0) || (ranks[i] >= group_size)){ - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_RANK, - FUNC_NAME); - } - } - } /* end if( MPI_PARAM_CHECK ) */ - - if ( 0 == n ) { - *new_group = MPI_GROUP_EMPTY; - OBJ_RETAIN(MPI_GROUP_EMPTY); - return MPI_SUCCESS; - } - - err = ompi_group_incl(group,n,ranks,new_group); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err,FUNC_NAME); -} diff --git a/ompi/mpi/c/group_incl.c.in b/ompi/mpi/c/group_incl.c.in new file mode 100644 index 00000000000..2380238c1d7 --- /dev/null +++ b/ompi/mpi/c/group_incl.c.in @@ -0,0 +1,79 @@ +/* -*- 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-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 University of Houston. All rights reserved. + * Copyright (c) 2006-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_incl(GROUP group, INT n, INT_ARRAY ranks, GROUP_OUT new_group) +{ + int i, group_size, err; + ompi_group_t *group_pointer; + + group_pointer = (ompi_group_t *)group; + group_size = ompi_group_size ( group_pointer ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* verify that group is valid group */ + if ( (MPI_GROUP_NULL == group) || ( NULL == group) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } else if (NULL == ranks && n > 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + /* check that new group is no larger than old group */ + if ( n > group_size ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, + FUNC_NAME); + } + + for (i = 0; i < n; i++) { + if ((ranks[i] < 0) || (ranks[i] >= group_size)){ + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_RANK, + FUNC_NAME); + } + } + } /* end if( MPI_PARAM_CHECK ) */ + + if ( 0 == n ) { + *new_group = MPI_GROUP_EMPTY; + OBJ_RETAIN(MPI_GROUP_EMPTY); + return MPI_SUCCESS; + } + + err = ompi_group_incl(group,n,ranks,new_group); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err,FUNC_NAME); +} diff --git a/ompi/mpi/c/group_intersection.c b/ompi/mpi/c/group_intersection.c deleted file mode 100644 index 93e56d54b79..00000000000 --- a/ompi/mpi/c/group_intersection.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_intersection = PMPI_Group_intersection -#endif -#define MPI_Group_intersection PMPI_Group_intersection -#endif - -static const char FUNC_NAME[] = "MPI_Group_intersection"; - - -int MPI_Group_intersection(MPI_Group group1, MPI_Group group2, - MPI_Group *new_group) -{ - int err; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* verify that groups are valid */ - if ( (MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || - ( NULL == group1) || (NULL == group2) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - } - - err = ompi_group_intersection ( group1, group2, new_group ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); -} diff --git a/ompi/mpi/c/group_intersection.c.in b/ompi/mpi/c/group_intersection.c.in new file mode 100644 index 00000000000..0464ad5b570 --- /dev/null +++ b/ompi/mpi/c/group_intersection.c.in @@ -0,0 +1,52 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2006 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_intersection(GROUP group1, GROUP group2, + GROUP_OUT new_group) +{ + int err; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* verify that groups are valid */ + if ( (MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || + ( NULL == group1) || (NULL == group2) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + } + + err = ompi_group_intersection ( group1, group2, new_group ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); +} diff --git a/ompi/mpi/c/group_range_excl.c b/ompi/mpi/c/group_range_excl.c deleted file mode 100644 index 48bf5fb56cb..00000000000 --- a/ompi/mpi/c/group_range_excl.c +++ /dev/null @@ -1,120 +0,0 @@ -/* - * 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-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 University of Houston. 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$ - */ -#include "ompi_config.h" -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_range_excl = PMPI_Group_range_excl -#endif -#define MPI_Group_range_excl PMPI_Group_range_excl -#endif - -static const char FUNC_NAME[] = "MPI_Group_range_excl"; - - -int MPI_Group_range_excl(MPI_Group group, int n_triplets, int ranges[][3], - MPI_Group *new_group) -{ - int err, i, group_size, indx; - int * elements_int_list; - - /* can't act on NULL group */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ( (MPI_GROUP_NULL == group) || (NULL == group) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - - group_size = ompi_group_size ( group ); - elements_int_list = (int *) malloc(sizeof(int) * (group_size+1)); - if (NULL == elements_int_list) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OTHER, - FUNC_NAME); - } - for (i = 0; i < group_size; i++) { - elements_int_list[i] = -1; - } - - for (i = 0; i < n_triplets; i++) { - if ((0 > ranges[i][0]) || (ranges[i][0] > group_size)) { - goto error_rank; - } - if ((0 > ranges[i][1]) || (ranges[i][1] > group_size)) { - goto error_rank; - } - if (ranges[i][2] == 0) { - goto error_rank; - } - - if (ranges[i][0] < ranges[i][1]) { - if (ranges[i][2] < 0) { - goto error_rank; - } - /* positive stride */ - for (indx = ranges[i][0]; indx <= ranges[i][1]; indx += ranges[i][2]) { - /* make sure rank has not already been selected */ - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } else if (ranges[i][0] > ranges[i][1]) { - if (ranges[i][2] > 0) { - goto error_rank; - } - /* negative stride */ - for (indx = ranges[i][0]; indx >= ranges[i][1]; indx += ranges[i][2]) { - /* make sure rank has not already been selected */ - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } else { - /* first_rank == last_rank */ - indx = ranges[i][0]; - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } - - free (elements_int_list); - } - - err = ompi_group_range_excl(group,n_triplets,ranges,new_group); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err,FUNC_NAME); - -error_rank: - free(elements_int_list); - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, FUNC_NAME); -} diff --git a/ompi/mpi/c/group_range_excl.c.in b/ompi/mpi/c/group_range_excl.c.in new file mode 100644 index 00000000000..483d3a75685 --- /dev/null +++ b/ompi/mpi/c/group_range_excl.c.in @@ -0,0 +1,112 @@ +/* + * 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-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 University of Houston. 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) 2024 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/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_range_excl(GROUP group, INT n_triplets, RANGE_ARRAY ranges, + GROUP_OUT new_group) +{ + int err, i, group_size, indx; + int * elements_int_list; + + /* can't act on NULL group */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ( (MPI_GROUP_NULL == group) || (NULL == group) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + + group_size = ompi_group_size ( group ); + elements_int_list = (int *) malloc(sizeof(int) * (group_size+1)); + if (NULL == elements_int_list) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OTHER, + FUNC_NAME); + } + for (i = 0; i < group_size; i++) { + elements_int_list[i] = -1; + } + + for (i = 0; i < n_triplets; i++) { + if ((0 > ranges[i][0]) || (ranges[i][0] > group_size)) { + goto error_rank; + } + if ((0 > ranges[i][1]) || (ranges[i][1] > group_size)) { + goto error_rank; + } + if (ranges[i][2] == 0) { + goto error_rank; + } + + if (ranges[i][0] < ranges[i][1]) { + if (ranges[i][2] < 0) { + goto error_rank; + } + /* positive stride */ + for (indx = ranges[i][0]; indx <= ranges[i][1]; indx += ranges[i][2]) { + /* make sure rank has not already been selected */ + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } else if (ranges[i][0] > ranges[i][1]) { + if (ranges[i][2] > 0) { + goto error_rank; + } + /* negative stride */ + for (indx = ranges[i][0]; indx >= ranges[i][1]; indx += ranges[i][2]) { + /* make sure rank has not already been selected */ + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } else { + /* first_rank == last_rank */ + indx = ranges[i][0]; + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } + + free (elements_int_list); + } + + err = ompi_group_range_excl(group,n_triplets,ranges,new_group); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err,FUNC_NAME); + +error_rank: + free(elements_int_list); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, FUNC_NAME); +} diff --git a/ompi/mpi/c/group_range_incl.c b/ompi/mpi/c/group_range_incl.c deleted file mode 100644 index 3559b88f872..00000000000 --- a/ompi/mpi/c/group_range_incl.c +++ /dev/null @@ -1,121 +0,0 @@ -/* - * 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-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 University of Houston. 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$ - */ -#include "ompi_config.h" -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_range_incl = PMPI_Group_range_incl -#endif -#define MPI_Group_range_incl PMPI_Group_range_incl -#endif - -static const char FUNC_NAME[] = "MPI_Group_range_incl"; - - -int MPI_Group_range_incl(MPI_Group group, int n_triplets, int ranges[][3], - MPI_Group *new_group) -{ - int err, i,indx; - int group_size; - int * elements_int_list; - - /* can't act on NULL group */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( (MPI_GROUP_NULL == group) || (NULL == group) || - (NULL == new_group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - - group_size = ompi_group_size ( group); - elements_int_list = (int *) malloc(sizeof(int) * (group_size+1)); - if (NULL == elements_int_list) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OTHER, FUNC_NAME); - } - for (i = 0; i < group_size; i++) { - elements_int_list[i] = -1; - } - - for ( i=0; i < n_triplets; i++) { - if ((0 > ranges[i][0]) || (ranges[i][0] > group_size)) { - goto error_rank; - } - if ((0 > ranges[i][1]) || (ranges[i][1] > group_size)) { - goto error_rank; - } - if (ranges[i][2] == 0) { - goto error_rank; - } - - if ((ranges[i][0] < ranges[i][1])) { - if (ranges[i][2] < 0) { - goto error_rank; - } - /* positive stride */ - for (indx = ranges[i][0]; indx <= ranges[i][1]; indx += ranges[i][2]) { - /* make sure rank has not already been selected */ - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } else if (ranges[i][0] > ranges[i][1]) { - if (ranges[i][2] > 0) { - goto error_rank; - } - /* negative stride */ - for (indx = ranges[i][0]; indx >= ranges[i][1]; indx += ranges[i][2]) { - /* make sure rank has not already been selected */ - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } else { - /* first_rank == last_rank */ - indx = ranges[i][0]; - if (elements_int_list[indx] != -1) { - goto error_rank; - } - elements_int_list[indx] = i; - } - } - - free ( elements_int_list); - } - - err = ompi_group_range_incl ( group, n_triplets, ranges, new_group ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); - -error_rank: - free(elements_int_list); - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, FUNC_NAME); -} diff --git a/ompi/mpi/c/group_range_incl.c.in b/ompi/mpi/c/group_range_incl.c.in new file mode 100644 index 00000000000..deee2458a53 --- /dev/null +++ b/ompi/mpi/c/group_range_incl.c.in @@ -0,0 +1,113 @@ +/* + * 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-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 University of Houston. 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) 2024 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/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_range_incl(GROUP group, INT n_triplets, RANGE_ARRAY ranges, + GROUP_OUT new_group) +{ + int err, i,indx; + int group_size; + int * elements_int_list; + + /* can't act on NULL group */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( (MPI_GROUP_NULL == group) || (NULL == group) || + (NULL == new_group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + + group_size = ompi_group_size ( group); + elements_int_list = (int *) malloc(sizeof(int) * (group_size+1)); + if (NULL == elements_int_list) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OTHER, FUNC_NAME); + } + for (i = 0; i < group_size; i++) { + elements_int_list[i] = -1; + } + + for ( i=0; i < n_triplets; i++) { + if ((0 > ranges[i][0]) || (ranges[i][0] > group_size)) { + goto error_rank; + } + if ((0 > ranges[i][1]) || (ranges[i][1] > group_size)) { + goto error_rank; + } + if (ranges[i][2] == 0) { + goto error_rank; + } + + if ((ranges[i][0] < ranges[i][1])) { + if (ranges[i][2] < 0) { + goto error_rank; + } + /* positive stride */ + for (indx = ranges[i][0]; indx <= ranges[i][1]; indx += ranges[i][2]) { + /* make sure rank has not already been selected */ + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } else if (ranges[i][0] > ranges[i][1]) { + if (ranges[i][2] > 0) { + goto error_rank; + } + /* negative stride */ + for (indx = ranges[i][0]; indx >= ranges[i][1]; indx += ranges[i][2]) { + /* make sure rank has not already been selected */ + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } else { + /* first_rank == last_rank */ + indx = ranges[i][0]; + if (elements_int_list[indx] != -1) { + goto error_rank; + } + elements_int_list[indx] = i; + } + } + + free ( elements_int_list); + } + + err = ompi_group_range_incl ( group, n_triplets, ranges, new_group ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); + +error_rank: + free(elements_int_list); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_RANK, FUNC_NAME); +} diff --git a/ompi/mpi/c/group_rank.c b/ompi/mpi/c/group_rank.c deleted file mode 100644 index ea42ce8b11c..00000000000 --- a/ompi/mpi/c/group_rank.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_rank = PMPI_Group_rank -#endif -#define MPI_Group_rank PMPI_Group_rank -#endif - -static const char FUNC_NAME[] = "MPI_Group_rank"; - - -int MPI_Group_rank(MPI_Group group, int *rank) -{ - /* error checking */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if( (MPI_GROUP_NULL == group) || ( NULL == group) ){ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } else if (NULL == rank) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - *rank=ompi_group_rank((ompi_group_t *)group); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/group_rank.c.in b/ompi/mpi/c/group_rank.c.in new file mode 100644 index 00000000000..550c18b347b --- /dev/null +++ b/ompi/mpi/c/group_rank.c.in @@ -0,0 +1,50 @@ +/* + * 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-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 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$ + * + * 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/group/group.h" + +PROTOTYPE ERROR_CLASS group_rank(GROUP group, INT_OUT rank) +{ + /* error checking */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if( (MPI_GROUP_NULL == group) || ( NULL == group) ){ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } else if (NULL == rank) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + *rank=ompi_group_rank((ompi_group_t *)group); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/group_size.c b/ompi/mpi/c/group_size.c deleted file mode 100644 index 51e4bbda3de..00000000000 --- a/ompi/mpi/c/group_size.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_size = PMPI_Group_size -#endif -#define MPI_Group_size PMPI_Group_size -#endif - -static const char FUNC_NAME[] = "MPI_Group_size"; - - -int MPI_Group_size(MPI_Group group, int *size) -{ - /* error checking */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if( (MPI_GROUP_NULL == group) || (NULL == group) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } else if (NULL == size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - *size=ompi_group_size((ompi_group_t *)group); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/group_size.c.in b/ompi/mpi/c/group_size.c.in new file mode 100644 index 00000000000..2179e5b9f63 --- /dev/null +++ b/ompi/mpi/c/group_size.c.in @@ -0,0 +1,50 @@ +/* + * 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-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 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$ + * + * 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/group/group.h" + +PROTOTYPE ERROR_CLASS group_size(GROUP group, INT_OUT size) +{ + /* error checking */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if( (MPI_GROUP_NULL == group) || (NULL == group) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } else if (NULL == size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + *size=ompi_group_size((ompi_group_t *)group); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/group_translate_ranks.c b/ompi/mpi/c/group_translate_ranks.c deleted file mode 100644 index c1949fe1a94..00000000000 --- a/ompi/mpi/c/group_translate_ranks.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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) 2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/group/group.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_translate_ranks = PMPI_Group_translate_ranks -#endif -#define MPI_Group_translate_ranks PMPI_Group_translate_ranks -#endif - -static const char FUNC_NAME[] = "MPI_Group_translate_ranks"; - - -int MPI_Group_translate_ranks(MPI_Group group1, int n_ranks, const int ranks1[], - MPI_Group group2, int ranks2[]) -{ - int err; - - /* check for errors */ - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || - (NULL == group1) || (NULL == group2)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - if (n_ranks < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - if (n_ranks > 0 && ((NULL == ranks1) || (NULL == ranks2 ))) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - } - - if (0 == n_ranks) { - return MPI_SUCCESS; - } - - err = ompi_group_translate_ranks ( group1, n_ranks, ranks1, - group2, ranks2 ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); -} diff --git a/ompi/mpi/c/group_translate_ranks.c.in b/ompi/mpi/c/group_translate_ranks.c.in new file mode 100644 index 00000000000..b84f7212f56 --- /dev/null +++ b/ompi/mpi/c/group_translate_ranks.c.in @@ -0,0 +1,66 @@ +/* -*- 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-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) 2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. 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$ + * + * 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/group/group.h" + +PROTOTYPE ERROR_CLASS group_translate_ranks(GROUP group1, INT n_ranks, INT_ARRAY ranks1, + GROUP group2, INT_OUT ranks2) +{ + int err; + + /* check for errors */ + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || + (NULL == group1) || (NULL == group2)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + if (n_ranks < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + if (n_ranks > 0 && ((NULL == ranks1) || (NULL == ranks2 ))) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + } + + if (0 == n_ranks) { + return MPI_SUCCESS; + } + + err = ompi_group_translate_ranks ( group1, n_ranks, ranks1, + group2, ranks2 ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); +} diff --git a/ompi/mpi/c/group_union.c b/ompi/mpi/c/group_union.c deleted file mode 100644 index cdfc3efb3c9..00000000000 --- a/ompi/mpi/c/group_union.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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-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 University of Houston. All rights reserved. - * Copyright (c) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/group/group.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Group_union = PMPI_Group_union -#endif -#define MPI_Group_union PMPI_Group_union -#endif - -static const char FUNC_NAME[] = "MPI_Group_union"; - - -int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *new_group) -{ - int err; - - /* check for errors */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || - (NULL == group1) || (NULL == group2) || - (NULL == new_group)) { - return - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, - FUNC_NAME); - } - } - - err = ompi_group_union ( group1, group2, new_group ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); -} diff --git a/ompi/mpi/c/group_union.c.in b/ompi/mpi/c/group_union.c.in new file mode 100644 index 00000000000..af291660747 --- /dev/null +++ b/ompi/mpi/c/group_union.c.in @@ -0,0 +1,52 @@ +/* + * 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-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 University of Houston. All rights reserved. + * Copyright (c) 2006 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/group/group.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS group_union(GROUP group1, GROUP group2, GROUP_OUT new_group) +{ + int err; + + /* check for errors */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ((MPI_GROUP_NULL == group1) || (MPI_GROUP_NULL == group2) || + (NULL == group1) || (NULL == group2) || + (NULL == new_group)) { + return + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_GROUP, + FUNC_NAME); + } + } + + err = ompi_group_union ( group1, group2, new_group ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME ); +} diff --git a/ompi/mpi/c/iallgather.c b/ompi/mpi/c/iallgather.c deleted file mode 100644 index 75cfb5d3ceb..00000000000 --- a/ompi/mpi/c/iallgather.c +++ /dev/null @@ -1,109 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iallgather = PMPI_Iallgather -#endif -#define MPI_Iallgather PMPI_Iallgather -#endif - -static const char FUNC_NAME[] = "MPI_Iallgather"; - - -int MPI_Iallgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IALLGATHER, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*recvcount*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_iallgather(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - request, comm->c_coll->coll_iallgather_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/iallgather.c.in b/ompi/mpi/c/iallgather.c.in new file mode 100644 index 00000000000..6bc3d09adee --- /dev/null +++ b/ompi/mpi/c/iallgather.c.in @@ -0,0 +1,100 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iallgather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IALLGATHER, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*recvcount*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_iallgather(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + request, comm->c_coll->coll_iallgather_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/iallgatherv.c b/ompi/mpi/c/iallgatherv.c deleted file mode 100644 index 3b9142c727a..00000000000 --- a/ompi/mpi/c/iallgatherv.c +++ /dev/null @@ -1,137 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iallgatherv = PMPI_Iallgatherv -#endif -#define MPI_Iallgatherv PMPI_Iallgatherv -#endif - -static const char FUNC_NAME[] = "MPI_Iallgatherv"; - - -int MPI_Iallgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_IALLGATHERV, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - size = ompi_comm_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[rank]*ext, - recvcounts[rank], recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_iallgatherv(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, displs_desc, - recvtype, comm, request, - comm->c_coll->coll_iallgatherv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/iallgatherv.c.in b/ompi/mpi/c/iallgatherv.c.in new file mode 100644 index 00000000000..aa2b543a423 --- /dev/null +++ b/ompi/mpi/c/iallgatherv.c.in @@ -0,0 +1,129 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iallgatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_IALLGATHERV, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + size = ompi_comm_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[rank]*ext, + recvcounts[rank], recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_iallgatherv(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, displs_desc, + recvtype, comm, request, + comm->c_coll->coll_iallgatherv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/iallreduce.c b/ompi/mpi/c/iallreduce.c deleted file mode 100644 index ee9cf01e7a3..00000000000 --- a/ompi/mpi/c/iallreduce.c +++ /dev/null @@ -1,121 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iallreduce = PMPI_Iallreduce -#endif -#define MPI_Iallreduce PMPI_Iallreduce -#endif - -static const char FUNC_NAME[] = "MPI_Iallreduce"; - - -int MPI_Iallreduce(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IALLREDUCE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - /* check whether receive buffer is defined. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else if( (sendbuf == recvbuf) && - (MPI_BOTTOM != sendbuf) && - (count > 1) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - if (0 == count) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_iallreduce(sendbuf, recvbuf, count, datatype, - op, comm, request, comm->c_coll->coll_iallreduce_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/iallreduce.c.in b/ompi/mpi/c/iallreduce.c.in new file mode 100644 index 00000000000..60be428fa2e --- /dev/null +++ b/ompi/mpi/c/iallreduce.c.in @@ -0,0 +1,113 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iallreduce(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IALLREDUCE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + /* check whether receive buffer is defined. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else if( (sendbuf == recvbuf) && + (MPI_BOTTOM != sendbuf) && + (count > 1) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_BUFFER, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + if (0 == count) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_iallreduce(sendbuf, recvbuf, count, datatype, + op, comm, request, comm->c_coll->coll_iallreduce_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ialltoall.c b/ompi/mpi/c/ialltoall.c deleted file mode 100644 index 15451ba1e63..00000000000 --- a/ompi/mpi/c/ialltoall.c +++ /dev/null @@ -1,107 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ialltoall = PMPI_Ialltoall -#endif -#define MPI_Ialltoall PMPI_Ialltoall -#endif - -static const char FUNC_NAME[] = "MPI_Ialltoall"; - - -int MPI_Ialltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Request *request) -{ - size_t sendtype_size, recvtype_size; - int err; - - SPC_RECORD(OMPI_SPC_IALLTOALL, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_ialltoall(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - request, comm->c_coll->coll_ialltoall_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ialltoall.c.in b/ompi/mpi/c/ialltoall.c.in new file mode 100644 index 00000000000..f6ccdb72815 --- /dev/null +++ b/ompi/mpi/c/ialltoall.c.in @@ -0,0 +1,99 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ialltoall(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_INOUT request) +{ + size_t sendtype_size, recvtype_size; + int err; + + SPC_RECORD(OMPI_SPC_IALLTOALL, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_ialltoall(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + request, comm->c_coll->coll_ialltoall_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ialltoallv.c b/ompi/mpi/c/ialltoallv.c deleted file mode 100644 index 97d9cc31b91..00000000000 --- a/ompi/mpi/c/ialltoallv.c +++ /dev/null @@ -1,143 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ialltoallv = PMPI_Ialltoallv -#endif -#define MPI_Ialltoallv PMPI_Ialltoallv -#endif - -static const char FUNC_NAME[] = "MPI_Ialltoallv"; - - -int MPI_Ialltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], - MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], - const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, - MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_IALLTOALLV, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(sendtype, &send_ext); - } - - memchecker_datatype(recvtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtype = recvtype; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || - (NULL == recvcounts) || (NULL == rdispls) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - int me = ompi_comm_rank(comm); - size_t sendtype_size, recvtype_size; - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_ialltoallv(sendbuf, sendcounts_desc, sdispls_desc, - sendtype, recvbuf, recvcounts_desc, rdispls_desc, - recvtype, comm, request, comm->c_coll->coll_ialltoallv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ialltoallv.c.in b/ompi/mpi/c/ialltoallv.c.in new file mode 100644 index 00000000000..838286975ee --- /dev/null +++ b/ompi/mpi/c/ialltoallv.c.in @@ -0,0 +1,135 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ialltoallv(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm, + REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_IALLTOALLV, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(sendtype, &send_ext); + } + + memchecker_datatype(recvtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtype = recvtype; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || + (NULL == recvcounts) || (NULL == rdispls) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + int me = ompi_comm_rank(comm); + size_t sendtype_size, recvtype_size; + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_ialltoallv(sendbuf, sendcounts_desc, sdispls_desc, + sendtype, recvbuf, recvcounts_desc, rdispls_desc, + recvtype, comm, request, comm->c_coll->coll_ialltoallv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ialltoallw.c b/ompi/mpi/c/ialltoallw.c deleted file mode 100644 index 240f782adba..00000000000 --- a/ompi/mpi/c/ialltoallw.c +++ /dev/null @@ -1,134 +0,0 @@ -/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2020 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ialltoallw = PMPI_Ialltoallw -#endif -#define MPI_Ialltoallw PMPI_Ialltoallw -#endif - -static const char FUNC_NAME[] = "MPI_Ialltoallw"; - - -int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[], - const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], - const int rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, - MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_IALLTOALLW, 1); - - MEMCHECKER( - memchecker_comm(comm); - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for ( i = 0; i < size; i++ ) { - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtypes[i]); - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i], - sendcounts[i], sendtypes[i]); - } - - memchecker_datatype(recvtypes[i]); - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i], - recvcounts[i], recvtypes[i]); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if (MPI_IN_PLACE == sendbuf) { - sendcounts = recvcounts; - sdispls = rdispls; - sendtypes = recvtypes; - } - - if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || - (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || - (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || - MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { - int me = ompi_comm_rank(comm); - size_t sendtype_size, recvtype_size; - ompi_datatype_type_size(sendtypes[me], &sendtype_size); - ompi_datatype_type_size(recvtypes[me], &recvtype_size); - if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_ialltoallw(sendbuf, sendcounts_desc, sdispls_desc, - sendtypes, recvbuf, recvcounts_desc, - rdispls_desc, recvtypes, comm, request, - comm->c_coll->coll_ialltoallw_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes_w(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtypes, recvtypes, false); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ialltoallw.c.in b/ompi/mpi/c/ialltoallw.c.in new file mode 100644 index 00000000000..44e5f4a9e7a --- /dev/null +++ b/ompi/mpi/c/ialltoallw.c.in @@ -0,0 +1,126 @@ +/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ialltoallw(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE_ARRAY sendtypes, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes, COMM comm, + REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_IALLTOALLW, 1); + + MEMCHECKER( + memchecker_comm(comm); + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for ( i = 0; i < size; i++ ) { + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtypes[i]); + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i], + sendcounts[i], sendtypes[i]); + } + + memchecker_datatype(recvtypes[i]); + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i], + recvcounts[i], recvtypes[i]); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if (MPI_IN_PLACE == sendbuf) { + sendcounts = recvcounts; + sdispls = rdispls; + sendtypes = recvtypes; + } + + if ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes) || + (NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes) || + (MPI_IN_PLACE == sendbuf && OMPI_COMM_IS_INTER(comm)) || + MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + size = OMPI_COMM_IS_INTER(comm)?ompi_comm_remote_size(comm):ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf && !OMPI_COMM_IS_INTER(comm)) { + int me = ompi_comm_rank(comm); + size_t sendtype_size, recvtype_size; + ompi_datatype_type_size(sendtypes[me], &sendtype_size); + ompi_datatype_type_size(recvtypes[me], &recvtype_size); + if ((sendtype_size*sendcounts[me]) != (recvtype_size*recvcounts[me])) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_ialltoallw(sendbuf, sendcounts_desc, sdispls_desc, + sendtypes, recvbuf, recvcounts_desc, + rdispls_desc, recvtypes, comm, request, + comm->c_coll->coll_ialltoallw_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes_w(*request, (MPI_IN_PLACE==sendbuf)?NULL:sendtypes, recvtypes, false); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ibarrier.c b/ompi/mpi/c/ibarrier.c deleted file mode 100644 index e5672a14580..00000000000 --- a/ompi/mpi/c/ibarrier.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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) 2012 Oak Rigde National Laboratory. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ibarrier = PMPI_Ibarrier -#endif -#define MPI_Ibarrier PMPI_Ibarrier -#endif - -static const char FUNC_NAME[] = "MPI_Ibarrier"; - - -int MPI_Ibarrier(MPI_Comm comm, MPI_Request *request) -{ - int err = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_IBARRIER, 1); - - MEMCHECKER( - memchecker_comm(comm); - ); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - } - - err = comm->c_coll->coll_ibarrier(comm, request, comm->c_coll->coll_ibarrier_module); - - /* All done */ - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ibarrier.c.in b/ompi/mpi/c/ibarrier.c.in new file mode 100644 index 00000000000..a0c23d31dec --- /dev/null +++ b/ompi/mpi/c/ibarrier.c.in @@ -0,0 +1,58 @@ +/* + * 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) 2012 Oak Rigde National Laboratory. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ibarrier(COMM comm, REQUEST_INOUT request) +{ + int err = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_IBARRIER, 1); + + MEMCHECKER( + memchecker_comm(comm); + ); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + } + + err = comm->c_coll->coll_ibarrier(comm, request, comm->c_coll->coll_ibarrier_module); + + /* All done */ + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ibcast.c b/ompi/mpi/c/ibcast.c deleted file mode 100644 index acb55f93b9b..00000000000 --- a/ompi/mpi/c/ibcast.c +++ /dev/null @@ -1,121 +0,0 @@ -/* - * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ibcast = PMPI_Ibcast -#endif -#define MPI_Ibcast PMPI_Ibcast -#endif - -static const char FUNC_NAME[] = "MPI_Ibcast"; - - -int MPI_Ibcast(void *buffer, int count, MPI_Datatype datatype, - int root, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IBCAST, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - if (OMPI_COMM_IS_INTRA(comm)) { - if (ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); - } else { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); - } - } else { - if (MPI_ROOT == root) { - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); - } else if (MPI_PROC_NULL != root) { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Errors for all ranks */ - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (MPI_IN_PLACE == buffer) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - - /* If there's only one node, or if the count is 0, we're done */ - - if ((OMPI_COMM_IS_INTRA(comm) && ompi_comm_size(comm) <= 1) || - 0 == count) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_ibcast(buffer, count, datatype, root, comm, - request, - comm->c_coll->coll_ibcast_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (!OMPI_COMM_IS_INTRA(comm)) { - if (MPI_PROC_NULL == root) { - datatype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, datatype, NULL); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ibcast.c.in b/ompi/mpi/c/ibcast.c.in new file mode 100644 index 00000000000..70eaea4a18f --- /dev/null +++ b/ompi/mpi/c/ibcast.c.in @@ -0,0 +1,113 @@ +/* + * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ibcast(BUFFER_OUT buffer, COUNT count, DATATYPE datatype, + INT root, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IBCAST, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + if (OMPI_COMM_IS_INTRA(comm)) { + if (ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); + } else { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); + } + } else { + if (MPI_ROOT == root) { + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, buffer, count, datatype); + } else if (MPI_PROC_NULL != root) { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, buffer, count, datatype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Errors for all ranks */ + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (MPI_IN_PLACE == buffer) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + + /* If there's only one node, or if the count is 0, we're done */ + + if ((OMPI_COMM_IS_INTRA(comm) && ompi_comm_size(comm) <= 1) || + 0 == count) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_ibcast(buffer, count, datatype, root, comm, + request, + comm->c_coll->coll_ibcast_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (!OMPI_COMM_IS_INTRA(comm)) { + if (MPI_PROC_NULL == root) { + datatype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, datatype, NULL); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ibsend.c b/ompi/mpi/c/ibsend.c deleted file mode 100644 index fa22b745213..00000000000 --- a/ompi/mpi/c/ibsend.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/mca/pml/base/pml_base_bsend.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ibsend = PMPI_Ibsend -#endif -#define MPI_Ibsend PMPI_Ibsend -#endif - -static const char FUNC_NAME[] = "MPI_Ibsend"; - - -int MPI_Ibsend(const void *buf, int count, MPI_Datatype type, int dest, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_IBSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - MEMCHECKER ( - memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); - ); - rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, MCA_PML_BASE_SEND_BUFFERED, comm, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ibsend.c.in b/ompi/mpi/c/ibsend.c.in new file mode 100644 index 00000000000..dbe9b9e0c29 --- /dev/null +++ b/ompi/mpi/c/ibsend.c.in @@ -0,0 +1,90 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/mca/pml/base/pml_base_bsend.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ibsend(BUFFER buf, COUNT count, DATATYPE type, INT dest, + INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_IBSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + MEMCHECKER ( + memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); + ); + rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, MCA_PML_BASE_SEND_BUFFERED, comm, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/iexscan.c b/ompi/mpi/c/iexscan.c deleted file mode 100644 index 0c90e47af12..00000000000 --- a/ompi/mpi/c/iexscan.c +++ /dev/null @@ -1,96 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iexscan = PMPI_Iexscan -#endif -#define MPI_Iexscan PMPI_Iexscan -#endif - -static const char FUNC_NAME[] = "MPI_Iexscan"; - - -int MPI_Iexscan(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IEXSCAN, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - if (MPI_IN_PLACE != sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation -- same checks for intracommunicators - and intercommunicators */ - else if (MPI_OP_NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_iexscan(sendbuf, recvbuf, count, - datatype, op, comm, request, - comm->c_coll->coll_iexscan_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/iexscan.c.in b/ompi/mpi/c/iexscan.c.in new file mode 100644 index 00000000000..a945d98ae53 --- /dev/null +++ b/ompi/mpi/c/iexscan.c.in @@ -0,0 +1,88 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iexscan(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IEXSCAN, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + if (MPI_IN_PLACE != sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation -- same checks for intracommunicators + and intercommunicators */ + else if (MPI_OP_NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_iexscan(sendbuf, recvbuf, count, + datatype, op, comm, request, + comm->c_coll->coll_iexscan_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/igather.c b/ompi/mpi/c/igather.c deleted file mode 100644 index 37b977162b5..00000000000 --- a/ompi/mpi/c/igather.c +++ /dev/null @@ -1,202 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Igather = PMPI_Igather -#endif -#define MPI_Igather PMPI_Igather -#endif - -static const char FUNC_NAME[] = "MPI_Igather"; - - -int MPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IGATHER, 1); - - MEMCHECKER( - int rank; - ptrdiff_t ext; - - rank = ompi_comm_rank(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+rank*ext, - recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_igather(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, request, - comm->c_coll->coll_igather_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == sendbuf) { - sendtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - recvtype = NULL; - } - } else { - if (MPI_ROOT == root) { - sendtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - recvtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/igather.c.in b/ompi/mpi/c/igather.c.in new file mode 100644 index 00000000000..b947a324081 --- /dev/null +++ b/ompi/mpi/c/igather.c.in @@ -0,0 +1,195 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS igather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IGATHER, 1); + + MEMCHECKER( + int rank; + ptrdiff_t ext; + + rank = ompi_comm_rank(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+rank*ext, + recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_igather(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, request, + comm->c_coll->coll_igather_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == sendbuf) { + sendtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + recvtype = NULL; + } + } else { + if (MPI_ROOT == root) { + sendtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + recvtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/igatherv.c b/ompi/mpi/c/igatherv.c deleted file mode 100644 index f34993cb8a7..00000000000 --- a/ompi/mpi/c/igatherv.c +++ /dev/null @@ -1,229 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Igatherv = PMPI_Igatherv -#endif -#define MPI_Igatherv PMPI_Igatherv -#endif - -static const char FUNC_NAME[] = "MPI_Igatherv"; - - -int MPI_Igatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_IGATHERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else { - memchecker_datatype(sendtype); - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } else { - if (MPI_ROOT == root) { - memchecker_datatype(recvtype); - /* check whether root's receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(sendtype); - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != sendbuf) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the senders */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == recvcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - } - } - } - - void* updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - } else { - updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_igatherv(sendbuf, sendcount, sendtype, updated_recvbuf, - recvcounts_desc, displs_desc, recvtype, - root, comm, request, comm->c_coll->coll_igatherv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == sendbuf) { - sendtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - recvtype = NULL; - } - } else { - if (MPI_ROOT == root) { - sendtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - recvtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/igatherv.c.in b/ompi/mpi/c/igatherv.c.in new file mode 100644 index 00000000000..346db74a4c9 --- /dev/null +++ b/ompi/mpi/c/igatherv.c.in @@ -0,0 +1,221 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS igatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, INT root, COMM comm, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_IGATHERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else { + memchecker_datatype(sendtype); + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } else { + if (MPI_ROOT == root) { + memchecker_datatype(recvtype); + /* check whether root's receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(sendtype); + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != sendbuf) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the senders */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == recvcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + } + } + } + + void* updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + } else { + updated_recvbuf = (root == MPI_ROOT) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_igatherv(sendbuf, sendcount, sendtype, updated_recvbuf, + recvcounts_desc, displs_desc, recvtype, + root, comm, request, comm->c_coll->coll_igatherv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == sendbuf) { + sendtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + recvtype = NULL; + } + } else { + if (MPI_ROOT == root) { + sendtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + recvtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/improbe.c b/ompi/mpi/c/improbe.c deleted file mode 100644 index d0ea3f708f6..00000000000 --- a/ompi/mpi/c/improbe.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020-2021 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/message/message.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Improbe = PMPI_Improbe -#endif -#define MPI_Improbe PMPI_Improbe -#endif - -static const char FUNC_NAME[] = "MPI_Improbe"; - - -int MPI_Improbe(int source, int tag, MPI_Comm comm, int *flag, - MPI_Message *message, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_invalid(comm)) { - rc = MPI_ERR_COMM; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (NULL == message) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == source) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* Per MPI-1, the MPI_ERROR field is not defined for - single-completion calls */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - *message = &ompi_message_no_proc.message; - *flag = 1; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - rc = MCA_PML_CALL(improbe(source, tag, comm, flag, message, status)); - /* Per MPI-1, the MPI_ERROR field is not defined for - single-completion calls */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/improbe.c.in b/ompi/mpi/c/improbe.c.in new file mode 100644 index 00000000000..a0f1c7c221f --- /dev/null +++ b/ompi/mpi/c/improbe.c.in @@ -0,0 +1,84 @@ +/* + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/message/message.h" + +PROTOTYPE ERROR_CLASS improbe(INT source, INT tag, COMM comm, INT_OUT flag, + MESSAGE_OUT message, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_invalid(comm)) { + rc = MPI_ERR_COMM; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (NULL == message) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == source) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* Per MPI-1, the MPI_ERROR field is not defined for + single-completion calls */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + *message = &ompi_message_no_proc.message; + *flag = 1; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + rc = MCA_PML_CALL(improbe(source, tag, comm, flag, message, status)); + /* Per MPI-1, the MPI_ERROR field is not defined for + single-completion calls */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/imrecv.c b/ompi/mpi/c/imrecv.c deleted file mode 100644 index 719a3b8b719..00000000000 --- a/ompi/mpi/c/imrecv.c +++ /dev/null @@ -1,78 +0,0 @@ -/* - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/message/message.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Imrecv = PMPI_Imrecv -#endif -#define MPI_Imrecv PMPI_Imrecv -#endif - -static const char FUNC_NAME[] = "MPI_Imrecv"; - - -int MPI_Imrecv(void *buf, int count, MPI_Datatype type, - MPI_Message *message, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - ompi_communicator_t *comm; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_message(message); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - - if (NULL == message || MPI_MESSAGE_NULL == *message) { - rc = MPI_ERR_REQUEST; - comm = MPI_COMM_NULL; - } else { - comm = (*message)->comm; - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } else { - comm = (*message)->comm; - } - - if (&ompi_message_no_proc.message == *message) { - *request = &ompi_request_empty; - *message = MPI_MESSAGE_NULL; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The message and associated request will be checked by the PML, and - * handled appropriately. So no need to check here. - */ -#endif - - rc = MCA_PML_CALL(imrecv(buf, count, type, message, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/imrecv.c.in b/ompi/mpi/c/imrecv.c.in new file mode 100644 index 00000000000..ea8823790c0 --- /dev/null +++ b/ompi/mpi/c/imrecv.c.in @@ -0,0 +1,70 @@ +/* + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/message/message.h" + +PROTOTYPE ERROR_CLASS imrecv(BUFFER_OUT buf, COUNT count, DATATYPE type, + MESSAGE_OUT message, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + ompi_communicator_t *comm; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_message(message); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + + if (NULL == message || MPI_MESSAGE_NULL == *message) { + rc = MPI_ERR_REQUEST; + comm = MPI_COMM_NULL; + } else { + comm = (*message)->comm; + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } else { + comm = (*message)->comm; + } + + if (&ompi_message_no_proc.message == *message) { + *request = &ompi_request_empty; + *message = MPI_MESSAGE_NULL; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The message and associated request will be checked by the PML, and + * handled appropriately. So no need to check here. + */ +#endif + + rc = MCA_PML_CALL(imrecv(buf, count, type, message, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/ineighbor_allgather.c b/ompi/mpi/c/ineighbor_allgather.c deleted file mode 100644 index a6a5603ecd4..00000000000 --- a/ompi/mpi/c/ineighbor_allgather.c +++ /dev/null @@ -1,129 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ineighbor_allgather = PMPI_Ineighbor_allgather -#endif -#define MPI_Ineighbor_allgather PMPI_Ineighbor_allgather -#endif - -static const char FUNC_NAME[] = "MPI_Ineighbor_allgather"; - - -int MPI_Ineighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLGATHER, 1); - - MEMCHECKER( - ptrdiff_t ext; - - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_ineighbor_allgather(sendbuf, sendcount, sendtype, recvbuf, - recvcount, recvtype, comm, request, - comm->c_coll->coll_ineighbor_allgather_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ineighbor_allgather.c.in b/ompi/mpi/c/ineighbor_allgather.c.in new file mode 100644 index 00000000000..b434176f31e --- /dev/null +++ b/ompi/mpi/c/ineighbor_allgather.c.in @@ -0,0 +1,121 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ineighbor_allgather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLGATHER, 1); + + MEMCHECKER( + ptrdiff_t ext; + + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_ineighbor_allgather(sendbuf, sendcount, sendtype, recvbuf, + recvcount, recvtype, comm, request, + comm->c_coll->coll_ineighbor_allgather_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ineighbor_allgatherv.c b/ompi/mpi/c/ineighbor_allgatherv.c deleted file mode 100644 index 1a8f0c65e04..00000000000 --- a/ompi/mpi/c/ineighbor_allgatherv.c +++ /dev/null @@ -1,156 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ineighbor_allgatherv = PMPI_Ineighbor_allgatherv -#endif -#define MPI_Ineighbor_allgatherv PMPI_Ineighbor_allgatherv -#endif - -static const char FUNC_NAME[] = "MPI_Ineighbor_allgatherv"; - - -int MPI_Ineighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, MPI_Comm comm, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLGATHERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_ineighbor_allgatherv(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, displs_desc, - recvtype, comm, request, - comm->c_coll->coll_ineighbor_allgatherv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ineighbor_allgatherv.c.in b/ompi/mpi/c/ineighbor_allgatherv.c.in new file mode 100644 index 00000000000..5f1eb6086b9 --- /dev/null +++ b/ompi/mpi/c/ineighbor_allgatherv.c.in @@ -0,0 +1,148 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ineighbor_allgatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLGATHERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_ineighbor_allgatherv(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, displs_desc, + recvtype, comm, request, + comm->c_coll->coll_ineighbor_allgatherv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ineighbor_alltoall.c b/ompi/mpi/c/ineighbor_alltoall.c deleted file mode 100644 index 18ef991ecc5..00000000000 --- a/ompi/mpi/c/ineighbor_alltoall.c +++ /dev/null @@ -1,130 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ineighbor_alltoall = PMPI_Ineighbor_alltoall -#endif -#define MPI_Ineighbor_alltoall PMPI_Ineighbor_alltoall -#endif - -static const char FUNC_NAME[] = "MPI_Ineighbor_alltoall"; - - -int MPI_Ineighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Request *request) -{ - size_t sendtype_size, recvtype_size; - int err; - - SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALL, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_ineighbor_alltoall(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - request, comm->c_coll->coll_ineighbor_alltoall_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ineighbor_alltoall.c.in b/ompi/mpi/c/ineighbor_alltoall.c.in new file mode 100644 index 00000000000..c93bb5a248e --- /dev/null +++ b/ompi/mpi/c/ineighbor_alltoall.c.in @@ -0,0 +1,122 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ineighbor_alltoall(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_INOUT request) +{ + size_t sendtype_size, recvtype_size; + int err; + + SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALL, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_ineighbor_alltoall(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + request, comm->c_coll->coll_ineighbor_alltoall_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ineighbor_alltoallv.c b/ompi/mpi/c/ineighbor_alltoallv.c deleted file mode 100644 index 97fe2728901..00000000000 --- a/ompi/mpi/c/ineighbor_alltoallv.c +++ /dev/null @@ -1,161 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ineighbor_alltoallv = PMPI_Ineighbor_alltoallv -#endif -#define MPI_Ineighbor_alltoallv PMPI_Ineighbor_alltoallv -#endif - -static const char FUNC_NAME[] = "MPI_Ineighbor_alltoallv"; - - -int MPI_Ineighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], - MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], - const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, - MPI_Request *request) -{ - int i, err; - int indegree, outdegree; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALLV, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - } - - memchecker_datatype(recvtype); - ompi_datatype_type_extent(sendtype, &send_ext); - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - if (MPI_SUCCESS == err) { - if (MPI_IN_PLACE != sendbuf) { - for ( i = 0; i < outdegree; i++ ) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - } - for ( i = 0; i < indegree; i++ ) { - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || - ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || - MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - for (i = 0; i < outdegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - for (i = 0; i < indegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - indegree = dist_graph->indegree; - outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_ineighbor_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, - sendtype, recvbuf, recvcounts_desc, rdispls_desc, - recvtype, comm, request, comm->c_coll->coll_ineighbor_alltoallv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ineighbor_alltoallv.c.in b/ompi/mpi/c/ineighbor_alltoallv.c.in new file mode 100644 index 00000000000..38e7bf82abd --- /dev/null +++ b/ompi/mpi/c/ineighbor_alltoallv.c.in @@ -0,0 +1,153 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ineighbor_alltoallv(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm, + REQUEST_INOUT request) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALLV, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + } + + memchecker_datatype(recvtype); + ompi_datatype_type_extent(sendtype, &send_ext); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + } + for ( i = 0; i < indegree; i++ ) { + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_ineighbor_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, + sendtype, recvbuf, recvcounts_desc, rdispls_desc, + recvtype, comm, request, comm->c_coll->coll_ineighbor_alltoallv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ineighbor_alltoallw.c b/ompi/mpi/c/ineighbor_alltoallw.c deleted file mode 100644 index 5e04be41b54..00000000000 --- a/ompi/mpi/c/ineighbor_alltoallw.c +++ /dev/null @@ -1,159 +0,0 @@ -/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ineighbor_alltoallw = PMPI_Ineighbor_alltoallw -#endif -#define MPI_Ineighbor_alltoallw PMPI_Ineighbor_alltoallw -#endif - -static const char FUNC_NAME[] = "MPI_Ineighbor_alltoallw"; - - -int MPI_Ineighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], - const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[], - const MPI_Aint rdispls[], const MPI_Datatype recvtypes[], MPI_Comm comm, - MPI_Request *request) -{ - int i, err; - int indegree, outdegree; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALLW, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - if (MPI_SUCCESS == err) { - if (MPI_IN_PLACE != sendbuf) { - for ( i = 0; i < outdegree; i++ ) { - memchecker_datatype(sendtypes[i]); - - ompi_datatype_type_extent(sendtypes[i], &send_ext); - - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtypes[i]); - } - } - for ( i = 0; i < indegree; i++ ) { - memchecker_datatype(recvtypes[i]); - - ompi_datatype_type_extent(recvtypes[i], &recv_ext); - - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+sdispls[i]*recv_ext, - recvcounts[i], recvtypes[i]); - } - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes))) || - ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes))) || - MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - for (i = 0; i < outdegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - for (i = 0; i < indegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - indegree = dist_graph->indegree; - outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_ineighbor_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, sendtypes, - recvbuf, recvcounts_desc, rdispls_desc, recvtypes, comm, request, - comm->c_coll->coll_ineighbor_alltoallw_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes_w(*request, sendtypes, recvtypes, true); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ineighbor_alltoallw.c.in b/ompi/mpi/c/ineighbor_alltoallw.c.in new file mode 100644 index 00000000000..8f9d29591de --- /dev/null +++ b/ompi/mpi/c/ineighbor_alltoallw.c.in @@ -0,0 +1,151 @@ +/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ineighbor_alltoallw(BUFFER sendbuf, COUNT_ARRAY sendcounts, AINT_ARRAY sdispls, + DATATYPE_ARRAY sendtypes, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + AINT_ARRAY rdispls, DATATYPE_ARRAY recvtypes, COMM comm, + REQUEST_INOUT request) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_INEIGHBOR_ALLTOALLW, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + memchecker_datatype(sendtypes[i]); + + ompi_datatype_type_extent(sendtypes[i], &send_ext); + + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtypes[i]); + } + } + for ( i = 0; i < indegree; i++ ) { + memchecker_datatype(recvtypes[i]); + + ompi_datatype_type_extent(recvtypes[i], &recv_ext); + + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+sdispls[i]*recv_ext, + recvcounts[i], recvtypes[i]); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_ineighbor_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, sendtypes, + recvbuf, recvcounts_desc, rdispls_desc, recvtypes, comm, request, + comm->c_coll->coll_ineighbor_alltoallw_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes_w(*request, sendtypes, recvtypes, true); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/info_c2f.c b/ompi/mpi/c/info_c2f.c deleted file mode 100644 index 372c8abe766..00000000000 --- a/ompi/mpi/c/info_c2f.c +++ /dev/null @@ -1,52 +0,0 @@ -/* -*- 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-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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_c2f = PMPI_Info_c2f -#endif -#define MPI_Info_c2f PMPI_Info_c2f -#endif - -/* static const char FUNC_NAME[] = "MPI_Info_c2f"; */ - - -MPI_Fint MPI_Info_c2f(MPI_Info info) -{ - if (MPI_PARAM_CHECK) { - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(info->i_f_to_c_index); -} diff --git a/ompi/mpi/c/info_c2f.c.in b/ompi/mpi/c/info_c2f.c.in new file mode 100644 index 00000000000..827dde289ae --- /dev/null +++ b/ompi/mpi/c/info_c2f.c.in @@ -0,0 +1,42 @@ +/* -*- 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-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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/info/info.h" + +PROTOTYPE FINT info_c2f(INFO info) +{ + if (MPI_PARAM_CHECK) { + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(info->i_f_to_c_index); +} diff --git a/ompi/mpi/c/info_create.c b/ompi/mpi/c/info_create.c deleted file mode 100644 index c6f7ee18f26..00000000000 --- a/ompi/mpi/c/info_create.c +++ /dev/null @@ -1,69 +0,0 @@ -/* -*- 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_create = PMPI_Info_create -#endif -#define MPI_Info_create PMPI_Info_create -#endif - -static const char FUNC_NAME[] = "MPI_Info_create"; - -/** - * Create a new info object - * - * @param info Pointer to the MPI_Info handle - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_INFO - * @retval MPI_ERR_NO_MEM - * - * When an MPI_Info object is not being used, it should be freed using - * MPI_Info_free - */ -int MPI_Info_create(MPI_Info *info) -{ - if (MPI_PARAM_CHECK) { - if (NULL == info) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - *info = ompi_info_allocate (); - if (NULL == (*info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, - FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/info_create.c.in b/ompi/mpi/c/info_create.c.in new file mode 100644 index 00000000000..ad60e3f306d --- /dev/null +++ b/ompi/mpi/c/info_create.c.in @@ -0,0 +1,60 @@ +/* -*- 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + +/** + * Create a new info object + * + * @param info Pointer to the MPI_Info handle + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_INFO + * @retval MPI_ERR_NO_MEM + * + * When an MPI_Info object is not being used, it should be freed using + * MPI_Info_free + */ +PROTOTYPE ERROR_CLASS info_create(INFO_OUT info) +{ + if (MPI_PARAM_CHECK) { + if (NULL == info) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + *info = ompi_info_allocate (); + if (NULL == (*info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/info_create_env.c b/ompi/mpi/c/info_create_env.c deleted file mode 100644 index 68f7ffca99c..00000000000 --- a/ompi/mpi/c/info_create_env.c +++ /dev/null @@ -1,79 +0,0 @@ -/* -*- 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_create_env = PMPI_Info_create_env -#endif -#define MPI_Info_create_env PMPI_Info_create_env -#endif - -static const char FUNC_NAME[] = "MPI_Info_create_env"; - -/** - * Returns an info object with the same construction as MPI_INFO_ENV as created - * during MPI_INIT or MPI_INIT_THREAD when the same arguments are used. - * - * @param argc number or arguments (Integer) - * @param argv Pointer to array of arguments - * @param info Pointer to the MPI_Info handle - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_INFO - * @retval MPI_ERR_NO_MEM - * - * When an MPI_Info object is not being used, it should be freed using - * MPI_Info_free - */ -int MPI_Info_create_env(int argc, char *argv[], MPI_Info *info) -{ - int rc; - ompi_info_t *the_info; - - if (MPI_PARAM_CHECK) { - if (NULL == info) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - the_info = ompi_info_allocate (); - if (NULL == the_info) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, - FUNC_NAME); - } - - *info = the_info; - - rc = ompi_mpiinfo_init_env(argc, argv, the_info); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/info_create_env.c.in b/ompi/mpi/c/info_create_env.c.in new file mode 100644 index 00000000000..9cdd7fc0120 --- /dev/null +++ b/ompi/mpi/c/info_create_env.c.in @@ -0,0 +1,70 @@ +/* -*- 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + +/** + * Returns an info object with the same construction as MPI_INFO_ENV as created + * during MPI_INIT or MPI_INIT_THREAD when the same arguments are used. + * + * @param argc number or arguments (Integer) + * @param argv Pointer to array of arguments + * @param info Pointer to the MPI_Info handle + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_INFO + * @retval MPI_ERR_NO_MEM + * + * When an MPI_Info object is not being used, it should be freed using + * MPI_Info_free + */ +PROTOTYPE ERROR_CLASS info_create_env(INT argc, STRING_ARRAY argv, INFO_OUT info) +{ + int rc; + ompi_info_t *the_info; + + if (MPI_PARAM_CHECK) { + if (NULL == info) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + the_info = ompi_info_allocate (); + if (NULL == the_info) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + } + + *info = the_info; + + rc = ompi_mpiinfo_init_env(argc, argv, the_info); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/info_delete.c b/ompi/mpi/c/info_delete.c deleted file mode 100644 index 3fcf5256782..00000000000 --- a/ompi/mpi/c/info_delete.c +++ /dev/null @@ -1,91 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_delete = PMPI_Info_delete -#endif -#define MPI_Info_delete PMPI_Info_delete -#endif - -static const char FUNC_NAME[] = "MPI_Info_delete"; - - -/** - * Delete a (key,value) pair from "info" - * - * @param info MPI_Info handle on which we need to operate - * @param key The key portion of the (key,value) pair that - * needs to be deleted - * - * @retval MPI_SUCCESS If the (key,val) pair was deleted - * @retval MPI_ERR_INFO - * @retval MPI_ERR_INFO_KEYY - */ -int MPI_Info_delete(MPI_Info info, const char *key) { - int key_length; - int err; - - /** - * This function merely deletes the (key,val) pair in info - */ - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - - key_length = (key) ? (int)strlen (key) : 0; - if ((NULL == key) || (0 == key_length) || - (MPI_MAX_INFO_KEY <= key_length)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, - FUNC_NAME); - } - } - - err = ompi_info_delete (info, key); - - // Note that ompi_info_delete() (i.e., opal_info_delete()) will - // return OPAL_ERR_NOT_FOUND if there was no corresponding key to - // delete. Per MPI-3.1, we need to convert that to - // MPI_ERR_INFO_NOKEY. - if (OPAL_ERR_NOT_FOUND == err) { - err = MPI_ERR_INFO_NOKEY; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_delete.c.in b/ompi/mpi/c/info_delete.c.in new file mode 100644 index 00000000000..1c0126803b6 --- /dev/null +++ b/ompi/mpi/c/info_delete.c.in @@ -0,0 +1,82 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include +#include + +/** + * Delete a (key,value) pair from "info" + * + * @param info MPI_Info handle on which we need to operate + * @param key The key portion of the (key,value) pair that + * needs to be deleted + * + * @retval MPI_SUCCESS If the (key,val) pair was deleted + * @retval MPI_ERR_INFO + * @retval MPI_ERR_INFO_KEYY + */ +PROTOTYPE ERROR_CLASS info_delete(INFO info, STRING key) +{ + int key_length; + int err; + + /** + * This function merely deletes the (key,val) pair in info + */ + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + + key_length = (key) ? (int)strlen (key) : 0; + if ((NULL == key) || (0 == key_length) || + (MPI_MAX_INFO_KEY <= key_length)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, + FUNC_NAME); + } + } + + err = ompi_info_delete (info, key); + + // Note that ompi_info_delete() (i.e., opal_info_delete()) will + // return OPAL_ERR_NOT_FOUND if there was no corresponding key to + // delete. Per MPI-3.1, we need to convert that to + // MPI_ERR_INFO_NOKEY. + if (OPAL_ERR_NOT_FOUND == err) { + err = MPI_ERR_INFO_NOKEY; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_dup.c b/ompi/mpi/c/info_dup.c deleted file mode 100644 index f678c2738b0..00000000000 --- a/ompi/mpi/c/info_dup.c +++ /dev/null @@ -1,89 +0,0 @@ -/* -*- 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_dup = PMPI_Info_dup -#endif -#define MPI_Info_dup PMPI_Info_dup -#endif - -static const char FUNC_NAME[] = "MPI_Info_dup"; - - -/** - * MPI_Info_dup - Duplicate an 'MPI_Info' object - * - * @param info source info object (handle) - * @param newinfo pointer to the new info object (handle) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_INFO - * @retval MPI_ERR_NO_MEM - * - * Not only will the (key, value) pairs be duplicated, the order of keys - * will be the same in 'newinfo' as it is in 'info'. - * When an info object is no longer being used, it should be freed with - * 'MPI_Info_free'. - */ -int MPI_Info_dup(MPI_Info info, MPI_Info *newinfo) { - int err; - - /** - * Here we need to do 2 things - * 1. Create a newinfo object using MPI_Info_create - * 2. Fetch all the values from info and copy them to - * newinfo using MPI_Info_set - * The new implementation facilitates traversal in many ways. - * I have chosen to get the number of elements on the list - * and copy them to newinfo one by one - */ - - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || NULL == newinfo || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - *newinfo = ompi_info_allocate(); - if (NULL == *newinfo) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, - FUNC_NAME); - } - - /* - * Now to actually duplicate all the values - */ - err = ompi_info_dup (info, newinfo); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_dup.c.in b/ompi/mpi/c/info_dup.c.in new file mode 100644 index 00000000000..b18c11a36ec --- /dev/null +++ b/ompi/mpi/c/info_dup.c.in @@ -0,0 +1,80 @@ +/* -*- 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + +/** + * MPI_Info_dup - Duplicate an 'MPI_Info' object + * + * @param info source info object (handle) + * @param newinfo pointer to the new info object (handle) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_INFO + * @retval MPI_ERR_NO_MEM + * + * Not only will the (key, value) pairs be duplicated, the order of keys + * will be the same in 'newinfo' as it is in 'info'. + * When an info object is no longer being used, it should be freed with + * 'MPI_Info_free'. + */ +PROTOTYPE ERROR_CLASS info_dup(INFO info, INFO_OUT newinfo) +{ + int err; + + /** + * Here we need to do 2 things + * 1. Create a newinfo object using MPI_Info_create + * 2. Fetch all the values from info and copy them to + * newinfo using MPI_Info_set + * The new implementation facilitates traversal in many ways. + * I have chosen to get the number of elements on the list + * and copy them to newinfo one by one + */ + + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || NULL == newinfo || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + *newinfo = ompi_info_allocate(); + if (NULL == *newinfo) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + } + + /* + * Now to actually duplicate all the values + */ + err = ompi_info_dup (info, newinfo); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_f2c.c b/ompi/mpi/c/info_f2c.c deleted file mode 100644 index 16f2161d5ed..00000000000 --- a/ompi/mpi/c/info_f2c.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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-2007 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) 2018-2022 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_f2c = PMPI_Info_f2c -#endif -#define MPI_Info_f2c PMPI_Info_f2c -#endif - -static const char FUNC_NAME[] __opal_attribute_unused__ = "MPI_Info_f2c"; - - -/** - * Converts the MPI_Fint info into a valid C MPI_Info handle - * - * @param info Integer handle to an MPI_INFO object - * @retval C handle corresponding to MPI_INFO object - */ -MPI_Info MPI_Info_f2c(MPI_Fint info) -{ - int info_index = OMPI_FINT_2_INT(info); - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - /* - * Deal with special pre-defined cases for MPI 4.0 - */ - - if (info_index == 0) { - return MPI_INFO_NULL; - } - - if (info_index == 1) { - return MPI_INFO_ENV; - } - - /* - * if the application has not created an info object yet - * then the size of the ompi_info_f_to_c_table is zero - * so this check can be done even if an info object has not - * previously been created. - */ - - if (info_index < 0 || - info_index >= - opal_pointer_array_get_size(&ompi_info_f_to_c_table)) { - return NULL; - } - - /* - * if we get here, then the info support infrastructure has been initialized - * either via a prior call to MPI_Info_create or one of the MPI initialization - * methods. - */ - return (MPI_Info)opal_pointer_array_get_item(&ompi_info_f_to_c_table, info_index); -} diff --git a/ompi/mpi/c/info_f2c.c.in b/ompi/mpi/c/info_f2c.c.in new file mode 100644 index 00000000000..44f1c9e9c0d --- /dev/null +++ b/ompi/mpi/c/info_f2c.c.in @@ -0,0 +1,78 @@ +/* -*- 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-2007 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) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/info/info.h" + +/** + * Converts the MPI_Fint info into a valid C MPI_Info handle + * + * @param info Integer handle to an MPI_INFO object + * @retval C handle corresponding to MPI_INFO object + */ +PROTOTYPE INFO info_f2c(FINT info) +{ + int info_index = OMPI_FINT_2_INT(info); + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + /* + * Deal with special pre-defined cases for MPI 4.0 + */ + + if (info_index == 0) { + return MPI_INFO_NULL; + } + + if (info_index == 1) { + return MPI_INFO_ENV; + } + + /* + * if the application has not created an info object yet + * then the size of the ompi_info_f_to_c_table is zero + * so this check can be done even if an info object has not + * previously been created. + */ + + if (info_index < 0 || + info_index >= + opal_pointer_array_get_size(&ompi_info_f_to_c_table)) { + return NULL; + } + + /* + * if we get here, then the info support infrastructure has been initialized + * either via a prior call to MPI_Info_create or one of the MPI initialization + * methods. + */ + return (MPI_Info)opal_pointer_array_get_item(&ompi_info_f_to_c_table, info_index); +} diff --git a/ompi/mpi/c/info_free.c b/ompi/mpi/c/info_free.c deleted file mode 100644 index 9ebc5a761fb..00000000000 --- a/ompi/mpi/c/info_free.c +++ /dev/null @@ -1,72 +0,0 @@ -/* -*- 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_free = PMPI_Info_free -#endif -#define MPI_Info_free PMPI_Info_free -#endif - -static const char FUNC_NAME[] = "MPI_Info_free"; - - -/** - * MPI_Info_free - Free an 'MPI_Info' object. - * - * @param info pointer to info object to be freed (handle) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_INFO - * - * Upon successful completion, 'info' will be set to 'MPI_INFO_NULL'. - */ -int MPI_Info_free(MPI_Info *info) -{ - int err; - - /* - * Free all the alloced items from MPI_Info info. - * Make sure the items are freed in an orderly - * fashion so that there are no dangling pointers. - */ - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == *info || - ompi_info_is_freed(*info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - err = ompi_info_free(info); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_free.c.in b/ompi/mpi/c/info_free.c.in new file mode 100644 index 00000000000..96e45184187 --- /dev/null +++ b/ompi/mpi/c/info_free.c.in @@ -0,0 +1,62 @@ +/* -*- 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + +/** + * MPI_Info_free - Free an 'MPI_Info' object. + * + * @param info pointer to info object to be freed (handle) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_INFO + * + * Upon successful completion, 'info' will be set to 'MPI_INFO_NULL'. + */ +PROTOTYPE ERROR_CLASS info_free(INFO_OUT info) +{ + int err; + + /* + * Free all the alloced items from MPI_Info info. + * Make sure the items are freed in an orderly + * fashion so that there are no dangling pointers. + */ + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == *info || + ompi_info_is_freed(*info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + err = ompi_info_free(info); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_get.c b/ompi/mpi/c/info_get.c deleted file mode 100644 index 563c6cd1f83..00000000000 --- a/ompi/mpi/c/info_get.c +++ /dev/null @@ -1,112 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "opal/util/string_copy.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_get = PMPI_Info_get -#endif -#define MPI_Info_get PMPI_Info_get -#endif - -static const char FUNC_NAME[] = "MPI_Info_get"; - -/** - * MPI_Info_get - Get a (key, value) pair from an 'MPI_Info' object - * - * @param info info object (handle) - * @param key null-terminated character string of the index key - * @param valuelen maximum length of 'value' (integer) - * @param value null-terminated character string of the value - * @param flag true (1) if 'key' defined on 'info', false (0) if not - * (logical) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO - * @retval MPI_ERR_INFO_KEY - * @retval MPI_ERR_INFO_VALUE - * - * In C and C++, 'valuelen' should be one less than the allocated space - * to allow for for the null terminator. - */ -int MPI_Info_get(MPI_Info info, const char *key, int valuelen, - char *value, int *flag) -{ - int err; - int key_length; - opal_cstring_t *info_str; - - /* - * Simple function. All we need to do is search for the value - * having the "key" associated with it and then populate the - * necessary structures. - */ - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - if (0 > valuelen){ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - - key_length = (key) ? (int)strlen (key) : 0; - if ((NULL == key) || (0 == key_length) || - (MPI_MAX_INFO_KEY <= key_length)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, - FUNC_NAME); - } - if (NULL == value) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_VALUE, - FUNC_NAME); - } - if (NULL == flag) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - err = ompi_info_get(info, key, &info_str, flag); - if (*flag) { - opal_string_copy(value, info_str->string, valuelen+1); - OBJ_RELEASE(info_str); - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_get.c.in b/ompi/mpi/c/info_get.c.in new file mode 100644 index 00000000000..4784eafcf26 --- /dev/null +++ b/ompi/mpi/c/info_get.c.in @@ -0,0 +1,103 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "opal/util/string_copy.h" +#include +#include + +/** + * MPI_Info_get - Get a (key, value) pair from an 'MPI_Info' object + * + * @param info info object (handle) + * @param key null-terminated character string of the index key + * @param valuelen maximum length of 'value' (integer) + * @param value null-terminated character string of the value + * @param flag true (1) if 'key' defined on 'info', false (0) if not + * (logical) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO + * @retval MPI_ERR_INFO_KEY + * @retval MPI_ERR_INFO_VALUE + * + * In C and C++, 'valuelen' should be one less than the allocated space + * to allow for for the null terminator. + */ +PROTOTYPE ERROR_CLASS info_get(INFO info, STRING key, INT valuelen, + STRING_OUT value, INT_OUT flag) +{ + int err; + int key_length; + opal_cstring_t *info_str; + + /* + * Simple function. All we need to do is search for the value + * having the "key" associated with it and then populate the + * necessary structures. + */ + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + if (0 > valuelen){ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + + key_length = (key) ? (int)strlen (key) : 0; + if ((NULL == key) || (0 == key_length) || + (MPI_MAX_INFO_KEY <= key_length)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, + FUNC_NAME); + } + if (NULL == value) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_VALUE, + FUNC_NAME); + } + if (NULL == flag) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + err = ompi_info_get(info, key, &info_str, flag); + if (*flag) { + opal_string_copy(value, info_str->string, valuelen+1); + OBJ_RELEASE(info_str); + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_get_nkeys.c b/ompi/mpi/c/info_get_nkeys.c deleted file mode 100644 index 850dadeb5ca..00000000000 --- a/ompi/mpi/c/info_get_nkeys.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_get_nkeys = PMPI_Info_get_nkeys -#endif -#define MPI_Info_get_nkeys PMPI_Info_get_nkeys -#endif - -static const char FUNC_NAME[] = "MPI_Info_get_nkeys"; - - -/** - * MPI_Info_get_nkeys - Returns the number of keys defined on an - * 'MPI_Info' object - * - * @param info info object (handle) - * @param nkeys number of keys defined on 'info' (integer) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO - * - * This function returns the number of elements in the list - * containing the key-value pairs - */ -int MPI_Info_get_nkeys(MPI_Info info, int *nkeys) -{ - int err; - - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - if (NULL == nkeys) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - err = ompi_info_get_nkeys(info, nkeys); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_get_nkeys.c.in b/ompi/mpi/c/info_get_nkeys.c.in new file mode 100644 index 00000000000..95e2bd9a540 --- /dev/null +++ b/ompi/mpi/c/info_get_nkeys.c.in @@ -0,0 +1,65 @@ +/* -*- 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + + +/** + * MPI_Info_get_nkeys - Returns the number of keys defined on an + * 'MPI_Info' object + * + * @param info info object (handle) + * @param nkeys number of keys defined on 'info' (integer) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO + * + * This function returns the number of elements in the list + * containing the key-value pairs + */ +PROTOTYPE ERROR_CLASS info_get_nkeys(INFO info, INT_OUT nkeys) +{ + int err; + + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + if (NULL == nkeys) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + err = ompi_info_get_nkeys(info, nkeys); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_get_nthkey.c b/ompi/mpi/c/info_get_nthkey.c deleted file mode 100644 index 6e40ac8bab3..00000000000 --- a/ompi/mpi/c/info_get_nthkey.c +++ /dev/null @@ -1,101 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "opal/util/string_copy.h" -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_get_nthkey = PMPI_Info_get_nthkey -#endif -#define MPI_Info_get_nthkey PMPI_Info_get_nthkey -#endif - -static const char FUNC_NAME[] = "MPI_Info_get_nthkey"; - - -/** - * MPI_Info_get_nthkey - Get a key indexed by integer from an 'MPI_Info' obje - * - * @param info info object (handle) - * @param n index of key to retrieve (integer) - * @param key character string of at least 'MPI_MAX_INFO_KEY' characters - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO - * @retval MPI_ERR_INFO_KEY - */ -int MPI_Info_get_nthkey(MPI_Info info, int n, char *key) -{ - int nkeys; - int err; - - /* - * 1. Check if info is a valid handle - * 2. Check if there are at least (n+1) elements - * 3. If so, give the nth defined key - */ - if (NULL == info || MPI_INFO_NULL == info) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, FUNC_NAME); - } - - if (MPI_PARAM_CHECK) { - if (ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, FUNC_NAME); - } - if (0 > n) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - if (NULL == key) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, FUNC_NAME); - } - } - - /* Keys are indexed on 0, which makes the "n" parameter offset by - 1 from the value returned by get_nkeys(). So be sure to - compare appropriately. */ - - err = ompi_info_get_nkeys(info, &nkeys); - OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); - if (n > (nkeys - 1)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE (MPI_ERR_INFO_KEY, FUNC_NAME); - } - - /* Everything seems alright. Call the back end key copy */ - - opal_cstring_t *key_str = NULL; - err = ompi_info_get_nthkey (info, n, &key_str); - if (NULL != key_str) { - opal_string_copy(key, key_str->string, MPI_MAX_INFO_KEY); - OBJ_RELEASE(key_str); - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_get_nthkey.c.in b/ompi/mpi/c/info_get_nthkey.c.in new file mode 100644 index 00000000000..1795a2ac905 --- /dev/null +++ b/ompi/mpi/c/info_get_nthkey.c.in @@ -0,0 +1,91 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "opal/util/string_copy.h" +#include + +/** + * MPI_Info_get_nthkey - Get a key indexed by integer from an 'MPI_Info' obje + * + * @param info info object (handle) + * @param n index of key to retrieve (integer) + * @param key character string of at least 'MPI_MAX_INFO_KEY' characters + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO + * @retval MPI_ERR_INFO_KEY + */ +PROTOTYPE ERROR_CLASS info_get_nthkey(INFO info, INT n, STRING_OUT key) +{ + int nkeys; + int err; + + /* + * 1. Check if info is a valid handle + * 2. Check if there are at least (n+1) elements + * 3. If so, give the nth defined key + */ + if (NULL == info || MPI_INFO_NULL == info) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, FUNC_NAME); + } + + if (MPI_PARAM_CHECK) { + if (ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, FUNC_NAME); + } + if (0 > n) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + if (NULL == key) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, FUNC_NAME); + } + } + + /* Keys are indexed on 0, which makes the "n" parameter offset by + 1 from the value returned by get_nkeys(). So be sure to + compare appropriately. */ + + err = ompi_info_get_nkeys(info, &nkeys); + OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); + if (n > (nkeys - 1)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE (MPI_ERR_INFO_KEY, FUNC_NAME); + } + + /* Everything seems alright. Call the back end key copy */ + + opal_cstring_t *key_str = NULL; + err = ompi_info_get_nthkey (info, n, &key_str); + if (NULL != key_str) { + opal_string_copy(key, key_str->string, MPI_MAX_INFO_KEY); + OBJ_RELEASE(key_str); + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_get_string.c b/ompi/mpi/c/info_get_string.c deleted file mode 100644 index d62d106b6ca..00000000000 --- a/ompi/mpi/c/info_get_string.c +++ /dev/null @@ -1,118 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2021-2022 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "opal/util/string_copy.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_get_string = PMPI_Info_get_string -#endif -#define MPI_Info_get_string PMPI_Info_get_string -#endif - -static const char FUNC_NAME[] = "MPI_Info_get_string"; - -/** - * MPI_Info_get_string - Get a (key, value) pair from an 'MPI_Info' object - * - * @param info info object (handle) - * @param key null-terminated character string of the index key - * @param buflen maximum length of 'value' (integer) - * @param value null-terminated character string of the value - * @param flag true (1) if 'key' defined on 'info', false (0) if not - * (logical) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO - * @retval MPI_ERR_INFO_KEY - * @retval MPI_ERR_INFO_VALUE - * - */ -int MPI_Info_get_string(MPI_Info info, const char *key, int *buflen, - char *value, int *flag) -{ - int err; - int key_length; - opal_cstring_t *info_str; - - /* - * Simple function. All we need to do is search for the value - * having the "key" associated with it and then populate the - * necessary structures. - */ - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - - key_length = (key) ? (int)strlen (key) : 0; - if ((NULL == key) || (0 == key_length) || - (MPI_MAX_INFO_KEY <= key_length)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, - FUNC_NAME); - } - if (NULL == buflen) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if ((NULL == value) && *buflen) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_VALUE, - FUNC_NAME); - } - if (NULL == flag) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - if (0 == *buflen) { - err = ompi_info_get_valuelen(info, key, buflen, flag); - if (1 == *flag) { - *buflen += 1; /* add on for the \0, see MPI 4.0 Standard */ - } - } else { - err = ompi_info_get(info, key, &info_str, flag); - if (*flag) { - opal_string_copy(value, info_str->string, *buflen); - *buflen = info_str->length + 1; /* add on for the \0, see MPI 4.0 Standard */ - OBJ_RELEASE(info_str); - } - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_get_string.c.in b/ompi/mpi/c/info_get_string.c.in new file mode 100644 index 00000000000..a9b17c3f99c --- /dev/null +++ b/ompi/mpi/c/info_get_string.c.in @@ -0,0 +1,110 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "opal/util/string_copy.h" +#include +#include + + +/** + * MPI_Info_get_string - Get a (key, value) pair from an 'MPI_Info' object + * + * @param info info object (handle) + * @param key null-terminated character string of the index key + * @param buflen maximum length of 'value' (integer) + * @param value null-terminated character string of the value + * @param flag true (1) if 'key' defined on 'info', false (0) if not + * (logical) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO + * @retval MPI_ERR_INFO_KEY + * @retval MPI_ERR_INFO_VALUE + * + */ +PROTOTYPE ERROR_CLASS Info_get_string(INFO info, STRING key, INT_OUT buflen, + STRING_OUT value, INT_OUT flag) +{ + int err; + int key_length; + opal_cstring_t *info_str; + + /* + * Simple function. All we need to do is search for the value + * having the "key" associated with it and then populate the + * necessary structures. + */ + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + + key_length = (key) ? (int)strlen (key) : 0; + if ((NULL == key) || (0 == key_length) || + (MPI_MAX_INFO_KEY <= key_length)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, + FUNC_NAME); + } + if (NULL == buflen) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if ((NULL == value) && *buflen) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_VALUE, + FUNC_NAME); + } + if (NULL == flag) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + if (0 == *buflen) { + err = ompi_info_get_valuelen(info, key, buflen, flag); + if (1 == *flag) { + *buflen += 1; /* add on for the \0, see MPI 4.0 Standard */ + } + } else { + err = ompi_info_get(info, key, &info_str, flag); + if (*flag) { + opal_string_copy(value, info_str->string, *buflen); + *buflen = info_str->length + 1; /* add on for the \0, see MPI 4.0 Standard */ + OBJ_RELEASE(info_str); + } + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_get_valuelen.c b/ompi/mpi/c/info_get_valuelen.c deleted file mode 100644 index e40d3c110f8..00000000000 --- a/ompi/mpi/c/info_get_valuelen.c +++ /dev/null @@ -1,94 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_get_valuelen = PMPI_Info_get_valuelen -#endif -#define MPI_Info_get_valuelen PMPI_Info_get_valuelen -#endif - -static const char FUNC_NAME[] = "MPI_Info_get_valuelen"; - - -/** - * MPI_Info_get_valuelen - Get the length of a value for a given key in an 'M - * - * @param info - info object (handle) - * @param key - null-terminated character string of the index key - * @param valuelen - length of the value associated with 'key' (integer) - * @param flag - true (1) if 'key' defined on 'info', false (0) if not - * (logical) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO - * @retval MPI_ERR_INFO_KEY - * - * The length returned in C and C++ does not include the end-of-string - * character. If the 'key' is not found on 'info', 'valuelen' is left - * alone. - */ -int MPI_Info_get_valuelen(MPI_Info info, const char *key, int *valuelen, - int *flag) -{ - int key_length; - int err; - - /* - * Simple function. All we need to do is search for the value - * having the "key" associated with it and return the length - */ - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - key_length = (key) ? (int)strlen (key) : 0; - if ((NULL == key) || (0 == key_length) || - (MPI_MAX_INFO_KEY <= key_length)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, - FUNC_NAME); - } - if (NULL == flag || NULL == valuelen) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - err = ompi_info_get_valuelen (info, key, valuelen, flag); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_get_valuelen.c.in b/ompi/mpi/c/info_get_valuelen.c.in new file mode 100644 index 00000000000..0195d602e28 --- /dev/null +++ b/ompi/mpi/c/info_get_valuelen.c.in @@ -0,0 +1,84 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include +#include + +/** + * MPI_Info_get_valuelen - Get the length of a value for a given key in an 'M + * + * @param info - info object (handle) + * @param key - null-terminated character string of the index key + * @param valuelen - length of the value associated with 'key' (integer) + * @param flag - true (1) if 'key' defined on 'info', false (0) if not + * (logical) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO + * @retval MPI_ERR_INFO_KEY + * + * The length returned in C and C++ does not include the end-of-string + * character. If the 'key' is not found on 'info', 'valuelen' is left + * alone. + */ +PROTOTYPE ERROR_CLASS info_get_valuelen(INFO info, STRING key, INT_OUT valuelen, + INT_OUT flag) +{ + int key_length; + int err; + + /* + * Simple function. All we need to do is search for the value + * having the "key" associated with it and return the length + */ + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + key_length = (key) ? (int)strlen (key) : 0; + if ((NULL == key) || (0 == key_length) || + (MPI_MAX_INFO_KEY <= key_length)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO_KEY, + FUNC_NAME); + } + if (NULL == flag || NULL == valuelen) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + err = ompi_info_get_valuelen (info, key, valuelen, flag); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/info_set.c b/ompi/mpi/c/info_set.c deleted file mode 100644 index c6bc689e903..00000000000 --- a/ompi/mpi/c/info_set.c +++ /dev/null @@ -1,111 +0,0 @@ -/* -*- 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-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) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 IBM Corporation. All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "opal/util/show_help.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Info_set = PMPI_Info_set -#endif -#define MPI_Info_set PMPI_Info_set -#endif - -static const char FUNC_NAME[] = "MPI_Info_set"; - - -/** - * MPI_Info_set - Set a (key, value) pair in an 'MPI_Info' object - * - * @param key null-terminated character string of the index key - * @param value null-terminated character string of the value - * @param info info object (handle) - * - * @retval MPI_SUCCESS - * @retval MPI_ERR_ARG - * @retval MPI_ERR_INFO_KEY - * @retval MPI_ERR_INFO_VAL - * @retval MPI_ERR_INFO_NOKEY - * @retval MPI_ERR_NO_MEM - * - * MPI_Info_set adds the (key,value) pair to info, and overrides - * the value if for the same key a previous value was set. key and - * value must be NULL terminated strings in C. In Fortran, leading - * and trailing spaces in key and value are stripped. If either - * key or value is greater than the allowed maxima, MPI_ERR_INFO_KEY - * and MPI_ERR_INFO_VALUE are raised - */ -int MPI_Info_set(MPI_Info info, const char *key, const char *value) -{ - int err; - int key_length; - int value_length; - - /* - * Error conditions are - * - info is NULL - * - No storage space available for the new value - * - Key length exceeded MPI_MAX_KEY_VAL - * - value length exceeded MPI_MAX_KEY_VAL - */ - - if (MPI_PARAM_CHECK) { - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO, - FUNC_NAME); - } - - key_length = (key) ? (int)strlen (key) : 0; - if ((NULL == key) || (0 == key_length) || - (MPI_MAX_INFO_KEY <= key_length)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_KEY, - FUNC_NAME); - } - - value_length = (value) ? (int)strlen (value) : 0; - if ((NULL == value) || (0 == value_length) || - (MPI_MAX_INFO_VAL <= value_length)) { - return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_VALUE, - FUNC_NAME); - } - } - - /* - * If all is right with the arguments, then call the back-end - * allocator. - */ - - err = ompi_info_set (info, key, value); - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/info_set.c.in b/ompi/mpi/c/info_set.c.in new file mode 100644 index 00000000000..c58121ab9c9 --- /dev/null +++ b/ompi/mpi/c/info_set.c.in @@ -0,0 +1,101 @@ +/* -*- 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-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) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 IBM Corporation. All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "opal/util/show_help.h" +#include +#include + +/** + * MPI_Info_set - Set a (key, value) pair in an 'MPI_Info' object + * + * @param key null-terminated character string of the index key + * @param value null-terminated character string of the value + * @param info info object (handle) + * + * @retval MPI_SUCCESS + * @retval MPI_ERR_ARG + * @retval MPI_ERR_INFO_KEY + * @retval MPI_ERR_INFO_VAL + * @retval MPI_ERR_INFO_NOKEY + * @retval MPI_ERR_NO_MEM + * + * MPI_Info_set adds the (key,value) pair to info, and overrides + * the value if for the same key a previous value was set. key and + * value must be NULL terminated strings in C. In Fortran, leading + * and trailing spaces in key and value are stripped. If either + * key or value is greater than the allowed maxima, MPI_ERR_INFO_KEY + * and MPI_ERR_INFO_VALUE are raised + */ +PROTOTYPE ERROR_CLASS info_set(INFO info, STRING key, STRING value) +{ + int err; + int key_length; + int value_length; + + /* + * Error conditions are + * - info is NULL + * - No storage space available for the new value + * - Key length exceeded MPI_MAX_KEY_VAL + * - value length exceeded MPI_MAX_KEY_VAL + */ + + if (MPI_PARAM_CHECK) { + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO, + FUNC_NAME); + } + + key_length = (key) ? (int)strlen (key) : 0; + if ((NULL == key) || (0 == key_length) || + (MPI_MAX_INFO_KEY <= key_length)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_KEY, + FUNC_NAME); + } + + value_length = (value) ? (int)strlen (value) : 0; + if ((NULL == value) || (0 == value_length) || + (MPI_MAX_INFO_VAL <= value_length)) { + return OMPI_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_VALUE, + FUNC_NAME); + } + } + + /* + * If all is right with the arguments, then call the back-end + * allocator. + */ + + err = ompi_info_set (info, key, value); + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/init.c b/ompi/mpi/c/init.c deleted file mode 100644 index eb5a50a7643..00000000000 --- a/ompi/mpi/c/init.c +++ /dev/null @@ -1,88 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2018 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2004-2006 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-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2007-2008 Sun Microsystems, 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 - -#include "opal/util/show_help.h" -#include "ompi/runtime/ompi_spc.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/constants.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Init = PMPI_Init -#endif -#define MPI_Init PMPI_Init -#endif - -static const char FUNC_NAME[] = "MPI_Init"; - - -int MPI_Init(int *argc, char ***argv) -{ - int err; - int provided; - char *env; - int required = MPI_THREAD_SINGLE; - - /* check for environment overrides for required thread level. If - there is, check to see that it is a valid/supported thread level. - If not, default to MPI_THREAD_MULTIPLE. */ - - if (NULL != (env = getenv("OMPI_MPI_THREAD_LEVEL"))) { - required = atoi(env); - if (required < MPI_THREAD_SINGLE || required > MPI_THREAD_MULTIPLE) { - required = MPI_THREAD_MULTIPLE; - } - } - - /* Call the back-end initialization function (we need to put as - little in this function as possible so that if it's profiled, we - don't lose anything) */ - - if (NULL != argc && NULL != argv) { - err = ompi_mpi_init(*argc, *argv, required, &provided, false); - } else { - err = ompi_mpi_init(0, NULL, required, &provided, false); - } - - /* Since we don't have a communicator to invoke an errorhandler on - here, don't use the fancy-schmancy ERRHANDLER macros; they're - really designed for real communicator objects. Just use the - back-end function directly. */ - - if (MPI_SUCCESS != err) { - return ompi_errhandler_invoke(NULL, NULL, - OMPI_ERRHANDLER_TYPE_COMM, - err < - 0 ? ompi_errcode_get_mpi_code(err) : - err, FUNC_NAME); - } - - SPC_INIT(); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/init.c.in b/ompi/mpi/c/init.c.in new file mode 100644 index 00000000000..b9e5d513482 --- /dev/null +++ b/ompi/mpi/c/init.c.in @@ -0,0 +1,80 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2018 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2006 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-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2007-2008 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/util/show_help.h" +#include "ompi/runtime/ompi_spc.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/constants.h" + +PROTOTYPE INT init(INT_OUT argc, ARGV argv) +{ + int err; + int provided; + char *env; + int required = MPI_THREAD_SINGLE; + + /* check for environment overrides for required thread level. If + there is, check to see that it is a valid/supported thread level. + If not, default to MPI_THREAD_MULTIPLE. */ + + if (NULL != (env = getenv("OMPI_MPI_THREAD_LEVEL"))) { + required = atoi(env); + if (required < MPI_THREAD_SINGLE || required > MPI_THREAD_MULTIPLE) { + required = MPI_THREAD_MULTIPLE; + } + } + + /* Call the back-end initialization function (we need to put as + little in this function as possible so that if it's profiled, we + don't lose anything) */ + + if (NULL != argc && NULL != argv) { + err = ompi_mpi_init(*argc, *argv, required, &provided, false); + } else { + err = ompi_mpi_init(0, NULL, required, &provided, false); + } + + /* Since we don't have a communicator to invoke an errorhandler on + here, don't use the fancy-schmancy ERRHANDLER macros; they're + really designed for real communicator objects. Just use the + back-end function directly. */ + + if (MPI_SUCCESS != err) { + return ompi_errhandler_invoke(NULL, NULL, + OMPI_ERRHANDLER_TYPE_COMM, + err < + 0 ? ompi_errcode_get_mpi_code(err) : + err, FUNC_NAME); + } + + SPC_INIT(); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/init_thread.c b/ompi/mpi/c/init_thread.c deleted file mode 100644 index 95ca9df25e2..00000000000 --- a/ompi/mpi/c/init_thread.c +++ /dev/null @@ -1,105 +0,0 @@ -/* -*- 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-2018 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2004-2006 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) 2010 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2016 Los Alamos National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "opal/util/show_help.h" -#include "ompi/runtime/ompi_spc.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/constants.h" -#include "ompi/mca/hook/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Init_thread = PMPI_Init_thread -#endif -#define MPI_Init_thread PMPI_Init_thread -#endif - -static const char FUNC_NAME[] = "MPI_Init_thread"; - - -int MPI_Init_thread(int *argc, char ***argv, int required, - int *provided) -{ - int err, safe_required = MPI_THREAD_SERIALIZED; - char *env; - - ompi_hook_base_mpi_init_thread_top(argc, argv, required, provided); - - /* Detect an incorrect thread support level, but dont report until we have the minimum - * infrastructure setup. - */ - if( (MPI_THREAD_SINGLE == required) || (MPI_THREAD_SERIALIZED == required) || - (MPI_THREAD_FUNNELED == required) || (MPI_THREAD_MULTIPLE == required) ) { - - if (NULL != (env = getenv("OMPI_MPI_THREAD_LEVEL"))) { - safe_required = atoi(env); - } - else { - safe_required = required; - } - } - - *provided = safe_required; - - /* Call the back-end initialization function (we need to put as - little in this function as possible so that if it's profiled, we - don't lose anything) */ - - if (NULL != argc && NULL != argv) { - err = ompi_mpi_init(*argc, *argv, safe_required, provided, false); - } else { - err = ompi_mpi_init(0, NULL, safe_required, provided, false); - } - - if( safe_required != required ) { - /* Trigger the error handler for the incorrect argument. Keep it separate from the - * check on the ompi_mpi_init return and report a nice, meaningful error message to - * the user. */ - return ompi_errhandler_invoke((ompi_errhandler_t*)&ompi_mpi_errors_are_fatal, NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG, FUNC_NAME); - } - - /* Since we don't have a communicator to invoke an errorhandler on - here, don't use the fancy-schmancy ERRHANDLER macros; they're - really designed for real communicator objects. Just use the - back-end function directly. */ - - if (MPI_SUCCESS != err) { - return ompi_errhandler_invoke(NULL, NULL, OMPI_ERRHANDLER_TYPE_COMM, - err < 0 ? ompi_errcode_get_mpi_code(err) : - err, FUNC_NAME); - } - - SPC_INIT(); - - ompi_hook_base_mpi_init_thread_bottom(argc, argv, required, provided); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/init_thread.c.in b/ompi/mpi/c/init_thread.c.in new file mode 100644 index 00000000000..f56728ee262 --- /dev/null +++ b/ompi/mpi/c/init_thread.c.in @@ -0,0 +1,97 @@ +/* -*- 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-2018 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2004-2006 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) 2010 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "opal/util/show_help.h" +#include "ompi/runtime/ompi_spc.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/constants.h" +#include "ompi/mca/hook/base/base.h" + +PROTOTYPE ERROR_CLASS init_thread(INT_OUT argc, ARGV argv, INT required, + INT_OUT provided) +{ + int err, safe_required = MPI_THREAD_SERIALIZED; + char *env; + + ompi_hook_base_mpi_init_thread_top(argc, argv, required, provided); + + /* Detect an incorrect thread support level, but dont report until we have the minimum + * infrastructure setup. + */ + if( (MPI_THREAD_SINGLE == required) || (MPI_THREAD_SERIALIZED == required) || + (MPI_THREAD_FUNNELED == required) || (MPI_THREAD_MULTIPLE == required) ) { + + if (NULL != (env = getenv("OMPI_MPI_THREAD_LEVEL"))) { + safe_required = atoi(env); + } + else { + safe_required = required; + } + } + + *provided = safe_required; + + /* Call the back-end initialization function (we need to put as + little in this function as possible so that if it's profiled, we + don't lose anything) */ + + if (NULL != argc && NULL != argv) { + err = ompi_mpi_init(*argc, *argv, safe_required, provided, false); + } else { + err = ompi_mpi_init(0, NULL, safe_required, provided, false); + } + + if( safe_required != required ) { + /* Trigger the error handler for the incorrect argument. Keep it separate from the + * check on the ompi_mpi_init return and report a nice, meaningful error message to + * the user. */ + return ompi_errhandler_invoke((ompi_errhandler_t*)&ompi_mpi_errors_are_fatal, NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG, FUNC_NAME); + } + + /* Since we don't have a communicator to invoke an errorhandler on + here, don't use the fancy-schmancy ERRHANDLER macros; they're + really designed for real communicator objects. Just use the + back-end function directly. */ + + if (MPI_SUCCESS != err) { + return ompi_errhandler_invoke(NULL, NULL, OMPI_ERRHANDLER_TYPE_COMM, + err < 0 ? ompi_errcode_get_mpi_code(err) : + err, FUNC_NAME); + } + + SPC_INIT(); + + ompi_hook_base_mpi_init_thread_bottom(argc, argv, required, provided); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/initialized.c b/ompi/mpi/c/initialized.c deleted file mode 100644 index 57f4e466243..00000000000 --- a/ompi/mpi/c/initialized.c +++ /dev/null @@ -1,73 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2015 Intel, Inc. All rights reserved - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/hook/base/base.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Initialized = PMPI_Initialized -#endif -#define MPI_Initialized PMPI_Initialized -#endif - -static const char FUNC_NAME[] = "MPI_Initialized"; - - -int MPI_Initialized(int *flag) -{ - ompi_hook_base_mpi_initialized_top(flag); - - int32_t state = ompi_mpi_state; - - if (MPI_PARAM_CHECK) { - if (NULL == flag) { - - /* If we have an error, the action that we take depends on - whether we're currently (after MPI_Init and before - MPI_Finalize) or not */ - - if (state >= OMPI_MPI_STATE_INIT_COMPLETED && - state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - /* We have no MPI object here so call ompi_errhandle_invoke - * directly */ - return ompi_errhandler_invoke(NULL, NULL, -1, - ompi_errcode_get_mpi_code(MPI_ERR_ARG), - FUNC_NAME); - } - } - } - - *flag = (state >= OMPI_MPI_STATE_INIT_COMPLETED); - - ompi_hook_base_mpi_initialized_bottom(flag); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/initialized.c.in b/ompi/mpi/c/initialized.c.in new file mode 100644 index 00000000000..db347371bd2 --- /dev/null +++ b/ompi/mpi/c/initialized.c.in @@ -0,0 +1,65 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2015 Intel, Inc. All rights reserved + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/hook/base/base.h" + +PROTOTYPE ERROR_CLASS initialized(INT_OUT flag) +{ + ompi_hook_base_mpi_initialized_top(flag); + + int32_t state = ompi_mpi_state; + + if (MPI_PARAM_CHECK) { + if (NULL == flag) { + + /* If we have an error, the action that we take depends on + whether we're currently (after MPI_Init and before + MPI_Finalize) or not */ + + if (state >= OMPI_MPI_STATE_INIT_COMPLETED && + state < OMPI_MPI_STATE_FINALIZE_PAST_COMM_SELF_DESTRUCT) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + /* We have no MPI object here so call ompi_errhandle_invoke + * directly */ + return ompi_errhandler_invoke(NULL, NULL, -1, + ompi_errcode_get_mpi_code(MPI_ERR_ARG), + FUNC_NAME); + } + } + } + + *flag = (state >= OMPI_MPI_STATE_INIT_COMPLETED); + + ompi_hook_base_mpi_initialized_bottom(flag); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/intercomm_create.c b/ompi/mpi/c/intercomm_create.c deleted file mode 100644 index 0e8a903032a..00000000000 --- a/ompi/mpi/c/intercomm_create.c +++ /dev/null @@ -1,92 +0,0 @@ -/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2009 University of Houston. All rights reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/communicator/communicator.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Intercomm_create = PMPI_Intercomm_create -#endif -#define MPI_Intercomm_create PMPI_Intercomm_create -#endif - -static const char FUNC_NAME[] = "MPI_Intercomm_create"; - - -int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader, - MPI_Comm bridge_comm, int remote_leader, - int tag, MPI_Comm *newintercomm) -{ - int rc; - - MEMCHECKER( - memchecker_comm(local_comm); - memchecker_comm(bridge_comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( ompi_comm_invalid ( local_comm ) || - ( local_comm->c_flags & OMPI_COMM_INTER ) ) - return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == newintercomm ) - return OMPI_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, - FUNC_NAME); - - /* if ( tag < 0 || tag > MPI_TAG_UB ) - return OMPI_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, - FUNC_NAME); - */ - } - -#if OPAL_ENABLE_FT_MPI - /* - * We must not call ompi_comm_iface_create_check() here, because that - * risks leaving the remote group dangling on an unmatched operation. - * We will let the logic proceed and discover the - * issue internally so that all sides get informed. - */ -#endif - - rc = ompi_intercomm_create (local_comm, local_leader, bridge_comm, remote_leader, tag, - newintercomm); - - OMPI_ERRHANDLER_RETURN (rc, local_comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/intercomm_create.c.in b/ompi/mpi/c/intercomm_create.c.in new file mode 100644 index 00000000000..6eb055aae98 --- /dev/null +++ b/ompi/mpi/c/intercomm_create.c.in @@ -0,0 +1,82 @@ +/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2009 University of Houston. All rights reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/communicator/communicator.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS intercomm_create(COMM local_comm, INT local_leader, + COMM bridge_comm, INT remote_leader, + INT tag, COMM_OUT newintercomm) +{ + int rc; + + MEMCHECKER( + memchecker_comm(local_comm); + memchecker_comm(bridge_comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( ompi_comm_invalid ( local_comm ) || + ( local_comm->c_flags & OMPI_COMM_INTER ) ) + return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == newintercomm ) + return OMPI_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + FUNC_NAME); + + /* if ( tag < 0 || tag > MPI_TAG_UB ) + return OMPI_ERRHANDLER_INVOKE ( local_comm, MPI_ERR_ARG, + FUNC_NAME); + */ + } + +#if OPAL_ENABLE_FT_MPI + /* + * We must not call ompi_comm_iface_create_check() here, because that + * risks leaving the remote group dangling on an unmatched operation. + * We will let the logic proceed and discover the + * issue internally so that all sides get informed. + */ +#endif + + rc = ompi_intercomm_create (local_comm, local_leader, bridge_comm, remote_leader, tag, + newintercomm); + + OMPI_ERRHANDLER_RETURN (rc, local_comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/intercomm_create_from_groups.c b/ompi/mpi/c/intercomm_create_from_groups.c deleted file mode 100644 index ef509b1a500..00000000000 --- a/ompi/mpi/c/intercomm_create_from_groups.c +++ /dev/null @@ -1,112 +0,0 @@ -/* -*- 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-2017 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2009 University of Houston. All rights reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2018-2024 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/communicator/communicator.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Intercomm_create_from_groups = PMPI_Intercomm_create_from_groups -#endif -#define MPI_Intercomm_create_from_groups PMPI_Intercomm_create_from_groups -#endif - -static const char FUNC_NAME[] = "MPI_Intercomm_create_from_groups"; - - -int MPI_Intercomm_create_from_groups (MPI_Group local_group, int local_leader, MPI_Group remote_group, - int remote_leader, const char *tag, MPI_Info info, MPI_Errhandler errhandler, - MPI_Comm *newintercomm) -{ - int rc, my_grp_rank, remote_grp_size; - - MEMCHECKER( - memchecker_comm(local_comm); - memchecker_comm(bridge_comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == errhandler || - MPI_ERRHANDLER_NULL == errhandler || - ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && - OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { - return ompi_errhandler_invoke (NULL, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG,FUNC_NAME); - - } - - if (NULL == info || ompi_info_is_freed(info)) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_INFO, FUNC_NAME); - } - if (NULL == tag) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_TAG, FUNC_NAME); - } - if (NULL == newintercomm) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG, FUNC_NAME); - } - - my_grp_rank = ompi_group_rank((ompi_group_t *)local_group); - if (local_leader == my_grp_rank) { - - if (NULL == local_group || NULL == remote_group) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_GROUP, FUNC_NAME); - } - - remote_grp_size = ompi_group_size((ompi_group_t *)remote_group); - if (remote_leader >= remote_grp_size) { - rc = ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, - MPI_ERR_ARG, FUNC_NAME); - return rc; - } - } - } - - rc = ompi_intercomm_create_from_groups (local_group, local_leader, remote_group, remote_leader, tag, - &info->super, errhandler, newintercomm); - - if (MPI_SUCCESS != rc) { - return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, errhandler->eh_mpi_object_type, - rc, FUNC_NAME); - } - - return rc; -} - diff --git a/ompi/mpi/c/intercomm_create_from_groups.c.in b/ompi/mpi/c/intercomm_create_from_groups.c.in new file mode 100644 index 00000000000..ac1b88f257c --- /dev/null +++ b/ompi/mpi/c/intercomm_create_from_groups.c.in @@ -0,0 +1,102 @@ +/* -*- 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-2017 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2009 University of Houston. All rights reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/communicator/communicator.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS intercomm_create_from_groups (GROUP local_group, INT local_leader, GROUP remote_group, + INT remote_leader, STRING tag, INFO info, ERRHANDLER errhandler, + COMM_OUT newintercomm) +{ + int rc, my_grp_rank, remote_grp_size; + + MEMCHECKER( + memchecker_comm(local_comm); + memchecker_comm(bridge_comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + ( OMPI_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return ompi_errhandler_invoke (NULL, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG,FUNC_NAME); + + } + + if (NULL == info || ompi_info_is_freed(info)) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_INFO, FUNC_NAME); + } + if (NULL == tag) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_TAG, FUNC_NAME); + } + if (NULL == newintercomm) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG, FUNC_NAME); + } + + my_grp_rank = ompi_group_rank((ompi_group_t *)local_group); + if (local_leader == my_grp_rank) { + + if (NULL == local_group || NULL == remote_group) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_GROUP, FUNC_NAME); + } + + remote_grp_size = ompi_group_size((ompi_group_t *)remote_group); + if (remote_leader >= remote_grp_size) { + rc = ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, OMPI_ERRHANDLER_TYPE_COMM, + MPI_ERR_ARG, FUNC_NAME); + return rc; + } + } + } + + rc = ompi_intercomm_create_from_groups (local_group, local_leader, remote_group, remote_leader, tag, + &info->super, errhandler, newintercomm); + + if (MPI_SUCCESS != rc) { + return ompi_errhandler_invoke (errhandler, MPI_COMM_NULL, errhandler->eh_mpi_object_type, + rc, FUNC_NAME); + } + + return rc; +} + diff --git a/ompi/mpi/c/intercomm_merge.c b/ompi/mpi/c/intercomm_merge.c deleted file mode 100644 index 4d09f159612..00000000000 --- a/ompi/mpi/c/intercomm_merge.c +++ /dev/null @@ -1,167 +0,0 @@ -/* -*- 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-2017 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2006-2009 University of Houston. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Inria. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2018-2021 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/communicator/communicator.h" -#include "ompi/proc/proc.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Intercomm_merge = PMPI_Intercomm_merge -#endif -#define MPI_Intercomm_merge PMPI_Intercomm_merge -#endif - -static const char FUNC_NAME[] = "MPI_Intercomm_merge"; - - -int MPI_Intercomm_merge(MPI_Comm intercomm, int high, - MPI_Comm *newcomm) -{ - ompi_communicator_t *newcomp = MPI_COMM_NULL; - ompi_proc_t **procs=NULL; - int first, thigh = high; - int local_size, remote_size; - int total_size; - int rc=MPI_SUCCESS; - ompi_group_t *new_group_pointer; - - MEMCHECKER( - memchecker_comm(intercomm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid ( intercomm ) || - !( intercomm->c_flags & OMPI_COMM_INTER ) ) - return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, - FUNC_NAME); - - if ( NULL == newcomm ) - return OMPI_ERRHANDLER_INVOKE ( intercomm, MPI_ERR_ARG, - FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(intercomm, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, intercomm, rc, FUNC_NAME); - } -#endif - - local_size = ompi_comm_size ( intercomm ); - remote_size = ompi_comm_remote_size ( intercomm ); - total_size = local_size + remote_size; - procs = (ompi_proc_t **) malloc ( total_size * sizeof(ompi_proc_t *)); - if ( NULL == procs ) { - rc = MPI_ERR_INTERN; - goto exit; - } - - first = ompi_comm_determine_first ( intercomm, thigh ); - if ( MPI_UNDEFINED == first ) { - rc = MPI_ERR_INTERN; - goto exit; - } - - if ( first ) { - ompi_group_union ( intercomm->c_local_group, intercomm->c_remote_group, &new_group_pointer ); - } - else { - ompi_group_union ( intercomm->c_remote_group, intercomm->c_local_group, &new_group_pointer ); - } - - rc = ompi_comm_set ( &newcomp, /* new comm */ - intercomm, /* old comm */ - total_size, /* local_size */ - NULL, /* local_procs*/ - 0, /* remote_size */ - NULL, /* remote_procs */ - NULL, /* attrs */ - intercomm->error_handler, /* error handler*/ - new_group_pointer, /* local group */ - NULL, /* remote group */ - 0); - if ( MPI_SUCCESS != rc ) { - goto exit; - } - - OBJ_RELEASE(new_group_pointer); - new_group_pointer = MPI_GROUP_NULL; - - /* Determine context id */ - rc = ompi_comm_nextcid (newcomp, intercomm, NULL, NULL, NULL, false, - OMPI_COMM_CID_INTER); - if ( OMPI_SUCCESS != rc ) { - goto exit; - } - - /* activate communicator and init coll-module */ - rc = ompi_comm_activate (&newcomp, intercomm, NULL, NULL, NULL, false, - OMPI_COMM_CID_INTER); - if ( OMPI_SUCCESS != rc ) { - goto exit; - } - - ompi_info_memkind_assert_type type; - newcomp->super.s_info = OBJ_NEW(opal_info_t); - ompi_info_memkind_copy_or_set (&intercomm->instance->super, &newcomp->super, - &ompi_mpi_info_null.info.super, &type); - if (OMPI_INFO_MEMKIND_ASSERT_NO_ACCEL == type) { - newcomp->c_assertions |= OMPI_COMM_ASSERT_NO_ACCEL_BUF; - } - - - exit: - - if ( NULL != procs ) { - free ( procs ); - } - if ( MPI_SUCCESS != rc ) { - if ( MPI_COMM_NULL != newcomp && NULL != newcomp ) { - OBJ_RELEASE(newcomp); - } - *newcomm = MPI_COMM_NULL; - return OMPI_ERRHANDLER_INVOKE(intercomm, rc, FUNC_NAME); - } - - *newcomm = newcomp; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/intercomm_merge.c.in b/ompi/mpi/c/intercomm_merge.c.in new file mode 100644 index 00000000000..6e26f1e3fb6 --- /dev/null +++ b/ompi/mpi/c/intercomm_merge.c.in @@ -0,0 +1,157 @@ +/* -*- 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-2017 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2006-2009 University of Houston. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Inria. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2018-2024 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/communicator/communicator.h" +#include "ompi/proc/proc.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS intercomm_merge(COMM intercomm, INT high, + COMM_OUT newcomm) +{ + ompi_communicator_t *newcomp = MPI_COMM_NULL; + ompi_proc_t **procs=NULL; + int first, thigh = high; + int local_size, remote_size; + int total_size; + int rc=MPI_SUCCESS; + ompi_group_t *new_group_pointer; + + MEMCHECKER( + memchecker_comm(intercomm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid ( intercomm ) || + !( intercomm->c_flags & OMPI_COMM_INTER ) ) + return OMPI_ERRHANDLER_INVOKE ( MPI_COMM_WORLD, MPI_ERR_COMM, + FUNC_NAME); + + if ( NULL == newcomm ) + return OMPI_ERRHANDLER_INVOKE ( intercomm, MPI_ERR_ARG, + FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_create_check(intercomm, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, intercomm, rc, FUNC_NAME); + } +#endif + + local_size = ompi_comm_size ( intercomm ); + remote_size = ompi_comm_remote_size ( intercomm ); + total_size = local_size + remote_size; + procs = (ompi_proc_t **) malloc ( total_size * sizeof(ompi_proc_t *)); + if ( NULL == procs ) { + rc = MPI_ERR_INTERN; + goto exit; + } + + first = ompi_comm_determine_first ( intercomm, thigh ); + if ( MPI_UNDEFINED == first ) { + rc = MPI_ERR_INTERN; + goto exit; + } + + if ( first ) { + ompi_group_union ( intercomm->c_local_group, intercomm->c_remote_group, &new_group_pointer ); + } + else { + ompi_group_union ( intercomm->c_remote_group, intercomm->c_local_group, &new_group_pointer ); + } + + rc = ompi_comm_set ( &newcomp, /* new comm */ + intercomm, /* old comm */ + total_size, /* local_size */ + NULL, /* local_procs*/ + 0, /* remote_size */ + NULL, /* remote_procs */ + NULL, /* attrs */ + intercomm->error_handler, /* error handler*/ + new_group_pointer, /* local group */ + NULL, /* remote group */ + 0); + if ( MPI_SUCCESS != rc ) { + goto exit; + } + + OBJ_RELEASE(new_group_pointer); + new_group_pointer = MPI_GROUP_NULL; + + /* Determine context id */ + rc = ompi_comm_nextcid (newcomp, intercomm, NULL, NULL, NULL, false, + OMPI_COMM_CID_INTER); + if ( OMPI_SUCCESS != rc ) { + goto exit; + } + + /* activate communicator and init coll-module */ + rc = ompi_comm_activate (&newcomp, intercomm, NULL, NULL, NULL, false, + OMPI_COMM_CID_INTER); + if ( OMPI_SUCCESS != rc ) { + goto exit; + } + + ompi_info_memkind_assert_type type; + newcomp->super.s_info = OBJ_NEW(opal_info_t); + ompi_info_memkind_copy_or_set (&intercomm->instance->super, &newcomp->super, + &ompi_mpi_info_null.info.super, &type); + if (OMPI_INFO_MEMKIND_ASSERT_NO_ACCEL == type) { + newcomp->c_assertions |= OMPI_COMM_ASSERT_NO_ACCEL_BUF; + } + + + exit: + + if ( NULL != procs ) { + free ( procs ); + } + if ( MPI_SUCCESS != rc ) { + if ( MPI_COMM_NULL != newcomp && NULL != newcomp ) { + OBJ_RELEASE(newcomp); + } + *newcomm = MPI_COMM_NULL; + return OMPI_ERRHANDLER_INVOKE(intercomm, rc, FUNC_NAME); + } + + *newcomm = newcomp; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/iprobe.c b/ompi/mpi/c/iprobe.c deleted file mode 100644 index c156e704f86..00000000000 --- a/ompi/mpi/c/iprobe.c +++ /dev/null @@ -1,99 +0,0 @@ -/* - * 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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iprobe = PMPI_Iprobe -#endif -#define MPI_Iprobe PMPI_Iprobe -#endif - -static const char FUNC_NAME[] = "MPI_Iprobe"; - - -int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, MPI_Status *status) -{ - int rc; - - SPC_RECORD(OMPI_SPC_IPROBE, 1); - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_invalid(comm)) { - rc = MPI_ERR_COMM; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == source) { - *flag = 1; - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The call will check for process failure errors during the - * operation. So no need to check here. - */ -#endif - - rc = MCA_PML_CALL(iprobe(source, tag, comm, flag, status)); - - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/iprobe.c.in b/ompi/mpi/c/iprobe.c.in new file mode 100644 index 00000000000..751f41ec8c3 --- /dev/null +++ b/ompi/mpi/c/iprobe.c.in @@ -0,0 +1,91 @@ +/* + * 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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iprobe(INT source, INT tag, COMM comm, INT_OUT flag, STATUS_OUT status) +{ + int rc; + + SPC_RECORD(OMPI_SPC_IPROBE, 1); + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_invalid(comm)) { + rc = MPI_ERR_COMM; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == source) { + *flag = 1; + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The call will check for process failure errors during the + * operation. So no need to check here. + */ +#endif + + rc = MCA_PML_CALL(iprobe(source, tag, comm, flag, status)); + + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/irecv.c b/ompi/mpi/c/irecv.c deleted file mode 100644 index 7173282de18..00000000000 --- a/ompi/mpi/c/irecv.c +++ /dev/null @@ -1,91 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Irecv = PMPI_Irecv -#endif -#define MPI_Irecv PMPI_Irecv -#endif - -static const char FUNC_NAME[] = "MPI_Irecv"; - - -int MPI_Irecv(void *buf, int count, MPI_Datatype type, int source, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_IRECV, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if ((MPI_ANY_SOURCE != source) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (source == MPI_PROC_NULL) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - MEMCHECKER ( - memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); - ); - rc = MCA_PML_CALL(irecv(buf,count,type,source,tag,comm,request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/irecv.c.in b/ompi/mpi/c/irecv.c.in new file mode 100644 index 00000000000..b2344cb5982 --- /dev/null +++ b/ompi/mpi/c/irecv.c.in @@ -0,0 +1,83 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS irecv(BUFFER_OUT buf, COUNT count, DATATYPE type, + INT source, INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_IRECV, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if ((MPI_ANY_SOURCE != source) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (source == MPI_PROC_NULL) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + MEMCHECKER ( + memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); + ); + rc = MCA_PML_CALL(irecv(buf,count,type,source,tag,comm,request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/ireduce.c b/ompi/mpi/c/ireduce.c deleted file mode 100644 index 7aed9bafb27..00000000000 --- a/ompi/mpi/c/ireduce.c +++ /dev/null @@ -1,156 +0,0 @@ -/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ireduce = PMPI_Ireduce -#endif -#define MPI_Ireduce PMPI_Ireduce -#endif - -static const char FUNC_NAME[] = "MPI_Ireduce"; - - -int MPI_Ireduce(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IREDUCE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else { - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } else { - if (MPI_ROOT == root) { - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else if (MPI_PROC_NULL != root) { - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || - ((sendbuf == recvbuf) && (0 != count))))) { - err = MPI_ERR_ARG; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Intercommunicator errors */ - - if (!OMPI_COMM_IS_INTRA(comm)) { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Intracommunicator errors */ - - else { - if (root < 0 || root >= ompi_comm_size(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - if (0 == count) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - void *updated_recvbuf; - const void *updated_sendbuf; - if(OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - updated_sendbuf = sendbuf; - } else { - updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; - updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_ireduce(updated_sendbuf, updated_recvbuf, count, - datatype, op, root, comm, request, - comm->c_coll->coll_ireduce_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ireduce.c.in b/ompi/mpi/c/ireduce.c.in new file mode 100644 index 00000000000..5dbdf1b102b --- /dev/null +++ b/ompi/mpi/c/ireduce.c.in @@ -0,0 +1,148 @@ +/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ireduce(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, INT root, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IREDUCE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else { + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } else { + if (MPI_ROOT == root) { + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else if (MPI_PROC_NULL != root) { + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || + ((sendbuf == recvbuf) && (0 != count))))) { + err = MPI_ERR_ARG; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Intercommunicator errors */ + + if (!OMPI_COMM_IS_INTRA(comm)) { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Intracommunicator errors */ + + else { + if (root < 0 || root >= ompi_comm_size(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + if (0 == count) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + void *updated_recvbuf; + const void *updated_sendbuf; + if(OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + updated_sendbuf = sendbuf; + } else { + updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; + updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_ireduce(updated_sendbuf, updated_recvbuf, count, + datatype, op, root, comm, request, + comm->c_coll->coll_ireduce_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ireduce_scatter.c b/ompi/mpi/c/ireduce_scatter.c deleted file mode 100644 index 9efcb1c0cdd..00000000000 --- a/ompi/mpi/c/ireduce_scatter.c +++ /dev/null @@ -1,144 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ireduce_scatter = PMPI_Ireduce_scatter -#endif -#define MPI_Ireduce_scatter PMPI_Ireduce_scatter -#endif - -static const char FUNC_NAME[] = "MPI_Ireduce_scatter"; - - -int MPI_Ireduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request) -{ - int i, err, size, count; - ompi_count_array_t recvcounts_desc; - - SPC_RECORD(OMPI_SPC_IREDUCE_SCATTER, 1); - - MEMCHECKER( - int rank; - int count; - - size = ompi_comm_size(comm); - rank = ompi_comm_rank(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - count += recvcounts[i]; - } - } - - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcounts[rank], datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (NULL == recvcounts) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Based on the standard each group has to provide the same total - number of elements, so the size of the recvcounts array depends - on the number of participants in the local group. */ - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - size = ompi_comm_size(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - ++count; - } - } - if (size == count) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - err = comm->c_coll->coll_ireduce_scatter(sendbuf, recvbuf, recvcounts_desc, - datatype, op, comm, request, - comm->c_coll->coll_ireduce_scatter_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ireduce_scatter.c.in b/ompi/mpi/c/ireduce_scatter.c.in new file mode 100644 index 00000000000..7b47a7b7888 --- /dev/null +++ b/ompi/mpi/c/ireduce_scatter.c.in @@ -0,0 +1,136 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ireduce_scatter(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DATATYPE datatype, OP op, COMM comm, REQUEST_INOUT request) +{ + int i, err, size, count; + ompi_count_array_t recvcounts_desc; + + SPC_RECORD(OMPI_SPC_IREDUCE_SCATTER, 1); + + MEMCHECKER( + int rank; + int count; + + size = ompi_comm_size(comm); + rank = ompi_comm_rank(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + count += recvcounts[i]; + } + } + + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcounts[rank], datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (NULL == recvcounts) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Based on the standard each group has to provide the same total + number of elements, so the size of the recvcounts array depends + on the number of participants in the local group. */ + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + size = ompi_comm_size(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + ++count; + } + } + if (size == count) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + err = comm->c_coll->coll_ireduce_scatter(sendbuf, recvbuf, recvcounts_desc, + datatype, op, comm, request, + comm->c_coll->coll_ireduce_scatter_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/ireduce_scatter_block.c b/ompi/mpi/c/ireduce_scatter_block.c deleted file mode 100644 index e33416d3b81..00000000000 --- a/ompi/mpi/c/ireduce_scatter_block.c +++ /dev/null @@ -1,114 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ireduce_scatter_block = PMPI_Ireduce_scatter_block -#endif -#define MPI_Ireduce_scatter_block PMPI_Ireduce_scatter_block -#endif - -static const char FUNC_NAME[] = "MPI_Ireduce_scatter_block"; - - -int MPI_Ireduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, - MPI_Datatype datatype, MPI_Op op, - MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_IREDUCE_SCATTER_BLOCK, 1); - - MEMCHECKER( - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcount, datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if (0 == recvcount) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_ireduce_scatter_block(sendbuf, recvbuf, recvcount, - datatype, op, comm, request, - comm->c_coll->coll_ireduce_scatter_block_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/ireduce_scatter_block.c.in b/ompi/mpi/c/ireduce_scatter_block.c.in new file mode 100644 index 00000000000..d4d7e3e7361 --- /dev/null +++ b/ompi/mpi/c/ireduce_scatter_block.c.in @@ -0,0 +1,107 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ireduce_scatter_block(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE datatype, OP op, + COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_IREDUCE_SCATTER_BLOCK, 1); + + MEMCHECKER( + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcount, datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if (0 == recvcount) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_ireduce_scatter_block(sendbuf, recvbuf, recvcount, + datatype, op, comm, request, + comm->c_coll->coll_ireduce_scatter_block_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/irsend.c b/ompi/mpi/c/irsend.c deleted file mode 100644 index 4db6cf39e3f..00000000000 --- a/ompi/mpi/c/irsend.c +++ /dev/null @@ -1,101 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Irsend = PMPI_Irsend -#endif -#define MPI_Irsend PMPI_Irsend -#endif - -static const char FUNC_NAME[] = "MPI_Irsend"; - - -int MPI_Irsend(const void *buf, int count, MPI_Datatype type, int dest, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc; - - SPC_RECORD(OMPI_SPC_IRSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - MEMCHECKER ( - memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); - ); - rc = MCA_PML_CALL(isend(buf,count,type,dest,tag, - MCA_PML_BASE_SEND_READY,comm,request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - - diff --git a/ompi/mpi/c/irsend.c.in b/ompi/mpi/c/irsend.c.in new file mode 100644 index 00000000000..777d8feec29 --- /dev/null +++ b/ompi/mpi/c/irsend.c.in @@ -0,0 +1,93 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS Irsend(BUFFER buf, COUNT count, DATATYPE type, INT dest, + INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_IRSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + MEMCHECKER ( + memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); + ); + rc = MCA_PML_CALL(isend(buf,count,type,dest,tag, + MCA_PML_BASE_SEND_READY,comm,request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + + diff --git a/ompi/mpi/c/is_thread_main.c b/ompi/mpi/c/is_thread_main.c deleted file mode 100644 index b876dff4661..00000000000 --- a/ompi/mpi/c/is_thread_main.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/runtime/mpiruntime.h" -#include "opal/mca/threads/threads.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Is_thread_main = PMPI_Is_thread_main -#endif -#define MPI_Is_thread_main PMPI_Is_thread_main -#endif - -static const char FUNC_NAME[] = "MPI_Is_thread_main"; - - -int MPI_Is_thread_main(int *flag) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == flag) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } - } - - /* Compare this thread ID to the main thread ID */ - - *flag = (int) opal_thread_self_compare(ompi_mpi_main_thread); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/is_thread_main.c.in b/ompi/mpi/c/is_thread_main.c.in new file mode 100644 index 00000000000..5e80109f2b4 --- /dev/null +++ b/ompi/mpi/c/is_thread_main.c.in @@ -0,0 +1,46 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/runtime/mpiruntime.h" +#include "opal/mca/threads/threads.h" + +PROTOTYPE ERROR_CLASS is_thread_main(INT_OUT flag) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == flag) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } + } + + /* Compare this thread ID to the main thread ID */ + + *flag = (int) opal_thread_self_compare(ompi_mpi_main_thread); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/iscan.c b/ompi/mpi/c/iscan.c deleted file mode 100644 index 165add74124..00000000000 --- a/ompi/mpi/c/iscan.c +++ /dev/null @@ -1,106 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iscan = PMPI_Iscan -#endif -#define MPI_Iscan PMPI_Iscan -#endif - -static const char FUNC_NAME[] = "MPI_Iscan"; - - -int MPI_Iscan(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_ISCAN, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* No intercommunicators allowed! (MPI does not define - MPI_SCAN on intercommunicators) */ - - else if (OMPI_COMM_IS_INTER(comm)) { - err = MPI_ERR_COMM; - } - - /* Unrooted operation; checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Call the coll component to actually perform the allgather */ - - err = comm->c_coll->coll_iscan(sendbuf, recvbuf, count, - datatype, op, comm, - request, - comm->c_coll->coll_iscan_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/iscan.c.in b/ompi/mpi/c/iscan.c.in new file mode 100644 index 00000000000..6d2c1d950ec --- /dev/null +++ b/ompi/mpi/c/iscan.c.in @@ -0,0 +1,98 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iscan(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_ISCAN, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* No intercommunicators allowed! (MPI does not define + MPI_SCAN on intercommunicators) */ + + else if (OMPI_COMM_IS_INTER(comm)) { + err = MPI_ERR_COMM; + } + + /* Unrooted operation; checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Call the coll component to actually perform the allgather */ + + err = comm->c_coll->coll_iscan(sendbuf, recvbuf, count, + datatype, op, comm, + request, + comm->c_coll->coll_iscan_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/iscatter.c b/ompi/mpi/c/iscatter.c deleted file mode 100644 index 56954038e8f..00000000000 --- a/ompi/mpi/c/iscatter.c +++ /dev/null @@ -1,188 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iscatter = PMPI_Iscatter -#endif -#define MPI_Iscatter PMPI_Iscatter -#endif - -static const char FUNC_NAME[] = "MPI_Iscatter"; - - -int MPI_Iscatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_ISCATTER, 1); - - MEMCHECKER( - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - else if (ompi_comm_rank(comm) == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - err = MPI_ERR_ROOT; - } - - /* Errors for the receivers */ - - else if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_iscatter(updated_sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, request, - comm->c_coll->coll_iscatter_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == recvbuf) { - recvtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - sendtype = NULL; - } - } else { - if (MPI_ROOT == root) { - recvtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - sendtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/iscatter.c.in b/ompi/mpi/c/iscatter.c.in new file mode 100644 index 00000000000..b5450ba9f6f --- /dev/null +++ b/ompi/mpi/c/iscatter.c.in @@ -0,0 +1,180 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iscatter(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_ISCATTER, 1); + + MEMCHECKER( + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + else if (ompi_comm_rank(comm) == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + err = MPI_ERR_ROOT; + } + + /* Errors for the receivers */ + + else if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_iscatter(updated_sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, request, + comm->c_coll->coll_iscatter_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == recvbuf) { + recvtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + sendtype = NULL; + } + } else { + if (MPI_ROOT == root) { + recvtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + sendtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/iscatterv.c b/ompi/mpi/c/iscatterv.c deleted file mode 100644 index 40c68157861..00000000000 --- a/ompi/mpi/c/iscatterv.c +++ /dev/null @@ -1,232 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Iscatterv = PMPI_Iscatterv -#endif -#define MPI_Iscatterv PMPI_Iscatterv -#endif - -static const char FUNC_NAME[] = "MPI_Iscatterv"; - - -int MPI_Iscatterv(const void *sendbuf, const int sendcounts[], const int displs[], - MPI_Datatype sendtype, void *recvbuf, int recvcount, - MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_ISCATTERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - } else if (MPI_PROC_NULL != root) { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, - FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, - FUNC_NAME); - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the receivers */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - } - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_iscatterv(updated_sendbuf, sendcounts_desc, displs_desc, - sendtype, updated_recvbuf, recvcount, recvtype, root, comm, - request, comm->c_coll->coll_iscatterv_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == recvbuf) { - recvtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - sendtype = NULL; - } - } else { - if (MPI_ROOT == root) { - recvtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - sendtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/iscatterv.c.in b/ompi/mpi/c/iscatterv.c.in new file mode 100644 index 00000000000..1791f64c5a2 --- /dev/null +++ b/ompi/mpi/c/iscatterv.c.in @@ -0,0 +1,224 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS iscatterv(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY displs, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE recvtype, INT root, COMM comm, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_ISCATTERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + } else if (MPI_PROC_NULL != root) { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, + FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, + FUNC_NAME); + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the receivers */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + } + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_iscatterv(updated_sendbuf, sendcounts_desc, displs_desc, + sendtype, updated_recvbuf, recvcount, recvtype, root, comm, + request, comm->c_coll->coll_iscatterv_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == recvbuf) { + recvtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + sendtype = NULL; + } + } else { + if (MPI_ROOT == root) { + recvtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + sendtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/isend.c b/ompi/mpi/c/isend.c deleted file mode 100644 index 5cbcd36d0d7..00000000000 --- a/ompi/mpi/c/isend.c +++ /dev/null @@ -1,106 +0,0 @@ -/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Isend = PMPI_Isend -#endif -#define MPI_Isend PMPI_Isend -#endif - -static const char FUNC_NAME[] = "MPI_Isend"; - - -int MPI_Isend(const void *buf, int count, MPI_Datatype type, int dest, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_ISEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * today's MPI standard mandates the send buffer remains accessible during the send operation - * hence memchecker cannot mark buf as non accessible, but it might mark buf as read-only in - * order to trap end user errors. Unfortunately valgrind does not support marking buffers as read-only, - * so there is pretty much nothing we can do here. - */ - - rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_STANDARD, comm, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - - diff --git a/ompi/mpi/c/isend.c.in b/ompi/mpi/c/isend.c.in new file mode 100644 index 00000000000..1be898b1b3d --- /dev/null +++ b/ompi/mpi/c/isend.c.in @@ -0,0 +1,98 @@ +/* -*- 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) 2006-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS isend(BUFFER buf, COUNT count, DATATYPE type, INT dest, + INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_ISEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * today's MPI standard mandates the send buffer remains accessible during the send operation + * hence memchecker cannot mark buf as non accessible, but it might mark buf as read-only in + * order to trap end user errors. Unfortunately valgrind does not support marking buffers as read-only, + * so there is pretty much nothing we can do here. + */ + + rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_STANDARD, comm, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + + diff --git a/ompi/mpi/c/isendrecv.c b/ompi/mpi/c/isendrecv.c deleted file mode 100644 index a4bcc6c7db9..00000000000 --- a/ompi/mpi/c/isendrecv.c +++ /dev/null @@ -1,197 +0,0 @@ -/* -*- 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-2022 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Nanook Consulting. All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/communicator/comm_request.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Isendrecv = PMPI_Isendrecv -#endif -#define MPI_Isendrecv PMPI_Isendrecv -#endif - -static const char FUNC_NAME[] = "MPI_Isendrecv"; - -struct ompi_isendrecv_context_t { - opal_object_t super; - int nreqs; - int source; - ompi_request_t *subreq[2]; -}; - -typedef struct ompi_isendrecv_context_t ompi_isendrecv_context_t; -#if OMPI_BUILD_MPI_PROFILING -OBJ_CLASS_INSTANCE(ompi_isendrecv_context_t, opal_object_t, NULL, NULL); -#else -OBJ_CLASS_DECLARATION(ompi_isendrecv_context_t); -#endif /* OMPI_BUILD_MPI_PROFILING */ - -static int ompi_isendrecv_complete_func (ompi_comm_request_t *request) -{ - ompi_isendrecv_context_t *context = - (ompi_isendrecv_context_t *) request->context; - - /* - * Copy the status from the receive side of the sendrecv request? - * But what if the send failed? - * - * Probably need to bring up in the MPI forum. - */ - - if (MPI_PROC_NULL != context->source) { - OMPI_COPY_STATUS(&request->super.req_status, - context->subreq[0]->req_status, false); - } else { - OMPI_COPY_STATUS(&request->super.req_status, - ompi_request_empty.req_status, false); - } - - if(NULL != context->subreq[0]) { - ompi_request_free(&context->subreq[0]); - } - if(NULL != context->subreq[1]) { - ompi_request_free(&context->subreq[1]); - } - - return OMPI_SUCCESS; -} - - -int MPI_Isendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - int dest, int sendtag, void *recvbuf, int recvcount, - MPI_Datatype recvtype, int source, int recvtag, - MPI_Comm comm, MPI_Request *request) -{ - ompi_isendrecv_context_t *context = NULL; - ompi_comm_request_t *crequest; - int rc = MPI_SUCCESS; - int nreqs = 0; - uint32_t flags; - - SPC_RECORD(OMPI_SPC_ISENDRECV, 1); - - MEMCHECKER( - memchecker_datatype(sendtype); - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_SEND(rc, sendtype, sendcount); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, recvtype, recvcount); - OMPI_CHECK_USER_BUFFER(rc, sendbuf, sendtype, sendcount); - OMPI_CHECK_USER_BUFFER(rc, recvbuf, recvtype, recvcount); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { - rc = MPI_ERR_RANK; - } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - crequest = ompi_comm_request_get (); - if (NULL == crequest) { - return OMPI_ERR_OUT_OF_RESOURCE; - } - - context = OBJ_NEW(ompi_isendrecv_context_t); - if (NULL == context) { - ompi_comm_request_return (crequest); - return OMPI_ERR_OUT_OF_RESOURCE; - } - - crequest->context = &context->super; - context->subreq[0] = MPI_REQUEST_NULL; - context->subreq[1] = MPI_REQUEST_NULL; - context->source = source; - - if (source != MPI_PROC_NULL) { /* post recv */ - rc = MCA_PML_CALL(irecv(recvbuf, recvcount, recvtype, - source, recvtag, comm, &context->subreq[nreqs++])); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (dest != MPI_PROC_NULL) { /* send */ - rc = MCA_PML_CALL(isend(sendbuf, sendcount, sendtype, dest, - sendtag, MCA_PML_BASE_SEND_STANDARD, comm, &context->subreq[nreqs++])); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - /* - * schedule the operation - */ - - context->nreqs = nreqs; - assert(nreqs <= 2); - - flags = OMPI_COMM_REQ_FLAG_RETAIN_SUBREQ; - - rc = ompi_comm_request_schedule_append_w_flags(crequest, ompi_isendrecv_complete_func, - context->subreq, nreqs, flags); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - - /* kick off the request */ - - ompi_comm_request_start (crequest); - *request = &crequest->super; - - return rc; -} diff --git a/ompi/mpi/c/isendrecv.c.in b/ompi/mpi/c/isendrecv.c.in new file mode 100644 index 00000000000..39f410b6796 --- /dev/null +++ b/ompi/mpi/c/isendrecv.c.in @@ -0,0 +1,188 @@ +/* -*- 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-2022 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021 Nanook Consulting. All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/communicator/comm_request.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + + +struct ompi_isendrecv_context_t { + opal_object_t super; + int nreqs; + int source; + ompi_request_t *subreq[2]; +}; + +typedef struct ompi_isendrecv_context_t ompi_isendrecv_context_t; +#if OMPI_BUILD_MPI_PROFILING +OBJ_CLASS_INSTANCE(ompi_isendrecv_context_t, opal_object_t, NULL, NULL); +#else +OBJ_CLASS_DECLARATION(ompi_isendrecv_context_t); +#endif /* OMPI_BUILD_MPI_PROFILING */ + +static int ompi_isendrecv_complete_func (ompi_comm_request_t *request) +{ + ompi_isendrecv_context_t *context = + (ompi_isendrecv_context_t *) request->context; + + /* + * Copy the status from the receive side of the sendrecv request? + * But what if the send failed? + * + * Probably need to bring up in the MPI forum. + */ + + if (MPI_PROC_NULL != context->source) { + OMPI_COPY_STATUS(&request->super.req_status, + context->subreq[0]->req_status, false); + } else { + OMPI_COPY_STATUS(&request->super.req_status, + ompi_request_empty.req_status, false); + } + + if(NULL != context->subreq[0]) { + ompi_request_free(&context->subreq[0]); + } + if(NULL != context->subreq[1]) { + ompi_request_free(&context->subreq[1]); + } + + return OMPI_SUCCESS; +} + +PROTOTYPE ERROR_CLASS isendrecv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + INT dest, INT sendtag, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE recvtype, INT source, INT recvtag, + COMM comm, REQUEST_INOUT request) +{ + ompi_isendrecv_context_t *context = NULL; + ompi_comm_request_t *crequest; + int rc = MPI_SUCCESS; + int nreqs = 0; + uint32_t flags; + + SPC_RECORD(OMPI_SPC_ISENDRECV, 1); + + MEMCHECKER( + memchecker_datatype(sendtype); + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_SEND(rc, sendtype, sendcount); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, recvtype, recvcount); + OMPI_CHECK_USER_BUFFER(rc, sendbuf, sendtype, sendcount); + OMPI_CHECK_USER_BUFFER(rc, recvbuf, recvtype, recvcount); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { + rc = MPI_ERR_RANK; + } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + crequest = ompi_comm_request_get (); + if (NULL == crequest) { + return OMPI_ERR_OUT_OF_RESOURCE; + } + + context = OBJ_NEW(ompi_isendrecv_context_t); + if (NULL == context) { + ompi_comm_request_return (crequest); + return OMPI_ERR_OUT_OF_RESOURCE; + } + + crequest->context = &context->super; + context->subreq[0] = MPI_REQUEST_NULL; + context->subreq[1] = MPI_REQUEST_NULL; + context->source = source; + + if (source != MPI_PROC_NULL) { /* post recv */ + rc = MCA_PML_CALL(irecv(recvbuf, recvcount, recvtype, + source, recvtag, comm, &context->subreq[nreqs++])); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (dest != MPI_PROC_NULL) { /* send */ + rc = MCA_PML_CALL(isend(sendbuf, sendcount, sendtype, dest, + sendtag, MCA_PML_BASE_SEND_STANDARD, comm, &context->subreq[nreqs++])); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + /* + * schedule the operation + */ + + context->nreqs = nreqs; + assert(nreqs <= 2); + + flags = OMPI_COMM_REQ_FLAG_RETAIN_SUBREQ; + + rc = ompi_comm_request_schedule_append_w_flags(crequest, ompi_isendrecv_complete_func, + context->subreq, nreqs, flags); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + + /* kick off the request */ + + ompi_comm_request_start (crequest); + *request = &crequest->super; + + return rc; +} diff --git a/ompi/mpi/c/isendrecv_replace.c b/ompi/mpi/c/isendrecv_replace.c deleted file mode 100644 index 1079f63fd88..00000000000 --- a/ompi/mpi/c/isendrecv_replace.c +++ /dev/null @@ -1,261 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2022 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) 2010-2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/communicator/comm_request.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/proc/proc.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Isendrecv_replace = PMPI_Isendrecv_replace -#endif -#define MPI_Isendrecv_replace PMPI_Isendrecv_replace -#endif - -static const char FUNC_NAME[] = "MPI_Isendrecv_replace"; - -struct ompi_isendrecv_replace_context_t { - opal_object_t super; - opal_convertor_t convertor; - size_t packed_size; - unsigned char packed_data[2048]; - struct iovec iov; - int nreqs; - int source; - ompi_request_t *subreq[2]; -}; - -typedef struct ompi_isendrecv_replace_context_t ompi_isendrecv_replace_context_t; - -#if OMPI_BUILD_MPI_PROFILING -static void ompi_isendrecv_context_constructor(ompi_isendrecv_replace_context_t *context) -{ - context->packed_size = 0; - OBJ_CONSTRUCT(&context->convertor, opal_convertor_t); -} - -static void ompi_isendrecv_context_destructor(ompi_isendrecv_replace_context_t *context) -{ - if (context->packed_size > sizeof(context->packed_data)) { - PMPI_Free_mem(context->iov.iov_base); - } - OBJ_DESTRUCT(&context->convertor); -} - -OBJ_CLASS_INSTANCE(ompi_isendrecv_replace_context_t, - opal_object_t, - ompi_isendrecv_context_constructor, - ompi_isendrecv_context_destructor); -#else -OBJ_CLASS_DECLARATION(ompi_isendrecv_replace_context_t); -#endif /* OMPI_BUILD_MPI_PROFILING */ - -static int ompi_isendrecv_replace_complete_func (ompi_comm_request_t *request) -{ - ompi_isendrecv_replace_context_t *context = - (ompi_isendrecv_replace_context_t *) request->context; - - /* - * Copy the status from the receive side of the sendrecv request? - * But what if the send failed? - * - * Probably need to bring up in the MPI forum. - */ - - if (MPI_PROC_NULL != context->source) { - OMPI_COPY_STATUS(&request->super.req_status, - context->subreq[0]->req_status, false); - } else { - OMPI_COPY_STATUS(&request->super.req_status, - ompi_request_empty.req_status, false); - } - - if(NULL != context->subreq[0]) { - ompi_request_free(&context->subreq[0]); - } - if(NULL != context->subreq[1]) { - ompi_request_free(&context->subreq[1]); - } - - return OMPI_SUCCESS; -} - - -int MPI_Isendrecv_replace(void * buf, int count, MPI_Datatype datatype, - int dest, int sendtag, int source, int recvtag, - MPI_Comm comm, MPI_Request *request) - -{ - int rc = MPI_SUCCESS; - size_t max_data; - uint32_t iov_count; - ompi_comm_request_t *crequest = NULL; - ompi_isendrecv_replace_context_t *context = NULL; - int nreqs = 0; - uint32_t flags; - - SPC_RECORD(OMPI_SPC_ISENDRECV_REPLACE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { - rc = MPI_ERR_RANK; - } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - /* simple case */ - if ( source == MPI_PROC_NULL || dest == MPI_PROC_NULL || count == 0 ) { - rc = PMPI_Isendrecv(buf, count, datatype, dest, sendtag, buf, count, datatype, source, recvtag, comm, request); - return rc; - } - - ompi_proc_t* proc = ompi_comm_peer_lookup(comm, dest); - if(proc == NULL) { - rc = MPI_ERR_RANK; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - - crequest = ompi_comm_request_get (); - if (NULL == crequest) { - return OMPI_ERR_OUT_OF_RESOURCE; - } - - context = OBJ_NEW(ompi_isendrecv_replace_context_t); - if (NULL == context) { - ompi_comm_request_return (crequest); - return OMPI_ERR_OUT_OF_RESOURCE; - } - - context->iov.iov_base = context->packed_data; - context->iov.iov_len = sizeof(context->packed_data); - - crequest->context = &context->super; - context->subreq[0] = NULL; - context->subreq[1] = NULL; - context->source = source; - - /* initialize convertor to unpack recv buffer */ - OBJ_CONSTRUCT(&context->convertor, opal_convertor_t); - opal_convertor_copy_and_prepare_for_send( proc->super.proc_convertor, &(datatype->super), - count, buf, 0, &context->convertor ); - - /* setup a buffer for recv */ - opal_convertor_get_packed_size( &context->convertor, &context->packed_size ); - if( context->packed_size > sizeof(context->packed_data) ) { - rc = PMPI_Alloc_mem(context->packed_size, MPI_INFO_NULL, &context->iov.iov_base); - if(OMPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - context->iov.iov_len = context->packed_size; - } - max_data = context->packed_size; - iov_count = 1; - rc = opal_convertor_pack(&context->convertor, &context->iov, &iov_count, &max_data); - if ( 0 > rc ) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - rc = MPI_ERR_UNKNOWN; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - - if (source != MPI_PROC_NULL) { /* post recv */ - rc = MCA_PML_CALL(irecv(buf, count, datatype, - source, recvtag, comm, &context->subreq[nreqs++])); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (dest != MPI_PROC_NULL) { /* send */ - rc = MCA_PML_CALL(isend(context->iov.iov_base, context->packed_size, MPI_PACKED, dest, - sendtag, MCA_PML_BASE_SEND_STANDARD, comm, - &context->subreq[nreqs++])); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - /* - * schedule the operation - */ - - context->nreqs = nreqs; - assert(nreqs <= 2); - - flags = OMPI_COMM_REQ_FLAG_RETAIN_SUBREQ; - - rc = ompi_comm_request_schedule_append_w_flags(crequest, - ompi_isendrecv_replace_complete_func, - context->subreq, - nreqs, - flags); - if (MPI_SUCCESS != rc) { - OBJ_RELEASE(context); - ompi_comm_request_return (crequest); - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - - /* kick off the request */ - - ompi_comm_request_start (crequest); - *request = &crequest->super; - - return rc; -} diff --git a/ompi/mpi/c/isendrecv_replace.c.in b/ompi/mpi/c/isendrecv_replace.c.in new file mode 100644 index 00000000000..2dad8a3078e --- /dev/null +++ b/ompi/mpi/c/isendrecv_replace.c.in @@ -0,0 +1,250 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2022 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) 2010-2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/communicator/comm_request.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/proc/proc.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +struct ompi_isendrecv_replace_context_t { + opal_object_t super; + opal_convertor_t convertor; + size_t packed_size; + unsigned char packed_data[2048]; + struct iovec iov; + int nreqs; + int source; + ompi_request_t *subreq[2]; +}; + +typedef struct ompi_isendrecv_replace_context_t ompi_isendrecv_replace_context_t; + +#if OMPI_BUILD_MPI_PROFILING +static void ompi_isendrecv_context_constructor(ompi_isendrecv_replace_context_t *context) +{ + context->packed_size = 0; + OBJ_CONSTRUCT(&context->convertor, opal_convertor_t); +} + +static void ompi_isendrecv_context_destructor(ompi_isendrecv_replace_context_t *context) +{ + if (context->packed_size > sizeof(context->packed_data)) { + PMPI_Free_mem(context->iov.iov_base); + } + OBJ_DESTRUCT(&context->convertor); +} + +OBJ_CLASS_INSTANCE(ompi_isendrecv_replace_context_t, + opal_object_t, + ompi_isendrecv_context_constructor, + ompi_isendrecv_context_destructor); +#else +OBJ_CLASS_DECLARATION(ompi_isendrecv_replace_context_t); +#endif /* OMPI_BUILD_MPI_PROFILING */ + +static int ompi_isendrecv_replace_complete_func (ompi_comm_request_t *request) +{ + ompi_isendrecv_replace_context_t *context = + (ompi_isendrecv_replace_context_t *) request->context; + + /* + * Copy the status from the receive side of the sendrecv request? + * But what if the send failed? + * + * Probably need to bring up in the MPI forum. + */ + + if (MPI_PROC_NULL != context->source) { + OMPI_COPY_STATUS(&request->super.req_status, + context->subreq[0]->req_status, false); + } else { + OMPI_COPY_STATUS(&request->super.req_status, + ompi_request_empty.req_status, false); + } + + if(NULL != context->subreq[0]) { + ompi_request_free(&context->subreq[0]); + } + if(NULL != context->subreq[1]) { + ompi_request_free(&context->subreq[1]); + } + + return OMPI_SUCCESS; +} + +PROTOTYPE ERROR_CLASS isendrecv_replace(BUFFER_OUT buf, COUNT count, DATATYPE datatype, + INT dest, INT sendtag, INT source, INT recvtag, + COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + size_t max_data; + uint32_t iov_count; + ompi_comm_request_t *crequest = NULL; + ompi_isendrecv_replace_context_t *context = NULL; + int nreqs = 0; + uint32_t flags; + + SPC_RECORD(OMPI_SPC_ISENDRECV_REPLACE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { + rc = MPI_ERR_RANK; + } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + /* simple case */ + if ( source == MPI_PROC_NULL || dest == MPI_PROC_NULL || count == 0 ) { + rc = PMPI_Isendrecv(buf, count, datatype, dest, sendtag, buf, count, datatype, source, recvtag, comm, request); + return rc; + } + + ompi_proc_t* proc = ompi_comm_peer_lookup(comm, dest); + if(proc == NULL) { + rc = MPI_ERR_RANK; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + + crequest = ompi_comm_request_get (); + if (NULL == crequest) { + return OMPI_ERR_OUT_OF_RESOURCE; + } + + context = OBJ_NEW(ompi_isendrecv_replace_context_t); + if (NULL == context) { + ompi_comm_request_return (crequest); + return OMPI_ERR_OUT_OF_RESOURCE; + } + + context->iov.iov_base = context->packed_data; + context->iov.iov_len = sizeof(context->packed_data); + + crequest->context = &context->super; + context->subreq[0] = NULL; + context->subreq[1] = NULL; + context->source = source; + + /* initialize convertor to unpack recv buffer */ + OBJ_CONSTRUCT(&context->convertor, opal_convertor_t); + opal_convertor_copy_and_prepare_for_send( proc->super.proc_convertor, &(datatype->super), + count, buf, 0, &context->convertor ); + + /* setup a buffer for recv */ + opal_convertor_get_packed_size( &context->convertor, &context->packed_size ); + if( context->packed_size > sizeof(context->packed_data) ) { + rc = PMPI_Alloc_mem(context->packed_size, MPI_INFO_NULL, &context->iov.iov_base); + if(OMPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + context->iov.iov_len = context->packed_size; + } + max_data = context->packed_size; + iov_count = 1; + rc = opal_convertor_pack(&context->convertor, &context->iov, &iov_count, &max_data); + if ( 0 > rc ) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + rc = MPI_ERR_UNKNOWN; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + + if (source != MPI_PROC_NULL) { /* post recv */ + rc = MCA_PML_CALL(irecv(buf, count, datatype, + source, recvtag, comm, &context->subreq[nreqs++])); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (dest != MPI_PROC_NULL) { /* send */ + rc = MCA_PML_CALL(isend(context->iov.iov_base, context->packed_size, MPI_PACKED, dest, + sendtag, MCA_PML_BASE_SEND_STANDARD, comm, + &context->subreq[nreqs++])); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + /* + * schedule the operation + */ + + context->nreqs = nreqs; + assert(nreqs <= 2); + + flags = OMPI_COMM_REQ_FLAG_RETAIN_SUBREQ; + + rc = ompi_comm_request_schedule_append_w_flags(crequest, + ompi_isendrecv_replace_complete_func, + context->subreq, + nreqs, + flags); + if (MPI_SUCCESS != rc) { + OBJ_RELEASE(context); + ompi_comm_request_return (crequest); + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + + /* kick off the request */ + + ompi_comm_request_start (crequest); + *request = &crequest->super; + + return rc; +} diff --git a/ompi/mpi/c/issend.c b/ompi/mpi/c/issend.c deleted file mode 100644 index e233b145da1..00000000000 --- a/ompi/mpi/c/issend.c +++ /dev/null @@ -1,99 +0,0 @@ -/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Issend = PMPI_Issend -#endif -#define MPI_Issend PMPI_Issend -#endif - -static const char FUNC_NAME[] = "MPI_Issend"; - - -int MPI_Issend(const void *buf, int count, MPI_Datatype type, int dest, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_ISSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - MEMCHECKER ( - memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); - ); - rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_SYNCHRONOUS, comm, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - - diff --git a/ompi/mpi/c/issend.c.in b/ompi/mpi/c/issend.c.in new file mode 100644 index 00000000000..1a34c0a4c9c --- /dev/null +++ b/ompi/mpi/c/issend.c.in @@ -0,0 +1,91 @@ +/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS issend(BUFFER buf, COUNT count, DATATYPE type, INT dest, + INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_ISSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + MEMCHECKER ( + memchecker_call(&opal_memchecker_base_mem_noaccess, buf, count, type); + ); + rc = MCA_PML_CALL(isend(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_SYNCHRONOUS, comm, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + + diff --git a/ompi/mpi/c/keyval_create.c b/ompi/mpi/c/keyval_create.c deleted file mode 100644 index be340fe4efc..00000000000 --- a/ompi/mpi/c/keyval_create.c +++ /dev/null @@ -1,67 +0,0 @@ -/* - * 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-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) 2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. - * All Rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Keyval_create = PMPI_Keyval_create -#endif -#define MPI_Keyval_create PMPI_Keyval_create -#endif - -static const char FUNC_NAME[] = "MPI_Keyval_create"; - - -int MPI_Keyval_create(MPI_Copy_function *copy_attr_fn, - MPI_Delete_function *delete_attr_fn, - int *keyval, void *extra_state) -{ - int ret; - ompi_attribute_fn_ptr_union_t copy_fn; - ompi_attribute_fn_ptr_union_t del_fn; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, - FUNC_NAME); - } else if ((NULL == copy_attr_fn) || (NULL == delete_attr_fn)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - copy_fn.attr_communicator_copy_fn = copy_attr_fn; - del_fn.attr_communicator_delete_fn = delete_attr_fn; - - ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn, - del_fn, keyval, extra_state, 0, NULL); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/keyval_create.c.in b/ompi/mpi/c/keyval_create.c.in new file mode 100644 index 00000000000..8a318ad4da3 --- /dev/null +++ b/ompi/mpi/c/keyval_create.c.in @@ -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-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) 2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. + * All Rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS keyval_create(COPY_FUNCTION copy_attr_fn, + DELETE_FUNCTION delete_attr_fn, + INT_OUT keyval, BUFFER_OUT extra_state) +{ + int ret; + ompi_attribute_fn_ptr_union_t copy_fn; + ompi_attribute_fn_ptr_union_t del_fn; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, + FUNC_NAME); + } else if ((NULL == copy_attr_fn) || (NULL == delete_attr_fn)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + copy_fn.attr_communicator_copy_fn = copy_attr_fn; + del_fn.attr_communicator_delete_fn = delete_attr_fn; + + ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn, + del_fn, keyval, extra_state, 0, NULL); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/keyval_free.c b/ompi/mpi/c/keyval_free.c deleted file mode 100644 index 40183f72f14..00000000000 --- a/ompi/mpi/c/keyval_free.c +++ /dev/null @@ -1,53 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Keyval_free = PMPI_Keyval_free -#endif -#define MPI_Keyval_free PMPI_Keyval_free -#endif - -static const char FUNC_NAME[] = "MPI_Keyval_free"; - - -int MPI_Keyval_free(int *keyval) -{ - int ret; - - /* Check for valid key pointer */ - if (MPI_PARAM_CHECK) { - if (NULL == keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, - FUNC_NAME); - } - } - - ret = ompi_attr_free_keyval(COMM_ATTR, keyval, 0); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/keyval_free.c.in b/ompi/mpi/c/keyval_free.c.in new file mode 100644 index 00000000000..8705ada7a10 --- /dev/null +++ b/ompi/mpi/c/keyval_free.c.in @@ -0,0 +1,45 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS keyval_free(INT_OUT keyval) +{ + int ret; + + /* Check for valid key pointer */ + if (MPI_PARAM_CHECK) { + if (NULL == keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, + FUNC_NAME); + } + } + + ret = ompi_attr_free_keyval(COMM_ATTR, keyval, 0); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/lookup_name.c b/ompi/mpi/c/lookup_name.c deleted file mode 100644 index 0633d05a90f..00000000000 --- a/ompi/mpi/c/lookup_name.c +++ /dev/null @@ -1,122 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "opal/class/opal_list.h" -#include "opal/mca/pmix/pmix-internal.h" -#include "opal/util/show_help.h" -#include "opal/util/string_copy.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Lookup_name = PMPI_Lookup_name -#endif -#define MPI_Lookup_name PMPI_Lookup_name -#endif - -static const char FUNC_NAME[] = "MPI_Lookup_name"; - - -int MPI_Lookup_name(const char *service_name, MPI_Info info, char *port_name) -{ - int flag=0, ret; - pmix_status_t rc; - pmix_pdata_t pdat; - pmix_info_t pinfo; - pmix_data_range_t rng; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == port_name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == service_name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - /* OMPI supports info keys to pass the range to - * be searched for the given key */ - if (MPI_INFO_NULL != info) { - opal_cstring_t *info_str; - ompi_info_get (info, "range", &info_str, &flag); - if (flag) { - if (0 == strcmp(info_str->string, "nspace")) { - rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace - } else if (0 == strcmp(info_str->string, "session")) { - rng = PMIX_RANGE_SESSION; // share only with procs in same session - } else { - /* unrecognized scope */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - OBJ_RELEASE(info_str); - } - } - PMIX_INFO_LOAD(&pinfo, PMIX_RANGE, &rng, PMIX_DATA_RANGE); - - /* collect the findings */ - PMIX_PDATA_CONSTRUCT(&pdat); - PMIX_LOAD_KEY(pdat.key, service_name); - - rc = PMIx_Lookup(&pdat, 1, &pinfo, 1); - PMIX_INFO_DESTRUCT(&pinfo); - if (PMIX_SUCCESS != rc || - PMIX_STRING != pdat.value.type || - NULL == pdat.value.data.string) { - if (PMIX_ERR_NOT_SUPPORTED == rc) { - ret = OMPI_ERR_NOT_SUPPORTED; - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support name lookup functionality"); - } else { - ret = MPI_ERR_NAME; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); - } - - opal_string_copy( port_name, pdat.value.data.string, - MPI_MAX_PORT_NAME ); - PMIX_PDATA_DESTRUCT(&pdat); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/lookup_name.c.in b/ompi/mpi/c/lookup_name.c.in new file mode 100644 index 00000000000..a49ee143e59 --- /dev/null +++ b/ompi/mpi/c/lookup_name.c.in @@ -0,0 +1,112 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015-2018 Cisco Systems, Inc. All rights reserved + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "opal/class/opal_list.h" +#include "opal/mca/pmix/pmix-internal.h" +#include "opal/util/show_help.h" +#include "opal/util/string_copy.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS lookup_name(STRING service_name, INFO info, STRING_OUT port_name) +{ + int flag=0, ret; + pmix_status_t rc; + pmix_pdata_t pdat; + pmix_info_t pinfo; + pmix_data_range_t rng; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == port_name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == service_name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + /* OMPI supports info keys to pass the range to + * be searched for the given key */ + if (MPI_INFO_NULL != info) { + opal_cstring_t *info_str; + ompi_info_get (info, "range", &info_str, &flag); + if (flag) { + if (0 == strcmp(info_str->string, "nspace")) { + rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace + } else if (0 == strcmp(info_str->string, "session")) { + rng = PMIX_RANGE_SESSION; // share only with procs in same session + } else { + /* unrecognized scope */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + OBJ_RELEASE(info_str); + } + } + PMIX_INFO_LOAD(&pinfo, PMIX_RANGE, &rng, PMIX_DATA_RANGE); + + /* collect the findings */ + PMIX_PDATA_CONSTRUCT(&pdat); + PMIX_LOAD_KEY(pdat.key, service_name); + + rc = PMIx_Lookup(&pdat, 1, &pinfo, 1); + PMIX_INFO_DESTRUCT(&pinfo); + if (PMIX_SUCCESS != rc || + PMIX_STRING != pdat.value.type || + NULL == pdat.value.data.string) { + if (PMIX_ERR_NOT_SUPPORTED == rc) { + ret = OMPI_ERR_NOT_SUPPORTED; + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support name lookup functionality"); + } else { + ret = MPI_ERR_NAME; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); + } + + opal_string_copy( port_name, pdat.value.data.string, + MPI_MAX_PORT_NAME ); + PMIX_PDATA_DESTRUCT(&pdat); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/message_c2f.c b/ompi/mpi/c/message_c2f.c deleted file mode 100644 index c6406da434b..00000000000 --- a/ompi/mpi/c/message_c2f.c +++ /dev/null @@ -1,75 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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-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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/message/message.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Message_c2f = PMPI_Message_c2f -#endif -#define MPI_Message_c2f PMPI_Message_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Message_c2f"; - - -MPI_Fint MPI_Message_c2f(MPI_Message message) -{ - MEMCHECKER( - memchecker_message(&message); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == message) { - return OMPI_INT_2_FINT(-1); - } - } - - /* We only put messages in the f2c table when this function is - invoked. This is because putting messages in the table - involves locking and unlocking the table, which would incur a - performance penalty (in the critical performance path) for C - applications. In this way, at least only Fortran applications - are penalized. :-\ - - Modifying this one function neatly fixes up all the Fortran - bindings because they all call MPI_Message_c2f in order to - transmorgify the C MPI_Message that they got back into a - fortran integer. - */ - - if (MPI_UNDEFINED == message->m_f_to_c_index) { - message->m_f_to_c_index = - opal_pointer_array_add(&ompi_message_f_to_c_table, message); - } - - return OMPI_INT_2_FINT(message->m_f_to_c_index) ; -} diff --git a/ompi/mpi/c/message_c2f.c.in b/ompi/mpi/c/message_c2f.c.in new file mode 100644 index 00000000000..407fc9f1ff3 --- /dev/null +++ b/ompi/mpi/c/message_c2f.c.in @@ -0,0 +1,67 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/message/message.h" +#include "ompi/memchecker.h" + +PROTOTYPE FINT message_c2f(MESSAGE message) +{ + MEMCHECKER( + memchecker_message(&message); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == message) { + return OMPI_INT_2_FINT(-1); + } + } + + /* We only put messages in the f2c table when this function is + invoked. This is because putting messages in the table + involves locking and unlocking the table, which would incur a + performance penalty (in the critical performance path) for C + applications. In this way, at least only Fortran applications + are penalized. :-\ + + Modifying this one function neatly fixes up all the Fortran + bindings because they all call MPI_Message_c2f in order to + transmorgify the C MPI_Message that they got back into a + fortran integer. + */ + + if (MPI_UNDEFINED == message->m_f_to_c_index) { + message->m_f_to_c_index = + opal_pointer_array_add(&ompi_message_f_to_c_table, message); + } + + return OMPI_INT_2_FINT(message->m_f_to_c_index) ; +} diff --git a/ompi/mpi/c/message_f2c.c b/ompi/mpi/c/message_f2c.c deleted file mode 100644 index b667b573b19..00000000000 --- a/ompi/mpi/c/message_f2c.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/message/message.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Message_f2c = PMPI_Message_f2c -#endif -#define MPI_Message_f2c PMPI_Message_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Message_f2c"; - - -MPI_Message MPI_Message_f2c(MPI_Fint message) -{ - int message_index = OMPI_FINT_2_INT(message); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (message_index < 0 || - message_index >= - opal_pointer_array_get_size(&ompi_message_f_to_c_table)) { - return NULL; - } - - return (MPI_Message)opal_pointer_array_get_item(&ompi_message_f_to_c_table, - message_index); -} diff --git a/ompi/mpi/c/message_f2c.c.in b/ompi/mpi/c/message_f2c.c.in new file mode 100644 index 00000000000..e9179e86ba0 --- /dev/null +++ b/ompi/mpi/c/message_f2c.c.in @@ -0,0 +1,52 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/message/message.h" + +PROTOTYPE MESSAGE message_f2c(FINT message) +{ + int message_index = OMPI_FINT_2_INT(message); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (message_index < 0 || + message_index >= + opal_pointer_array_get_size(&ompi_message_f_to_c_table)) { + return NULL; + } + + return (MPI_Message)opal_pointer_array_get_item(&ompi_message_f_to_c_table, + message_index); +} diff --git a/ompi/mpi/c/mprobe.c b/ompi/mpi/c/mprobe.c deleted file mode 100644 index b63e446b91c..00000000000 --- a/ompi/mpi/c/mprobe.c +++ /dev/null @@ -1,99 +0,0 @@ -/* - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020-2021 The University of Tennessee and The University - * of Tennessee Research Foundation. 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/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/message/message.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Mprobe = PMPI_Mprobe -#endif -#define MPI_Mprobe PMPI_Mprobe -#endif - -static const char FUNC_NAME[] = "MPI_Mprobe"; - -int MPI_Mprobe(int source, int tag, MPI_Comm comm, - MPI_Message *message, MPI_Status *status) -{ - int rc; - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_invalid(comm)) { - rc = MPI_ERR_COMM; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (NULL == message) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == source) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* Per MPI-1, the MPI_ERROR field is not defined for - single-completion calls */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - *message = &ompi_message_no_proc.message; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * Check here for issues with the peer, so we do not have to duplicate the - * functionality in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { - if (MPI_STATUS_IGNORE != status) { - status->MPI_SOURCE = source; - status->MPI_TAG = tag; - } - *message = &ompi_message_no_proc.message; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = MCA_PML_CALL(mprobe(source, tag, comm, message, status)); - /* Per MPI-1, the MPI_ERROR field is not defined for - single-completion calls */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/mprobe.c.in b/ompi/mpi/c/mprobe.c.in new file mode 100644 index 00000000000..2f060e52b49 --- /dev/null +++ b/ompi/mpi/c/mprobe.c.in @@ -0,0 +1,92 @@ +/* + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 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/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/message/message.h" + +PROTOTYPE ERROR_CLASS mprobe(INT source, INT tag, COMM comm, + MESSAGE_OUT message, STATUS_OUT status) +{ + int rc; + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_invalid(comm)) { + rc = MPI_ERR_COMM; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (NULL == message) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == source) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* Per MPI-1, the MPI_ERROR field is not defined for + single-completion calls */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + *message = &ompi_message_no_proc.message; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * Check here for issues with the peer, so we do not have to duplicate the + * functionality in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { + if (MPI_STATUS_IGNORE != status) { + status->MPI_SOURCE = source; + status->MPI_TAG = tag; + } + *message = &ompi_message_no_proc.message; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = MCA_PML_CALL(mprobe(source, tag, comm, message, status)); + /* Per MPI-1, the MPI_ERROR field is not defined for + single-completion calls */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/mrecv.c b/ompi/mpi/c/mrecv.c deleted file mode 100644 index c56a0830619..00000000000 --- a/ompi/mpi/c/mrecv.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/message/message.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Mrecv = PMPI_Mrecv -#endif -#define MPI_Mrecv PMPI_Mrecv -#endif - -static const char FUNC_NAME[] = "MPI_Mrecv"; - - -int MPI_Mrecv(void *buf, int count, MPI_Datatype type, - MPI_Message *message, MPI_Status *status) -{ - int rc = MPI_SUCCESS; - ompi_communicator_t *comm; - - SPC_RECORD(OMPI_SPC_MRECV, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_message(message); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - - if (NULL == message || MPI_MESSAGE_NULL == *message) { - rc = MPI_ERR_REQUEST; - comm = MPI_COMM_NULL; - } else { - comm = (*message)->comm; - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } else { - comm = (*message)->comm; - } - - if (&ompi_message_no_proc.message == *message) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - } - *message = MPI_MESSAGE_NULL; - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * The message and associated request will be checked by the PML, and - * handled appropriately. SO no need to check here. - */ -#endif - - rc = MCA_PML_CALL(mrecv(buf, count, type, message, status)); - /* Per MPI-1, the MPI_ERROR field is not defined for - single-completion calls */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/mrecv.c.in b/ompi/mpi/c/mrecv.c.in new file mode 100644 index 00000000000..a23368eaf51 --- /dev/null +++ b/ompi/mpi/c/mrecv.c.in @@ -0,0 +1,84 @@ +/* + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2021 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/message/message.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS mrecv(BUFFER_OUT buf, COUNT count, DATATYPE type, + MESSAGE_OUT message, STATUS_OUT status) +{ + int rc = MPI_SUCCESS; + ompi_communicator_t *comm; + + SPC_RECORD(OMPI_SPC_MRECV, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_message(message); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + + if (NULL == message || MPI_MESSAGE_NULL == *message) { + rc = MPI_ERR_REQUEST; + comm = MPI_COMM_NULL; + } else { + comm = (*message)->comm; + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } else { + comm = (*message)->comm; + } + + if (&ompi_message_no_proc.message == *message) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + } + *message = MPI_MESSAGE_NULL; + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * The message and associated request will be checked by the PML, and + * handled appropriately. SO no need to check here. + */ +#endif + + rc = MCA_PML_CALL(mrecv(buf, count, type, message, status)); + /* Per MPI-1, the MPI_ERROR field is not defined for + single-completion calls */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/neighbor_allgather.c b/ompi/mpi/c/neighbor_allgather.c deleted file mode 100644 index 872c2ffb292..00000000000 --- a/ompi/mpi/c/neighbor_allgather.c +++ /dev/null @@ -1,143 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010 University of Houston. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_allgather = PMPI_Neighbor_allgather -#endif -#define MPI_Neighbor_allgather PMPI_Neighbor_allgather -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_allgather"; - - -int MPI_Neighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHER, 1); - - MEMCHECKER( - ptrdiff_t ext; - - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Do we need to do anything? Everyone had to give the same send - signature, which means that everyone must have given a - sendcount > 0. */ - if ((0 == sendcount) || (0 == recvcount)) { - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_neighbor_allgather(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - comm->c_coll->coll_neighbor_allgather_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_allgather.c.in b/ompi/mpi/c/neighbor_allgather.c.in new file mode 100644 index 00000000000..fbfbf8ef342 --- /dev/null +++ b/ompi/mpi/c/neighbor_allgather.c.in @@ -0,0 +1,135 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010 University of Houston. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_allgather(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHER, 1); + + MEMCHECKER( + ptrdiff_t ext; + + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Do we need to do anything? Everyone had to give the same send + signature, which means that everyone must have given a + sendcount > 0. */ + if ((0 == sendcount) || (0 == recvcount)) { + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_neighbor_allgather(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + comm->c_coll->coll_neighbor_allgather_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/neighbor_allgather_init.c b/ompi/mpi/c/neighbor_allgather_init.c deleted file mode 100644 index 5b6042e7a8d..00000000000 --- a/ompi/mpi/c/neighbor_allgather_init.c +++ /dev/null @@ -1,129 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_allgather_init = PMPI_Neighbor_allgather_init -#endif -#define MPI_Neighbor_allgather_init PMPI_Neighbor_allgather_init -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_allgather_init"; - - -int MPI_Neighbor_allgather_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHER_INIT, 1); - - MEMCHECKER( - ptrdiff_t ext; - - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm(comm); - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - /* check whether the receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } else if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_neighbor_allgather_init(sendbuf, sendcount, sendtype, recvbuf, - recvcount, recvtype, comm, info, request, - comm->c_coll->coll_neighbor_allgather_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/neighbor_allgather_init.c.in b/ompi/mpi/c/neighbor_allgather_init.c.in new file mode 100644 index 00000000000..ed93cf30c69 --- /dev/null +++ b/ompi/mpi/c/neighbor_allgather_init.c.in @@ -0,0 +1,121 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Rigde National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_allgather_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHER_INIT, 1); + + MEMCHECKER( + ptrdiff_t ext; + + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm(comm); + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + /* check whether the receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } else if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_neighbor_allgather_init(sendbuf, sendcount, sendtype, recvbuf, + recvcount, recvtype, comm, info, request, + comm->c_coll->coll_neighbor_allgather_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/neighbor_allgatherv.c b/ompi/mpi/c/neighbor_allgatherv.c deleted file mode 100644 index 572ee918599..00000000000 --- a/ompi/mpi/c/neighbor_allgatherv.c +++ /dev/null @@ -1,162 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2016 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_allgatherv = PMPI_Neighbor_allgatherv -#endif -#define MPI_Neighbor_allgatherv PMPI_Neighbor_allgatherv -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_allgatherv"; - - -int MPI_Neighbor_allgatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, MPI_Comm comm) -{ - int in_size, out_size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - mca_topo_base_neighbor_count (comm, &in_size, &out_size); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (int i = 0; i < in_size; ++i) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - mca_topo_base_neighbor_count (comm, &in_size, &out_size); - for (int i = 0; i < in_size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_neighbor_allgatherv(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, displs_desc, - recvtype, comm, comm->c_coll->coll_neighbor_allgatherv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/neighbor_allgatherv.c.in b/ompi/mpi/c/neighbor_allgatherv.c.in new file mode 100644 index 00000000000..c71ffe1674d --- /dev/null +++ b/ompi/mpi/c/neighbor_allgatherv.c.in @@ -0,0 +1,154 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_allgatherv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm) +{ + int in_size, out_size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + mca_topo_base_neighbor_count (comm, &in_size, &out_size); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (int i = 0; i < in_size; ++i) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + mca_topo_base_neighbor_count (comm, &in_size, &out_size); + for (int i = 0; i < in_size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_neighbor_allgatherv(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, displs_desc, + recvtype, comm, comm->c_coll->coll_neighbor_allgatherv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/neighbor_allgatherv_init.c b/ompi/mpi/c/neighbor_allgatherv_init.c deleted file mode 100644 index 086443433b2..00000000000 --- a/ompi/mpi/c/neighbor_allgatherv_init.c +++ /dev/null @@ -1,157 +0,0 @@ -/* -*- 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) 2010 University of Houston. All rights reserved. - * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_allgatherv_init = PMPI_Neighbor_allgatherv_init -#endif -#define MPI_Neighbor_allgatherv_init PMPI_Neighbor_allgatherv_init -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_allgatherv_init"; - - -int MPI_Neighbor_allgatherv_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, const int recvcounts[], const int displs[], - MPI_Datatype recvtype, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t recvcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHERV_INIT, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_datatype(recvtype); - memchecker_comm (comm); - /* check whether the receive buffer is addressable. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+displs[i]*ext, - recvcounts[i], recvtype); - } - - /* check whether the actual send buffer is defined. */ - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* We always define the remote group to be the same as the local - group in the case of an intracommunicator, so it's safe to - get the size of the remote group here for both intra- and - intercommunicators */ - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - if (recvcounts[i] < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - } - - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_neighbor_allgatherv_init(sendbuf, sendcount, sendtype, - recvbuf, recvcounts_desc, displs_desc, - recvtype, comm, info, request, - comm->c_coll->coll_neighbor_allgatherv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_allgatherv_init.c.in b/ompi/mpi/c/neighbor_allgatherv_init.c.in new file mode 100644 index 00000000000..24dc3c9a503 --- /dev/null +++ b/ompi/mpi/c/neighbor_allgatherv_init.c.in @@ -0,0 +1,149 @@ +/* -*- 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) 2010 University of Houston. All rights reserved. + * Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_allgatherv_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t recvcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLGATHERV_INIT, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_datatype(recvtype); + memchecker_comm (comm); + /* check whether the receive buffer is addressable. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+displs[i]*ext, + recvcounts[i], recvtype); + } + + /* check whether the actual send buffer is defined. */ + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* We always define the remote group to be the same as the local + group in the case of an intracommunicator, so it's safe to + get the size of the remote group here for both intra- and + intercommunicators */ + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + if (recvcounts[i] < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + } + + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_BUFFER, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_neighbor_allgatherv_init(sendbuf, sendcount, sendtype, + recvbuf, recvcounts_desc, displs_desc, + recvtype, comm, info, request, + comm->c_coll->coll_neighbor_allgatherv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/neighbor_alltoall.c b/ompi/mpi/c/neighbor_alltoall.c deleted file mode 100644 index e50885fb1c3..00000000000 --- a/ompi/mpi/c/neighbor_alltoall.c +++ /dev/null @@ -1,146 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_alltoall = PMPI_Neighbor_alltoall -#endif -#define MPI_Neighbor_alltoall PMPI_Neighbor_alltoall -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_alltoall"; - - -int MPI_Neighbor_alltoall(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm) -{ - size_t sendtype_size, recvtype_size; - int err; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALL, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Do we need to do anything? */ - - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if (((0 == sendcount) || (0 == sendtype_size)) && - ((0 == recvcount) || 0 == (recvtype_size))) { - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_neighbor_alltoall(sendbuf, sendcount, sendtype, recvbuf, - recvcount, recvtype, comm, - comm->c_coll->coll_neighbor_alltoall_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_alltoall.c.in b/ompi/mpi/c/neighbor_alltoall.c.in new file mode 100644 index 00000000000..d015c2742ba --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoall.c.in @@ -0,0 +1,138 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoall(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + size_t sendtype_size, recvtype_size; + int err; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALL, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Do we need to do anything? */ + + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if (((0 == sendcount) || (0 == sendtype_size)) && + ((0 == recvcount) || 0 == (recvtype_size))) { + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_neighbor_alltoall(sendbuf, sendcount, sendtype, recvbuf, + recvcount, recvtype, comm, + comm->c_coll->coll_neighbor_alltoall_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/neighbor_alltoall_init.c b/ompi/mpi/c/neighbor_alltoall_init.c deleted file mode 100644 index ee6bb510f63..00000000000 --- a/ompi/mpi/c/neighbor_alltoall_init.c +++ /dev/null @@ -1,131 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_alltoall_init = PMPI_Neighbor_alltoall_init -#endif -#define MPI_Neighbor_alltoall_init PMPI_Neighbor_alltoall_init -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_alltoall_init"; - - -int MPI_Neighbor_alltoall_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - size_t sendtype_size, recvtype_size; - int err; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALL_INIT, 1); - - MEMCHECKER( - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); - } - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks on both - intracommunicators and intercommunicators */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, - FUNC_NAME); - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - ompi_datatype_type_size(sendtype, &sendtype_size); - ompi_datatype_type_size(recvtype, &recvtype_size); - if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - int indegree = dist_graph->indegree; - int outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_neighbor_alltoall_init(sendbuf, sendcount, sendtype, - recvbuf, recvcount, recvtype, comm, - info, request, - comm->c_coll->coll_neighbor_alltoall_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/neighbor_alltoall_init.c.in b/ompi/mpi/c/neighbor_alltoall_init.c.in new file mode 100644 index 00000000000..7541a5d7824 --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoall_init.c.in @@ -0,0 +1,123 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoall_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_INOUT request) +{ + size_t sendtype_size, recvtype_size; + int err; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALL_INIT, 1); + + MEMCHECKER( + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + memchecker_call(&opal_memchecker_base_isdefined, (void *)sendbuf, sendcount, sendtype); + } + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks on both + intracommunicators and intercommunicators */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } else if (MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, + FUNC_NAME); + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + ompi_datatype_type_size(sendtype, &sendtype_size); + ompi_datatype_type_size(recvtype, &recvtype_size); + if ((sendtype_size*sendcount) != (recvtype_size*recvcount)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + int indegree = dist_graph->indegree; + int outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_neighbor_alltoall_init(sendbuf, sendcount, sendtype, + recvbuf, recvcount, recvtype, comm, + info, request, + comm->c_coll->coll_neighbor_alltoall_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/neighbor_alltoallv.c b/ompi/mpi/c/neighbor_alltoallv.c deleted file mode 100644 index 5fbffa9f0e3..00000000000 --- a/ompi/mpi/c/neighbor_alltoallv.c +++ /dev/null @@ -1,168 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_alltoallv = PMPI_Neighbor_alltoallv -#endif -#define MPI_Neighbor_alltoallv PMPI_Neighbor_alltoallv -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_alltoallv"; - - -int MPI_Neighbor_alltoallv(const void *sendbuf, const int sendcounts[], const int sdispls[], - MPI_Datatype sendtype, void *recvbuf, - const int recvcounts[], const int rdispls[], - MPI_Datatype recvtype, MPI_Comm comm) -{ - int i, err; - int indegree, outdegree; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLV, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - } - - memchecker_datatype(recvtype); - ompi_datatype_type_extent(sendtype, &send_ext); - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - if (MPI_SUCCESS == err) { - if (MPI_IN_PLACE != sendbuf) { - for ( i = 0; i < outdegree; i++ ) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - } - for ( i = 0; i < indegree; i++ ) { - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || - ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || - MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - for (i = 0; i < outdegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - for (i = 0; i < indegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - indegree = dist_graph->indegree; - outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_neighbor_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, sendtype, - recvbuf, recvcounts_desc, rdispls_desc, recvtype, - comm, comm->c_coll->coll_neighbor_alltoallv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_alltoallv.c.in b/ompi/mpi/c/neighbor_alltoallv.c.in new file mode 100644 index 00000000000..62a2051edbd --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoallv.c.in @@ -0,0 +1,160 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoallv(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT recvbuf, + COUNT_ARRAY recvcounts, DISP_ARRAY rdispls, + DATATYPE recvtype, COMM comm) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLV, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + } + + memchecker_datatype(recvtype); + ompi_datatype_type_extent(sendtype, &send_ext); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + } + for ( i = 0; i < indegree; i++ ) { + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_neighbor_alltoallv(sendbuf, sendcounts_desc, sdispls_desc, sendtype, + recvbuf, recvcounts_desc, rdispls_desc, recvtype, + comm, comm->c_coll->coll_neighbor_alltoallv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/neighbor_alltoallv_init.c b/ompi/mpi/c/neighbor_alltoallv_init.c deleted file mode 100644 index fde885483f7..00000000000 --- a/ompi/mpi/c/neighbor_alltoallv_init.c +++ /dev/null @@ -1,162 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2023 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_alltoallv_init = PMPI_Neighbor_alltoallv_init -#endif -#define MPI_Neighbor_alltoallv_init PMPI_Neighbor_alltoallv_init -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_alltoallv_init"; - - -int MPI_Neighbor_alltoallv_init(const void *sendbuf, const int sendcounts[], const int sdispls[], - MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], - const int rdispls[], MPI_Datatype recvtype, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int i, err; - int indegree, outdegree; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLV_INIT, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - if (MPI_IN_PLACE != sendbuf) { - memchecker_datatype(sendtype); - ompi_datatype_type_extent(recvtype, &recv_ext); - } - - memchecker_datatype(recvtype); - ompi_datatype_type_extent(sendtype, &send_ext); - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - if (MPI_SUCCESS == err) { - if (MPI_IN_PLACE != sendbuf) { - for ( i = 0; i < outdegree; i++ ) { - /* check if send chunks are defined. */ - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtype); - } - } - for ( i = 0; i < indegree; i++ ) { - /* check if receive chunks are addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+rdispls[i]*recv_ext, - recvcounts[i], recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || - ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || - MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - for (i = 0; i < outdegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - for (i = 0; i < indegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - indegree = dist_graph->indegree; - outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_neighbor_alltoallv_init(sendbuf, sendcounts_desc, sdispls_desc, - sendtype, recvbuf, recvcounts_desc, rdispls_desc, - recvtype, comm, info, request, - comm->c_coll->coll_neighbor_alltoallv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_alltoallv_init.c.in b/ompi/mpi/c/neighbor_alltoallv_init.c.in new file mode 100644 index 00000000000..e5a7fcfb541 --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoallv_init.c.in @@ -0,0 +1,154 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2023 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoallv_init(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLV_INIT, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + if (MPI_IN_PLACE != sendbuf) { + memchecker_datatype(sendtype); + ompi_datatype_type_extent(recvtype, &recv_ext); + } + + memchecker_datatype(recvtype); + ompi_datatype_type_extent(sendtype, &send_ext); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + /* check if send chunks are defined. */ + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtype); + } + } + for ( i = 0; i < indegree; i++ ) { + /* check if receive chunks are addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+rdispls[i]*recv_ext, + recvcounts[i], recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_neighbor_alltoallv_init(sendbuf, sendcounts_desc, sdispls_desc, + sendtype, recvbuf, recvcounts_desc, rdispls_desc, + recvtype, comm, info, request, + comm->c_coll->coll_neighbor_alltoallv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/neighbor_alltoallw.c b/ompi/mpi/c/neighbor_alltoallw.c deleted file mode 100644 index f6343fdb270..00000000000 --- a/ompi/mpi/c/neighbor_alltoallw.c +++ /dev/null @@ -1,164 +0,0 @@ -/* -*- 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/mca/topo/topo.h" -#include "ompi/mca/topo/base/base.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Neighbor_alltoallw = PMPI_Neighbor_alltoallw -#endif -#define MPI_Neighbor_alltoallw PMPI_Neighbor_alltoallw -#endif - -static const char FUNC_NAME[] = "MPI_Neighbor_alltoallw"; - - -int MPI_Neighbor_alltoallw(const void *sendbuf, const int sendcounts[], const MPI_Aint sdispls[], - const MPI_Datatype sendtypes[], void *recvbuf, - const int recvcounts[], const MPI_Aint rdispls[], - const MPI_Datatype recvtypes[], MPI_Comm comm) -{ - int i, err; - int indegree, outdegree; - ompi_count_array_t sendcounts_desc, recvcounts_desc; - ompi_disp_array_t sdispls_desc, rdispls_desc; - - SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLW, 1); - - MEMCHECKER( - ptrdiff_t recv_ext; - ptrdiff_t send_ext; - - memchecker_comm(comm); - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - if (MPI_SUCCESS == err) { - if (MPI_IN_PLACE != sendbuf) { - for ( i = 0; i < outdegree; i++ ) { - memchecker_datatype(sendtypes[i]); - - ompi_datatype_type_extent(sendtypes[i], &send_ext); - - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+sdispls[i]*send_ext, - sendcounts[i], sendtypes[i]); - } - } - for ( i = 0; i < indegree; i++ ) { - memchecker_datatype(recvtypes[i]); - ompi_datatype_type_extent(recvtypes[i], &recv_ext); - memchecker_call(&opal_memchecker_base_isaddressable, - (char *)(recvbuf)+sdispls[i]*recv_ext, - recvcounts[i], recvtypes[i]); - } - } - ); - - if (MPI_PARAM_CHECK) { - - /* Unrooted operation -- same checks for all ranks */ - - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (! OMPI_COMM_IS_TOPO(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, - FUNC_NAME); - } - - err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes))) || - ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes))) || - MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - for (i = 0; i < outdegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - for (i = 0; i < indegree; ++i) { - OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - if( OMPI_COMM_IS_CART(comm) ) { - const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; - if( 0 > cart->ndims ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_GRAPH(comm) ) { - int degree; - mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); - if( 0 > degree ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { - const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; - indegree = dist_graph->indegree; - outdegree = dist_graph->outdegree; - if( indegree < 0 || outdegree < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); - OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); - err = comm->c_coll->coll_neighbor_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, sendtypes, - recvbuf, recvcounts_desc, rdispls_desc, recvtypes, - comm, comm->c_coll->coll_neighbor_alltoallw_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} - diff --git a/ompi/mpi/c/neighbor_alltoallw.c.in b/ompi/mpi/c/neighbor_alltoallw.c.in new file mode 100644 index 00000000000..e44c1ed260a --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoallw.c.in @@ -0,0 +1,157 @@ +/* -*- 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoallw(BUFFER sendbuf, COUNT_ARRAY sendcounts, AINT_ARRAY sdispls, + DATATYPE_ARRAY sendtypes, BUFFER_OUT recvbuf, + COUNT_ARRAY recvcounts, AINT_ARRAY rdispls, + DATATYPE_ARRAY recvtypes, COMM comm) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLW, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + memchecker_datatype(sendtypes[i]); + + ompi_datatype_type_extent(sendtypes[i], &send_ext); + + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtypes[i]); + } + } + for ( i = 0; i < indegree; i++ ) { + memchecker_datatype(recvtypes[i]); + ompi_datatype_type_extent(recvtypes[i], &recv_ext); + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+sdispls[i]*recv_ext, + recvcounts[i], recvtypes[i]); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_neighbor_alltoallw(sendbuf, sendcounts_desc, sdispls_desc, sendtypes, + recvbuf, recvcounts_desc, rdispls_desc, recvtypes, + comm, comm->c_coll->coll_neighbor_alltoallw_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + + diff --git a/ompi/mpi/c/neighbor_alltoallw_init.c.in b/ompi/mpi/c/neighbor_alltoallw_init.c.in new file mode 100644 index 00000000000..a51fb2f7e1c --- /dev/null +++ b/ompi/mpi/c/neighbor_alltoallw_init.c.in @@ -0,0 +1,152 @@ +/* -*- 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-2022 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2023 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/mca/topo/topo.h" +#include "ompi/mca/topo/base/base.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS neighbor_alltoallw_init(BUFFER sendbuf, COUNT_ARRAY sendcounts, AINT_ARRAY sdispls, + DATATYPE_ARRAY sendtypes, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + AINT_ARRAY rdispls, DATATYPE_ARRAY recvtypes, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int i, err; + int indegree, outdegree; + ompi_count_array_t sendcounts_desc, recvcounts_desc; + ompi_disp_array_t sdispls_desc, rdispls_desc; + + SPC_RECORD(OMPI_SPC_NEIGHBOR_ALLTOALLW_INIT, 1); + + MEMCHECKER( + ptrdiff_t recv_ext; + ptrdiff_t send_ext; + + memchecker_comm(comm); + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + if (MPI_SUCCESS == err) { + if (MPI_IN_PLACE != sendbuf) { + for ( i = 0; i < outdegree; i++ ) { + memchecker_datatype(sendtypes[i]); + + ompi_datatype_type_extent(sendtypes[i], &send_ext); + + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+sdispls[i]*send_ext, + sendcounts[i], sendtypes[i]); + } + } + for ( i = 0; i < indegree; i++ ) { + memchecker_datatype(recvtypes[i]); + + ompi_datatype_type_extent(recvtypes[i], &recv_ext); + + memchecker_call(&opal_memchecker_base_isaddressable, + (char *)(recvbuf)+sdispls[i]*recv_ext, + recvcounts[i], recvtypes[i]); + } + } + ); + + if (MPI_PARAM_CHECK) { + + /* Unrooted operation -- same checks for all ranks */ + + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm) || OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (! OMPI_COMM_IS_TOPO(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TOPOLOGY, + FUNC_NAME); + } + + err = mca_topo_base_neighbor_count (comm, &indegree, &outdegree); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + if (((0 < outdegree) && ((NULL == sendcounts) || (NULL == sdispls) || (NULL == sendtypes))) || + ((0 < indegree) && ((NULL == recvcounts) || (NULL == rdispls) || (NULL == recvtypes))) || + MPI_IN_PLACE == sendbuf || MPI_IN_PLACE == recvbuf) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + for (i = 0; i < outdegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtypes[i], sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + for (i = 0; i < indegree; ++i) { + OMPI_CHECK_DATATYPE_FOR_RECV(err, recvtypes[i], recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + if( OMPI_COMM_IS_CART(comm) ) { + const mca_topo_base_comm_cart_2_2_0_t *cart = comm->c_topo->mtc.cart; + if( 0 > cart->ndims ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_GRAPH(comm) ) { + int degree; + mca_topo_base_graph_neighbors_count(comm, ompi_comm_rank(comm), °ree); + if( 0 > degree ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + else if( OMPI_COMM_IS_DIST_GRAPH(comm) ) { + const mca_topo_base_comm_dist_graph_2_2_0_t *dist_graph = comm->c_topo->mtc.dist_graph; + indegree = dist_graph->indegree; + outdegree = dist_graph->outdegree; + if( indegree < 0 || outdegree < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&sdispls_desc, sdispls); + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OMPI_DISP_ARRAY_INIT(&rdispls_desc, rdispls); + err = comm->c_coll->coll_neighbor_alltoallw_init(sendbuf, sendcounts_desc, sdispls_desc, sendtypes, + recvbuf, recvcounts_desc, rdispls_desc, recvtypes, comm, + info, request, + comm->c_coll->coll_neighbor_alltoallw_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_datatypes_w(*request, sendtypes, recvtypes, true); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} + diff --git a/ompi/mpi/c/op_c2f.c b/ompi/mpi/c/op_c2f.c deleted file mode 100644 index bf09306c21e..00000000000 --- a/ompi/mpi/c/op_c2f.c +++ /dev/null @@ -1,51 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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$ - */ -#include "ompi_config.h" -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/op/op.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Op_c2f = PMPI_Op_c2f -#endif -#define MPI_Op_c2f PMPI_Op_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Op_c2f"; - - -MPI_Fint MPI_Op_c2f(MPI_Op op) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == op) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(op->o_f_to_c_index); -} diff --git a/ompi/mpi/c/op_c2f.c.in b/ompi/mpi/c/op_c2f.c.in new file mode 100644 index 00000000000..be3a49fe04c --- /dev/null +++ b/ompi/mpi/c/op_c2f.c.in @@ -0,0 +1,43 @@ +/* + * Copyright (c) 2004-2007 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) 2006-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/op/op.h" + +PROTOTYPE FINT op_c2f(OP op) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == op) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(op->o_f_to_c_index); +} diff --git a/ompi/mpi/c/op_commutative.c b/ompi/mpi/c/op_commutative.c deleted file mode 100644 index 2bd6ea94cd7..00000000000 --- a/ompi/mpi/c/op_commutative.c +++ /dev/null @@ -1,64 +0,0 @@ -/* - * 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) 2009-2014 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/op/op.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Op_commutative = PMPI_Op_commutative -#endif -#define MPI_Op_commutative PMPI_Op_commutative -#endif - -static const char FUNC_NAME[] = "MPI_Op_commutative"; - - -int MPI_Op_commutative(MPI_Op op, int *commute) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == op || MPI_OP_NULL == op) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, - FUNC_NAME); - } - if (NULL == commute) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* We have a valid op, get the flag */ - - *commute = ompi_op_is_commute(op); - - /* All done */ - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/op_commutative.c.in b/ompi/mpi/c/op_commutative.c.in new file mode 100644 index 00000000000..0346036efee --- /dev/null +++ b/ompi/mpi/c/op_commutative.c.in @@ -0,0 +1,56 @@ +/* + * 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) 2009-2014 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$ + * + * 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/op/op.h" + +PROTOTYPE ERROR_CLASS op_commutative(OP op, INT_OUT commute) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == op || MPI_OP_NULL == op) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, + FUNC_NAME); + } + if (NULL == commute) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* We have a valid op, get the flag */ + + *commute = ompi_op_is_commute(op); + + /* All done */ + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/op_create.c b/ompi/mpi/c/op_create.c deleted file mode 100644 index 1fafbea899a..00000000000 --- a/ompi/mpi/c/op_create.c +++ /dev/null @@ -1,68 +0,0 @@ -/* - * 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-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-2009 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/op/op.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Op_create = PMPI_Op_create -#endif -#define MPI_Op_create PMPI_Op_create -#endif - -static const char FUNC_NAME[] = "MPI_Op_create"; - - -int MPI_Op_create(MPI_User_function * function, int commute, MPI_Op * op) -{ - int err = MPI_SUCCESS; - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == op) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, - FUNC_NAME); - } else if (NULL == function) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* Create and cache the op. Sets a refcount of 1. */ - - *op = ompi_op_create_user(OPAL_INT_TO_BOOL(commute), - false, - (ompi_op_fortran_handler_fn_t *) function); - if (NULL == *op) { - err = MPI_ERR_INTERN; - } - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); -} diff --git a/ompi/mpi/c/op_create.c.in b/ompi/mpi/c/op_create.c.in new file mode 100644 index 00000000000..b3a39473ce1 --- /dev/null +++ b/ompi/mpi/c/op_create.c.in @@ -0,0 +1,63 @@ +/* + * 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-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-2009 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 + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/op/op.h" + +PROTOTYPE ERROR_CLASS op_create(USER_FUNCTION function, INT commute, OP_OUT op) +{ + int err = MPI_SUCCESS; +#if OMPI_BIGCOUNT_SRC + bool bc_op = true; +#else + bool bc_op = false; +#endif + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == op) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, + FUNC_NAME); + } else if (NULL == function) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Create and cache the op. Sets a refcount of 1. */ + + *op = ompi_op_create_user(OPAL_INT_TO_BOOL(commute), + bc_op, + (ompi_op_fortran_handler_fn_t *) function); + if (NULL == *op) { + err = MPI_ERR_INTERN; + } + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); +} diff --git a/ompi/mpi/c/op_f2c.c b/ompi/mpi/c/op_f2c.c deleted file mode 100644 index d9be1f240b0..00000000000 --- a/ompi/mpi/c/op_f2c.c +++ /dev/null @@ -1,61 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/op/op.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Op_f2c = PMPI_Op_f2c -#endif -#define MPI_Op_f2c PMPI_Op_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Op_f2c"; - - -MPI_Op MPI_Op_f2c(MPI_Fint op_f) -{ - int op_index = OMPI_FINT_2_INT(op_f); - - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (op_index < 0 || - op_index >= - opal_pointer_array_get_size(ompi_op_f_to_c_table)) { - return NULL; - } - - return (MPI_Op)opal_pointer_array_get_item(ompi_op_f_to_c_table, op_index); -} diff --git a/ompi/mpi/c/op_f2c.c.in b/ompi/mpi/c/op_f2c.c.in new file mode 100644 index 00000000000..59812d893d2 --- /dev/null +++ b/ompi/mpi/c/op_f2c.c.in @@ -0,0 +1,53 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/op/op.h" + +PROTOTYPE OP op_f2c(FINT op_f) +{ + int op_index = OMPI_FINT_2_INT(op_f); + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (op_index < 0 || + op_index >= + opal_pointer_array_get_size(ompi_op_f_to_c_table)) { + return NULL; + } + + return (MPI_Op)opal_pointer_array_get_item(ompi_op_f_to_c_table, op_index); +} diff --git a/ompi/mpi/c/op_free.c b/ompi/mpi/c/op_free.c deleted file mode 100644 index 8920f271fd7..00000000000 --- a/ompi/mpi/c/op_free.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/op/op.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Op_free = PMPI_Op_free -#endif -#define MPI_Op_free PMPI_Op_free -#endif - -static const char FUNC_NAME[] = "MPI_Op_free"; - - -int MPI_Op_free(MPI_Op *op) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == op || - ompi_op_is_intrinsic(*op)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, - FUNC_NAME); - } - } - - /* We have a valid op, release it */ - - OBJ_RELEASE(*op); - *op = MPI_OP_NULL; - - /* All done */ - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/op_free.c.in b/ompi/mpi/c/op_free.c.in new file mode 100644 index 00000000000..93668a28abc --- /dev/null +++ b/ompi/mpi/c/op_free.c.in @@ -0,0 +1,52 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/op/op.h" + +PROTOTYPE ERROR_CLASS op_free(OP_OUT op) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == op || + ompi_op_is_intrinsic(*op)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, + FUNC_NAME); + } + } + + /* We have a valid op, release it */ + + OBJ_RELEASE(*op); + *op = MPI_OP_NULL; + + /* All done */ + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/open_port.c b/ompi/mpi/c/open_port.c deleted file mode 100644 index f77ee6ae583..00000000000 --- a/ompi/mpi/c/open_port.c +++ /dev/null @@ -1,72 +0,0 @@ -/* - * 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-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) 2015 Intel, 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/dpm/dpm.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Open_port = PMPI_Open_port -#endif -#define MPI_Open_port PMPI_Open_port -#endif - -static const char FUNC_NAME[] = "MPI_Open_port"; - - -int MPI_Open_port(MPI_Info info, char *port_name) -{ - int rc; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == port_name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - if ( MPI_INFO_NULL != info ) { - /* in theory, they user might tell us here - how to establish the address. Since our communication - is relying on OOB, we probably won't use the info-object. - - Potential values defined in MPI-2: - - "ip_port" : value contains IP port number - - "ip_address" : value contains IP address - */ - } - - rc = ompi_dpm_open_port(port_name); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/open_port.c.in b/ompi/mpi/c/open_port.c.in new file mode 100644 index 00000000000..5020da632b2 --- /dev/null +++ b/ompi/mpi/c/open_port.c.in @@ -0,0 +1,64 @@ +/* + * 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-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) 2015 Intel, 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$ + * + * 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/info/info.h" +#include "ompi/dpm/dpm.h" + +PROTOTYPE ERROR_CLASS open_port(INFO info, STRING_OUT port_name) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == port_name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + if ( MPI_INFO_NULL != info ) { + /* in theory, they user might tell us here + how to establish the address. Since our communication + is relying on OOB, we probably won't use the info-object. + + Potential values defined in MPI-2: + - "ip_port" : value contains IP port number + - "ip_address" : value contains IP address + */ + } + + rc = ompi_dpm_open_port(port_name); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pack.c b/ompi/mpi/c/pack.c deleted file mode 100644 index b43904ac7b2..00000000000 --- a/ompi/mpi/c/pack.c +++ /dev/null @@ -1,125 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pack = PMPI_Pack -#endif -#define MPI_Pack PMPI_Pack -#endif - -static const char FUNC_NAME[] = "MPI_Pack"; - - -int MPI_Pack(const void *inbuf, int incount, MPI_Datatype datatype, - void *outbuf, int outsize, int *position, MPI_Comm comm) -{ - int rc = MPI_SUCCESS, ret; - opal_convertor_t local_convertor; - struct iovec invec; - unsigned int iov_count; - size_t size; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, inbuf, incount, datatype); - memchecker_call(&opal_memchecker_base_isaddressable, (void *)((char *)outbuf + *position), outsize, MPI_PACKED); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if ((NULL == outbuf) || (NULL == position)) { /* inbuf can be MPI_BOTTOM */ - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (incount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } else if (outsize < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, incount); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - OMPI_CHECK_USER_BUFFER(rc, inbuf, datatype, incount); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - /* - * If a datatype's description contains a single element that describes - * a large vector that path is reasonably optimized in pack/unpack. On - * the other hand if the count and datatype combined describe the same - * vector, that gets processed one element at a time. - * - * So at the top level we morph the call if the count and datatype look - * like a good vector. - */ - ompi_datatype_consolidate_t dtmod; - rc = ompi_datatype_consolidate_create(incount, datatype, &dtmod, - OMPI_DATATYPE_CONSOLIDATE_THRESHOLD); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - - OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); - /* the resulting convertor will be set to the position ZERO */ - opal_convertor_copy_and_prepare_for_send( ompi_mpi_local_convertor, - &(dtmod.dt->super), dtmod.count, - (void *) inbuf, 0, &local_convertor ); - - /* Check for truncation */ - opal_convertor_get_packed_size( &local_convertor, &size ); - if( (*position + size) > (unsigned int)outsize ) { /* we can cast as we already checked for < 0 */ - OBJ_DESTRUCT( &local_convertor ); - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - - /* Prepare the iovec with all information */ - invec.iov_base = (char*) outbuf + (*position); - invec.iov_len = size; - - /* Do the actual packing */ - iov_count = 1; - ret = opal_convertor_pack( &local_convertor, &invec, &iov_count, &size ); - *position += size; - OBJ_DESTRUCT( &local_convertor ); - - rc = ompi_datatype_consolidate_free(&dtmod); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - - /* All done. Note that the convertor returns 1 upon success, not - OPAL_SUCCESS. */ - if (1 != ret) { - rc = OMPI_ERROR; - } - OMPI_ERRHANDLER_RETURN(rc, comm, MPI_ERR_UNKNOWN, FUNC_NAME); -} diff --git a/ompi/mpi/c/pack.c.in b/ompi/mpi/c/pack.c.in new file mode 100644 index 00000000000..69a0bb358eb --- /dev/null +++ b/ompi/mpi/c/pack.c.in @@ -0,0 +1,117 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS pack(BUFFER inbuf, COUNT incount, DATATYPE datatype, + BUFFER_OUT outbuf, COUNT outsize, COUNT_OUT position, COMM comm) +{ + int rc = MPI_SUCCESS, ret; + opal_convertor_t local_convertor; + struct iovec invec; + unsigned int iov_count; + size_t size; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, inbuf, incount, datatype); + memchecker_call(&opal_memchecker_base_isaddressable, (void *)((char *)outbuf + *position), outsize, MPI_PACKED); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if ((NULL == outbuf) || (NULL == position)) { /* inbuf can be MPI_BOTTOM */ + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (incount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } else if (outsize < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, incount); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + OMPI_CHECK_USER_BUFFER(rc, inbuf, datatype, incount); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + /* + * If a datatype's description contains a single element that describes + * a large vector that path is reasonably optimized in pack/unpack. On + * the other hand if the count and datatype combined describe the same + * vector, that gets processed one element at a time. + * + * So at the top level we morph the call if the count and datatype look + * like a good vector. + */ + ompi_datatype_consolidate_t dtmod; + rc = ompi_datatype_consolidate_create(incount, datatype, &dtmod, + OMPI_DATATYPE_CONSOLIDATE_THRESHOLD); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + + OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); + /* the resulting convertor will be set to the position ZERO */ + opal_convertor_copy_and_prepare_for_send( ompi_mpi_local_convertor, + &(dtmod.dt->super), dtmod.count, + (void *) inbuf, 0, &local_convertor ); + + /* Check for truncation */ + opal_convertor_get_packed_size( &local_convertor, &size ); + if( (*position + size) > (unsigned int)outsize ) { /* we can cast as we already checked for < 0 */ + OBJ_DESTRUCT( &local_convertor ); + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + + /* Prepare the iovec with all information */ + invec.iov_base = (char*) outbuf + (*position); + invec.iov_len = size; + + /* Do the actual packing */ + iov_count = 1; + ret = opal_convertor_pack( &local_convertor, &invec, &iov_count, &size ); + *position += size; + OBJ_DESTRUCT( &local_convertor ); + + rc = ompi_datatype_consolidate_free(&dtmod); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + + /* All done. Note that the convertor returns 1 upon success, not + OPAL_SUCCESS. */ + if (1 != ret) { + rc = OMPI_ERROR; + } + OMPI_ERRHANDLER_RETURN(rc, comm, MPI_ERR_UNKNOWN, FUNC_NAME); +} diff --git a/ompi/mpi/c/pack_external.c b/ompi/mpi/c/pack_external.c deleted file mode 100644 index f8c59485134..00000000000 --- a/ompi/mpi/c/pack_external.c +++ /dev/null @@ -1,76 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pack_external = PMPI_Pack_external -#endif -#define MPI_Pack_external PMPI_Pack_external -#endif - -static const char FUNC_NAME[] = "MPI_Pack_external"; - - -int MPI_Pack_external(const char datarep[], const void *inbuf, int incount, - MPI_Datatype datatype, void *outbuf, - MPI_Aint outsize, MPI_Aint *position) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, inbuf, incount, datatype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == outbuf) || (NULL == position)) { /* inbuf can be MPI_BOTTOM */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (incount < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); - } else if (outsize < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, incount); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - OMPI_CHECK_USER_BUFFER(rc, inbuf, datatype, incount); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - rc = ompi_datatype_pack_external(datarep, inbuf, incount, - datatype, outbuf, - outsize, position); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/pack_external.c.in b/ompi/mpi/c/pack_external.c.in new file mode 100644 index 00000000000..cc880e91ee7 --- /dev/null +++ b/ompi/mpi/c/pack_external.c.in @@ -0,0 +1,68 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS pack_external(STRING datarep, BUFFER inbuf, COUNT incount, + DATATYPE datatype, BUFFER_OUT outbuf, + AINT_COUNT outsize, AINT_COUNT_OUT position) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, inbuf, incount, datatype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == outbuf) || (NULL == position)) { /* inbuf can be MPI_BOTTOM */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (incount < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); + } else if (outsize < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_SEND(rc, datatype, incount); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + OMPI_CHECK_USER_BUFFER(rc, inbuf, datatype, incount); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + rc = ompi_datatype_pack_external(datarep, inbuf, incount, + datatype, outbuf, + outsize, (MPI_Aint *)position); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pack_external_size.c b/ompi/mpi/c/pack_external_size.c deleted file mode 100644 index 024aaf49de3..00000000000 --- a/ompi/mpi/c/pack_external_size.c +++ /dev/null @@ -1,67 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pack_external_size = PMPI_Pack_external_size -#endif -#define MPI_Pack_external_size PMPI_Pack_external_size -#endif - -static const char FUNC_NAME[] = "MPI_Pack_external_size"; - - -int MPI_Pack_external_size(const char datarep[], int incount, - MPI_Datatype datatype, MPI_Aint *size) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == datatype || NULL == datatype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } - } - - rc = ompi_datatype_pack_external_size(datarep, incount, - datatype, size); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/pack_external_size.c.in b/ompi/mpi/c/pack_external_size.c.in new file mode 100644 index 00000000000..8ff195bf34f --- /dev/null +++ b/ompi/mpi/c/pack_external_size.c.in @@ -0,0 +1,61 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS pack_external_size(STRING datarep, COUNT incount, + DATATYPE datatype, AINT_COUNT_OUT size) +{ + int rc = MPI_SUCCESS; + MPI_Aint tmp_size = 0; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == datatype || NULL == datatype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } + } + + rc = ompi_datatype_pack_external_size(datarep, incount, + datatype, &tmp_size); + *size = tmp_size; + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pack_size.c b/ompi/mpi/c/pack_size.c deleted file mode 100644 index 306dbcf2c6a..00000000000 --- a/ompi/mpi/c/pack_size.c +++ /dev/null @@ -1,74 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pack_size = PMPI_Pack_size -#endif -#define MPI_Pack_size PMPI_Pack_size -#endif - -static const char FUNC_NAME[] = "MPI_Pack_size"; - -int MPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, - int *size) -{ - opal_convertor_t local_convertor; - size_t length; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if (NULL == size) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_DATATYPE_NULL == datatype || NULL == datatype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - - OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); - /* the resulting convertor will be set to the position ZERO */ - opal_convertor_copy_and_prepare_for_send( ompi_mpi_local_convertor, &(datatype->super), - incount, NULL, 0, &local_convertor ); - - opal_convertor_get_packed_size( &local_convertor, &length ); - *size = (int)length; - OBJ_DESTRUCT( &local_convertor ); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/pack_size.c.in b/ompi/mpi/c/pack_size.c.in new file mode 100644 index 00000000000..f0931d00671 --- /dev/null +++ b/ompi/mpi/c/pack_size.c.in @@ -0,0 +1,67 @@ +/* + * 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) 2006 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$ + * + * 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/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS pack_size(COUNT incount, DATATYPE datatype, COMM comm, + COUNT_OUT size) +{ + opal_convertor_t local_convertor; + size_t length; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if (NULL == size) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_DATATYPE_NULL == datatype || NULL == datatype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + + OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); + /* the resulting convertor will be set to the position ZERO */ + opal_convertor_copy_and_prepare_for_send( ompi_mpi_local_convertor, &(datatype->super), + incount, NULL, 0, &local_convertor ); + + opal_convertor_get_packed_size( &local_convertor, &length ); + *size = (int)length; + OBJ_DESTRUCT( &local_convertor ); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/parrived.c b/ompi/mpi/c/parrived.c deleted file mode 100644 index eeda2b6827b..00000000000 --- a/ompi/mpi/c/parrived.c +++ /dev/null @@ -1,64 +0,0 @@ -/* -*- 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-2018 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-2022 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Parrived = PMPI_Parrived -#endif -#define MPI_Parrived PMPI_Parrived -#endif - -static const char FUNC_NAME[] = "MPI_Parrived"; - - -int MPI_Parrived(MPI_Request request, int partition, int *flag) -{ - int rc; - - SPC_RECORD(OMPI_SPC_PARRIVED, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || OMPI_REQUEST_PART != request->req_type) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - rc = mca_part.part_parrived(partition, partition, flag, request); - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/parrived.c.in b/ompi/mpi/c/parrived.c.in new file mode 100644 index 00000000000..562138ef1ca --- /dev/null +++ b/ompi/mpi/c/parrived.c.in @@ -0,0 +1,56 @@ +/* -*- 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-2018 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-2022 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS parrived(REQUEST request, INT partition, INT_OUT flag) +{ + int rc; + + SPC_RECORD(OMPI_SPC_PARRIVED, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || OMPI_REQUEST_PART != request->req_type) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + rc = mca_part.part_parrived(partition, partition, flag, request); + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pready.c b/ompi/mpi/c/pready.c deleted file mode 100644 index 808cbdaf315..00000000000 --- a/ompi/mpi/c/pready.c +++ /dev/null @@ -1,64 +0,0 @@ -/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pready = PMPI_Pready -#endif -#define MPI_Pready PMPI_Pready -#endif - -static const char FUNC_NAME[] = "MPI_Pready"; - - -int MPI_Pready(int partition, MPI_Request request) -{ - int rc; - - SPC_RECORD(OMPI_SPC_PREADY, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || OMPI_REQUEST_PART != request->req_type) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - rc = mca_part.part_pready(partition, partition, request); - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/pready.c.in b/ompi/mpi/c/pready.c.in new file mode 100644 index 00000000000..8610688f420 --- /dev/null +++ b/ompi/mpi/c/pready.c.in @@ -0,0 +1,56 @@ +/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS pready(INT partition, REQUEST request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_PREADY, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || OMPI_REQUEST_PART != request->req_type) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + rc = mca_part.part_pready(partition, partition, request); + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pready_list.c b/ompi/mpi/c/pready_list.c deleted file mode 100644 index 94498eaba9b..00000000000 --- a/ompi/mpi/c/pready_list.c +++ /dev/null @@ -1,65 +0,0 @@ -/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pready_list = PMPI_Pready_list -#endif -#define MPI_Pready_list PMPI_Pready_list -#endif - -static const char FUNC_NAME[] = "MPI_Pready_list"; - - -int MPI_Pready_list(int length, int* partitions, MPI_Request request) -{ - int rc = OMPI_SUCCESS; - SPC_RECORD(OMPI_SPC_PREADY, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || OMPI_REQUEST_PART != request->req_type) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - for(int i = 0; i < length && OMPI_SUCCESS == rc; i++) { - rc = mca_part.part_pready(partitions[i], partitions[i], request); - } - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/pready_list.c.in b/ompi/mpi/c/pready_list.c.in new file mode 100644 index 00000000000..086ff618954 --- /dev/null +++ b/ompi/mpi/c/pready_list.c.in @@ -0,0 +1,57 @@ +/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS pready_list(INT length, INT_ARRAY partitions, REQUEST request) +{ + int rc = OMPI_SUCCESS; + SPC_RECORD(OMPI_SPC_PREADY, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || OMPI_REQUEST_PART != request->req_type) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + for(int i = 0; i < length && OMPI_SUCCESS == rc; i++) { + rc = mca_part.part_pready(partitions[i], partitions[i], request); + } + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/pready_range.c b/ompi/mpi/c/pready_range.c deleted file mode 100644 index 07082cd79b7..00000000000 --- a/ompi/mpi/c/pready_range.c +++ /dev/null @@ -1,64 +0,0 @@ -/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Pready_range = PMPI_Pready_range -#endif -#define MPI_Pready_range PMPI_Pready_range -#endif - -static const char FUNC_NAME[] = "MPI_Pready_range"; - - -int MPI_Pready_range(int partition_low, int partition_high, MPI_Request request) -{ - int rc; - - SPC_RECORD(OMPI_SPC_PREADY, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || OMPI_REQUEST_PART != request->req_type) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - rc = mca_part.part_pready(partition_low, partition_high, request); - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/pready_range.c.in b/ompi/mpi/c/pready_range.c.in new file mode 100644 index 00000000000..7dfc2df59ae --- /dev/null +++ b/ompi/mpi/c/pready_range.c.in @@ -0,0 +1,56 @@ +/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS pready_range(INT partition_low, INT partition_high, REQUEST request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_PREADY, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || OMPI_REQUEST_PART != request->req_type) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + rc = mca_part.part_pready(partition_low, partition_high, request); + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/precv_init.c b/ompi/mpi/c/precv_init.c deleted file mode 100644 index 2b7b5f09658..00000000000 --- a/ompi/mpi/c/precv_init.c +++ /dev/null @@ -1,63 +0,0 @@ -/* -*- 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-2018 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-2021 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2021 Bull S.A.S. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Precv_init = PMPI_Precv_init -#endif -#define MPI_Precv_init PMPI_Precv_init -#endif - -static const char FUNC_NAME[] = "MPI_Precv_init"; - - -int MPI_Precv_init(void* buf, int partitions, MPI_Count count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - rc = mca_part.part_precv_init(buf, partitions, count, datatype, source, tag, comm, info, request); - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/precv_init.c.in b/ompi/mpi/c/precv_init.c.in new file mode 100644 index 00000000000..31b1f3d97f8 --- /dev/null +++ b/ompi/mpi/c/precv_init.c.in @@ -0,0 +1,57 @@ +/* -*- 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-2018 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-2021 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2021 Bull S.A.S. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS precv_init(BUFFER_OUT buf, INT partitions, PARTITIONED_COUNT count, + DATATYPE datatype, INT source, INT tag, + COMM comm, INFO info, REQUEST_INOUT request) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + rc = mca_part.part_precv_init(buf, partitions, count, datatype, source, tag, comm, info, request); + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/probe.c b/ompi/mpi/c/probe.c deleted file mode 100644 index 3944f04a159..00000000000 --- a/ompi/mpi/c/probe.c +++ /dev/null @@ -1,104 +0,0 @@ -/* - * 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) 2010-2012 Oak Ridge National Labs. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Probe = PMPI_Probe -#endif -#define MPI_Probe PMPI_Probe -#endif - -static const char FUNC_NAME[] = "MPI_Probe"; - - -int MPI_Probe(int source, int tag, MPI_Comm comm, MPI_Status *status) -{ - int rc; - - SPC_RECORD(OMPI_SPC_PROBE, 1); - - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_invalid(comm)) { - rc = MPI_ERR_COMM; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, "MPI_Probe"); - } - - if (MPI_PROC_NULL == source) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * Check here for issues with the peer, so we do not have to duplicate the - * functionality in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { - if (MPI_STATUS_IGNORE != status) { - status->MPI_SOURCE = source; - status->MPI_TAG = tag; - } - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - rc = MCA_PML_CALL(probe(source, tag, comm, status)); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, "MPI_Probe"); -} diff --git a/ompi/mpi/c/probe.c.in b/ompi/mpi/c/probe.c.in new file mode 100644 index 00000000000..906b164633e --- /dev/null +++ b/ompi/mpi/c/probe.c.in @@ -0,0 +1,96 @@ +/* + * 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) 2010-2012 Oak Ridge National Labs. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS probe(INT source, INT tag, COMM comm, STATUS_OUT status) +{ + int rc; + + SPC_RECORD(OMPI_SPC_PROBE, 1); + + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_invalid(comm)) { + rc = MPI_ERR_COMM; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, "MPI_Probe"); + } + + if (MPI_PROC_NULL == source) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * Check here for issues with the peer, so we do not have to duplicate the + * functionality in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { + if (MPI_STATUS_IGNORE != status) { + status->MPI_SOURCE = source; + status->MPI_TAG = tag; + } + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + rc = MCA_PML_CALL(probe(source, tag, comm, status)); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, "MPI_Probe"); +} diff --git a/ompi/mpi/c/psend_init.c b/ompi/mpi/c/psend_init.c deleted file mode 100644 index 7981f845f09..00000000000 --- a/ompi/mpi/c/psend_init.c +++ /dev/null @@ -1,63 +0,0 @@ -/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2021 Bull S.A.S. 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/mca/part/part.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Psend_init = PMPI_Psend_init -#endif -#define MPI_Psend_init PMPI_Psend_init -#endif - -static const char FUNC_NAME[] = "MPI_Psend_init"; - - -int MPI_Psend_init(const void* buf, int partitions, MPI_Count count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); - } - - rc = mca_part.part_psend_init(buf, partitions, count, datatype, dest, tag, comm, info, request); - OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/psend_init.c.in b/ompi/mpi/c/psend_init.c.in new file mode 100644 index 00000000000..7ddf8335090 --- /dev/null +++ b/ompi/mpi/c/psend_init.c.in @@ -0,0 +1,57 @@ +/* -*- 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-2018 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2021 Bull S.A.S. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/part/part.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS psend_init(BUFFER buf, INT partitions, PARTITIONED_COUNT count, + DATATYPE datatype, INT dest, INT tag, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_COMM_WORLD, rc, FUNC_NAME); + } + + rc = mca_part.part_psend_init(buf, partitions, count, datatype, dest, tag, comm, info, request); + OMPI_ERRHANDLER_RETURN(rc, MPI_COMM_WORLD, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/publish_name.c b/ompi/mpi/c/publish_name.c deleted file mode 100644 index 73c95ab9e04..00000000000 --- a/ompi/mpi/c/publish_name.c +++ /dev/null @@ -1,141 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include - -#include "opal/class/opal_list.h" -#include "opal/mca/pmix/pmix-internal.h" -#include "opal/util/show_help.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/communicator/communicator.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Publish_name = PMPI_Publish_name -#endif -#define MPI_Publish_name PMPI_Publish_name -#endif - -static const char FUNC_NAME[] = "MPI_Publish_name"; - - -int MPI_Publish_name(const char *service_name, MPI_Info info, - const char *port_name) -{ - int ret; - opal_cstring_t *info_str; - int flag=0; - pmix_status_t rc; - pmix_info_t pinfo[3]; - pmix_data_range_t rng = PMIX_RANGE_SESSION; - pmix_persistence_t pers = PMIX_PERSIST_SESSION; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == port_name || 0 == strlen(port_name) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == service_name || 0 == strlen(service_name) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - /* OMPI supports info keys to pass the range and persistence to - * be used for the given key */ - if (MPI_INFO_NULL != info) { - ompi_info_get (info, "range", &info_str, &flag); - if (flag) { - if (0 == strcmp(info_str->string, "nspace")) { - rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace - } else if (0 == strcmp(info_str->string, "session")) { - rng = PMIX_RANGE_SESSION; // share only with procs in same session - } else { - /* unrecognized scope */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - OBJ_RELEASE(info_str); - } - ompi_info_get (info, "persistence", &info_str, &flag); - if (flag) { - if (0 == strcmp(info_str->string, "indef")) { - pers = PMIX_PERSIST_INDEF; // retain until specifically deleted - } else if (0 == strcmp(info_str->string, "proc")) { - pers = PMIX_PERSIST_PROC; // retain until publishing process terminates - } else if (0 == strcmp(info_str->string, "app")) { - pers = PMIX_PERSIST_APP; // retain until application terminates - } else if (0 == strcmp(info_str->string, "session")) { - pers = PMIX_PERSIST_SESSION; // retain until session/allocation terminates - } else { - /* unrecognized persistence */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - OBJ_RELEASE(info_str); - } - } - - /* publish the service name */ - PMIX_INFO_LOAD(&pinfo[0], service_name, port_name, PMIX_STRING); - PMIX_INFO_LOAD(&pinfo[1], PMIX_RANGE, &rng, PMIX_DATA_RANGE); - PMIX_INFO_LOAD(&pinfo[2], PMIX_PERSISTENCE, &pers, PMIX_PERSIST); - - rc = PMIx_Publish(pinfo, 3); - PMIX_INFO_DESTRUCT(&pinfo[0]); - PMIX_INFO_DESTRUCT(&pinfo[1]); - PMIX_INFO_DESTRUCT(&pinfo[2]); - - if ( PMIX_SUCCESS != rc ) { - if (PMIX_EXISTS == rc) { - /* already exists - can't publish it */ - ret = MPI_ERR_FILE_EXISTS; - } else if (PMIX_ERR_NOT_SUPPORTED == rc) { - /* this PMIX environment doesn't support publishing */ - ret = OMPI_ERR_NOT_SUPPORTED; - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support name publishing functionality"); - } else { - ret = MPI_ERR_INTERN; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/publish_name.c.in b/ompi/mpi/c/publish_name.c.in new file mode 100644 index 00000000000..967ee44033f --- /dev/null +++ b/ompi/mpi/c/publish_name.c.in @@ -0,0 +1,133 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/class/opal_list.h" +#include "opal/mca/pmix/pmix-internal.h" +#include "opal/util/show_help.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/communicator/communicator.h" + +PROTOTYPE ERROR_CLASS publish_name(STRING service_name, INFO info, + STRING port_name) +{ + int ret; + opal_cstring_t *info_str; + int flag=0; + pmix_status_t rc; + pmix_info_t pinfo[3]; + pmix_data_range_t rng = PMIX_RANGE_SESSION; + pmix_persistence_t pers = PMIX_PERSIST_SESSION; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == port_name || 0 == strlen(port_name) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == service_name || 0 == strlen(service_name) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + /* OMPI supports info keys to pass the range and persistence to + * be used for the given key */ + if (MPI_INFO_NULL != info) { + ompi_info_get (info, "range", &info_str, &flag); + if (flag) { + if (0 == strcmp(info_str->string, "nspace")) { + rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace + } else if (0 == strcmp(info_str->string, "session")) { + rng = PMIX_RANGE_SESSION; // share only with procs in same session + } else { + /* unrecognized scope */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + OBJ_RELEASE(info_str); + } + ompi_info_get (info, "persistence", &info_str, &flag); + if (flag) { + if (0 == strcmp(info_str->string, "indef")) { + pers = PMIX_PERSIST_INDEF; // retain until specifically deleted + } else if (0 == strcmp(info_str->string, "proc")) { + pers = PMIX_PERSIST_PROC; // retain until publishing process terminates + } else if (0 == strcmp(info_str->string, "app")) { + pers = PMIX_PERSIST_APP; // retain until application terminates + } else if (0 == strcmp(info_str->string, "session")) { + pers = PMIX_PERSIST_SESSION; // retain until session/allocation terminates + } else { + /* unrecognized persistence */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + OBJ_RELEASE(info_str); + } + } + + /* publish the service name */ + PMIX_INFO_LOAD(&pinfo[0], service_name, port_name, PMIX_STRING); + PMIX_INFO_LOAD(&pinfo[1], PMIX_RANGE, &rng, PMIX_DATA_RANGE); + PMIX_INFO_LOAD(&pinfo[2], PMIX_PERSISTENCE, &pers, PMIX_PERSIST); + + rc = PMIx_Publish(pinfo, 3); + PMIX_INFO_DESTRUCT(&pinfo[0]); + PMIX_INFO_DESTRUCT(&pinfo[1]); + PMIX_INFO_DESTRUCT(&pinfo[2]); + + if ( PMIX_SUCCESS != rc ) { + if (PMIX_EXISTS == rc) { + /* already exists - can't publish it */ + ret = MPI_ERR_FILE_EXISTS; + } else if (PMIX_ERR_NOT_SUPPORTED == rc) { + /* this PMIX environment doesn't support publishing */ + ret = OMPI_ERR_NOT_SUPPORTED; + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support name publishing functionality"); + } else { + ret = MPI_ERR_INTERN; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/put.c b/ompi/mpi/c/put.c deleted file mode 100644 index 097b41b5b9d..00000000000 --- a/ompi/mpi/c/put.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013-2015 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Put = PMPI_Put -#endif -#define MPI_Put PMPI_Put -#endif - -static const char FUNC_NAME[] = "MPI_Put"; - - -int MPI_Put(const 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) -{ - int rc; - - SPC_RECORD(OMPI_SPC_PUT, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (NULL == target_datatype || - MPI_DATATYPE_NULL == target_datatype) { - rc = MPI_ERR_TYPE; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; - - rc = win->w_osc_module->osc_put(origin_addr, origin_count, origin_datatype, - target_rank, target_disp, target_count, - target_datatype, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/put.c.in b/ompi/mpi/c/put.c.in new file mode 100644 index 00000000000..c24cedd7e62 --- /dev/null +++ b/ompi/mpi/c/put.c.in @@ -0,0 +1,78 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS put(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win) +{ + int rc; + + SPC_RECORD(OMPI_SPC_PUT, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (NULL == target_datatype || + MPI_DATATYPE_NULL == target_datatype) { + rc = MPI_ERR_TYPE; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) return MPI_SUCCESS; + + rc = win->w_osc_module->osc_put(origin_addr, origin_count, origin_datatype, + target_rank, target_disp, target_count, + target_datatype, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/query_thread.c b/ompi/mpi/c/query_thread.c deleted file mode 100644 index aaaef184d67..00000000000 --- a/ompi/mpi/c/query_thread.c +++ /dev/null @@ -1,51 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Query_thread = PMPI_Query_thread -#endif -#define MPI_Query_thread PMPI_Query_thread -#endif - -static const char FUNC_NAME[] = "MPI_Query_thread"; - - -int MPI_Query_thread(int *provided) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == provided) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - /* Simple */ - - *provided = ompi_mpi_thread_provided; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/query_thread.c.in b/ompi/mpi/c/query_thread.c.in new file mode 100644 index 00000000000..493076c2ce9 --- /dev/null +++ b/ompi/mpi/c/query_thread.c.in @@ -0,0 +1,43 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS query_thread(INT_OUT provided) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == provided) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Simple */ + + *provided = ompi_mpi_thread_provided; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/raccumulate.c b/ompi/mpi/c/raccumulate.c deleted file mode 100644 index 3e7bb667312..00000000000 --- a/ompi/mpi/c/raccumulate.c +++ /dev/null @@ -1,139 +0,0 @@ -/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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 -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/op/op.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Raccumulate = PMPI_Raccumulate -#endif -#define MPI_Raccumulate PMPI_Raccumulate -#endif - -static const char FUNC_NAME[] = "MPI_Raccumulate"; - -int MPI_Raccumulate(const 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_Op op, MPI_Win win, MPI_Request *request) -{ - int rc; - ompi_win_t *ompi_win = (ompi_win_t*) win; - - MEMCHECKER( - memchecker_datatype(origin_datatype); - memchecker_datatype(target_datatype); - memchecker_call(&opal_memchecker_base_isdefined, origin_addr, origin_count, origin_datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (MPI_OP_NULL == op || MPI_NO_OP == op) { - rc = MPI_ERR_OP; - } else if (!ompi_op_is_intrinsic(op)) { - rc = MPI_ERR_OP; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - if (OMPI_SUCCESS == rc) { - /* While technically the standard probably requires that the - datatypes used with MPI_REPLACE conform to all the rules - for other reduction operators, we don't require such - behavior, as checking for it is expensive here and we don't - care in implementation.. */ - if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { - ompi_datatype_t *op_check_dt, *origin_check_dt; - char *msg; - - /* RACCUMULATE, unlike REDUCE, can use with derived - datatypes with predefinied operations, with some - restrictions outlined in MPI-3:11.3.4. The derived - datatype must be composed entirely from one predefined - datatype (so you can do all the construction you want, - but at the bottom, you can only use one datatype, say, - MPI_INT). If the datatype at the target isn't - predefined, then make sure it's composed of only one - datatype, and check that datatype against - ompi_op_is_valid(). */ - origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); - op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); - - if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { - OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); - } - - /* check to make sure primitive type is valid for - reduction. Should do this on the target, but - then can't get the errcode back for this - call */ - if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); - free(msg); - return ret; - } - } - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - rc = ompi_win->w_osc_module->osc_raccumulate(origin_addr, - origin_count, - origin_datatype, - target_rank, - target_disp, - target_count, - target_datatype, - op, win, request); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/raccumulate.c.in b/ompi/mpi/c/raccumulate.c.in new file mode 100644 index 00000000000..8280c313295 --- /dev/null +++ b/ompi/mpi/c/raccumulate.c.in @@ -0,0 +1,132 @@ +/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/op/op.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS raccumulate(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win, REQUEST_INOUT request) +{ + int rc; + ompi_win_t *ompi_win = (ompi_win_t*) win; + + MEMCHECKER( + memchecker_datatype(origin_datatype); + memchecker_datatype(target_datatype); + memchecker_call(&opal_memchecker_base_isdefined, origin_addr, origin_count, origin_datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (MPI_OP_NULL == op || MPI_NO_OP == op) { + rc = MPI_ERR_OP; + } else if (!ompi_op_is_intrinsic(op)) { + rc = MPI_ERR_OP; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + if (OMPI_SUCCESS == rc) { + /* While technically the standard probably requires that the + datatypes used with MPI_REPLACE conform to all the rules + for other reduction operators, we don't require such + behavior, as checking for it is expensive here and we don't + care in implementation.. */ + if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { + ompi_datatype_t *op_check_dt, *origin_check_dt; + char *msg; + + /* RACCUMULATE, unlike REDUCE, can use with derived + datatypes with predefinied operations, with some + restrictions outlined in MPI-3:11.3.4. The derived + datatype must be composed entirely from one predefined + datatype (so you can do all the construction you want, + but at the bottom, you can only use one datatype, say, + MPI_INT). If the datatype at the target isn't + predefined, then make sure it's composed of only one + datatype, and check that datatype against + ompi_op_is_valid(). */ + origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); + op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); + + if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { + OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); + } + + /* check to make sure primitive type is valid for + reduction. Should do this on the target, but + then can't get the errcode back for this + call */ + if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); + free(msg); + return ret; + } + } + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + rc = ompi_win->w_osc_module->osc_raccumulate(origin_addr, + origin_count, + origin_datatype, + target_rank, + target_disp, + target_count, + target_datatype, + op, win, request); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/recv.c b/ompi/mpi/c/recv.c deleted file mode 100644 index 6a36bcf1167..00000000000 --- a/ompi/mpi/c/recv.c +++ /dev/null @@ -1,106 +0,0 @@ -/* - * 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/request/request.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Recv = PMPI_Recv -#endif -#define MPI_Recv PMPI_Recv -#endif - -static const char FUNC_NAME[] = "MPI_Recv"; - - -int MPI_Recv(void *buf, int count, MPI_Datatype type, int source, - int tag, MPI_Comm comm, MPI_Status *status) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_RECV, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are communicating with - * a failed process. This is not absolutely necessary since we will - * check for this, and other, error conditions during the completion - * call in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { - if (MPI_STATUS_IGNORE != status) { - status->MPI_SOURCE = source; - status->MPI_TAG = tag; - } - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if (MPI_PROC_NULL == source) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - return MPI_SUCCESS; - } - - rc = MCA_PML_CALL(recv(buf, count, type, source, tag, comm, status)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/recv.c.in b/ompi/mpi/c/recv.c.in new file mode 100644 index 00000000000..6a022fc14a8 --- /dev/null +++ b/ompi/mpi/c/recv.c.in @@ -0,0 +1,97 @@ +/* + * 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/request/request.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS recv(BUFFER_OUT buf, COUNT count, DATATYPE type, + INT source, INT tag, COMM comm, STATUS_OUT status) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_RECV, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are communicating with + * a failed process. This is not absolutely necessary since we will + * check for this, and other, error conditions during the completion + * call in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, source, &rc)) ) { + if (MPI_STATUS_IGNORE != status) { + status->MPI_SOURCE = source; + status->MPI_TAG = tag; + } + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if (MPI_PROC_NULL == source) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + return MPI_SUCCESS; + } + + rc = MCA_PML_CALL(recv(buf, count, type, source, tag, comm, status)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/recv_init.c b/ompi/mpi/c/recv_init.c deleted file mode 100644 index a6d34477967..00000000000 --- a/ompi/mpi/c/recv_init.c +++ /dev/null @@ -1,91 +0,0 @@ -/* - * 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-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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Recv_init = PMPI_Recv_init -#endif -#define MPI_Recv_init PMPI_Recv_init -#endif - -static const char FUNC_NAME[] = "MPI_Recv_init"; - - -int MPI_Recv_init(void *buf, int count, MPI_Datatype type, int source, - int tag, MPI_Comm comm, MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } else if ((source != MPI_ANY_SOURCE) && - (MPI_PROC_NULL != source) && - ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (NULL == request) { - rc = MPI_ERR_REQUEST; - } - - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == source) { - rc = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. - */ - rc = MCA_PML_CALL(irecv_init(buf,count,type,source,tag,comm,request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/recv_init.c.in b/ompi/mpi/c/recv_init.c.in new file mode 100644 index 00000000000..33386f94c25 --- /dev/null +++ b/ompi/mpi/c/recv_init.c.in @@ -0,0 +1,83 @@ +/* + * 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-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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS recv_init(BUFFER_OUT buf, COUNT count, DATATYPE type, INT source, + INT tag, COMM comm, REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (((tag < 0) && (tag != MPI_ANY_TAG)) || (tag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } else if ((source != MPI_ANY_SOURCE) && + (MPI_PROC_NULL != source) && + ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (NULL == request) { + rc = MPI_ERR_REQUEST; + } + + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == source) { + rc = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. + */ + rc = MCA_PML_CALL(irecv_init(buf,count,type,source,tag,comm,request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce.c b/ompi/mpi/c/reduce.c deleted file mode 100644 index a46c9f218c7..00000000000 --- a/ompi/mpi/c/reduce.c +++ /dev/null @@ -1,164 +0,0 @@ -/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce = PMPI_Reduce -#endif -#define MPI_Reduce PMPI_Reduce -#endif - -static const char FUNC_NAME[] = "MPI_Reduce"; - - -int MPI_Reduce(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_REDUCE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else { - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } else { - if (MPI_ROOT == root) { - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else if (MPI_PROC_NULL != root) { - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || - ((sendbuf == recvbuf) && (0 != count))))) { - err = MPI_ERR_ARG; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Intercommunicator errors */ - - if (!OMPI_COMM_IS_INTRA(comm)) { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Intracommunicator errors */ - - else { - if (root < 0 || root >= ompi_comm_size(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? (MPI says that reductions have to - have a count of at least 1, but at least IMB calls reduce with - a count of 0 -- blah!) */ - - if (0 == count) { - return MPI_SUCCESS; - } - - void *updated_recvbuf; - const void *updated_sendbuf; - if(OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - updated_sendbuf = sendbuf; - } else { - updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; - updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - OBJ_RETAIN(op); - err = comm->c_coll->coll_reduce(updated_sendbuf, updated_recvbuf, count, - datatype, op, root, comm, - comm->c_coll->coll_reduce_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce.c.in b/ompi/mpi/c/reduce.c.in new file mode 100644 index 00000000000..04aecd91675 --- /dev/null +++ b/ompi/mpi/c/reduce.c.in @@ -0,0 +1,156 @@ +/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, INT root, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_REDUCE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else { + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } else { + if (MPI_ROOT == root) { + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else if (MPI_PROC_NULL != root) { + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || + ((sendbuf == recvbuf) && (0 != count))))) { + err = MPI_ERR_ARG; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Intercommunicator errors */ + + if (!OMPI_COMM_IS_INTRA(comm)) { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Intracommunicator errors */ + + else { + if (root < 0 || root >= ompi_comm_size(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? (MPI says that reductions have to + have a count of at least 1, but at least IMB calls reduce with + a count of 0 -- blah!) */ + + if (0 == count) { + return MPI_SUCCESS; + } + + void *updated_recvbuf; + const void *updated_sendbuf; + if(OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + updated_sendbuf = sendbuf; + } else { + updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; + updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + OBJ_RETAIN(op); + err = comm->c_coll->coll_reduce(updated_sendbuf, updated_recvbuf, count, + datatype, op, root, comm, + comm->c_coll->coll_reduce_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_init.c b/ompi/mpi/c/reduce_init.c deleted file mode 100644 index e4c9991bf5a..00000000000 --- a/ompi/mpi/c/reduce_init.c +++ /dev/null @@ -1,157 +0,0 @@ -/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_init = PMPI_Reduce_init -#endif -#define MPI_Reduce_init PMPI_Reduce_init -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_init"; - - -int MPI_Reduce_init(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_REDUCE_INIT, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - /* check whether root's send buffer is defined. */ - if (MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else { - /* check whether send buffer is defined on other processes. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } else { - if (MPI_ROOT == root) { - /* check whether root's receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); - } else if (MPI_PROC_NULL != root) { - /* check whether send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || - (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || (sendbuf == recvbuf)))) { - err = MPI_ERR_ARG; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Intercommunicator errors */ - - if (!OMPI_COMM_IS_INTRA(comm)) { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - - /* Intracommunicator errors */ - - else { - if (root < 0 || root >= ompi_comm_size(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - } - } - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - if (0 == count) { - err = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } - - void *updated_recvbuf; - const void *updated_sendbuf; - if(OMPI_COMM_IS_INTRA(comm)) { - updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; - updated_sendbuf = sendbuf; - } else { - updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; - updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_reduce_init(updated_sendbuf, updated_recvbuf, count, - datatype, op, root, comm, info, request, - comm->c_coll->coll_reduce_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_init.c.in b/ompi/mpi/c/reduce_init.c.in new file mode 100644 index 00000000000..1912420e798 --- /dev/null +++ b/ompi/mpi/c/reduce_init.c.in @@ -0,0 +1,149 @@ +/* -*- 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-2023 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, INT root, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_REDUCE_INIT, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + /* check whether root's send buffer is defined. */ + if (MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else { + /* check whether send buffer is defined on other processes. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } else { + if (MPI_ROOT == root) { + /* check whether root's receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, count, datatype); + } else if (MPI_PROC_NULL != root) { + /* check whether send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == sendbuf) || + (ompi_comm_rank(comm) == root && ((MPI_IN_PLACE == recvbuf) || (sendbuf == recvbuf)))) { + err = MPI_ERR_ARG; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Intercommunicator errors */ + + if (!OMPI_COMM_IS_INTRA(comm)) { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + + /* Intracommunicator errors */ + + else { + if (root < 0 || root >= ompi_comm_size(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + } + } + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + if (0 == count) { + err = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } + + void *updated_recvbuf; + const void *updated_sendbuf; + if(OMPI_COMM_IS_INTRA(comm)) { + updated_recvbuf = (ompi_comm_rank(comm) == root) ? recvbuf : NULL; + updated_sendbuf = sendbuf; + } else { + updated_sendbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : sendbuf; + updated_recvbuf = (MPI_ROOT == root) ? recvbuf : NULL; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_reduce_init(updated_sendbuf, updated_recvbuf, count, + datatype, op, root, comm, info, request, + comm->c_coll->coll_reduce_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_local.c b/ompi/mpi/c/reduce_local.c deleted file mode 100644 index 982edd7c6a1..00000000000 --- a/ompi/mpi/c/reduce_local.c +++ /dev/null @@ -1,89 +0,0 @@ -/* -*- 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) 2006-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_local = PMPI_Reduce_local -#endif -#define MPI_Reduce_local PMPI_Reduce_local -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_local"; - - -int MPI_Reduce_local(const void *inbuf, void *inoutbuf, int count, - MPI_Datatype datatype, MPI_Op op) -{ - int err; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); - } - - /* If the count is 0, just return */ - if (0 == count) { - return MPI_SUCCESS; - } - - /* Invoke the op component to perform the back-end operation */ - OBJ_RETAIN(op); - OBJ_RETAIN(datatype); - // Since there is no 'comm' parameter to this interface use 'self' since - // this is a local operation to this process. - ompi_communicator_t *comm = &ompi_mpi_comm_self.comm; - err = comm->c_coll->coll_reduce_local(inbuf, inoutbuf, count, datatype, op, - comm->c_coll->coll_reduce_local_module); - OBJ_RELEASE(datatype); - OBJ_RELEASE(op); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_local.c.in b/ompi/mpi/c/reduce_local.c.in new file mode 100644 index 00000000000..29bce96f91c --- /dev/null +++ b/ompi/mpi/c/reduce_local.c.in @@ -0,0 +1,81 @@ +/* -*- 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) 2006-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS reduce_local(BUFFER inbuf, BUFFER_OUT inoutbuf, COUNT count, + DATATYPE datatype, OP op) +{ + int err; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(err, err, FUNC_NAME); + } + + /* If the count is 0, just return */ + if (0 == count) { + return MPI_SUCCESS; + } + + /* Invoke the op component to perform the back-end operation */ + OBJ_RETAIN(op); + OBJ_RETAIN(datatype); + // Since there is no 'comm' parameter to this interface use 'self' since + // this is a local operation to this process. + ompi_communicator_t *comm = &ompi_mpi_comm_self.comm; + err = comm->c_coll->coll_reduce_local(inbuf, inoutbuf, count, datatype, op, + comm->c_coll->coll_reduce_local_module); + OBJ_RELEASE(datatype); + OBJ_RELEASE(op); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_scatter.c b/ompi/mpi/c/reduce_scatter.c deleted file mode 100644 index 1291fd1d95b..00000000000 --- a/ompi/mpi/c/reduce_scatter.c +++ /dev/null @@ -1,151 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_scatter = PMPI_Reduce_scatter -#endif -#define MPI_Reduce_scatter PMPI_Reduce_scatter -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_scatter"; - - -int MPI_Reduce_scatter(const void *sendbuf, void *recvbuf, const int recvcounts[], - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) -{ - int i, err, size, count; - ompi_count_array_t recvcounts_desc; - - SPC_RECORD(OMPI_SPC_REDUCE_SCATTER, 1); - - MEMCHECKER( - int rank; - - size = ompi_comm_size(comm); - rank = ompi_comm_rank(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - count += recvcounts[i]; - } - } - - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcounts[rank], datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (NULL == recvcounts) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Based on the standard each group has to provide the same total - number of elements, so the size of the recvcounts array depends - on the number of participants in the local group. */ - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* MPI-1, p114, says that each process must supply at least one - element. But at least the Pallas benchmarks call MPI_REDUCE - with a count of 0. So be sure to handle it. Grrr... */ - - size = ompi_comm_size(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - ++count; - } - } - if (size == count) { - return MPI_SUCCESS; - } - - /* Invoke the coll component to perform the back-end operation */ - - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - OBJ_RETAIN(op); - err = comm->c_coll->coll_reduce_scatter(sendbuf, recvbuf, recvcounts_desc, - datatype, op, comm, - comm->c_coll->coll_reduce_scatter_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_scatter.c.in b/ompi/mpi/c/reduce_scatter.c.in new file mode 100644 index 00000000000..4a83f57ea26 --- /dev/null +++ b/ompi/mpi/c/reduce_scatter.c.in @@ -0,0 +1,143 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce_scatter(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DATATYPE datatype, OP op, COMM comm) +{ + int i, err, size, count; + ompi_count_array_t recvcounts_desc; + + SPC_RECORD(OMPI_SPC_REDUCE_SCATTER, 1); + + MEMCHECKER( + int rank; + + size = ompi_comm_size(comm); + rank = ompi_comm_rank(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + count += recvcounts[i]; + } + } + + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcounts[rank], datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (NULL == recvcounts) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Based on the standard each group has to provide the same total + number of elements, so the size of the recvcounts array depends + on the number of participants in the local group. */ + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* MPI-1, p114, says that each process must supply at least one + element. But at least the Pallas benchmarks call MPI_REDUCE + with a count of 0. So be sure to handle it. Grrr... */ + + size = ompi_comm_size(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + ++count; + } + } + if (size == count) { + return MPI_SUCCESS; + } + + /* Invoke the coll component to perform the back-end operation */ + + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + OBJ_RETAIN(op); + err = comm->c_coll->coll_reduce_scatter(sendbuf, recvbuf, recvcounts_desc, + datatype, op, comm, + comm->c_coll->coll_reduce_scatter_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_scatter_block.c b/ompi/mpi/c/reduce_scatter_block.c deleted file mode 100644 index 25681c916f9..00000000000 --- a/ompi/mpi/c/reduce_scatter_block.c +++ /dev/null @@ -1,120 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_scatter_block = PMPI_Reduce_scatter_block -#endif -#define MPI_Reduce_scatter_block PMPI_Reduce_scatter_block -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_scatter_block"; - - -int MPI_Reduce_scatter_block(const void *sendbuf, void *recvbuf, int recvcount, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_BLOCK, 1); - - MEMCHECKER( - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcount, datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - if (0 == recvcount) { - return MPI_SUCCESS; - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Invoke the coll component to perform the back-end operation */ - - OBJ_RETAIN(op); - err = comm->c_coll->coll_reduce_scatter_block(sendbuf, recvbuf, recvcount, - datatype, op, comm, - comm->c_coll->coll_reduce_scatter_block_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_scatter_block.c.in b/ompi/mpi/c/reduce_scatter_block.c.in new file mode 100644 index 00000000000..124a0e9ebf9 --- /dev/null +++ b/ompi/mpi/c/reduce_scatter_block.c.in @@ -0,0 +1,112 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce_scatter_block(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE datatype, OP op, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_BLOCK, 1); + + MEMCHECKER( + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcount, datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + if (0 == recvcount) { + return MPI_SUCCESS; + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Invoke the coll component to perform the back-end operation */ + + OBJ_RETAIN(op); + err = comm->c_coll->coll_reduce_scatter_block(sendbuf, recvbuf, recvcount, + datatype, op, comm, + comm->c_coll->coll_reduce_scatter_block_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_scatter_block_init.c b/ompi/mpi/c/reduce_scatter_block_init.c deleted file mode 100644 index ec98b9aef78..00000000000 --- a/ompi/mpi/c/reduce_scatter_block_init.c +++ /dev/null @@ -1,109 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_scatter_block_init = PMPI_Reduce_scatter_block_init -#endif -#define MPI_Reduce_scatter_block_init PMPI_Reduce_scatter_block_init -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_scatter_block_init"; - - -int MPI_Reduce_scatter_block_init(const void *sendbuf, void *recvbuf, int recvcount, - MPI_Datatype datatype, MPI_Op op, - MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_BLOCK_INIT, 1); - - MEMCHECKER( - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcount, datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - - err = comm->c_coll->coll_reduce_scatter_block_init(sendbuf, recvbuf, recvcount, - datatype, op, comm, info, request, - comm->c_coll->coll_reduce_scatter_block_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_scatter_block_init.c.in b/ompi/mpi/c/reduce_scatter_block_init.c.in new file mode 100644 index 00000000000..46aec913ef1 --- /dev/null +++ b/ompi/mpi/c/reduce_scatter_block_init.c.in @@ -0,0 +1,101 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce_scatter_block_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE datatype, OP op, + COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_BLOCK_INIT, 1); + + MEMCHECKER( + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcount, datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, recvcount, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, recvcount, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcount); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + + err = comm->c_coll->coll_reduce_scatter_block_init(sendbuf, recvbuf, recvcount, + datatype, op, comm, info, request, + comm->c_coll->coll_reduce_scatter_block_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/reduce_scatter_init.c b/ompi/mpi/c/reduce_scatter_init.c deleted file mode 100644 index 9f064cba774..00000000000 --- a/ompi/mpi/c/reduce_scatter_init.c +++ /dev/null @@ -1,145 +0,0 @@ -/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016 IBM Corporation. All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Reduce_scatter_init = PMPI_Reduce_scatter_init -#endif -#define MPI_Reduce_scatter_init PMPI_Reduce_scatter_init -#endif - -static const char FUNC_NAME[] = "MPI_Reduce_scatter_init"; - - -int MPI_Reduce_scatter_init(const void *sendbuf, void *recvbuf, const int recvcounts[], - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int i, err, size, count; - ompi_count_array_t recvcounts_desc; - - SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_INIT, 1); - - MEMCHECKER( - int rank; - int count; - - size = ompi_comm_size(comm); - rank = ompi_comm_rank(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - count += recvcounts[i]; - } - } - - memchecker_comm(comm); - memchecker_datatype(datatype); - - /* check receive buffer of current process, whether it's addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, - recvcounts[rank], datatype); - - /* check whether the actual send buffer is defined. */ - if(MPI_IN_PLACE == sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* Unrooted operation; same checks for all ranks on both - intracommunicators and intercommunicators */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else if (NULL == recvcounts) { - err = MPI_ERR_COUNT; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - - /* Based on the standard each group has to provide the same total - number of elements, so the size of the recvcounts array depends - on the number of participants in the local group. */ - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - - /* MPI standard says that reductions have to have a count of at least 1, - * but some benchmarks (e.g., IMB) calls this function with a count of 0. - * So handle that case. - */ - size = ompi_comm_size(comm); - for (count = i = 0; i < size; ++i) { - if (0 == recvcounts[i]) { - ++count; - } - } - if (size == count) { - err = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } - - /* Invoke the coll component to perform the back-end operation */ - - OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); - err = comm->c_coll->coll_reduce_scatter_init(sendbuf, recvbuf, recvcounts_desc, - datatype, op, comm, info, request, - comm->c_coll->coll_reduce_scatter_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/reduce_scatter_init.c.in b/ompi/mpi/c/reduce_scatter_init.c.in new file mode 100644 index 00000000000..717093ca410 --- /dev/null +++ b/ompi/mpi/c/reduce_scatter_init.c.in @@ -0,0 +1,137 @@ +/* -*- 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016 IBM Corporation. All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS reduce_scatter_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT_ARRAY recvcounts, + DATATYPE datatype, OP op, COMM comm, INFO info, REQUEST_INOUT request) +{ + int i, err, size, count; + ompi_count_array_t recvcounts_desc; + + SPC_RECORD(OMPI_SPC_REDUCE_SCATTER_INIT, 1); + + MEMCHECKER( + int rank; + int count; + + size = ompi_comm_size(comm); + rank = ompi_comm_rank(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + count += recvcounts[i]; + } + } + + memchecker_comm(comm); + memchecker_datatype(datatype); + + /* check receive buffer of current process, whether it's addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, + recvcounts[rank], datatype); + + /* check whether the actual send buffer is defined. */ + if(MPI_IN_PLACE == sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* Unrooted operation; same checks for all ranks on both + intracommunicators and intercommunicators */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else if (NULL == recvcounts) { + err = MPI_ERR_COUNT; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + + /* Based on the standard each group has to provide the same total + number of elements, so the size of the recvcounts array depends + on the number of participants in the local group. */ + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, recvcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + + /* MPI standard says that reductions have to have a count of at least 1, + * but some benchmarks (e.g., IMB) calls this function with a count of 0. + * So handle that case. + */ + size = ompi_comm_size(comm); + for (count = i = 0; i < size; ++i) { + if (0 == recvcounts[i]) { + ++count; + } + } + if (size == count) { + err = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } + + /* Invoke the coll component to perform the back-end operation */ + + OMPI_COUNT_ARRAY_INIT(&recvcounts_desc, recvcounts); + err = comm->c_coll->coll_reduce_scatter_init(sendbuf, recvbuf, recvcounts_desc, + datatype, op, comm, info, request, + comm->c_coll->coll_reduce_scatter_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/register_datarep.c b/ompi/mpi/c/register_datarep.c deleted file mode 100644 index 2ce49dbe9f3..00000000000 --- a/ompi/mpi/c/register_datarep.c +++ /dev/null @@ -1,79 +0,0 @@ -/* -*- 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-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) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/io/base/base.h" -#include "ompi/file/file.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Register_datarep = PMPI_Register_datarep -#endif -#define MPI_Register_datarep PMPI_Register_datarep -#endif - -static const char FUNC_NAME[] = "MPI_Register_datarep"; - - -int MPI_Register_datarep(const char *datarep, - MPI_Datarep_conversion_function *read_conversion_fn, - MPI_Datarep_conversion_function *write_conversion_fn, - MPI_Datarep_extent_function *dtype_file_extent_fn, - void *extra_state) -{ - int rc; - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == datarep) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME); - } - - /* The io framework is only initialized lazily. If it hasn't - already been initialized, do so now (note that MPI_FILE_OPEN - and MPI_FILE_DELETE are the only two places that it will be - initialized). */ - - if (OMPI_SUCCESS != (rc = mca_base_framework_open(&ompi_io_base_framework, 0))) { - return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); - } - - /* Call the back-end io component function */ - rc = mca_io_base_register_datarep(datarep, read_conversion_fn, - write_conversion_fn, - dtype_file_extent_fn, - extra_state); - - - /* All done */ - - OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/register_datarep.c.in b/ompi/mpi/c/register_datarep.c.in new file mode 100644 index 00000000000..4f49fc239fc --- /dev/null +++ b/ompi/mpi/c/register_datarep.c.in @@ -0,0 +1,70 @@ +/* -*- 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-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) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/io/base/base.h" +#include "ompi/file/file.h" + +PROTOTYPE ERROR_CLASS register_datarep(STRING datarep, + DATAREP_CONVERSION_FUNCTION read_conversion_fn, + DATAREP_CONVERSION_FUNCTION write_conversion_fn, + DATAREP_EXTENT_FUNCTION dtype_file_extent_fn, + BUFFER_OUT extra_state) +{ + int rc; + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == datarep) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(rc, MPI_FILE_NULL, rc, FUNC_NAME); + } + + /* The io framework is only initialized lazily. If it hasn't + already been initialized, do so now (note that MPI_FILE_OPEN + and MPI_FILE_DELETE are the only two places that it will be + initialized). */ + + if (OMPI_SUCCESS != (rc = mca_base_framework_open(&ompi_io_base_framework, 0))) { + return OMPI_ERRHANDLER_INVOKE(MPI_FILE_NULL, rc, FUNC_NAME); + } + + /* Call the back-end io component function */ + rc = mca_io_base_register_datarep(datarep, (MPI_Datarep_conversion_function *) read_conversion_fn, + (MPI_Datarep_conversion_function *) write_conversion_fn, + dtype_file_extent_fn, + extra_state); + + + /* All done */ + + OMPI_ERRHANDLER_RETURN(rc, MPI_FILE_NULL, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/request_c2f.c b/ompi/mpi/c/request_c2f.c deleted file mode 100644 index 9d98b2928b5..00000000000 --- a/ompi/mpi/c/request_c2f.c +++ /dev/null @@ -1,75 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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-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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Request_c2f = PMPI_Request_c2f -#endif -#define MPI_Request_c2f PMPI_Request_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Request_c2f"; - - -MPI_Fint MPI_Request_c2f(MPI_Request request) -{ - MEMCHECKER( - memchecker_request(&request); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == request) { - return OMPI_INT_2_FINT(-1); - } - } - - /* We only put requests in the f2c table when this function is - invoked. This is because putting requests in the table - involves locking and unlocking the table, which would incur a - performance penalty (in the critical performance path) for C - applications. In this way, at least only Fortran applications - are penalized. :-\ - - Modifying this one function neatly fixes up all the Fortran - bindings because they all call MPI_Request_c2f in order to - transmorgify the C MPI_Request that they got back into a - fortran integer. - */ - - if (MPI_UNDEFINED == request->req_f_to_c_index) { - request->req_f_to_c_index = - opal_pointer_array_add(&ompi_request_f_to_c_table, request); - } - - return OMPI_INT_2_FINT(request->req_f_to_c_index) ; -} diff --git a/ompi/mpi/c/request_c2f.c.in b/ompi/mpi/c/request_c2f.c.in new file mode 100644 index 00000000000..65a21fb692d --- /dev/null +++ b/ompi/mpi/c/request_c2f.c.in @@ -0,0 +1,67 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE FINT request_c2f(REQUEST request) +{ + MEMCHECKER( + memchecker_request(&request); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == request) { + return OMPI_INT_2_FINT(-1); + } + } + + /* We only put requests in the f2c table when this function is + invoked. This is because putting requests in the table + involves locking and unlocking the table, which would incur a + performance penalty (in the critical performance path) for C + applications. In this way, at least only Fortran applications + are penalized. :-\ + + Modifying this one function neatly fixes up all the Fortran + bindings because they all call MPI_Request_c2f in order to + transmorgify the C MPI_Request that they got back into a + fortran integer. + */ + + if (MPI_UNDEFINED == request->req_f_to_c_index) { + request->req_f_to_c_index = + opal_pointer_array_add(&ompi_request_f_to_c_table, request); + } + + return OMPI_INT_2_FINT(request->req_f_to_c_index) ; +} diff --git a/ompi/mpi/c/request_f2c.c b/ompi/mpi/c/request_f2c.c deleted file mode 100644 index 993aa4383fe..00000000000 --- a/ompi/mpi/c/request_f2c.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/request/request.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Request_f2c = PMPI_Request_f2c -#endif -#define MPI_Request_f2c PMPI_Request_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Request_f2c"; - - -MPI_Request MPI_Request_f2c(MPI_Fint request) -{ - int request_index = OMPI_FINT_2_INT(request); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (request_index < 0 || - request_index >= - opal_pointer_array_get_size(&ompi_request_f_to_c_table)) { - return NULL; - } - - return (MPI_Request)opal_pointer_array_get_item(&ompi_request_f_to_c_table, - request_index); -} diff --git a/ompi/mpi/c/request_f2c.c.in b/ompi/mpi/c/request_f2c.c.in new file mode 100644 index 00000000000..3f6b6345f59 --- /dev/null +++ b/ompi/mpi/c/request_f2c.c.in @@ -0,0 +1,52 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/request/request.h" + +PROTOTYPE REQUEST request_f2c(FINT request) +{ + int request_index = OMPI_FINT_2_INT(request); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (request_index < 0 || + request_index >= + opal_pointer_array_get_size(&ompi_request_f_to_c_table)) { + return NULL; + } + + return (MPI_Request)opal_pointer_array_get_item(&ompi_request_f_to_c_table, + request_index); +} diff --git a/ompi/mpi/c/request_free.c b/ompi/mpi/c/request_free.c deleted file mode 100644 index 91f91786f13..00000000000 --- a/ompi/mpi/c/request_free.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * 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) 2006-2009 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 - -#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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Request_free = PMPI_Request_free -#endif -#define MPI_Request_free PMPI_Request_free -#endif - -static const char FUNC_NAME[] = "MPI_Request_free"; - - -int MPI_Request_free(MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_request(request); - ); - - if (MPI_PARAM_CHECK) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == request || NULL == *request || - MPI_REQUEST_NULL == *request) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - rc = ompi_request_free(request); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/request_free.c.in b/ompi/mpi/c/request_free.c.in new file mode 100644 index 00000000000..28a18e95431 --- /dev/null +++ b/ompi/mpi/c/request_free.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006-2009 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS request_free(REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_request(request); + ); + + if (MPI_PARAM_CHECK) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == request || NULL == *request || + MPI_REQUEST_NULL == *request) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + rc = ompi_request_free(request); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/request_get_status.c b/ompi/mpi/c/request_get_status.c deleted file mode 100644 index f97e3af4b0b..00000000000 --- a/ompi/mpi/c/request_get_status.c +++ /dev/null @@ -1,102 +0,0 @@ -/* - * 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$ - * - * 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" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Request_get_status = PMPI_Request_get_status -#endif -#define MPI_Request_get_status PMPI_Request_get_status -#endif - -static const char FUNC_NAME[] = "MPI_Request_get_status"; - -/* 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. - */ -int MPI_Request_get_status(MPI_Request request, int *flag, - MPI_Status *status) -{ -#if OPAL_ENABLE_PROGRESS_THREADS == 0 - int do_it_once = 0; -#endif - - MEMCHECKER( - memchecker_request(&request); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( (NULL == flag) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (NULL == request) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, - FUNC_NAME); - } - } - -#if OPAL_ENABLE_PROGRESS_THREADS == 0 - recheck_request_status: -#endif - opal_atomic_mb(); - if( (request == MPI_REQUEST_NULL) || (request->req_state == OMPI_REQUEST_INACTIVE) ) { - *flag = true; - if( MPI_STATUS_IGNORE != status ) { - OMPI_COPY_STATUS(status, ompi_status_empty, false); - } - return MPI_SUCCESS; - } - if( request->req_complete ) { - *flag = true; - /* 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 == request->req_type) { - ompi_grequest_invoke_query(request, &request->req_status); - } - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, request->req_status, 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; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/request_get_status.c.in b/ompi/mpi/c/request_get_status.c.in new file mode 100644 index 00000000000..86ba237866b --- /dev/null +++ b/ompi/mpi/c/request_get_status.c.in @@ -0,0 +1,95 @@ +/* + * 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$ + * + * 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(REQUEST request, INT_OUT flag, + STATUS_OUT status) +{ +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + int do_it_once = 0; +#endif + + MEMCHECKER( + memchecker_request(&request); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( (NULL == flag) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (NULL == request) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, + FUNC_NAME); + } + } + +#if OPAL_ENABLE_PROGRESS_THREADS == 0 + recheck_request_status: +#endif + opal_atomic_mb(); + if( (request == MPI_REQUEST_NULL) || (request->req_state == OMPI_REQUEST_INACTIVE) ) { + *flag = true; + if( MPI_STATUS_IGNORE != status ) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + } + return MPI_SUCCESS; + } + if( request->req_complete ) { + *flag = true; + /* 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 == request->req_type) { + ompi_grequest_invoke_query(request, &request->req_status); + } + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, request->req_status, 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; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/rget.c b/ompi/mpi/c/rget.c deleted file mode 100644 index a5e789b6de2..00000000000 --- a/ompi/mpi/c/rget.c +++ /dev/null @@ -1,86 +0,0 @@ -/* -*- 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) 2014-2015 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Rget = PMPI_Rget -#endif -#define MPI_Rget PMPI_Rget -#endif - -static const char FUNC_NAME[] = "MPI_Rget"; - - -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) -{ - int rc; - - SPC_RECORD(OMPI_SPC_RGET, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - rc = win->w_osc_module->osc_rget(origin_addr, origin_count, origin_datatype, - target_rank, target_disp, target_count, - target_datatype, win, request); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/rget.c.in b/ompi/mpi/c/rget.c.in new file mode 100644 index 00000000000..a0c70e235e9 --- /dev/null +++ b/ompi/mpi/c/rget.c.in @@ -0,0 +1,78 @@ +/* -*- 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) 2014-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS rget(BUFFER_OUT origin_addr, COUNT origin_count, + DATATYPE origin_datatype, INT target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win, REQUEST_INOUT request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_RGET, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + rc = win->w_osc_module->osc_rget(origin_addr, origin_count, origin_datatype, + target_rank, target_disp, target_count, + target_datatype, win, request); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/rget_accumulate.c b/ompi/mpi/c/rget_accumulate.c deleted file mode 100644 index 37f7ee3fb37..00000000000 --- a/ompi/mpi/c/rget_accumulate.c +++ /dev/null @@ -1,149 +0,0 @@ -/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. - * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2014-2015 Los Alamos National Security, LLC. All right - * 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 -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/request/request.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/op/op.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Rget_accumulate = PMPI_Rget_accumulate -#endif -#define MPI_Rget_accumulate PMPI_Rget_accumulate -#endif - -static const char FUNC_NAME[] = "MPI_Rget_accumulate"; - -int MPI_Rget_accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, - void *result_addr, int result_count, MPI_Datatype result_datatype, - int target_rank, MPI_Aint target_disp, int target_count, - MPI_Datatype target_datatype, MPI_Op op, MPI_Win win, MPI_Request *request) -{ - int rc; - ompi_win_t *ompi_win = (ompi_win_t*) win; - - MEMCHECKER( - memchecker_datatype(origin_datatype); - memchecker_datatype(target_datatype); - memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); - ); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (MPI_OP_NULL == op) { - rc = MPI_ERR_OP; - } else if (!ompi_op_is_intrinsic(op)) { - rc = MPI_ERR_OP; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - /* the origin datatype is meaningless when using MPI_OP_NO_OP */ - if (&ompi_mpi_op_no_op.op != op) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - } else { - rc = OMPI_SUCCESS; - } - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - if (OMPI_SUCCESS == rc) { - /* While technically the standard probably requires that the - datatypes used with MPI_REPLACE conform to all the rules - for other reduction operators, we don't require such - behavior, as checking for it is expensive here and we don't - care in implementation.. */ - if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { - ompi_datatype_t *op_check_dt, *origin_check_dt; - char *msg; - - /* RGET_ACCUMULATE, unlike REDUCE, can use with derived - datatypes with predefinied operations, with some - restrictions outlined in MPI-3:11.3.4. The derived - datatype must be composed entirely from one predefined - datatype (so you can do all the construction you want, - but at the bottom, you can only use one datatype, say, - MPI_INT). If the datatype at the target isn't - predefined, then make sure it's composed of only one - datatype, and check that datatype against - ompi_op_is_valid(). */ - origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); - op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); - - if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { - OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); - } - - /* check to make sure primitive type is valid for - reduction. Should do this on the target, but - then can't get the errcode back for this - call */ - if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); - free(msg); - return ret; - } - } - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - rc = ompi_win->w_osc_module->osc_rget_accumulate(origin_addr, - origin_count, - origin_datatype, - result_addr, - result_count, - result_datatype, - target_rank, - target_disp, - target_count, - target_datatype, - op, win, request); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/rget_accumulate.c.in b/ompi/mpi/c/rget_accumulate.c.in new file mode 100644 index 00000000000..146a9416dbb --- /dev/null +++ b/ompi/mpi/c/rget_accumulate.c.in @@ -0,0 +1,143 @@ +/* -*- 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) 2009 Sun Microsystmes, Inc. All rights reserved. + * Copyright (c) 2011 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2014-2015 Los Alamos National Security, LLC. All right + * 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$ + * + * 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/request/request.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/op/op.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" +#include "ompi/memchecker.h" + + +PROTOTYPE ERROR_CLASS Rget_accumulate(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + BUFFER_OUT result_addr, COUNT result_count, DATATYPE result_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win, REQUEST_INOUT request) +{ + int rc; + ompi_win_t *ompi_win = (ompi_win_t*) win; + + MEMCHECKER( + memchecker_datatype(origin_datatype); + memchecker_datatype(target_datatype); + memchecker_call(&opal_memchecker_base_isdefined, (void *) origin_addr, origin_count, origin_datatype); + ); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (MPI_OP_NULL == op) { + rc = MPI_ERR_OP; + } else if (!ompi_op_is_intrinsic(op)) { + rc = MPI_ERR_OP; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + /* the origin datatype is meaningless when using MPI_OP_NO_OP */ + if (&ompi_mpi_op_no_op.op != op) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + } else { + rc = OMPI_SUCCESS; + } + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + if (OMPI_SUCCESS == rc) { + /* While technically the standard probably requires that the + datatypes used with MPI_REPLACE conform to all the rules + for other reduction operators, we don't require such + behavior, as checking for it is expensive here and we don't + care in implementation.. */ + if (op != &ompi_mpi_op_replace.op && op != &ompi_mpi_op_no_op.op) { + ompi_datatype_t *op_check_dt, *origin_check_dt; + char *msg; + + /* RGET_ACCUMULATE, unlike REDUCE, can use with derived + datatypes with predefinied operations, with some + restrictions outlined in MPI-3:11.3.4. The derived + datatype must be composed entirely from one predefined + datatype (so you can do all the construction you want, + but at the bottom, you can only use one datatype, say, + MPI_INT). If the datatype at the target isn't + predefined, then make sure it's composed of only one + datatype, and check that datatype against + ompi_op_is_valid(). */ + origin_check_dt = ompi_datatype_get_single_predefined_type_from_args(origin_datatype); + op_check_dt = ompi_datatype_get_single_predefined_type_from_args(target_datatype); + + if( !((origin_check_dt == op_check_dt) & (NULL != op_check_dt)) ) { + OMPI_ERRHANDLER_RETURN(MPI_ERR_ARG, win, MPI_ERR_ARG, FUNC_NAME); + } + + /* check to make sure primitive type is valid for + reduction. Should do this on the target, but + then can't get the errcode back for this + call */ + if (!ompi_op_is_valid(op, op_check_dt, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_OP, msg); + free(msg); + return ret; + } + } + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + rc = ompi_win->w_osc_module->osc_rget_accumulate(origin_addr, + origin_count, + origin_datatype, + result_addr, + result_count, + result_datatype, + target_rank, + target_disp, + target_count, + target_datatype, + op, win, request); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/rput.c b/ompi/mpi/c/rput.c deleted file mode 100644 index 8493ac14aba..00000000000 --- a/ompi/mpi/c/rput.c +++ /dev/null @@ -1,89 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Rput = PMPI_Rput -#endif -#define MPI_Rput PMPI_Rput -#endif - -static const char FUNC_NAME[] = "MPI_Rput"; - - -int MPI_Rput(const 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) -{ - int rc; - - SPC_RECORD(OMPI_SPC_RPUT, 1); - - if (MPI_PARAM_CHECK) { - rc = OMPI_SUCCESS; - - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (origin_count < 0 || target_count < 0) { - rc = MPI_ERR_COUNT; - } else if (ompi_win_peer_invalid(win, target_rank) && - (MPI_PROC_NULL != target_rank)) { - rc = MPI_ERR_RANK; - } else if (NULL == target_datatype || - MPI_DATATYPE_NULL == target_datatype) { - rc = MPI_ERR_TYPE; - } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { - rc = MPI_ERR_DISP; - } else { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); - if (OMPI_SUCCESS == rc) { - OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); - } - } - OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == target_rank) { - *request = &ompi_request_empty; - return MPI_SUCCESS; - } - - rc = win->w_osc_module->osc_rput(origin_addr, origin_count, origin_datatype, - target_rank, target_disp, target_count, - target_datatype, win, request); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/rput.c.in b/ompi/mpi/c/rput.c.in new file mode 100644 index 00000000000..8ee8b5adabb --- /dev/null +++ b/ompi/mpi/c/rput.c.in @@ -0,0 +1,81 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2014-2015 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS rput(BUFFER origin_addr, COUNT origin_count, DATATYPE origin_datatype, + INT target_rank, AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win, REQUEST_INOUT request) +{ + int rc; + + SPC_RECORD(OMPI_SPC_RPUT, 1); + + if (MPI_PARAM_CHECK) { + rc = OMPI_SUCCESS; + + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (origin_count < 0 || target_count < 0) { + rc = MPI_ERR_COUNT; + } else if (ompi_win_peer_invalid(win, target_rank) && + (MPI_PROC_NULL != target_rank)) { + rc = MPI_ERR_RANK; + } else if (NULL == target_datatype || + MPI_DATATYPE_NULL == target_datatype) { + rc = MPI_ERR_TYPE; + } else if ( MPI_WIN_FLAVOR_DYNAMIC != win->w_flavor && target_disp < 0 ) { + rc = MPI_ERR_DISP; + } else { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, origin_datatype, origin_count); + if (OMPI_SUCCESS == rc) { + OMPI_CHECK_DATATYPE_FOR_ONE_SIDED(rc, target_datatype, target_count); + } + } + OMPI_ERRHANDLER_CHECK(rc, win, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == target_rank) { + *request = &ompi_request_empty; + return MPI_SUCCESS; + } + + rc = win->w_osc_module->osc_rput(origin_addr, origin_count, origin_datatype, + target_rank, target_disp, target_count, + target_datatype, win, request); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/rsend.c b/ompi/mpi/c/rsend.c deleted file mode 100644 index cce1334a04b..00000000000 --- a/ompi/mpi/c/rsend.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Rsend = PMPI_Rsend -#endif -#define MPI_Rsend PMPI_Rsend -#endif - -static const char FUNC_NAME[] = "MPI_Rsend"; - - -int MPI_Rsend(const void *buf, int count, MPI_Datatype type, int dest, int tag, MPI_Comm comm) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_RSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are communicating with - * a failed process. This is not absolutely necessary since we will - * check for this, and other, error conditions during the completion - * call in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if (MPI_PROC_NULL == dest) { - return MPI_SUCCESS; - } - - rc = MCA_PML_CALL(send(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_READY, comm)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/rsend.c.in b/ompi/mpi/c/rsend.c.in new file mode 100644 index 00000000000..2364e8178b5 --- /dev/null +++ b/ompi/mpi/c/rsend.c.in @@ -0,0 +1,90 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS rsend(BUFFER buf, COUNT count, DATATYPE type, INT dest, INT tag, COMM comm) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_RSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are communicating with + * a failed process. This is not absolutely necessary since we will + * check for this, and other, error conditions during the completion + * call in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if (MPI_PROC_NULL == dest) { + return MPI_SUCCESS; + } + + rc = MCA_PML_CALL(send(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_READY, comm)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/rsend_init.c b/ompi/mpi/c/rsend_init.c deleted file mode 100644 index d9fc9f4d1ee..00000000000 --- a/ompi/mpi/c/rsend_init.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Rsend_init = PMPI_Rsend_init -#endif -#define MPI_Rsend_init PMPI_Rsend_init -#endif - -static const char FUNC_NAME[] = "MPI_Rsend_init"; - - -int MPI_Rsend_init(const void *buf, int count, MPI_Datatype type, - int dest, int tag, MPI_Comm comm, - MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - rc = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. - */ - rc = MCA_PML_CALL(isend_init(buf,count,type,dest,tag, - MCA_PML_BASE_SEND_READY,comm,request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/rsend_init.c.in b/ompi/mpi/c/rsend_init.c.in new file mode 100644 index 00000000000..a6a90588c62 --- /dev/null +++ b/ompi/mpi/c/rsend_init.c.in @@ -0,0 +1,90 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS rsend_init(BUFFER buf, COUNT count, DATATYPE type, + INT dest, INT tag, COMM comm, + REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + rc = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. + */ + rc = MCA_PML_CALL(isend_init(buf,count,type,dest,tag, + MCA_PML_BASE_SEND_READY,comm,request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/scan.c b/ompi/mpi/c/scan.c deleted file mode 100644 index 3d6aef421b8..00000000000 --- a/ompi/mpi/c/scan.c +++ /dev/null @@ -1,123 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scan = PMPI_Scan -#endif -#define MPI_Scan PMPI_Scan -#endif - -static const char FUNC_NAME[] = "MPI_Scan"; - - -int MPI_Scan(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_SCAN, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* No intercommunicators allowed! (MPI does not define - MPI_SCAN on intercommunicators) */ - - else if (OMPI_COMM_IS_INTER(comm)) { - err = MPI_ERR_COMM; - } - - /* Unrooted operation; checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? (MPI says that reductions have to - have a count of at least 1, but at least IMB calls reduce with - a count of 0 -- blah!) */ - - if (0 == count) { - return MPI_SUCCESS; - } - - /* Call the coll component to actually perform the allgather */ - - OBJ_RETAIN(op); - err = comm->c_coll->coll_scan(sendbuf, recvbuf, count, - datatype, op, comm, - comm->c_coll->coll_scan_module); - OBJ_RELEASE(op); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scan.c.in b/ompi/mpi/c/scan.c.in new file mode 100644 index 00000000000..4f028c7c709 --- /dev/null +++ b/ompi/mpi/c/scan.c.in @@ -0,0 +1,115 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scan(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_SCAN, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* No intercommunicators allowed! (MPI does not define + MPI_SCAN on intercommunicators) */ + + else if (OMPI_COMM_IS_INTER(comm)) { + err = MPI_ERR_COMM; + } + + /* Unrooted operation; checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? (MPI says that reductions have to + have a count of at least 1, but at least IMB calls reduce with + a count of 0 -- blah!) */ + + if (0 == count) { + return MPI_SUCCESS; + } + + /* Call the coll component to actually perform the allgather */ + + OBJ_RETAIN(op); + err = comm->c_coll->coll_scan(sendbuf, recvbuf, count, + datatype, op, comm, + comm->c_coll->coll_scan_module); + OBJ_RELEASE(op); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/scan_init.c b/ompi/mpi/c/scan_init.c deleted file mode 100644 index 6008eb56190..00000000000 --- a/ompi/mpi/c/scan_init.c +++ /dev/null @@ -1,107 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/op/op.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scan_init = PMPI_Scan_init -#endif -#define MPI_Scan_init PMPI_Scan_init -#endif - -static const char FUNC_NAME[] = "MPI_Scan_init"; - - -int MPI_Scan_init(const void *sendbuf, void *recvbuf, int count, - MPI_Datatype datatype, MPI_Op op, MPI_Comm comm, - MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_SCAN_INIT, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_comm(comm); - if (MPI_IN_PLACE != sendbuf) { - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); - } else { - memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); - } - ); - - if (MPI_PARAM_CHECK) { - char *msg; - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - /* No intercommunicators allowed! (MPI does not define - MPI_SCAN on intercommunicators) */ - - else if (OMPI_COMM_IS_INTER(comm)) { - err = MPI_ERR_COMM; - } - - /* Unrooted operation; checks for all ranks */ - - else if (MPI_OP_NULL == op || NULL == op) { - err = MPI_ERR_OP; - } else if (MPI_IN_PLACE == recvbuf) { - err = MPI_ERR_ARG; - } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { - int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); - free(msg); - return ret; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Call the coll component to actually perform the allgather */ - - err = comm->c_coll->coll_scan_init(sendbuf, recvbuf, count, - datatype, op, comm, - info, request, - comm->c_coll->coll_scan_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - ompi_coll_base_retain_op(*request, op, datatype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scan_init.c.in b/ompi/mpi/c/scan_init.c.in new file mode 100644 index 00000000000..b1625f138a6 --- /dev/null +++ b/ompi/mpi/c/scan_init.c.in @@ -0,0 +1,99 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/op/op.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scan_init(BUFFER sendbuf, BUFFER_OUT recvbuf, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_SCAN_INIT, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_comm(comm); + if (MPI_IN_PLACE != sendbuf) { + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, count, datatype); + } else { + memchecker_call(&opal_memchecker_base_isdefined, recvbuf, count, datatype); + } + ); + + if (MPI_PARAM_CHECK) { + char *msg; + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + /* No intercommunicators allowed! (MPI does not define + MPI_SCAN on intercommunicators) */ + + else if (OMPI_COMM_IS_INTER(comm)) { + err = MPI_ERR_COMM; + } + + /* Unrooted operation; checks for all ranks */ + + else if (MPI_OP_NULL == op || NULL == op) { + err = MPI_ERR_OP; + } else if (MPI_IN_PLACE == recvbuf) { + err = MPI_ERR_ARG; + } else if (!ompi_op_is_valid(op, datatype, &msg, FUNC_NAME)) { + int ret = OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_OP, msg); + free(msg); + return ret; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(err, datatype, count); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Call the coll component to actually perform the allgather */ + + err = comm->c_coll->coll_scan_init(sendbuf, recvbuf, count, + datatype, op, comm, + info, request, + comm->c_coll->coll_scan_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + ompi_coll_base_retain_op(*request, op, datatype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/scatter.c b/ompi/mpi/c/scatter.c deleted file mode 100644 index 6b42690c51d..00000000000 --- a/ompi/mpi/c/scatter.c +++ /dev/null @@ -1,191 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scatter = PMPI_Scatter -#endif -#define MPI_Scatter PMPI_Scatter -#endif - -static const char FUNC_NAME[] = "MPI_Scatter"; - - -int MPI_Scatter(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm) -{ - int err; - - SPC_RECORD(OMPI_SPC_SCATTER, 1); - - MEMCHECKER( - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - else if (ompi_comm_rank(comm) == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - err = MPI_ERR_ROOT; - } - - /* Errors for the receivers */ - - else if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - /* Do we need to do anything? */ - - if ((0 == recvcount && MPI_ROOT != root && - (ompi_comm_rank(comm) != root || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE != recvbuf))) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf && - 0 == sendcount) || - (0 == sendcount && (MPI_ROOT == root || MPI_PROC_NULL == root))) { - return MPI_SUCCESS; - } - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_scatter(updated_sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, - comm->c_coll->coll_scatter_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scatter.c.in b/ompi/mpi/c/scatter.c.in new file mode 100644 index 00000000000..e07ffde7d9f --- /dev/null +++ b/ompi/mpi/c/scatter.c.in @@ -0,0 +1,183 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scatter(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm) +{ + int err; + + SPC_RECORD(OMPI_SPC_SCATTER, 1); + + MEMCHECKER( + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + else if (ompi_comm_rank(comm) == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + err = MPI_ERR_ROOT; + } + + /* Errors for the receivers */ + + else if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + /* Do we need to do anything? */ + + if ((0 == recvcount && MPI_ROOT != root && + (ompi_comm_rank(comm) != root || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE != recvbuf))) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == recvbuf && + 0 == sendcount) || + (0 == sendcount && (MPI_ROOT == root || MPI_PROC_NULL == root))) { + return MPI_SUCCESS; + } + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_scatter(updated_sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, + comm->c_coll->coll_scatter_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/scatter_init.c b/ompi/mpi/c/scatter_init.c deleted file mode 100644 index 86f43aae13f..00000000000 --- a/ompi/mpi/c/scatter_init.c +++ /dev/null @@ -1,188 +0,0 @@ -/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2008 University of Houston. All rights reserved. - * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scatter_init = PMPI_Scatter_init -#endif -#define MPI_Scatter_init PMPI_Scatter_init -#endif - -static const char FUNC_NAME[] = "MPI_Scatter_init"; - - -int MPI_Scatter_init(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - void *recvbuf, int recvcount, MPI_Datatype recvtype, - int root, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int err; - - SPC_RECORD(OMPI_SPC_SCATTER_INIT, 1); - - MEMCHECKER( - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - } else if (MPI_PROC_NULL != root) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - err = MPI_ERR_ROOT; - } else if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - else if (ompi_comm_rank(comm) == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - err = MPI_ERR_ROOT; - } - - /* Errors for the receivers */ - - else if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - err = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == recvtype) { - err = MPI_ERR_TYPE; - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); - } - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - err = comm->c_coll->coll_scatter_init(updated_sendbuf, sendcount, sendtype, updated_recvbuf, - recvcount, recvtype, root, comm, info, request, - comm->c_coll->coll_scatter_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == recvbuf) { - recvtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - sendtype = NULL; - } - } else { - if (MPI_ROOT == root) { - recvtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - sendtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scatter_init.c.in b/ompi/mpi/c/scatter_init.c.in new file mode 100644 index 00000000000..c17ef222d77 --- /dev/null +++ b/ompi/mpi/c/scatter_init.c.in @@ -0,0 +1,180 @@ +/* -*- 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-2023 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-2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2008 University of Houston. All rights reserved. + * Copyright (c) 2008 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scatter_init(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT recvbuf, COUNT recvcount, DATATYPE recvtype, + INT root, COMM comm, INFO info, REQUEST_INOUT request) +{ + int err; + + SPC_RECORD(OMPI_SPC_SCATTER_INIT, 1); + + MEMCHECKER( + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + } else if (MPI_PROC_NULL != root) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + err = MPI_ERR_ROOT; + } else if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + else if (ompi_comm_rank(comm) == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + err = MPI_ERR_ROOT; + } + + /* Errors for the receivers */ + + else if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + err = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == recvtype) { + err = MPI_ERR_TYPE; + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcount); + } + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + err = comm->c_coll->coll_scatter_init(updated_sendbuf, sendcount, sendtype, updated_recvbuf, + recvcount, recvtype, root, comm, info, request, + comm->c_coll->coll_scatter_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == recvbuf) { + recvtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + sendtype = NULL; + } + } else { + if (MPI_ROOT == root) { + recvtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + sendtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/scatterv.c b/ompi/mpi/c/scatterv.c deleted file mode 100644 index ac9688a018e..00000000000 --- a/ompi/mpi/c/scatterv.c +++ /dev/null @@ -1,224 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scatterv = PMPI_Scatterv -#endif -#define MPI_Scatterv PMPI_Scatterv -#endif - -static const char FUNC_NAME[] = "MPI_Scatterv"; - - -int MPI_Scatterv(const void *sendbuf, const int sendcounts[], const int displs[], - MPI_Datatype sendtype, void *recvbuf, int recvcount, - MPI_Datatype recvtype, int root, MPI_Comm comm) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_SCATTERV, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - } else if (MPI_PROC_NULL != root) { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, - FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, - FUNC_NAME); - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the receivers */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are using a broken - * communicator. This is not absolutely necessary since we will - * check for this, and other, error conditions during the operation. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); - } -#endif - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_scatterv(updated_sendbuf, sendcounts_desc, displs_desc, - sendtype, updated_recvbuf, recvcount, recvtype, root, comm, - comm->c_coll->coll_scatterv_module); - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scatterv.c.in b/ompi/mpi/c/scatterv.c.in new file mode 100644 index 00000000000..78eda87c80f --- /dev/null +++ b/ompi/mpi/c/scatterv.c.in @@ -0,0 +1,216 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scatterv(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY displs, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE recvtype, INT root, COMM comm) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_SCATTERV, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + } else if (MPI_PROC_NULL != root) { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, + FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, + FUNC_NAME); + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the receivers */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are using a broken + * communicator. This is not absolutely necessary since we will + * check for this, and other, error conditions during the operation. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_coll_check(comm, &err)) ) { + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); + } +#endif + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_scatterv(updated_sendbuf, sendcounts_desc, displs_desc, + sendtype, updated_recvbuf, recvcount, recvtype, root, comm, + comm->c_coll->coll_scatterv_module); + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/scatterv_init.c b/ompi/mpi/c/scatterv_init.c deleted file mode 100644 index 24180e10c8c..00000000000 --- a/ompi/mpi/c/scatterv_init.c +++ /dev/null @@ -1,232 +0,0 @@ -/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Research Organization for Information Science - * and Technology (RIST). 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/datatype/ompi_datatype.h" -#include "ompi/mca/coll/base/coll_base_util.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Scatterv_init = PMPI_Scatterv_init -#endif -#define MPI_Scatterv_init PMPI_Scatterv_init -#endif - -static const char FUNC_NAME[] = "MPI_Scatterv_init"; - - -int MPI_Scatterv_init(const void *sendbuf, const int sendcounts[], const int displs[], - MPI_Datatype sendtype, void *recvbuf, int recvcount, - MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Info info, MPI_Request *request) -{ - int i, size, err; - ompi_count_array_t sendcounts_desc; - ompi_disp_array_t displs_desc; - - SPC_RECORD(OMPI_SPC_SCATTERV_INIT, 1); - - MEMCHECKER( - ptrdiff_t ext; - - size = ompi_comm_remote_size(comm); - ompi_datatype_type_extent(recvtype, &ext); - - memchecker_comm(comm); - if(OMPI_COMM_IS_INTRA(comm)) { - if(ompi_comm_rank(comm) == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - if(MPI_IN_PLACE != recvbuf) { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - memchecker_datatype(recvtype); - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } else { - if(MPI_ROOT == root) { - memchecker_datatype(sendtype); - /* check whether root's send buffer is defined. */ - for (i = 0; i < size; i++) { - memchecker_call(&opal_memchecker_base_isdefined, - (char *)(sendbuf)+displs[i]*ext, - sendcounts[i], sendtype); - } - } else if (MPI_PROC_NULL != root) { - /* check whether receive buffer is addressable. */ - memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); - } - } - ); - - if (MPI_PARAM_CHECK) { - err = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || - (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - /* Errors for intracommunicators */ - - if (OMPI_COMM_IS_INTRA(comm)) { - - /* Errors for all ranks */ - - if ((root >= ompi_comm_size(comm)) || (root < 0)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - if (MPI_IN_PLACE != recvbuf) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, - FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, - FUNC_NAME); - } - } - - /* Errors for the root. Some of these could have been - combined into compound if statements above, but since - this whole section can be compiled out (or turned off at - run time) for efficiency, it's more clear to separate - them out into individual tests. */ - - if (ompi_comm_rank(comm) == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - - /* Errors for intercommunicators */ - - else { - if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || - MPI_ROOT == root || MPI_PROC_NULL == root)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); - } - - /* Errors for the receivers */ - - if (MPI_ROOT != root && MPI_PROC_NULL != root) { - if (recvcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); - } - } - - /* Errors for the root. Ditto on the comment above -- these - error checks could have been combined above, but let's - make the code easier to read. */ - - else if (MPI_ROOT == root) { - if (NULL == displs) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (NULL == sendcounts) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - size = ompi_comm_remote_size(comm); - for (i = 0; i < size; ++i) { - OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); - OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); - } - } - } - } - - const void *updated_sendbuf; - void *updated_recvbuf; - if (OMPI_COMM_IS_INTRA(comm)) { - updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; - updated_recvbuf = recvbuf; - } else { - updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; - updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; - } - - /* Invoke the coll component to perform the back-end operation */ - OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); - OMPI_DISP_ARRAY_INIT(&displs_desc, displs); - err = comm->c_coll->coll_scatterv_init(updated_sendbuf, sendcounts_desc, displs_desc, - sendtype, updated_recvbuf, recvcount, recvtype, root, comm, - info, request, comm->c_coll->coll_scatterv_init_module); - if (OPAL_LIKELY(OMPI_SUCCESS == err)) { - if (OMPI_COMM_IS_INTRA(comm)) { - if (MPI_IN_PLACE == recvbuf) { - recvtype = NULL; - } else if (ompi_comm_rank(comm) != root) { - sendtype = NULL; - } - } else { - if (MPI_ROOT == root) { - recvtype = NULL; - } else if (MPI_PROC_NULL == root) { - sendtype = NULL; - recvtype = NULL; - } else { - sendtype = NULL; - } - } - ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); - } - OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); -} diff --git a/ompi/mpi/c/scatterv_init.c.in b/ompi/mpi/c/scatterv_init.c.in new file mode 100644 index 00000000000..c42b0b1d9b5 --- /dev/null +++ b/ompi/mpi/c/scatterv_init.c.in @@ -0,0 +1,224 @@ +/* -*- 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-2023 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mca/coll/base/coll_base_util.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS scatterv_init(BUFFER sendbuf, COUNT_ARRAY sendcounts, DISP_ARRAY displs, + DATATYPE sendtype, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE recvtype, INT root, COMM comm, INFO info, REQUEST_INOUT request) +{ + int i, size, err; + ompi_count_array_t sendcounts_desc; + ompi_disp_array_t displs_desc; + + SPC_RECORD(OMPI_SPC_SCATTERV_INIT, 1); + + MEMCHECKER( + ptrdiff_t ext; + + size = ompi_comm_remote_size(comm); + ompi_datatype_type_extent(recvtype, &ext); + + memchecker_comm(comm); + if(OMPI_COMM_IS_INTRA(comm)) { + if(ompi_comm_rank(comm) == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + if(MPI_IN_PLACE != recvbuf) { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + memchecker_datatype(recvtype); + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } else { + if(MPI_ROOT == root) { + memchecker_datatype(sendtype); + /* check whether root's send buffer is defined. */ + for (i = 0; i < size; i++) { + memchecker_call(&opal_memchecker_base_isdefined, + (char *)(sendbuf)+displs[i]*ext, + sendcounts[i], sendtype); + } + } else if (MPI_PROC_NULL != root) { + /* check whether receive buffer is addressable. */ + memchecker_call(&opal_memchecker_base_isaddressable, recvbuf, recvcount, recvtype); + } + } + ); + + if (MPI_PARAM_CHECK) { + err = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ((ompi_comm_rank(comm) != root && MPI_IN_PLACE == recvbuf) || + (ompi_comm_rank(comm) == root && MPI_IN_PLACE == sendbuf)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + /* Errors for intracommunicators */ + + if (OMPI_COMM_IS_INTRA(comm)) { + + /* Errors for all ranks */ + + if ((root >= ompi_comm_size(comm)) || (root < 0)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + if (MPI_IN_PLACE != recvbuf) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, + FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, + FUNC_NAME); + } + } + + /* Errors for the root. Some of these could have been + combined into compound if statements above, but since + this whole section can be compiled out (or turned off at + run time) for efficiency, it's more clear to separate + them out into individual tests. */ + + if (ompi_comm_rank(comm) == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + + /* Errors for intercommunicators */ + + else { + if (! ((root >= 0 && root < ompi_comm_remote_size(comm)) || + MPI_ROOT == root || MPI_PROC_NULL == root)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ROOT, FUNC_NAME); + } + + /* Errors for the receivers */ + + if (MPI_ROOT != root && MPI_PROC_NULL != root) { + if (recvcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + if (MPI_DATATYPE_NULL == recvtype || NULL == recvtype) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TYPE, FUNC_NAME); + } + } + + /* Errors for the root. Ditto on the comment above -- these + error checks could have been combined above, but let's + make the code easier to read. */ + + else if (MPI_ROOT == root) { + if (NULL == displs) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (NULL == sendcounts) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + size = ompi_comm_remote_size(comm); + for (i = 0; i < size; ++i) { + OMPI_CHECK_DATATYPE_FOR_SEND(err, sendtype, sendcounts[i]); + OMPI_ERRHANDLER_CHECK(err, comm, err, FUNC_NAME); + } + } + } + } + + const void *updated_sendbuf; + void *updated_recvbuf; + if (OMPI_COMM_IS_INTRA(comm)) { + updated_sendbuf = (ompi_comm_rank(comm) != root) ? NULL : sendbuf; + updated_recvbuf = recvbuf; + } else { + updated_sendbuf = (MPI_ROOT != root ) ? NULL : sendbuf; + updated_recvbuf = ((MPI_ROOT == root) || (MPI_PROC_NULL == root)) ? NULL : recvbuf; + } + + /* Invoke the coll component to perform the back-end operation */ + OMPI_COUNT_ARRAY_INIT(&sendcounts_desc, sendcounts); + OMPI_DISP_ARRAY_INIT(&displs_desc, displs); + err = comm->c_coll->coll_scatterv_init(updated_sendbuf, sendcounts_desc, displs_desc, + sendtype, updated_recvbuf, recvcount, recvtype, root, comm, + info, request, comm->c_coll->coll_scatterv_init_module); + if (OPAL_LIKELY(OMPI_SUCCESS == err)) { + if (OMPI_COMM_IS_INTRA(comm)) { + if (MPI_IN_PLACE == recvbuf) { + recvtype = NULL; + } else if (ompi_comm_rank(comm) != root) { + sendtype = NULL; + } + } else { + if (MPI_ROOT == root) { + recvtype = NULL; + } else if (MPI_PROC_NULL == root) { + sendtype = NULL; + recvtype = NULL; + } else { + sendtype = NULL; + } + } + ompi_coll_base_retain_datatypes(*request, sendtype, recvtype); + } + OMPI_ERRHANDLER_RETURN(err, comm, err, FUNC_NAME); +} diff --git a/ompi/mpi/c/send.c b/ompi/mpi/c/send.c deleted file mode 100644 index b21bba2c7bc..00000000000 --- a/ompi/mpi/c/send.c +++ /dev/null @@ -1,95 +0,0 @@ -/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Send = PMPI_Send -#endif -#define MPI_Send PMPI_Send -#endif - -static const char FUNC_NAME[] = "MPI_Send"; - - -int MPI_Send(const void *buf, int count, MPI_Datatype type, int dest, - int tag, MPI_Comm comm) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_SEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are communicating with - * a failed process. This is not absolutely necessary since we will - * check for this, and other, error conditions during the completion - * call in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if (MPI_PROC_NULL == dest) { - return MPI_SUCCESS; - } - - rc = MCA_PML_CALL(send(buf, count, type, dest, tag, MCA_PML_BASE_SEND_STANDARD, comm)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/send.c.in b/ompi/mpi/c/send.c.in new file mode 100644 index 00000000000..797bc7630ad --- /dev/null +++ b/ompi/mpi/c/send.c.in @@ -0,0 +1,87 @@ +/* -*- 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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS send(BUFFER buf, COUNT count, DATATYPE type, RANK dest, + TAG tag, COMM comm) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_SEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are communicating with + * a failed process. This is not absolutely necessary since we will + * check for this, and other, error conditions during the completion + * call in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if (MPI_PROC_NULL == dest) { + return MPI_SUCCESS; + } + + rc = MCA_PML_CALL(send(buf, count, type, dest, tag, MCA_PML_BASE_SEND_STANDARD, comm)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/send_init.c b/ompi/mpi/c/send_init.c deleted file mode 100644 index 924b22948ff..00000000000 --- a/ompi/mpi/c/send_init.c +++ /dev/null @@ -1,97 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Send_init = PMPI_Send_init -#endif -#define MPI_Send_init PMPI_Send_init -#endif - -static const char FUNC_NAME[] = "MPI_Send_init"; - - -int MPI_Send_init(const void *buf, int count, MPI_Datatype type, - int dest, int tag, MPI_Comm comm, - MPI_Request *request) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - rc = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. - */ - rc = MCA_PML_CALL(isend_init(buf,count,type,dest,tag,MCA_PML_BASE_SEND_STANDARD,comm,request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/send_init.c.in b/ompi/mpi/c/send_init.c.in new file mode 100644 index 00000000000..de0dd93f777 --- /dev/null +++ b/ompi/mpi/c/send_init.c.in @@ -0,0 +1,89 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS send_init(BUFFER buf, COUNT count, DATATYPE type, + INT dest, INT tag, COMM comm, + REQUEST_INOUT request) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + rc = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. + */ + rc = MCA_PML_CALL(isend_init(buf,count,type,dest,tag,MCA_PML_BASE_SEND_STANDARD,comm,request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/sendrecv.c b/ompi/mpi/c/sendrecv.c deleted file mode 100644 index d4d35a27b28..00000000000 --- a/ompi/mpi/c/sendrecv.c +++ /dev/null @@ -1,139 +0,0 @@ -/* -*- 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-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) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Nanook Consulting. All rights reserved. - * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Sendrecv = PMPI_Sendrecv -#endif -#define MPI_Sendrecv PMPI_Sendrecv -#endif - -static const char FUNC_NAME[] = "MPI_Sendrecv"; - - -int MPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, - int dest, int sendtag, void *recvbuf, int recvcount, - MPI_Datatype recvtype, int source, int recvtag, - MPI_Comm comm, MPI_Status *status) -{ - ompi_request_t* req; - int rc = MPI_SUCCESS; - int rcs = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_SENDRECV, 1); - - MEMCHECKER( - memchecker_datatype(sendtype); - memchecker_datatype(recvtype); - memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_SEND(rc, sendtype, sendcount); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, recvtype, recvcount); - OMPI_CHECK_USER_BUFFER(rc, sendbuf, sendtype, sendcount); - OMPI_CHECK_USER_BUFFER(rc, recvbuf, recvtype, recvcount); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { - rc = MPI_ERR_RANK; - } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (source != MPI_PROC_NULL) { /* post recv */ - rc = MCA_PML_CALL(irecv(recvbuf, recvcount, recvtype, - source, recvtag, comm, &req)); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (dest != MPI_PROC_NULL) { /* send */ - rc = MCA_PML_CALL(send(sendbuf, sendcount, sendtype, dest, - sendtag, MCA_PML_BASE_SEND_STANDARD, comm)); - if (OPAL_UNLIKELY(MPI_SUCCESS != rc)) { - rcs = rc; -#if OPAL_ENABLE_FT_MPI - /* If this is a PROC_FAILED error, we still need to proceed with - * the receive, so that we do not propagate errors to the sender in - * the case src != dst, and only dst is dead. In this case the - * recv is guaranteed to complete (either in error if the source is - * dead, or successfully if the source is live). */ - if (OPAL_UNLIKELY(MPI_ERR_PROC_FAILED != rc)) - /* if intentionally spills outside ifdef */ -#endif - ompi_request_cancel(req); - } - } - - if (source != MPI_PROC_NULL) { /* wait for recv */ - rc = ompi_request_wait(&req, status); -#if OPAL_ENABLE_FT_MPI - /* Sendrecv never returns ERR_PROC_FAILED_PENDING because it is - * blocking. Lets cancel that irecv to complete it NOW and promote - * the error to ERR_PROC_FAILED */ - if( OPAL_UNLIKELY(MPI_ERR_PROC_FAILED_PENDING == rc) ) { - ompi_request_cancel(req); - ompi_request_wait(&req, MPI_STATUS_IGNORE); - rc = MPI_ERR_PROC_FAILED; - } -#endif - } else { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - rc = MPI_SUCCESS; - } - if( OPAL_UNLIKELY(MPI_SUCCESS != rcs && MPI_SUCCESS == rc) ) { - rc = rcs; - } - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/sendrecv.c.in b/ompi/mpi/c/sendrecv.c.in new file mode 100644 index 00000000000..ea00b883bb0 --- /dev/null +++ b/ompi/mpi/c/sendrecv.c.in @@ -0,0 +1,131 @@ +/* -*- 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-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) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021 Nanook Consulting. All rights reserved. + * Copyright (c) 2023 Jeffrey M. Squyres. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS sendrecv(BUFFER sendbuf, COUNT sendcount, DATATYPE sendtype, + INT dest, INT sendtag, BUFFER_OUT recvbuf, COUNT recvcount, + DATATYPE recvtype, INT source, INT recvtag, + COMM comm, STATUS_OUT status) +{ + ompi_request_t* req; + int rc = MPI_SUCCESS; + int rcs = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_SENDRECV, 1); + + MEMCHECKER( + memchecker_datatype(sendtype); + memchecker_datatype(recvtype); + memchecker_call(&opal_memchecker_base_isdefined, sendbuf, sendcount, sendtype); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_SEND(rc, sendtype, sendcount); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, recvtype, recvcount); + OMPI_CHECK_USER_BUFFER(rc, sendbuf, sendtype, sendcount); + OMPI_CHECK_USER_BUFFER(rc, recvbuf, recvtype, recvcount); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { + rc = MPI_ERR_RANK; + } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (source != MPI_PROC_NULL) { /* post recv */ + rc = MCA_PML_CALL(irecv(recvbuf, recvcount, recvtype, + source, recvtag, comm, &req)); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (dest != MPI_PROC_NULL) { /* send */ + rc = MCA_PML_CALL(send(sendbuf, sendcount, sendtype, dest, + sendtag, MCA_PML_BASE_SEND_STANDARD, comm)); + if (OPAL_UNLIKELY(MPI_SUCCESS != rc)) { + rcs = rc; +#if OPAL_ENABLE_FT_MPI + /* If this is a PROC_FAILED error, we still need to proceed with + * the receive, so that we do not propagate errors to the sender in + * the case src != dst, and only dst is dead. In this case the + * recv is guaranteed to complete (either in error if the source is + * dead, or successfully if the source is live). */ + if (OPAL_UNLIKELY(MPI_ERR_PROC_FAILED != rc)) + /* if intentionally spills outside ifdef */ +#endif + ompi_request_cancel(req); + } + } + + if (source != MPI_PROC_NULL) { /* wait for recv */ + rc = ompi_request_wait(&req, status); +#if OPAL_ENABLE_FT_MPI + /* Sendrecv never returns ERR_PROC_FAILED_PENDING because it is + * blocking. Lets cancel that irecv to complete it NOW and promote + * the error to ERR_PROC_FAILED */ + if( OPAL_UNLIKELY(MPI_ERR_PROC_FAILED_PENDING == rc) ) { + ompi_request_cancel(req); + ompi_request_wait(&req, MPI_STATUS_IGNORE); + rc = MPI_ERR_PROC_FAILED; + } +#endif + } else { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_request_empty.req_status, false); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + rc = MPI_SUCCESS; + } + if( OPAL_UNLIKELY(MPI_SUCCESS != rcs && MPI_SUCCESS == rc) ) { + rc = rcs; + } + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/sendrecv_replace.c b/ompi/mpi/c/sendrecv_replace.c deleted file mode 100644 index 46ce8fe753c..00000000000 --- a/ompi/mpi/c/sendrecv_replace.c +++ /dev/null @@ -1,183 +0,0 @@ -/* - * 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) 2010-2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2015-2021 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/proc/proc.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Sendrecv_replace = PMPI_Sendrecv_replace -#endif -#define MPI_Sendrecv_replace PMPI_Sendrecv_replace -#endif - -static const char FUNC_NAME[] = "MPI_Sendrecv_replace"; - - -int MPI_Sendrecv_replace(void * buf, int count, MPI_Datatype datatype, - int dest, int sendtag, int source, int recvtag, - MPI_Comm comm, MPI_Status *status) - -{ - ompi_request_t* req; - int rc = MPI_SUCCESS; -#if OPAL_ENABLE_FT_MPI - int rcs = MPI_SUCCESS; -#endif - - SPC_RECORD(OMPI_SPC_SENDRECV_REPLACE, 1); - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); - - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { - rc = MPI_ERR_RANK; - } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { - rc = MPI_ERR_RANK; - } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { - rc = MPI_ERR_TAG; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The final call to Sendrecv will check for process failures inside - * So no need to check here. - */ -#endif /* OPAL_ENABLE_FT_MPI */ - - /* simple case */ - if ( source == MPI_PROC_NULL || dest == MPI_PROC_NULL || count == 0 ) { - rc = PMPI_Sendrecv(buf, count, datatype, dest, sendtag, buf, count, datatype, source, recvtag, comm, status); - - return rc; - } - - /** - * If we look for an optimal solution, then we should receive the data into a temporary buffer - * and once the send completes we would unpack back into the original buffer. However, if the - * sender is unknown, this approach can only be implementing by receiving with the recv datatype - * (potentially non-contiguous) and thus the allocated memory will be larger than the size of the - * datatype. A simpler, but potentially less efficient approach is to work on the data we have - * control of, aka the sent data, and pack it into a contiguous buffer before posting the receive. - * Once the send completes, we free it. - */ - opal_convertor_t convertor; - unsigned char packed_data[2048]; - struct iovec iov = { .iov_base = packed_data, .iov_len = sizeof(packed_data) }; - size_t packed_size, max_data; - uint32_t iov_count; - ompi_proc_t* proc = ompi_comm_peer_lookup(comm, dest); - if(proc == NULL) { - rc = MPI_ERR_RANK; - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - - /* initialize convertor to pack send buffer */ - OBJ_CONSTRUCT(&convertor, opal_convertor_t); - opal_convertor_copy_and_prepare_for_send( proc->super.proc_convertor, &(datatype->super), - count, buf, 0, &convertor ); - - /* setup a temporary buffer to send */ - opal_convertor_get_packed_size( &convertor, &packed_size ); - if( packed_size > sizeof(packed_data) ) { - rc = PMPI_Alloc_mem(packed_size, MPI_INFO_NULL, &iov.iov_base); - if(OMPI_SUCCESS != rc) { - rc = OMPI_ERR_OUT_OF_RESOURCE; - goto cleanup_and_return; - } - iov.iov_len = packed_size; - } - max_data = packed_size; - iov_count = 1; - (void)opal_convertor_pack(&convertor, &iov, &iov_count, &max_data); - - /* receive into the buffer */ - rc = MCA_PML_CALL(irecv(buf, count, datatype, - source, recvtag, comm, &req)); - if(OMPI_SUCCESS != rc) { - goto cleanup_and_return; - } - - /* send from the temporary buffer */ - rc = MCA_PML_CALL(send(iov.iov_base, packed_size, MPI_PACKED, dest, - sendtag, MCA_PML_BASE_SEND_STANDARD, comm)); -#if OPAL_ENABLE_FT_MPI - /* If ULFM is enabled we need to wait for the posted receive to - * complete, hence we cannot return here */ - rcs = rc; -#else - if(OMPI_SUCCESS != rc) { - goto cleanup_and_return; - } -#endif /* OPAL_ENABLE_FT_MPI */ - - rc = ompi_request_wait(&req, status); -#if OPAL_ENABLE_FT_MPI - /* Sendrecv_replace never returns ERR_PROC_FAILED_PENDING because it is - * blocking. Lets complete now that irecv and promote the error - * to ERR_PROC_FAILED */ - if( OPAL_UNLIKELY(MPI_ERR_PROC_FAILED_PENDING == rc) ) { - ompi_request_cancel(req); - ompi_request_wait(&req, MPI_STATUS_IGNORE); - rc = MPI_ERR_PROC_FAILED; - } -#endif - -#if OPAL_ENABLE_FT_MPI - if( OPAL_UNLIKELY(MPI_SUCCESS != rcs && MPI_SUCCESS == rc) ) { - rc = rcs; - } -#endif - - cleanup_and_return: - - /* release resources */ - if(packed_size > sizeof(packed_data)) { - PMPI_Free_mem(iov.iov_base); - } - OBJ_DESTRUCT(&convertor); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/sendrecv_replace.c.in b/ompi/mpi/c/sendrecv_replace.c.in new file mode 100644 index 00000000000..76aadb3ab30 --- /dev/null +++ b/ompi/mpi/c/sendrecv_replace.c.in @@ -0,0 +1,174 @@ +/* + * 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) 2010-2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/proc/proc.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS sendrecv_replace(BUFFER_OUT buf, COUNT count, DATATYPE datatype, + INT dest, INT sendtag, INT source, INT recvtag, + COMM comm, STATUS_OUT status) +{ + ompi_request_t* req; + int rc = MPI_SUCCESS; +#if OPAL_ENABLE_FT_MPI + int rcs = MPI_SUCCESS; +#endif + + SPC_RECORD(OMPI_SPC_SENDRECV_REPLACE, 1); + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, datatype); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, count); + + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (dest != MPI_PROC_NULL && ompi_comm_peer_invalid(comm, dest)) { + rc = MPI_ERR_RANK; + } else if (sendtag < 0 || sendtag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (source != MPI_PROC_NULL && source != MPI_ANY_SOURCE && ompi_comm_peer_invalid(comm, source)) { + rc = MPI_ERR_RANK; + } else if (((recvtag < 0) && (recvtag != MPI_ANY_TAG)) || (recvtag > mca_pml.pml_max_tag)) { + rc = MPI_ERR_TAG; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The final call to Sendrecv will check for process failures inside + * So no need to check here. + */ +#endif /* OPAL_ENABLE_FT_MPI */ + + /* simple case */ + if ( source == MPI_PROC_NULL || dest == MPI_PROC_NULL || count == 0 ) { + rc = PMPI_Sendrecv(buf, count, datatype, dest, sendtag, buf, count, datatype, source, recvtag, comm, status); + + return rc; + } + + /** + * If we look for an optimal solution, then we should receive the data into a temporary buffer + * and once the send completes we would unpack back into the original buffer. However, if the + * sender is unknown, this approach can only be implementing by receiving with the recv datatype + * (potentially non-contiguous) and thus the allocated memory will be larger than the size of the + * datatype. A simpler, but potentially less efficient approach is to work on the data we have + * control of, aka the sent data, and pack it into a contiguous buffer before posting the receive. + * Once the send completes, we free it. + */ + opal_convertor_t convertor; + unsigned char packed_data[2048]; + struct iovec iov = { .iov_base = packed_data, .iov_len = sizeof(packed_data) }; + size_t packed_size, max_data; + uint32_t iov_count; + ompi_proc_t* proc = ompi_comm_peer_lookup(comm, dest); + if(proc == NULL) { + rc = MPI_ERR_RANK; + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + + /* initialize convertor to pack send buffer */ + OBJ_CONSTRUCT(&convertor, opal_convertor_t); + opal_convertor_copy_and_prepare_for_send( proc->super.proc_convertor, &(datatype->super), + count, buf, 0, &convertor ); + + /* setup a temporary buffer to send */ + opal_convertor_get_packed_size( &convertor, &packed_size ); + if( packed_size > sizeof(packed_data) ) { + rc = PMPI_Alloc_mem(packed_size, MPI_INFO_NULL, &iov.iov_base); + if(OMPI_SUCCESS != rc) { + rc = OMPI_ERR_OUT_OF_RESOURCE; + goto cleanup_and_return; + } + iov.iov_len = packed_size; + } + max_data = packed_size; + iov_count = 1; + (void)opal_convertor_pack(&convertor, &iov, &iov_count, &max_data); + + /* receive into the buffer */ + rc = MCA_PML_CALL(irecv(buf, count, datatype, + source, recvtag, comm, &req)); + if(OMPI_SUCCESS != rc) { + goto cleanup_and_return; + } + + /* send from the temporary buffer */ + rc = MCA_PML_CALL(send(iov.iov_base, packed_size, MPI_PACKED, dest, + sendtag, MCA_PML_BASE_SEND_STANDARD, comm)); +#if OPAL_ENABLE_FT_MPI + /* If ULFM is enabled we need to wait for the posted receive to + * complete, hence we cannot return here */ + rcs = rc; +#else + if(OMPI_SUCCESS != rc) { + goto cleanup_and_return; + } +#endif /* OPAL_ENABLE_FT_MPI */ + + rc = ompi_request_wait(&req, status); +#if OPAL_ENABLE_FT_MPI + /* Sendrecv_replace never returns ERR_PROC_FAILED_PENDING because it is + * blocking. Lets complete now that irecv and promote the error + * to ERR_PROC_FAILED */ + if( OPAL_UNLIKELY(MPI_ERR_PROC_FAILED_PENDING == rc) ) { + ompi_request_cancel(req); + ompi_request_wait(&req, MPI_STATUS_IGNORE); + rc = MPI_ERR_PROC_FAILED; + } +#endif + +#if OPAL_ENABLE_FT_MPI + if( OPAL_UNLIKELY(MPI_SUCCESS != rcs && MPI_SUCCESS == rc) ) { + rc = rcs; + } +#endif + + cleanup_and_return: + + /* release resources */ + if(packed_size > sizeof(packed_data)) { + PMPI_Free_mem(iov.iov_base); + } + OBJ_DESTRUCT(&convertor); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_c2f.c b/ompi/mpi/c/session_c2f.c deleted file mode 100644 index 93b5d7da7f5..00000000000 --- a/ompi/mpi/c/session_c2f.c +++ /dev/null @@ -1,56 +0,0 @@ -/* -*- 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-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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include - -#include "ompi/instance/instance.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_c2f = PMPI_Session_c2f -#endif -#define MPI_Session_c2f PMPI_Session_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Session_c2f"; - - -MPI_Fint MPI_Session_c2f (MPI_Session session) -{ - - if ( MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == session) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(session->i_f_to_c_index); -} diff --git a/ompi/mpi/c/session_c2f.c.in b/ompi/mpi/c/session_c2f.c.in new file mode 100644 index 00000000000..0bb1fa2ef79 --- /dev/null +++ b/ompi/mpi/c/session_c2f.c.in @@ -0,0 +1,46 @@ +/* -*- 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-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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include + +#include "ompi/instance/instance.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE FINT session_c2f(SESSION session) +{ + + if ( MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == session) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(session->i_f_to_c_index); +} diff --git a/ompi/mpi/c/session_call_errhandler.c b/ompi/mpi/c/session_call_errhandler.c deleted file mode 100644 index 4e177da8e5e..00000000000 --- a/ompi/mpi/c/session_call_errhandler.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * 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[] __opal_attribute_unused__ = "MPI_Session_call_errhandler"; - - -int MPI_Session_call_errhandler(MPI_Session session, int errorcode) -{ - /* Error checking */ - - if (MPI_PARAM_CHECK) { - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } - } - - /* Invoke the errhandler */ - - OMPI_ERRHANDLER_INVOKE(session, errorcode, FUNC_NAME); - - return MPI_SUCCESS; -} - diff --git a/ompi/mpi/c/session_call_errhandler.c.in b/ompi/mpi/c/session_call_errhandler.c.in new file mode 100644 index 00000000000..2966e85298b --- /dev/null +++ b/ompi/mpi/c/session_call_errhandler.c.in @@ -0,0 +1,51 @@ +/* + * 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-2024 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" + +PROTOTYPE ERROR_CLASS session_call_errhandler(SESSION session, INT errorcode) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } + } + + /* Invoke the errhandler */ + + OMPI_ERRHANDLER_INVOKE(session, errorcode, FUNC_NAME); + + return MPI_SUCCESS; +} + diff --git a/ompi/mpi/c/session_create_errhandler.c b/ompi/mpi/c/session_create_errhandler.c deleted file mode 100644 index e7677d992a6..00000000000 --- a/ompi/mpi/c/session_create_errhandler.c +++ /dev/null @@ -1,52 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018-2021 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" - -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_create_errhandler = PMPI_Session_create_errhandler -#endif -#define MPI_Session_create_errhandler PMPI_Session_create_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Session_create_errhandler"; - - -int MPI_Session_create_errhandler (MPI_Session_errhandler_function *session_errhandler_fn, MPI_Errhandler *errhandler) -{ - int err = MPI_SUCCESS; - - if ( MPI_PARAM_CHECK ) { - if (NULL == errhandler || NULL == session_errhandler_fn) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* Create and cache the errhandler. Sets a refcount of 1. */ - *errhandler = - ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_INSTANCE, - (ompi_errhandler_generic_handler_fn_t *) session_errhandler_fn, - OMPI_ERRHANDLER_LANG_C); - if (NULL == *errhandler) { - err = MPI_ERR_INTERN; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_create_errhandler.c.in b/ompi/mpi/c/session_create_errhandler.c.in new file mode 100644 index 00000000000..9a4a64435be --- /dev/null +++ b/ompi/mpi/c/session_create_errhandler.c.in @@ -0,0 +1,42 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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" + +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS session_create_errhandler (SESSION_ERRHANDLER_FUNCTION session_errhandler_fn, ERRHANDLER_OUT errhandler) +{ + int err = MPI_SUCCESS; + + if ( MPI_PARAM_CHECK ) { + if (NULL == errhandler || NULL == session_errhandler_fn) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Create and cache the errhandler. Sets a refcount of 1. */ + *errhandler = + ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_INSTANCE, + (ompi_errhandler_generic_handler_fn_t *) session_errhandler_fn, + OMPI_ERRHANDLER_LANG_C); + if (NULL == *errhandler) { + err = MPI_ERR_INTERN; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_f2c.c b/ompi/mpi/c/session_f2c.c deleted file mode 100644 index cb7c0dbd914..00000000000 --- a/ompi/mpi/c/session_f2c.c +++ /dev/null @@ -1,59 +0,0 @@ -/* -*- 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-2007 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) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/instance/instance.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_f2c = PMPI_Session_f2c -#endif -#define MPI_Session_f2c PMPI_Session_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Session_f2c"; - - -MPI_Session MPI_Session_f2c(MPI_Fint session) -{ - int o_index= OMPI_FINT_2_INT(session); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - - if (0 > o_index || o_index >= opal_pointer_array_get_size(&ompi_instance_f_to_c_table)) { - return NULL; - } - - return (MPI_Session) opal_pointer_array_get_item (&ompi_instance_f_to_c_table, o_index); -} diff --git a/ompi/mpi/c/session_f2c.c.in b/ompi/mpi/c/session_f2c.c.in new file mode 100644 index 00000000000..3f5f347a7f9 --- /dev/null +++ b/ompi/mpi/c/session_f2c.c.in @@ -0,0 +1,49 @@ +/* -*- 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-2007 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) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/instance/instance.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE SESSION session_f2c(FINT session) +{ + int o_index= OMPI_FINT_2_INT(session); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + + if (0 > o_index || o_index >= opal_pointer_array_get_size(&ompi_instance_f_to_c_table)) { + return NULL; + } + + return (MPI_Session) opal_pointer_array_get_item (&ompi_instance_f_to_c_table, o_index); +} diff --git a/ompi/mpi/c/session_finalize.c b/ompi/mpi/c/session_finalize.c deleted file mode 100644 index 1c071a95865..00000000000 --- a/ompi/mpi/c/session_finalize.c +++ /dev/null @@ -1,45 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_finalize = PMPI_Session_finalize -#endif -#define MPI_Session_finalize PMPI_Session_finalize -#endif - -static const char FUNC_NAME[] = "MPI_Session_finalize"; - - -int MPI_Session_finalize (MPI_Session *session) -{ - int rc; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == session || NULL == *session || MPI_SESSION_NULL == *session) { - return MPI_ERR_ARG; - } - } - - rc = ompi_mpi_instance_finalize (session); - /* if an error occurred raise it on the null session */ - OMPI_ERRHANDLER_RETURN (rc, MPI_SESSION_NULL, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_finalize.c.in b/ompi/mpi/c/session_finalize.c.in new file mode 100644 index 00000000000..44e67abeb8e --- /dev/null +++ b/ompi/mpi/c/session_finalize.c.in @@ -0,0 +1,35 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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/memchecker.h" + +PROTOTYPE ERROR_CLASS session_finalize (SESSION_OUT session) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == session || NULL == *session || MPI_SESSION_NULL == *session) { + return MPI_ERR_ARG; + } + } + + rc = ompi_mpi_instance_finalize (session); + /* if an error occurred raise it on the null session */ + OMPI_ERRHANDLER_RETURN (rc, MPI_SESSION_NULL, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_get_errhandler.c b/ompi/mpi/c/session_get_errhandler.c deleted file mode 100644 index 73ec6a2d0d7..00000000000 --- a/ompi/mpi/c/session_get_errhandler.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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 (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, 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 */ - OMPI_ERRHANDLER_RETURN (ret, session, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_get_errhandler.c.in b/ompi/mpi/c/session_get_errhandler.c.in new file mode 100644 index 00000000000..70c9eb75ebb --- /dev/null +++ b/ompi/mpi/c/session_get_errhandler.c.in @@ -0,0 +1,63 @@ +/* -*- 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-2024 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" + +PROTOTYPE ERROR_CLASS session_get_errhandler(SESSION session, ERRHANDLER_OUT errhandler) +{ + int ret = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, 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 */ + OMPI_ERRHANDLER_RETURN (ret, session, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_get_info.c b/ompi/mpi/c/session_get_info.c deleted file mode 100644 index 2170a2ae5cf..00000000000 --- a/ompi/mpi/c/session_get_info.c +++ /dev/null @@ -1,70 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/instance/instance.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_get_info = PMPI_Session_get_info -#endif -#define MPI_Session_get_info PMPI_Session_get_info -#endif - -static const char FUNC_NAME[] = "MPI_Session_get_info"; - - -int MPI_Session_get_info (MPI_Session session, MPI_Info *info_used) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } - if (NULL == info_used) { - return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); - } - } - - if (NULL == session->super.s_info) { - /* - * Setup any defaults if MPI_Win_set_info was never called - */ - opal_infosubscribe_change_info (&session->super, &MPI_INFO_NULL->super); - } - - - *info_used = ompi_info_allocate (); - if (OPAL_UNLIKELY(NULL == *info_used)) { - return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_NO_MEM, FUNC_NAME); - } - - opal_info_t *opal_info_used = &(*info_used)->super; - - opal_info_dup (session->super.s_info, &opal_info_used); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/session_get_info.c.in b/ompi/mpi/c/session_get_info.c.in new file mode 100644 index 00000000000..3c4d743b3d8 --- /dev/null +++ b/ompi/mpi/c/session_get_info.c.in @@ -0,0 +1,60 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/instance/instance.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include +#include + +PROTOTYPE ERROR_CLASS session_get_info (SESSION session, INFO_OUT info_used) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } + if (NULL == info_used) { + return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); + } + } + + if (NULL == session->super.s_info) { + /* + * Setup any defaults if MPI_Win_set_info was never called + */ + opal_infosubscribe_change_info (&session->super, &MPI_INFO_NULL->super); + } + + + *info_used = ompi_info_allocate (); + if (OPAL_UNLIKELY(NULL == *info_used)) { + return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_NO_MEM, FUNC_NAME); + } + + opal_info_t *opal_info_used = &(*info_used)->super; + + opal_info_dup (session->super.s_info, &opal_info_used); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/session_get_nth_pset.c b/ompi/mpi/c/session_get_nth_pset.c deleted file mode 100644 index a3a986d9c73..00000000000 --- a/ompi/mpi/c/session_get_nth_pset.c +++ /dev/null @@ -1,49 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018-2020 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_nth_pset = PMPI_Session_get_nth_pset -#endif -#define MPI_Session_get_nth_pset PMPI_Session_get_nth_pset -#endif - -static const char FUNC_NAME[] = "MPI_Session_get_nth_pset"; - - -int MPI_Session_get_nth_pset (MPI_Session session, MPI_Info info, int n, int *len, char *pset_name) -{ - int rc = MPI_SUCCESS; - - if ( MPI_PARAM_CHECK ) { - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } else if ((NULL == pset_name && *len > 0) || n < 0) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_instance_get_nth_pset (session, n, len, pset_name); - - OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, - rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_get_nth_pset.c.in b/ompi/mpi/c/session_get_nth_pset.c.in new file mode 100644 index 00000000000..11d84569b15 --- /dev/null +++ b/ompi/mpi/c/session_get_nth_pset.c.in @@ -0,0 +1,39 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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" + +PROTOTYPE ERROR_CLASS session_get_nth_pset (SESSION session, INFO info, INT n, INT_OUT len, STRING_OUT pset_name) +{ + int rc = MPI_SUCCESS; + + if ( MPI_PARAM_CHECK ) { + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } else if ((NULL == pset_name && *len > 0) || n < 0) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_instance_get_nth_pset (session, n, len, pset_name); + + OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, + rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_get_num_psets.c b/ompi/mpi/c/session_get_num_psets.c deleted file mode 100644 index 638700b5a1e..00000000000 --- a/ompi/mpi/c/session_get_num_psets.c +++ /dev/null @@ -1,49 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018 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_num_psets = PMPI_Session_get_num_psets -#endif -#define MPI_Session_get_num_psets PMPI_Session_get_num_psets -#endif - -static const char FUNC_NAME[] = "MPI_Session_get_num_psets"; - - -int MPI_Session_get_num_psets (MPI_Session session, MPI_Info info, int *npset_names) -{ - int rc; - - if ( MPI_PARAM_CHECK ) { - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } else if (NULL == npset_names) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_instance_get_num_psets (session, npset_names); - - OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, - rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_get_num_psets.c.in b/ompi/mpi/c/session_get_num_psets.c.in new file mode 100644 index 00000000000..93bb265424c --- /dev/null +++ b/ompi/mpi/c/session_get_num_psets.c.in @@ -0,0 +1,39 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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" + +PROTOTYPE ERROR_CLASS session_get_num_psets (SESSION session, INFO info, INT_OUT npset_names) +{ + int rc; + + if ( MPI_PARAM_CHECK ) { + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } else if (NULL == npset_names) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_instance_get_num_psets (session, npset_names); + + OMPI_ERRHANDLER_RETURN (rc, (NULL == session) ? MPI_SESSION_NULL : session, + rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_get_pset_info.c b/ompi/mpi/c/session_get_pset_info.c deleted file mode 100644 index a05741fabcd..00000000000 --- a/ompi/mpi/c/session_get_pset_info.c +++ /dev/null @@ -1,68 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2018-2022 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/instance/instance.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_get_pset_info = PMPI_Session_get_pset_info -#endif -#define MPI_Session_get_pset_info PMPI_Session_get_pset_info -#endif - -static const char FUNC_NAME[] = "MPI_Session_get_pset_info"; - - -int MPI_Session_get_pset_info (MPI_Session session, const char *pset_name, MPI_Info *info_used) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - } - if (NULL == info_used) { - return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); - } - if (NULL == pset_name) { - return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_instance_get_pset_info (session, pset_name, (opal_info_t **) info_used); - /* - * if process set was not found, OMPI_ERR_NOT_FOUND is the return value. - * we want to map this to MPI_ERR_ARG but we have to do it manually here - * since the OMPI error to MPI error code code maps this to MPI_ERR_INTERN - */ - if (OMPI_ERR_NOT_FOUND == rc) { - rc = MPI_ERR_ARG; - } - - return OMPI_ERRHANDLER_INVOKE(session, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_get_pset_info.c.in b/ompi/mpi/c/session_get_pset_info.c.in new file mode 100644 index 00000000000..660fe91ed6d --- /dev/null +++ b/ompi/mpi/c/session_get_pset_info.c.in @@ -0,0 +1,58 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/instance/instance.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include +#include + +PROTOTYPE ERROR_CLASS session_get_pset_info (SESSION session, STRING pset_name, INFO_OUT info_used) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + } + if (NULL == info_used) { + return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); + } + if (NULL == pset_name) { + return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_instance_get_pset_info (session, pset_name, (opal_info_t **) info_used); + /* + * if process set was not found, OMPI_ERR_NOT_FOUND is the return value. + * we want to map this to MPI_ERR_ARG but we have to do it manually here + * since the OMPI error to MPI error code code maps this to MPI_ERR_INTERN + */ + if (OMPI_ERR_NOT_FOUND == rc) { + rc = MPI_ERR_ARG; + } + + return OMPI_ERRHANDLER_INVOKE(session, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_init.c b/ompi/mpi/c/session_init.c deleted file mode 100644 index 74c6e6f2cc3..00000000000 --- a/ompi/mpi/c/session_init.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2018-2021 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/info/info.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_init = PMPI_Session_init -#endif -#define MPI_Session_init PMPI_Session_init -#endif - -static const char FUNC_NAME[] = "MPI_Session_init"; - - -int MPI_Session_init (MPI_Info info, MPI_Errhandler errhandler, MPI_Session *session) -{ - int rc, flag; - int ts_level = MPI_THREAD_SINGLE; /* for now we default to thread single for OMPI sessions */ - opal_cstring_t *info_value; - const char ts_level_multi[] = "MPI_THREAD_MULTIPLE"; - - if ( MPI_PARAM_CHECK ) { - if (NULL == errhandler || NULL == session) { - return MPI_ERR_ARG; - } - - if (NULL == info || ompi_info_is_freed (info)) { - return MPI_ERR_INFO; - } - } - - if (MPI_INFO_NULL != info) { - (void) ompi_info_get (info, "thread_level", &info_value, &flag); - if (flag) { - if(strncmp(info_value->string, ts_level_multi, strlen(ts_level_multi)) == 0) { - ts_level = MPI_THREAD_MULTIPLE; - } - OBJ_RELEASE(info_value); - } - } - - rc = ompi_mpi_instance_init (ts_level, &info->super, errhandler, session, 0, NULL); - /* if an error occurred raise it on the null session */ - OMPI_ERRHANDLER_RETURN (rc, MPI_SESSION_NULL, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/session_init.c.in b/ompi/mpi/c/session_init.c.in new file mode 100644 index 00000000000..bcc71c7eeb4 --- /dev/null +++ b/ompi/mpi/c/session_init.c.in @@ -0,0 +1,50 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2018-2024 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/info/info.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/instance/instance.h" + +PROTOTYPE ERROR_CLASS session_init (INFO info, ERRHANDLER errhandler, SESSION_OUT session) +{ + int rc, flag; + int ts_level = MPI_THREAD_SINGLE; /* for now we default to thread single for OMPI sessions */ + opal_cstring_t *info_value; + const char ts_level_multi[] = "MPI_THREAD_MULTIPLE"; + + if ( MPI_PARAM_CHECK ) { + if (NULL == errhandler || NULL == session) { + return MPI_ERR_ARG; + } + + if (NULL == info || ompi_info_is_freed (info)) { + return MPI_ERR_INFO; + } + } + + if (MPI_INFO_NULL != info) { + (void) ompi_info_get (info, "thread_level", &info_value, &flag); + if (flag) { + if(strncmp(info_value->string, ts_level_multi, strlen(ts_level_multi)) == 0) { + ts_level = MPI_THREAD_MULTIPLE; + } + OBJ_RELEASE(info_value); + } + } + + rc = ompi_mpi_instance_init (ts_level, &info->super, errhandler, session, 0, NULL); + /* if an error occurred raise it on the null session */ + OMPI_ERRHANDLER_RETURN (rc, MPI_SESSION_NULL, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/session_set_errhandler.c b/ompi/mpi/c/session_set_errhandler.c deleted file mode 100644 index bb6c12af62c..00000000000 --- a/ompi/mpi/c/session_set_errhandler.c +++ /dev/null @@ -1,73 +0,0 @@ -/* -*- 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 (ompi_instance_invalid(session)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, 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/c/session_set_errhandler.c.in b/ompi/mpi/c/session_set_errhandler.c.in new file mode 100644 index 00000000000..a2ad8e36efe --- /dev/null +++ b/ompi/mpi/c/session_set_errhandler.c.in @@ -0,0 +1,63 @@ +/* -*- 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-2024 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" + +PROTOTYPE ERROR_CLASS session_set_errhandler(SESSION session, ERRHANDLER errhandler) +{ + MPI_Errhandler tmp; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (ompi_instance_invalid(session)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, 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/c/session_set_info.c b/ompi/mpi/c/session_set_info.c deleted file mode 100644 index 5f7bffb8528..00000000000 --- a/ompi/mpi/c/session_set_info.c +++ /dev/null @@ -1,56 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * Copyright (c) 2018 Triad National Security, LLC. All rights - * reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/instance/instance.h" -#include "ompi/errhandler/errhandler.h" -#include "opal/util/info_subscriber.h" -#include -#include - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Session_set_info = PMPI_Session_set_info -#endif -#define MPI_Session_set_info PMPI_Session_set_info -#endif - -static const char FUNC_NAME[] = "MPI_Session_set_info"; - - -int MPI_Session_set_info (MPI_Session session, MPI_Info info) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_instance_invalid(session)) { - if (NULL != session) { - return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); - } else { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); - } - - } - if (NULL == info || MPI_INFO_NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); - } - } - - opal_infosubscribe_change_info (&session->super, &info->super); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/session_set_info.c.in b/ompi/mpi/c/session_set_info.c.in new file mode 100644 index 00000000000..ba974b2f402 --- /dev/null +++ b/ompi/mpi/c/session_set_info.c.in @@ -0,0 +1,46 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018-2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/instance/instance.h" +#include "ompi/errhandler/errhandler.h" +#include "opal/util/info_subscriber.h" +#include +#include + +PROTOTYPE ERROR_CLASS session_set_info (SESSION session, INFO info) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_instance_invalid(session)) { + if (NULL != session) { + return OMPI_ERRHANDLER_INVOKE(session, MPI_ERR_SESSION, FUNC_NAME); + } else { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_SESSION, FUNC_NAME); + } + + } + if (NULL == info || MPI_INFO_NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE (session, MPI_ERR_INFO, FUNC_NAME); + } + } + + opal_infosubscribe_change_info (&session->super, &info->super); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/ssend.c b/ompi/mpi/c/ssend.c deleted file mode 100644 index 55ec1c671ab..00000000000 --- a/ompi/mpi/c/ssend.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mca/pml/pml.h" -#include "ompi/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ssend = PMPI_Ssend -#endif -#define MPI_Ssend PMPI_Ssend -#endif - -static const char FUNC_NAME[] = "MPI_Ssend"; - - -int MPI_Ssend(const void *buf, int count, MPI_Datatype type, int dest, int tag, MPI_Comm comm) -{ - int rc = MPI_SUCCESS; - - SPC_RECORD(OMPI_SPC_SSEND, 1); - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else { - OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); - OMPI_CHECK_USER_BUFFER(rc, buf, type, count); - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * An early check, so as to return early if we are communicating with - * a failed process. This is not absolutely necessary since we will - * check for this, and other, error conditions during the completion - * call in the PML. - */ - if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } -#endif - - if (MPI_PROC_NULL == dest) { - return MPI_SUCCESS; - } - - rc = MCA_PML_CALL(send(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_SYNCHRONOUS, comm)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ssend.c.in b/ompi/mpi/c/ssend.c.in new file mode 100644 index 00000000000..a5bb55d0712 --- /dev/null +++ b/ompi/mpi/c/ssend.c.in @@ -0,0 +1,90 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mca/pml/pml.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS ssend(BUFFER buf, COUNT count, DATATYPE type, INT dest, INT tag, COMM comm) +{ + int rc = MPI_SUCCESS; + + SPC_RECORD(OMPI_SPC_SSEND, 1); + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isdefined, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else { + OMPI_CHECK_DATATYPE_FOR_SEND(rc, type, count); + OMPI_CHECK_USER_BUFFER(rc, buf, type, count); + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * An early check, so as to return early if we are communicating with + * a failed process. This is not absolutely necessary since we will + * check for this, and other, error conditions during the completion + * call in the PML. + */ + if( OPAL_UNLIKELY(!ompi_comm_iface_p2p_check_proc(comm, dest, &rc)) ) { + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } +#endif + + if (MPI_PROC_NULL == dest) { + return MPI_SUCCESS; + } + + rc = MCA_PML_CALL(send(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_SYNCHRONOUS, comm)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/ssend_init.c b/ompi/mpi/c/ssend_init.c deleted file mode 100644 index 78844583200..00000000000 --- a/ompi/mpi/c/ssend_init.c +++ /dev/null @@ -1,98 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. 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/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Ssend_init = PMPI_Ssend_init -#endif -#define MPI_Ssend_init PMPI_Ssend_init -#endif - -static const char FUNC_NAME[] = "MPI_Ssend_init"; - - -int MPI_Ssend_init(const void *buf, int count, MPI_Datatype type, - int dest, int tag, MPI_Comm comm, - MPI_Request *request) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(type); - memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } else if (MPI_DATATYPE_NULL == type || NULL == type) { - rc = MPI_ERR_TYPE; - } else if (tag < 0 || tag > mca_pml.pml_max_tag) { - rc = MPI_ERR_TAG; - } else if (ompi_comm_peer_invalid(comm, dest) && - (MPI_PROC_NULL != dest)) { - rc = MPI_ERR_RANK; - } else if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - if (MPI_PROC_NULL == dest) { - rc = ompi_request_persistent_noop_create(request); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - /* - * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. - */ - rc = MCA_PML_CALL(isend_init(buf, count, type, dest, tag, - MCA_PML_BASE_SEND_SYNCHRONOUS, comm, request)); - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} - diff --git a/ompi/mpi/c/ssend_init.c.in b/ompi/mpi/c/ssend_init.c.in new file mode 100644 index 00000000000..33bc8616a16 --- /dev/null +++ b/ompi/mpi/c/ssend_init.c.in @@ -0,0 +1,90 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS ssend_init(BUFFER buf, COUNT count, DATATYPE type, + INT dest, INT tag, COMM comm, + REQUEST_INOUT request) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(type); + memchecker_call(&opal_memchecker_base_isaddressable, buf, count, type); + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, FUNC_NAME); + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } else if (MPI_DATATYPE_NULL == type || NULL == type) { + rc = MPI_ERR_TYPE; + } else if (tag < 0 || tag > mca_pml.pml_max_tag) { + rc = MPI_ERR_TAG; + } else if (ompi_comm_peer_invalid(comm, dest) && + (MPI_PROC_NULL != dest)) { + rc = MPI_ERR_RANK; + } else if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + if (MPI_PROC_NULL == dest) { + rc = ompi_request_persistent_noop_create(request); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + /* + * Here, we just initialize the request -- memchecker should set the buffer in MPI_Start. + */ + rc = MCA_PML_CALL(isend_init(buf, count, type, dest, tag, + MCA_PML_BASE_SEND_SYNCHRONOUS, comm, request)); + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} + diff --git a/ompi/mpi/c/start.c b/ompi/mpi/c/start.c deleted file mode 100644 index 5bf202385f8..00000000000 --- a/ompi/mpi/c/start.c +++ /dev/null @@ -1,106 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 FUJITSU LIMITED. All rights reserved. - * Copyright (c) 2020 Sandia National Laboratories. 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/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Start = PMPI_Start -#endif -#define MPI_Start PMPI_Start -#endif - -static const char FUNC_NAME[] = "MPI_Start"; - - -int MPI_Start(MPI_Request *request) -{ - int ret = OMPI_SUCCESS; - - MEMCHECKER( - memchecker_request(request); - ); - - if ( MPI_PARAM_CHECK ) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - /** - * Per definition of the handling of persistent request in the - * MPI standard 3.1 page 78 line 19: we must have the following - * sequence CREATE (START COMPLETE)* FREE. The upper level is - * responsible for handling any concurrency. The PML must handle - * this case, as it is the only one knowing if the request can - * be reused or not (it is PML completed or not?). - */ - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - switch((*request)->req_type) { - case OMPI_REQUEST_PML: - case OMPI_REQUEST_COLL: - case OMPI_REQUEST_PART: - if ( MPI_PARAM_CHECK && !((*request)->req_persistent && - OMPI_REQUEST_INACTIVE == (*request)->req_state)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); - } - - ret = (*request)->req_start(1, request); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); - - case OMPI_REQUEST_NOOP: - /** - * We deal with a MPI_PROC_NULL request. If the request is - * already active, fall back to the error case in the default. - * Otherwise, mark it active so we can correctly handle it in - * the wait*. - */ - if( OMPI_REQUEST_INACTIVE == (*request)->req_state ) { - (*request)->req_state = OMPI_REQUEST_ACTIVE; - return MPI_SUCCESS; - } - - default: - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); - } -} - diff --git a/ompi/mpi/c/start.c.in b/ompi/mpi/c/start.c.in new file mode 100644 index 00000000000..954724e5154 --- /dev/null +++ b/ompi/mpi/c/start.c.in @@ -0,0 +1,98 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS start(REQUEST_INOUT request) +{ + int ret = OMPI_SUCCESS; + + MEMCHECKER( + memchecker_request(request); + ); + + if ( MPI_PARAM_CHECK ) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + /** + * Per definition of the handling of persistent request in the + * MPI standard 3.1 page 78 line 19: we must have the following + * sequence CREATE (START COMPLETE)* FREE. The upper level is + * responsible for handling any concurrency. The PML must handle + * this case, as it is the only one knowing if the request can + * be reused or not (it is PML completed or not?). + */ + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + switch((*request)->req_type) { + case OMPI_REQUEST_PML: + case OMPI_REQUEST_COLL: + case OMPI_REQUEST_PART: + if ( MPI_PARAM_CHECK && !((*request)->req_persistent && + OMPI_REQUEST_INACTIVE == (*request)->req_state)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); + } + + ret = (*request)->req_start(1, request); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); + + case OMPI_REQUEST_NOOP: + /** + * We deal with a MPI_PROC_NULL request. If the request is + * already active, fall back to the error case in the default. + * Otherwise, mark it active so we can correctly handle it in + * the wait*. + */ + if( OMPI_REQUEST_INACTIVE == (*request)->req_state ) { + (*request)->req_state = OMPI_REQUEST_ACTIVE; + return MPI_SUCCESS; + } + + default: + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); + } +} + diff --git a/ompi/mpi/c/startall.c b/ompi/mpi/c/startall.c deleted file mode 100644 index a733e7586cf..00000000000 --- a/ompi/mpi/c/startall.c +++ /dev/null @@ -1,122 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2012-2016 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017-2018 FUJITSU LIMITED. 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/mca/pml/pml.h" -#include "ompi/request/request.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Startall = PMPI_Startall -#endif -#define MPI_Startall PMPI_Startall -#endif - -static const char FUNC_NAME[] = "MPI_Startall"; - - -int MPI_Startall(int count, MPI_Request requests[]) -{ - int i, j; - int ret = OMPI_SUCCESS; - ompi_request_start_fn_t start_fn = NULL; - - MEMCHECKER( - 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) && (0 != count)) { - rc = MPI_ERR_REQUEST; - } else if (count < 0) { - rc = MPI_ERR_ARG; - } else { - for (i = 0; i < count; ++i) { - if (NULL == requests[i] || - ! requests[i]->req_persistent || - (OMPI_REQUEST_PML != requests[i]->req_type && - OMPI_REQUEST_COLL != requests[i]->req_type && - OMPI_REQUEST_PART != requests[i]->req_type && - OMPI_REQUEST_NOOP != requests[i]->req_type)) { - rc = MPI_ERR_REQUEST; - break; - } - } - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - -#if OPAL_ENABLE_FT_MPI - /* - * The request will be checked for process failure errors during the - * completion calls. So no need to check here. - */ -#endif - - for (i = 0, j = -1; i < count; ++i) { - /* Per MPI it is invalid to start an active request */ - if (OMPI_REQUEST_INACTIVE != requests[i]->req_state) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); - } - - if (OMPI_REQUEST_NOOP == requests[i]->req_type) { - /** - * We deal with a MPI_PROC_NULL request. If the request is - * already active, fall back to the error case in the default. - * Otherwise, mark it active so we can correctly handle it in - * the wait*. - */ - requests[i]->req_state = OMPI_REQUEST_ACTIVE; - } - - /* Call a req_start callback function per requests which have the - * same req_start value. */ - if (requests[i]->req_start != start_fn) { - if (NULL != start_fn && i != 0) { - start_fn(i - j, requests + j); - } - start_fn = requests[i]->req_start; - j = i; - } - } - - if (NULL != start_fn) { - start_fn(i - j, requests + j); - } - - return ret; -} - diff --git a/ompi/mpi/c/startall.c.in b/ompi/mpi/c/startall.c.in new file mode 100644 index 00000000000..d75c02debfe --- /dev/null +++ b/ompi/mpi/c/startall.c.in @@ -0,0 +1,114 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2010-2012 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2012-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017-2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mca/pml/pml.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS startall(INT count, REQUEST_INOUT requests) +{ + int i, j; + int ret = OMPI_SUCCESS; + ompi_request_start_fn_t start_fn = NULL; + + MEMCHECKER( + 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) && (0 != count)) { + rc = MPI_ERR_REQUEST; + } else if (count < 0) { + rc = MPI_ERR_ARG; + } else { + for (i = 0; i < count; ++i) { + if (NULL == requests[i] || + ! requests[i]->req_persistent || + (OMPI_REQUEST_PML != requests[i]->req_type && + OMPI_REQUEST_COLL != requests[i]->req_type && + OMPI_REQUEST_PART != requests[i]->req_type && + OMPI_REQUEST_NOOP != requests[i]->req_type)) { + rc = MPI_ERR_REQUEST; + break; + } + } + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + +#if OPAL_ENABLE_FT_MPI + /* + * The request will be checked for process failure errors during the + * completion calls. So no need to check here. + */ +#endif + + for (i = 0, j = -1; i < count; ++i) { + /* Per MPI it is invalid to start an active request */ + if (OMPI_REQUEST_INACTIVE != requests[i]->req_state) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_REQUEST, FUNC_NAME); + } + + if (OMPI_REQUEST_NOOP == requests[i]->req_type) { + /** + * We deal with a MPI_PROC_NULL request. If the request is + * already active, fall back to the error case in the default. + * Otherwise, mark it active so we can correctly handle it in + * the wait*. + */ + requests[i]->req_state = OMPI_REQUEST_ACTIVE; + } + + /* Call a req_start callback function per requests which have the + * same req_start value. */ + if (requests[i]->req_start != start_fn) { + if (NULL != start_fn && i != 0) { + start_fn(i - j, requests + j); + } + start_fn = requests[i]->req_start; + j = i; + } + } + + if (NULL != start_fn) { + start_fn(i - j, requests + j); + } + + return ret; +} + diff --git a/ompi/mpi/c/status_c2f.c b/ompi/mpi/c/status_c2f.c deleted file mode 100644 index dd0190cae66..00000000000 --- a/ompi/mpi/c/status_c2f.c +++ /dev/null @@ -1,101 +0,0 @@ -/* -*- 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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_c2f = PMPI_Status_c2f -#endif -#define MPI_Status_c2f PMPI_Status_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Status_c2f"; - - -int MPI_Status_c2f(const MPI_Status *c_status, MPI_Fint *f_status) -{ - const int *c_ints; - int i; - MEMCHECKER( - if(c_status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&c_status->MPI_ERROR, sizeof(int)); - memchecker_status(c_status); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-2:4.12.5 says that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == c_status || MPI_STATUS_IGNORE == c_status || - MPI_STATUSES_IGNORE == c_status || NULL == f_status) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - /* Note that MPI-2.2 16.3.5 states that even the hidden data in a - status must be converted (!). This is somewhat problematic - because the Fortran data is all INTEGERS while the C MPI_Status - contains a size_t. That being said, note 2 things: - - 1. The _ucount and _canceled members are never accessed from - Fortran. - 2. configure calculated a value of MPI_STATUS_SIZE to ensure - that the Fortran status is the Right size to hold the C - MPI_Status (including the size_t member). - - So for the purposes of this function, just copy over all the - data as if they were int's. This works because all OMPI - Fortran MPI API functions that take a status as an IN argument - first call MPI_Status_f2c on it before using it (in which case - we'll do the exact opposite copy, thereby rebuilding the size_t - value properly before it is accessed in C). - - Note that if sizeof(int) > sizeof(INTEGER), we're potentially - hosed anyway (i.e., even the public values in the status could - get truncated). But if sizeof(int) == sizeof(INTEGER) or - sizeof(int) < sizeof(INTEGER), everything should be kosher. */ - c_ints = (const int*)c_status; - for( i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int)); i++ ) { - f_status[i] = OMPI_INT_2_FINT(c_ints[i]); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_c2f.c.in b/ompi/mpi/c/status_c2f.c.in new file mode 100644 index 00000000000..d430bc7964f --- /dev/null +++ b/ompi/mpi/c/status_c2f.c.in @@ -0,0 +1,93 @@ +/* -*- 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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_c2f(STATUS c_status, FINT_OUT f_status) +{ + const int *c_ints; + int i; + MEMCHECKER( + if(c_status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&c_status->MPI_ERROR, sizeof(int)); + memchecker_status(c_status); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-2:4.12.5 says that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == c_status || MPI_STATUS_IGNORE == c_status || + MPI_STATUSES_IGNORE == c_status || NULL == f_status) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + /* Note that MPI-2.2 16.3.5 states that even the hidden data in a + status must be converted (!). This is somewhat problematic + because the Fortran data is all INTEGERS while the C MPI_Status + contains a size_t. That being said, note 2 things: + + 1. The _ucount and _canceled members are never accessed from + Fortran. + 2. configure calculated a value of MPI_STATUS_SIZE to ensure + that the Fortran status is the Right size to hold the C + MPI_Status (including the size_t member). + + So for the purposes of this function, just copy over all the + data as if they were int's. This works because all OMPI + Fortran MPI API functions that take a status as an IN argument + first call MPI_Status_f2c on it before using it (in which case + we'll do the exact opposite copy, thereby rebuilding the size_t + value properly before it is accessed in C). + + Note that if sizeof(int) > sizeof(INTEGER), we're potentially + hosed anyway (i.e., even the public values in the status could + get truncated). But if sizeof(int) == sizeof(INTEGER) or + sizeof(int) < sizeof(INTEGER), everything should be kosher. */ + c_ints = (const int*)c_status; + for( i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int)); i++ ) { + f_status[i] = OMPI_INT_2_FINT(c_ints[i]); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_c2f08.c b/ompi/mpi/c/status_c2f08.c deleted file mode 100644 index c5b5dd335b7..00000000000 --- a/ompi/mpi/c/status_c2f08.c +++ /dev/null @@ -1,85 +0,0 @@ -/* -*- 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-2005 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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). 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/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_c2f08 = PMPI_Status_c2f08 -#endif -#define MPI_Status_c2f08 PMPI_Status_c2f08 -#endif - -static const char FUNC_NAME[] = "MPI_Status_c2f08"; - - -int MPI_Status_c2f08(const MPI_Status *c_status, MPI_F08_status *f08_status) -{ - const int *c_ints; - MEMCHECKER( - if(c_status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&c_status->MPI_ERROR, sizeof(int)); - memchecker_status(c_status); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-4:18.2.5 implies that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == c_status || MPI_STATUS_IGNORE == c_status || - MPI_STATUSES_IGNORE == c_status || NULL == f08_status) { - return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - /* ***NOTE*** See huge comment in status_c2f.c (yes, I know - there's a size_t member in the C MPI_Status -- go - read that comment for an explanation why copying - everything as a bunch of int's is ok). */ - f08_status->MPI_SOURCE = OMPI_INT_2_FINT(c_status->MPI_SOURCE); - f08_status->MPI_TAG = OMPI_INT_2_FINT(c_status->MPI_TAG); - f08_status->MPI_ERROR = OMPI_INT_2_FINT(c_status->MPI_ERROR); - c_ints = (const int *)c_status + 3; - for(int i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int) - 3); i++ ) { - f08_status->internal[i] = OMPI_INT_2_FINT(c_ints[i]); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_c2f08.c.in b/ompi/mpi/c/status_c2f08.c.in new file mode 100644 index 00000000000..74919c4b1d7 --- /dev/null +++ b/ompi/mpi/c/status_c2f08.c.in @@ -0,0 +1,77 @@ +/* -*- 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-2005 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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_c2f08(STATUS c_status, F08_STATUS_OUT f08_status) +{ + const int *c_ints; + MEMCHECKER( + if(c_status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&c_status->MPI_ERROR, sizeof(int)); + memchecker_status(c_status); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-4:18.2.5 implies that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == c_status || MPI_STATUS_IGNORE == c_status || + MPI_STATUSES_IGNORE == c_status || NULL == f08_status) { + return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + /* ***NOTE*** See huge comment in status_c2f.c (yes, I know + there's a size_t member in the C MPI_Status -- go + read that comment for an explanation why copying + everything as a bunch of int's is ok). */ + f08_status->MPI_SOURCE = OMPI_INT_2_FINT(c_status->MPI_SOURCE); + f08_status->MPI_TAG = OMPI_INT_2_FINT(c_status->MPI_TAG); + f08_status->MPI_ERROR = OMPI_INT_2_FINT(c_status->MPI_ERROR); + c_ints = (const int *)c_status + 3; + for(int i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int) - 3); i++ ) { + f08_status->internal[i] = OMPI_INT_2_FINT(c_ints[i]); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_f082c.c b/ompi/mpi/c/status_f082c.c deleted file mode 100644 index 0134b698f78..00000000000 --- a/ompi/mpi/c/status_f082c.c +++ /dev/null @@ -1,84 +0,0 @@ -/* -*- 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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_f082c = PMPI_Status_f082c -#endif -#define MPI_Status_f082c PMPI_Status_f082c -#endif - -static const char FUNC_NAME[] = "MPI_Status_f082c"; - - -int MPI_Status_f082c(const MPI_F08_status *f08_status, MPI_Status *c_status) -{ - int *c_ints; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-4:18.2.5 implies that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == f08_status || -#if OMPI_BUILD_FORTRAN_BINDINGS - /* This section is #if'ed out if we are not building the - fortran bindings because these macros check values - against constants that only exist if the fortran - bindings exist. */ - OMPI_IS_FORTRAN_STATUS_IGNORE(f08_status) || - OMPI_IS_FORTRAN_STATUSES_IGNORE(f08_status) || -#endif - NULL == c_status) { - return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - /* ***NOTE*** See huge comment in status_c2f.c (yes, I know - there's a size_t member in the C MPI_Status -- go - read that comment for an explanation why copying - everything as a bunch of int's is ok). - - We can't use OMPI_FINT_2_INT here because of some complications - with include files. :-( So just do the casting manually. */ - c_status->MPI_SOURCE = (int)f08_status->MPI_SOURCE; - c_status->MPI_TAG = (int)f08_status->MPI_TAG; - c_status->MPI_ERROR = (int)f08_status->MPI_ERROR; - c_ints = (int *)c_status + 3; - for(int i=0; i < (int)(sizeof(MPI_Status) / sizeof(int) - 3); i++) { - c_ints[i] = (int)f08_status->internal[i]; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_f082c.c.in b/ompi/mpi/c/status_f082c.c.in new file mode 100644 index 00000000000..dc7920a4e13 --- /dev/null +++ b/ompi/mpi/c/status_f082c.c.in @@ -0,0 +1,76 @@ +/* -*- 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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" + +PROTOTYPE ERROR_CLASS status_f082c(F08_STATUS f08_status, STATUS_OUT c_status) +{ + int *c_ints; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-4:18.2.5 implies that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == f08_status || +#if OMPI_BUILD_FORTRAN_BINDINGS + /* This section is #if'ed out if we are not building the + fortran bindings because these macros check values + against constants that only exist if the fortran + bindings exist. */ + OMPI_IS_FORTRAN_STATUS_IGNORE(f08_status) || + OMPI_IS_FORTRAN_STATUSES_IGNORE(f08_status) || +#endif + NULL == c_status) { + return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + /* ***NOTE*** See huge comment in status_c2f.c (yes, I know + there's a size_t member in the C MPI_Status -- go + read that comment for an explanation why copying + everything as a bunch of int's is ok). + + We can't use OMPI_FINT_2_INT here because of some complications + with include files. :-( So just do the casting manually. */ + c_status->MPI_SOURCE = (int)f08_status->MPI_SOURCE; + c_status->MPI_TAG = (int)f08_status->MPI_TAG; + c_status->MPI_ERROR = (int)f08_status->MPI_ERROR; + c_ints = (int *)c_status + 3; + for(int i=0; i < (int)(sizeof(MPI_Status) / sizeof(int) - 3); i++) { + c_ints[i] = (int)f08_status->internal[i]; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_f082f.c b/ompi/mpi/c/status_f082f.c deleted file mode 100644 index 0abc1762b39..00000000000 --- a/ompi/mpi/c/status_f082f.c +++ /dev/null @@ -1,69 +0,0 @@ -/* -*- 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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_f082f = PMPI_Status_f082f -#endif -#define MPI_Status_f082f PMPI_Status_f082f -#endif - -static const char FUNC_NAME[] = "MPI_Status_f082f"; - - -int MPI_Status_f082f(const MPI_F08_status *f08_status, MPI_Fint *f_status) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-2:4.12.5 says that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == f08_status || -#if OMPI_BUILD_FORTRAN_BINDINGS - /* This section is #if'ed out if we are not building the - fortran bindings because these macros check values - against constants that only exist if the fortran - bindings exist. */ - OMPI_IS_FORTRAN_STATUS_IGNORE(f08_status) || - OMPI_IS_FORTRAN_STATUSES_IGNORE(f08_status) || -#endif - NULL == f_status) { - return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - memcpy(f_status, f08_status, OMPI_FORTRAN_STATUS_SIZE * sizeof(MPI_Fint)); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_f082f.c.in b/ompi/mpi/c/status_f082f.c.in new file mode 100644 index 00000000000..39ff75516c1 --- /dev/null +++ b/ompi/mpi/c/status_f082f.c.in @@ -0,0 +1,61 @@ +/* -*- 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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" + +PROTOTYPE ERROR_CLASS status_f082f(F08_STATUS f08_status, FINT_OUT f_status) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-2:4.12.5 says that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == f08_status || +#if OMPI_BUILD_FORTRAN_BINDINGS + /* This section is #if'ed out if we are not building the + fortran bindings because these macros check values + against constants that only exist if the fortran + bindings exist. */ + OMPI_IS_FORTRAN_STATUS_IGNORE(f08_status) || + OMPI_IS_FORTRAN_STATUSES_IGNORE(f08_status) || +#endif + NULL == f_status) { + return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + memcpy(f_status, f08_status, OMPI_FORTRAN_STATUS_SIZE * sizeof(MPI_Fint)); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_f2c.c b/ompi/mpi/c/status_f2c.c deleted file mode 100644 index 32fa39b86e9..00000000000 --- a/ompi/mpi/c/status_f2c.c +++ /dev/null @@ -1,81 +0,0 @@ -/* -*- 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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_f2c = PMPI_Status_f2c -#endif -#define MPI_Status_f2c PMPI_Status_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Status_f2c"; - - -int MPI_Status_f2c(const MPI_Fint *f_status, MPI_Status *c_status) -{ - int i, *c_ints; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-2:4.12.5 says that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == f_status || -#if OMPI_BUILD_FORTRAN_BINDINGS - /* This section is #if'ed out if we are not building the - fortran bindings because these macros check values - against constants that only exist if the fortran - bindings exist. */ - OMPI_IS_FORTRAN_STATUS_IGNORE(f_status) || - OMPI_IS_FORTRAN_STATUSES_IGNORE(f_status) || -#endif - NULL == c_status) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - /* ***NOTE*** See huge comment in status_c2f.c (yes, I know - there's a size_t member in the C MPI_Status -- go - read that comment for an explanation why copying - everything as a bunch of int's is ok). - - We can't use OMPI_FINT_2_INT here because of some complications - with include files. :-( So just do the casting manually. */ - c_ints = (int*)c_status; - for( i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int)); i++ ) { - c_ints[i] = (int)f_status[i]; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_f2c.c.in b/ompi/mpi/c/status_f2c.c.in new file mode 100644 index 00000000000..3216193e3e9 --- /dev/null +++ b/ompi/mpi/c/status_f2c.c.in @@ -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-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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" + +PROTOTYPE ERROR_CLASS status_f2c(FINT_CONST f_status, STATUS_OUT c_status) +{ + int i, *c_ints; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-2:4.12.5 says that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == f_status || +#if OMPI_BUILD_FORTRAN_BINDINGS + /* This section is #if'ed out if we are not building the + fortran bindings because these macros check values + against constants that only exist if the fortran + bindings exist. */ + OMPI_IS_FORTRAN_STATUS_IGNORE(f_status) || + OMPI_IS_FORTRAN_STATUSES_IGNORE(f_status) || +#endif + NULL == c_status) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + /* ***NOTE*** See huge comment in status_c2f.c (yes, I know + there's a size_t member in the C MPI_Status -- go + read that comment for an explanation why copying + everything as a bunch of int's is ok). + + We can't use OMPI_FINT_2_INT here because of some complications + with include files. :-( So just do the casting manually. */ + c_ints = (int*)c_status; + for( i = 0; i < (int)(sizeof(MPI_Status) / sizeof(int)); i++ ) { + c_ints[i] = (int)f_status[i]; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_f2f08.c b/ompi/mpi/c/status_f2f08.c deleted file mode 100644 index 3c7c31df312..00000000000 --- a/ompi/mpi/c/status_f2f08.c +++ /dev/null @@ -1,71 +0,0 @@ -/* -*- 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-2005 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) 2010-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2020 Research Organization for Information Science - * and Technology (RIST). 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/mpi/fortran/base/fint_2_int.h" -#include "ompi/mpi/fortran/base/constants.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_f2f08 = PMPI_Status_f2f08 -#endif -#define MPI_Status_f2f08 PMPI_Status_f2f08 -#endif - -static const char FUNC_NAME[] = "MPI_Status_f2f08"; - - -int MPI_Status_f2f08(const MPI_Fint *f_status, MPI_F08_status *f08_status) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* MPI-2:4.12.5 says that if you pass in - MPI_STATUS[ES]_IGNORE, it's erroneous */ - - if (NULL == f_status || -#if OMPI_BUILD_FORTRAN_BINDINGS - /* This section is #if'ed out if we are not building the - fortran bindings because these macros check values - against constants that only exist if the fortran - bindings exist. */ - OMPI_IS_FORTRAN_STATUS_IGNORE(f_status) || - OMPI_IS_FORTRAN_STATUSES_IGNORE(f_status) || -#endif - NULL == f08_status) { - return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, - MPI_ERR_IN_STATUS, FUNC_NAME); - } - } - - memcpy(f08_status, f_status, OMPI_FORTRAN_STATUS_SIZE*sizeof(MPI_Fint)); - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_f2f08.c.in b/ompi/mpi/c/status_f2f08.c.in new file mode 100644 index 00000000000..5bc1972e958 --- /dev/null +++ b/ompi/mpi/c/status_f2f08.c.in @@ -0,0 +1,63 @@ +/* -*- 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-2005 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) 2010-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2020 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/mpi/fortran/base/constants.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_f2f08(FINT_CONST f_status, F08_STATUS_OUT f08_status) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* MPI-2:4.12.5 says that if you pass in + MPI_STATUS[ES]_IGNORE, it's erroneous */ + + if (NULL == f_status || +#if OMPI_BUILD_FORTRAN_BINDINGS + /* This section is #if'ed out if we are not building the + fortran bindings because these macros check values + against constants that only exist if the fortran + bindings exist. */ + OMPI_IS_FORTRAN_STATUS_IGNORE(f_status) || + OMPI_IS_FORTRAN_STATUSES_IGNORE(f_status) || +#endif + NULL == f08_status) { + return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, + MPI_ERR_IN_STATUS, FUNC_NAME); + } + } + + memcpy(f08_status, f_status, OMPI_FORTRAN_STATUS_SIZE*sizeof(MPI_Fint)); + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_get_error.c b/ompi/mpi/c/status_get_error.c deleted file mode 100644 index b8a036a6dc9..00000000000 --- a/ompi/mpi/c/status_get_error.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_get_error = PMPI_Status_get_error -#endif -#define MPI_Status_get_error PMPI_Status_get_error -#endif - -static const char FUNC_NAME[] = "MPI_Status_get_error"; - - -int MPI_Status_get_error(const MPI_Status *status, int *error) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - if (NULL == error) { - rc = MPI_ERR_ARG; - } - - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - *error = status->MPI_ERROR; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_get_error.c.in b/ompi/mpi/c/status_get_error.c.in new file mode 100644 index 00000000000..9f5e95e6c27 --- /dev/null +++ b/ompi/mpi/c/status_get_error.c.in @@ -0,0 +1,52 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_get_error(STATUS status, INT_OUT error) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + if (NULL == error) { + rc = MPI_ERR_ARG; + } + + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + *error = status->MPI_ERROR; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_get_source.c b/ompi/mpi/c/status_get_source.c deleted file mode 100644 index 9c4e964966f..00000000000 --- a/ompi/mpi/c/status_get_source.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_get_source = PMPI_Status_get_source -#endif -#define MPI_Status_get_source PMPI_Status_get_source -#endif - -static const char FUNC_NAME[] = "MPI_Status_get_source"; - - -int MPI_Status_get_source(const MPI_Status *status, int *source) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - if (NULL == source) { - rc = MPI_ERR_ARG; - } - - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - *source = status->MPI_SOURCE; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_get_source.c.in b/ompi/mpi/c/status_get_source.c.in new file mode 100644 index 00000000000..a982b960cbc --- /dev/null +++ b/ompi/mpi/c/status_get_source.c.in @@ -0,0 +1,52 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_get_source(STATUS status, INT_OUT source) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + if (NULL == source) { + rc = MPI_ERR_ARG; + } + + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + *source = status->MPI_SOURCE; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_get_tag.c b/ompi/mpi/c/status_get_tag.c deleted file mode 100644 index 86ce2d5982b..00000000000 --- a/ompi/mpi/c/status_get_tag.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include -#include - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_get_tag = PMPI_Status_get_tag -#endif -#define MPI_Status_get_tag PMPI_Status_get_tag -#endif - -static const char FUNC_NAME[] = "MPI_Status_get_tag"; - - -int MPI_Status_get_tag(const MPI_Status *status, int *tag) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - if (status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - if (NULL == tag) { - rc = MPI_ERR_ARG; - } - - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - *tag = status->MPI_TAG; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_get_tag.c.in b/ompi/mpi/c/status_get_tag.c.in new file mode 100644 index 00000000000..b953cee1878 --- /dev/null +++ b/ompi/mpi/c/status_get_tag.c.in @@ -0,0 +1,54 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 Triad National Security, LLC. All rights + * reserved. + * + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include +#include + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + + +PROTOTYPE ERROR_CLASS status_get_tag(STATUS status, INT_OUT tag) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + if (status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined((void*)&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + if (NULL == tag) { + rc = MPI_ERR_ARG; + } + + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + *tag = status->MPI_TAG; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_cancelled.c b/ompi/mpi/c/status_set_cancelled.c deleted file mode 100644 index 1c6cb835e9e..00000000000 --- a/ompi/mpi/c/status_set_cancelled.c +++ /dev/null @@ -1,65 +0,0 @@ -/* - * 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$ - * - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_cancelled = PMPI_Status_set_cancelled -#endif -#define MPI_Status_set_cancelled PMPI_Status_set_cancelled -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_cancelled"; - - -int MPI_Status_set_cancelled(MPI_Status *status, int flag) -{ - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - status->_cancelled = flag; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_cancelled.c.in b/ompi/mpi/c/status_set_cancelled.c.in new file mode 100644 index 00000000000..3c47560527c --- /dev/null +++ b/ompi/mpi/c/status_set_cancelled.c.in @@ -0,0 +1,57 @@ +/* + * 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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_cancelled(STATUS_OUT status, INT flag) +{ + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + status->_cancelled = flag; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_elements.c b/ompi/mpi/c/status_set_elements.c deleted file mode 100644 index 34c8888bc81..00000000000 --- a/ompi/mpi/c/status_set_elements.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_elements = PMPI_Status_set_elements -#endif -#define MPI_Status_set_elements PMPI_Status_set_elements -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_elements"; - -int MPI_Status_set_elements(MPI_Status *status, MPI_Datatype datatype, int count) -{ - int rc = MPI_SUCCESS; - size_t size; - - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status (status); - memchecker_datatype(datatype); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - rc = MPI_ERR_TYPE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - /* ROMIO calls MPI_STATUS_SET_ELEMENTS with IGNORE values, so we - need to allow it. Blah! */ - if (MPI_STATUS_IGNORE == status || MPI_STATUSES_IGNORE == status) { - return MPI_SUCCESS; - } - - if( ompi_datatype_is_predefined(datatype) ) { - ompi_datatype_type_size( datatype, &size ); - status->_ucount = count * size; - } else { - ompi_datatype_set_element_count( datatype, count, &size ); - status->_ucount = size; - } - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_elements.c.in b/ompi/mpi/c/status_set_elements.c.in new file mode 100644 index 00000000000..953a7aef7d0 --- /dev/null +++ b/ompi/mpi/c/status_set_elements.c.in @@ -0,0 +1,76 @@ +/* + * 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_elements(STATUS_OUT status, DATATYPE datatype, COUNT count) +{ + int rc = MPI_SUCCESS; + size_t size; + + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status (status); + memchecker_datatype(datatype); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + rc = MPI_ERR_TYPE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + /* ROMIO calls MPI_STATUS_SET_ELEMENTS with IGNORE values, so we + need to allow it. Blah! */ + if (MPI_STATUS_IGNORE == status || MPI_STATUSES_IGNORE == status) { + return MPI_SUCCESS; + } + + if( ompi_datatype_is_predefined(datatype) ) { + ompi_datatype_type_size( datatype, &size ); + status->_ucount = count * size; + } else { + ompi_datatype_set_element_count( datatype, count, &size ); + status->_ucount = size; + } + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_elements_x.c b/ompi/mpi/c/status_set_elements_x.c deleted file mode 100644 index 8d7d4656718..00000000000 --- a/ompi/mpi/c/status_set_elements_x.c +++ /dev/null @@ -1,84 +0,0 @@ -/* - * 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_elements_x = PMPI_Status_set_elements_x -#endif -#define MPI_Status_set_elements_x PMPI_Status_set_elements_x -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_elements_x"; - -int MPI_Status_set_elements_x(MPI_Status *status, MPI_Datatype datatype, MPI_Count count) -{ - int rc = MPI_SUCCESS; - size_t size; - - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status (status); - memchecker_datatype(datatype); - } - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - rc = MPI_ERR_TYPE; - } else if (count < 0) { - rc = MPI_ERR_COUNT; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - /* ROMIO calls MPI_STATUS_SET_ELEMENTS with IGNORE values, so we - need to allow it. Blah! */ - if (MPI_STATUS_IGNORE == status || MPI_STATUSES_IGNORE == status) { - return MPI_SUCCESS; - } - - if( ompi_datatype_is_predefined(datatype) ) { - ompi_datatype_type_size( datatype, &size ); - status->_ucount = count * size; - } else { - ompi_datatype_set_element_count( datatype, count, &size ); - status->_ucount = size; - } - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_elements_x.c.in b/ompi/mpi/c/status_set_elements_x.c.in new file mode 100644 index 00000000000..c24b24f9c55 --- /dev/null +++ b/ompi/mpi/c/status_set_elements_x.c.in @@ -0,0 +1,76 @@ +/* + * 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_elements_x(STATUS_OUT status, DATATYPE datatype, PARTITIONED_COUNT count) +{ + int rc = MPI_SUCCESS; + size_t size; + + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status (status); + memchecker_datatype(datatype); + } + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + rc = MPI_ERR_TYPE; + } else if (count < 0) { + rc = MPI_ERR_COUNT; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + /* ROMIO calls MPI_STATUS_SET_ELEMENTS with IGNORE values, so we + need to allow it. Blah! */ + if (MPI_STATUS_IGNORE == status || MPI_STATUSES_IGNORE == status) { + return MPI_SUCCESS; + } + + if( ompi_datatype_is_predefined(datatype) ) { + ompi_datatype_type_size( datatype, &size ); + status->_ucount = count * size; + } else { + ompi_datatype_set_element_count( datatype, count, &size ); + status->_ucount = size; + } + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_error.c b/ompi/mpi/c/status_set_error.c deleted file mode 100644 index b2bd6c4e09b..00000000000 --- a/ompi/mpi/c/status_set_error.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_error = PMPI_Status_set_error -#endif -#define MPI_Status_set_error PMPI_Status_set_error -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_error"; - - -int MPI_Status_set_error(MPI_Status *status, int error) -{ - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - status->MPI_ERROR = error; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_error.c.in b/ompi/mpi/c/status_set_error.c.in new file mode 100644 index 00000000000..30a667cd5a5 --- /dev/null +++ b/ompi/mpi/c/status_set_error.c.in @@ -0,0 +1,46 @@ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_error(STATUS_OUT status, INT error) +{ + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + status->MPI_ERROR = error; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_source.c b/ompi/mpi/c/status_set_source.c deleted file mode 100644 index 8d02cb34d0a..00000000000 --- a/ompi/mpi/c/status_set_source.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_source = PMPI_Status_set_source -#endif -#define MPI_Status_set_source PMPI_Status_set_source -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_source"; - - -int MPI_Status_set_source(MPI_Status *status, int source) -{ - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - status->MPI_SOURCE = source; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_source.c.in b/ompi/mpi/c/status_set_source.c.in new file mode 100644 index 00000000000..46e1959bb85 --- /dev/null +++ b/ompi/mpi/c/status_set_source.c.in @@ -0,0 +1,46 @@ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_source(STATUS_OUT status, INT source) +{ + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + status->MPI_SOURCE = source; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/status_set_tag.c b/ompi/mpi/c/status_set_tag.c deleted file mode 100644 index f357c9a754b..00000000000 --- a/ompi/mpi/c/status_set_tag.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Status_set_tag = PMPI_Status_set_tag -#endif -#define MPI_Status_set_tag PMPI_Status_set_tag -#endif - -static const char FUNC_NAME[] = "MPI_Status_set_tag"; - - -int MPI_Status_set_tag(MPI_Status *status, int tag) -{ - MEMCHECKER( - if(status != MPI_STATUSES_IGNORE) { - /* - * Before checking the complete status, we need to reset the definedness - * of the MPI_ERROR-field (single-completion calls wait/test). - */ - opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); - memchecker_status(status); - } - ); - - if (MPI_PARAM_CHECK) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == status || - MPI_STATUS_IGNORE == status || - MPI_STATUSES_IGNORE == status) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - status->MPI_TAG = tag; - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/status_set_tag.c.in b/ompi/mpi/c/status_set_tag.c.in new file mode 100644 index 00000000000..2a85c3cb62f --- /dev/null +++ b/ompi/mpi/c/status_set_tag.c.in @@ -0,0 +1,47 @@ +/* + * Copyright (c) 2025 Advanced Micro Devices, Inc. All rights reserved. + * Copyright (c) 2025 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS status_set_tag(STATUS_OUT status, INT tag) +{ + MEMCHECKER( + if(status != MPI_STATUSES_IGNORE) { + /* + * Before checking the complete status, we need to reset the definedness + * of the MPI_ERROR-field (single-completion calls wait/test). + */ + opal_memchecker_base_mem_defined(&status->MPI_ERROR, sizeof(int)); + memchecker_status(status); + } + ); + + if (MPI_PARAM_CHECK) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == status || + MPI_STATUS_IGNORE == status || + MPI_STATUSES_IGNORE == status) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + status->MPI_TAG = tag; + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/test.c b/ompi/mpi/c/test.c deleted file mode 100644 index 795843da21f..00000000000 --- a/ompi/mpi/c/test.c +++ /dev/null @@ -1,76 +0,0 @@ -/* - * 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) 2006 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 - -#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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Test = PMPI_Test -#endif -#define MPI_Test PMPI_Test -#endif - -static const char FUNC_NAME[] = "MPI_Test"; - - -int MPI_Test(MPI_Request *request, int *completed, MPI_Status *status) -{ - int rc; - - SPC_RECORD(OMPI_SPC_TEST, 1); - - MEMCHECKER( - memchecker_request (request); - ); - - if ( MPI_PARAM_CHECK ) { - rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (request == NULL) { - rc = MPI_ERR_REQUEST; - } else if (completed == NULL) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - rc = ompi_request_test(request, completed, status); - if (*completed < 0) { - *completed = 0; - } - - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - - if (OMPI_SUCCESS == rc) { - return MPI_SUCCESS; - } - return ompi_errhandler_request_invoke(1, request, FUNC_NAME); -} diff --git a/ompi/mpi/c/test.c.in b/ompi/mpi/c/test.c.in new file mode 100644 index 00000000000..a44ac730458 --- /dev/null +++ b/ompi/mpi/c/test.c.in @@ -0,0 +1,68 @@ +/* + * 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) 2006 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$ + * + * 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS test(REQUEST_INOUT request, INT_OUT completed, STATUS_OUT status) +{ + int rc; + + SPC_RECORD(OMPI_SPC_TEST, 1); + + MEMCHECKER( + memchecker_request (request); + ); + + if ( MPI_PARAM_CHECK ) { + rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (request == NULL) { + rc = MPI_ERR_REQUEST; + } else if (completed == NULL) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + rc = ompi_request_test(request, completed, status); + if (*completed < 0) { + *completed = 0; + } + + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + + if (OMPI_SUCCESS == rc) { + return MPI_SUCCESS; + } + return ompi_errhandler_request_invoke(1, request, FUNC_NAME); +} diff --git a/ompi/mpi/c/test_cancelled.c b/ompi/mpi/c/test_cancelled.c deleted file mode 100644 index bc13ade2b3b..00000000000 --- a/ompi/mpi/c/test_cancelled.c +++ /dev/null @@ -1,61 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Test_cancelled = PMPI_Test_cancelled -#endif -#define MPI_Test_cancelled PMPI_Test_cancelled -#endif - -static const char FUNC_NAME[] = "MPI_Test_cancelled"; - - -int MPI_Test_cancelled(const MPI_Status *status, int *flag) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER ( - if(status != MPI_STATUSES_IGNORE) - memchecker_status(status); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == flag || NULL == status) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - *flag = status->_cancelled; - return rc; -} - diff --git a/ompi/mpi/c/test_cancelled.c.in b/ompi/mpi/c/test_cancelled.c.in new file mode 100644 index 00000000000..aa52f937d5f --- /dev/null +++ b/ompi/mpi/c/test_cancelled.c.in @@ -0,0 +1,53 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS test_cancelled(STATUS status, INT_OUT flag) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER ( + if(status != MPI_STATUSES_IGNORE) + memchecker_status(status); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == flag || NULL == status) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + *flag = status->_cancelled; + return rc; +} + diff --git a/ompi/mpi/c/testall.c b/ompi/mpi/c/testall.c deleted file mode 100644 index 4eac940b257..00000000000 --- a/ompi/mpi/c/testall.c +++ /dev/null @@ -1,92 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Testall = PMPI_Testall -#endif -#define MPI_Testall PMPI_Testall -#endif - -static const char FUNC_NAME[] = "MPI_Testall"; - - -int MPI_Testall(int count, MPI_Request requests[], int *flag, - MPI_Status statuses[]) -{ - SPC_RECORD(OMPI_SPC_TESTALL, 1); - - 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) && (0 != count) ) { - 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; - } - - if (OMPI_SUCCESS == ompi_request_test_all(count, requests, flag, - statuses)) { - return MPI_SUCCESS; - } - - if (MPI_SUCCESS != - ompi_errhandler_request_invoke(count, requests, FUNC_NAME)) { - return MPI_ERR_IN_STATUS; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/testall.c.in b/ompi/mpi/c/testall.c.in new file mode 100644 index 00000000000..c1ba8e9e21e --- /dev/null +++ b/ompi/mpi/c/testall.c.in @@ -0,0 +1,82 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS testall(INT count, REQUEST_INOUT requests, INT_OUT flag, + STATUS_OUT statuses) +{ + SPC_RECORD(OMPI_SPC_TESTALL, 1); + + 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) && (0 != count) ) { + 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; + } + + if (OMPI_SUCCESS == ompi_request_test_all(count, requests, flag, + statuses)) { + return MPI_SUCCESS; + } + + if (MPI_SUCCESS != + ompi_errhandler_request_invoke(count, requests, FUNC_NAME)) { + return MPI_ERR_IN_STATUS; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/testany.c b/ompi/mpi/c/testany.c deleted file mode 100644 index 8a70002d495..00000000000 --- a/ompi/mpi/c/testany.c +++ /dev/null @@ -1,91 +0,0 @@ -/* - * 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-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Testany = PMPI_Testany -#endif -#define MPI_Testany PMPI_Testany -#endif - -static const char FUNC_NAME[] = "MPI_Testany"; - - -int MPI_Testany(int count, MPI_Request requests[], int *indx, int *completed, MPI_Status *status) -{ - SPC_RECORD(OMPI_SPC_TESTANY, 1); - - 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) && (0 != count)) { - rc = MPI_ERR_REQUEST; - } else { - if(!ompi_request_check_same_instance(requests, count) ) { - rc = MPI_ERR_REQUEST; - } - } - if (((NULL == indx || NULL == completed) && count > 0) || - count < 0) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (OPAL_UNLIKELY(0 == count)) { - *completed = true; - *indx = MPI_UNDEFINED; - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_status_empty, false); - } - return MPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_test_any(count, requests, - indx, completed, status)) { - return MPI_SUCCESS; - } - - return ompi_errhandler_request_invoke(count, requests, FUNC_NAME); -} diff --git a/ompi/mpi/c/testany.c.in b/ompi/mpi/c/testany.c.in new file mode 100644 index 00000000000..50ed88b2fa5 --- /dev/null +++ b/ompi/mpi/c/testany.c.in @@ -0,0 +1,81 @@ +/* + * 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-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS testany(INT count, REQUEST_INOUT requests, INT_OUT indx, INT_OUT completed, STATUS_OUT status) +{ + SPC_RECORD(OMPI_SPC_TESTANY, 1); + + 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) && (0 != count)) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, count) ) { + rc = MPI_ERR_REQUEST; + } + } + if (((NULL == indx || NULL == completed) && count > 0) || + count < 0) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == count)) { + *completed = true; + *indx = MPI_UNDEFINED; + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + } + return MPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_test_any(count, requests, + indx, completed, status)) { + return MPI_SUCCESS; + } + + return ompi_errhandler_request_invoke(count, requests, FUNC_NAME); +} diff --git a/ompi/mpi/c/testsome.c b/ompi/mpi/c/testsome.c deleted file mode 100644 index 459335ded67..00000000000 --- a/ompi/mpi/c/testsome.c +++ /dev/null @@ -1,94 +0,0 @@ -/* - * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Testsome = PMPI_Testsome -#endif -#define MPI_Testsome PMPI_Testsome -#endif - -static const char FUNC_NAME[] = "MPI_Testsome"; - - -int MPI_Testsome(int incount, MPI_Request requests[], - int *outcount, int indices[], - MPI_Status statuses[]) -{ - SPC_RECORD(OMPI_SPC_TESTSOME, 1); - - 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) && (0 != incount)) { - rc = MPI_ERR_REQUEST; - } else { - if(!ompi_request_check_same_instance(requests, incount) ) { - rc = MPI_ERR_REQUEST; - } - } - if (((NULL == outcount || NULL == indices) && incount > 0) || - incount < 0) { - return MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (OPAL_UNLIKELY(0 == incount)) { - *outcount = MPI_UNDEFINED; - return OMPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_test_some(incount, requests, outcount, - indices, statuses)) { - return MPI_SUCCESS; - } - - if (MPI_SUCCESS != - ompi_errhandler_request_invoke(incount, requests, FUNC_NAME)) { - return MPI_ERR_IN_STATUS; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/testsome.c.in b/ompi/mpi/c/testsome.c.in new file mode 100644 index 00000000000..e5bccca0a28 --- /dev/null +++ b/ompi/mpi/c/testsome.c.in @@ -0,0 +1,84 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS testsome(INT incount, REQUEST_INOUT requests, + INT_OUT outcount, INT_OUT indices, + STATUS_OUT statuses) +{ + SPC_RECORD(OMPI_SPC_TESTSOME, 1); + + 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) && (0 != incount)) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, incount) ) { + rc = MPI_ERR_REQUEST; + } + } + if (((NULL == outcount || NULL == indices) && incount > 0) || + incount < 0) { + return MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == incount)) { + *outcount = MPI_UNDEFINED; + return OMPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_test_some(incount, requests, outcount, + indices, statuses)) { + return MPI_SUCCESS; + } + + if (MPI_SUCCESS != + ompi_errhandler_request_invoke(incount, requests, FUNC_NAME)) { + return MPI_ERR_IN_STATUS; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/topo_test.c b/ompi/mpi/c/topo_test.c deleted file mode 100644 index 2fc9d82f25a..00000000000 --- a/ompi/mpi/c/topo_test.c +++ /dev/null @@ -1,67 +0,0 @@ -/* - * 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) 2012-2013 Inria. 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 -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/memchecker.h" -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Topo_test = PMPI_Topo_test -#endif -#define MPI_Topo_test PMPI_Topo_test -#endif - -static const char FUNC_NAME[] = "MPI_Topo_test"; - - -int MPI_Topo_test(MPI_Comm comm, int *status) -{ - MEMCHECKER( - memchecker_comm(comm); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } else if ( NULL == status ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - } - - if (OMPI_COMM_IS_CART(comm)) { - *status = MPI_CART; - } else if (OMPI_COMM_IS_GRAPH(comm)) { - *status = MPI_GRAPH; - } else if (OMPI_COMM_IS_DIST_GRAPH(comm)) { - *status = MPI_DIST_GRAPH; - } else { - *status = MPI_UNDEFINED; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/topo_test.c.in b/ompi/mpi/c/topo_test.c.in new file mode 100644 index 00000000000..33c1d9e1fda --- /dev/null +++ b/ompi/mpi/c/topo_test.c.in @@ -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) 2012-2013 Inria. 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$ + * + * 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/memchecker.h" + +PROTOTYPE ERROR_CLASS topo_test(COMM comm, INT_OUT status) +{ + MEMCHECKER( + memchecker_comm(comm); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } else if ( NULL == status ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + } + + if (OMPI_COMM_IS_CART(comm)) { + *status = MPI_CART; + } else if (OMPI_COMM_IS_GRAPH(comm)) { + *status = MPI_GRAPH; + } else if (OMPI_COMM_IS_DIST_GRAPH(comm)) { + *status = MPI_DIST_GRAPH; + } else { + *status = MPI_UNDEFINED; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_c2f.c b/ompi/mpi/c/type_c2f.c deleted file mode 100644 index d660756f81b..00000000000 --- a/ompi/mpi/c/type_c2f.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2017 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-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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_c2f = PMPI_Type_c2f -#endif -#define MPI_Type_c2f PMPI_Type_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Type_c2f"; - - -MPI_Fint MPI_Type_c2f(MPI_Datatype datatype) -{ - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (NULL == datatype) { - return OMPI_INT_2_FINT(-1); - } - } - - /* If necessary add the datatype to the f2c translation table */ - if( -1 == datatype->d_f_to_c_index ) { - datatype->d_f_to_c_index = opal_pointer_array_add(&ompi_datatype_f_to_c_table, datatype); - /* We don't check for error as returning a negative value is considered as an error */ - } - return OMPI_INT_2_FINT(datatype->d_f_to_c_index); -} diff --git a/ompi/mpi/c/type_c2f.c.in b/ompi/mpi/c/type_c2f.c.in new file mode 100644 index 00000000000..9ca8ec5faa7 --- /dev/null +++ b/ompi/mpi/c/type_c2f.c.in @@ -0,0 +1,54 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2017 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-2012 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$ + * + * 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/mpi/fortran/base/fint_2_int.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE FINT type_c2f(DATATYPE datatype) +{ + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (NULL == datatype) { + return OMPI_INT_2_FINT(-1); + } + } + + /* If necessary add the datatype to the f2c translation table */ + if( -1 == datatype->d_f_to_c_index ) { + datatype->d_f_to_c_index = opal_pointer_array_add(&ompi_datatype_f_to_c_table, datatype); + /* We don't check for error as returning a negative value is considered as an error */ + } + return OMPI_INT_2_FINT(datatype->d_f_to_c_index); +} diff --git a/ompi/mpi/c/type_commit.c b/ompi/mpi/c/type_commit.c deleted file mode 100644 index d7ac77d87f6..00000000000 --- a/ompi/mpi/c/type_commit.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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) 2006 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_commit = PMPI_Type_commit -#endif -#define MPI_Type_commit PMPI_Type_commit -#endif - -static const char FUNC_NAME[] = "MPI_Type_commit"; - - -int MPI_Type_commit(MPI_Datatype *type) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(*type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || NULL == *type || MPI_DATATYPE_NULL == *type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } - } - - rc = ompi_datatype_commit( type ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_commit.c.in b/ompi/mpi/c/type_commit.c.in new file mode 100644 index 00000000000..cd67aa24501 --- /dev/null +++ b/ompi/mpi/c/type_commit.c.in @@ -0,0 +1,50 @@ +/* + * 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) 2006 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_commit(DATATYPE_OUT type) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(*type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || NULL == *type || MPI_DATATYPE_NULL == *type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } + } + + rc = ompi_datatype_commit( type ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_contiguous.c b/ompi/mpi/c/type_contiguous.c deleted file mode 100644 index 4bac82c79ee..00000000000 --- a/ompi/mpi/c/type_contiguous.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_contiguous = PMPI_Type_contiguous -#endif -#define MPI_Type_contiguous PMPI_Type_contiguous -#endif - -static const char FUNC_NAME[] = "MPI_Type_contiguous"; - - -int MPI_Type_contiguous(int count, - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (MPI_DATATYPE_NULL == oldtype || NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); - } - } - - rc = ompi_datatype_create_contiguous( count, oldtype, newtype ); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); - - /* data description */ - { - const int* a_i[1] = {&count}; - ompi_datatype_set_args( *newtype, 1, a_i, 0, NULL, 1, &oldtype, MPI_COMBINER_CONTIGUOUS ); - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_contiguous.c.in b/ompi/mpi/c/type_contiguous.c.in new file mode 100644 index 00000000000..cc88f3cab77 --- /dev/null +++ b/ompi/mpi/c/type_contiguous.c.in @@ -0,0 +1,82 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + + +PROTOTYPE ERROR_CLASS type_contiguous(COUNT count, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (MPI_DATATYPE_NULL == oldtype || NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + } + + rc = ompi_datatype_create_contiguous( count, oldtype, newtype ); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); + + /* data description */ + { +#if OMPI_BIGCOUNT_SRC + int icount = (int)count; + const int* a_i[1] = {&icount}; +#else + const int* a_i[1] = {&count}; +#endif + ompi_datatype_set_args( *newtype, 1, a_i, 0, NULL, 1, &oldtype, MPI_COMBINER_CONTIGUOUS ); + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_create_darray.c b/ompi/mpi/c/type_create_darray.c deleted file mode 100644 index 9dbe45d615a..00000000000 --- a/ompi/mpi/c/type_create_darray.c +++ /dev/null @@ -1,112 +0,0 @@ -/* -*- 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-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2009 Sun Microsystems, 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_darray = PMPI_Type_create_darray -#endif -#define MPI_Type_create_darray PMPI_Type_create_darray -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_darray"; - -int MPI_Type_create_darray(int size, - int rank, - int ndims, - const int gsize_array[], - const int distrib_array[], - const int darg_array[], - const int psize_array[], - int order, - MPI_Datatype oldtype, - MPI_Datatype *newtype) - -{ - int i, rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if (MPI_PARAM_CHECK) { - int prod_psize = 1; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( (rank < 0) || (size < 0) || (rank >= size) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( ndims < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); - } else if( (ndims > 0) && ((NULL == gsize_array) || (NULL == distrib_array) || - (NULL == darg_array) || (NULL == psize_array))) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if( !(OPAL_DATATYPE_FLAG_DATA & oldtype->super.flags) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if( (MPI_ORDER_C != order) && (MPI_ORDER_FORTRAN != order) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - if( ndims > 0 ) { - for( i = 0; i < ndims; i++ ) { - if( (MPI_DISTRIBUTE_BLOCK != distrib_array[i]) && - (MPI_DISTRIBUTE_CYCLIC != distrib_array[i]) && - (MPI_DISTRIBUTE_NONE != distrib_array[i]) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( (gsize_array[i] < 1) || (psize_array[i] < 0) || - ((darg_array[i] < 0) && (MPI_DISTRIBUTE_DFLT_DARG != darg_array[i]) ) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( (MPI_DISTRIBUTE_DFLT_DARG != darg_array[i]) && - (MPI_DISTRIBUTE_BLOCK == distrib_array[i]) && - ((darg_array[i] * psize_array[i]) < gsize_array[i]) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( 1 > psize_array[i] ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - prod_psize *= psize_array[i]; - } - if( prod_psize != size ) - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_datatype_create_darray( size, rank, ndims, - gsize_array, distrib_array, darg_array, psize_array, - order, oldtype, newtype ); - if( OMPI_SUCCESS == rc ) { - const int* a_i[8] = {&size, &rank, &ndims, gsize_array, distrib_array, darg_array, - psize_array, &order}; - - ompi_datatype_set_args( *newtype, 4 * ndims + 4, a_i, 0, NULL, 1, &oldtype, - MPI_COMBINER_DARRAY ); - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_create_darray.c.in b/ompi/mpi/c/type_create_darray.c.in new file mode 100644 index 00000000000..f1a7fd20e1c --- /dev/null +++ b/ompi/mpi/c/type_create_darray.c.in @@ -0,0 +1,133 @@ +/* -*- 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-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2009 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + + +PROTOTYPE ERROR_CLASS type_create_darray(INT size, + INT rank, + INT ndims, + COUNT_ARRAY gsize_array, + INT_ARRAY distrib_array, + INT_ARRAY darg_array, + INT_ARRAY psize_array, + INT order, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int i, rc; + int *igsize_array = NULL; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if (MPI_PARAM_CHECK) { + int prod_psize = 1; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( (rank < 0) || (size < 0) || (rank >= size) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( ndims < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); + } else if( (ndims > 0) && ((NULL == gsize_array) || (NULL == distrib_array) || + (NULL == darg_array) || (NULL == psize_array))) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if( !(OPAL_DATATYPE_FLAG_DATA & oldtype->super.flags) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if( (MPI_ORDER_C != order) && (MPI_ORDER_FORTRAN != order) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + if( ndims > 0 ) { +#if OMPI_BIGCOUNT_SRC + for( i = 0; i < ndims; i++ ) { + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, gsize_array[i]); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + } +#endif + for( i = 0; i < ndims; i++ ) { + if( (MPI_DISTRIBUTE_BLOCK != distrib_array[i]) && + (MPI_DISTRIBUTE_CYCLIC != distrib_array[i]) && + (MPI_DISTRIBUTE_NONE != distrib_array[i]) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( (gsize_array[i] < 1) || (psize_array[i] < 0) || + ((darg_array[i] < 0) && (MPI_DISTRIBUTE_DFLT_DARG != darg_array[i]) ) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( (MPI_DISTRIBUTE_DFLT_DARG != darg_array[i]) && + (MPI_DISTRIBUTE_BLOCK == distrib_array[i]) && + ((darg_array[i] * psize_array[i]) < gsize_array[i]) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( 1 > psize_array[i] ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + prod_psize *= psize_array[i]; + } + if( prod_psize != size ) + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + +#if OMPI_BIGCOUNT_SRC + igsize_array = (int *)malloc(ndims * sizeof(int)); + if (NULL == igsize_array) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (int ii=0;ii - -#include "opal/util/printf.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_f90_complex = PMPI_Type_create_f90_complex -#endif -#define MPI_Type_create_f90_complex PMPI_Type_create_f90_complex -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_f90_complex"; - - -int MPI_Type_create_f90_complex(int p, int r, MPI_Datatype *newtype) -{ - uint64_t key; - int p_key, r_key; - int sflt_dig = 3, sflt_max_10_exp = +5, sflt_min_10_exp = -4; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note: These functions accept negative integers for the p and r - * arguments. This is because for the SELECTED_COMPLEX_KIND, - * negative numbers are equivalent to zero values. See section - * 13.14.95 of the Fortran 95 standard. */ - - if ((MPI_UNDEFINED == p && MPI_UNDEFINED == r)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - /* if the user does not care about p or r set them to 0 so the - * test associate with them will always succeed. - */ - p_key = p; - r_key = r; - if( MPI_UNDEFINED == p ) p_key = 0; - if( MPI_UNDEFINED == r ) r_key = 0; - - /** - * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, - * page 295, line 47 we handle this nicely by caching the values in a hash table. - * However, as the value of might not always make sense, a little bit of optimization - * might be a good idea. Therefore, first we try to see if we can handle the value - * with some kind of default value, and if it's the case then we look into the - * cache. - */ - - if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; - else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_ldblcplex.dt; - else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_dblcplex.dt; - else if( ! OMPI_HAVE_FORTRAN_COMPLEX4 || - (sflt_dig < p) || (sflt_max_10_exp < r) || (-sflt_min_10_exp < r) ) *newtype = &ompi_mpi_cplex.dt; - else *newtype = &ompi_mpi_complex4.dt; - - if( *newtype != &ompi_mpi_datatype_null.dt ) { - ompi_datatype_t* datatype; - const int* a_i[2]; - int rc; - - key = (((uint64_t)p_key) << 32) | ((uint64_t)r_key); - if( OPAL_SUCCESS == opal_hash_table_get_value_uint64( &ompi_mpi_f90_complex_hashtable, - key, (void**)newtype ) ) { - return MPI_SUCCESS; - } - /* Create the duplicate type corresponding to selected type, then - * set the argument to be a COMBINER with the correct value of r - * and add it to the hash table. */ - if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { - OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, - MPI_ERR_INTERN, FUNC_NAME ); - } - /* Make sure the user is not allowed to free this datatype as specified - * in the MPI standard. - */ - datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; - /* Mark the datatype as a special F90 convenience type */ - snprintf(datatype->name, sizeof(datatype->name), - "COMBINER %s", (*newtype)->name); - - a_i[0] = &p; - a_i[1] = &r; - ompi_datatype_set_args( datatype, 2, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_COMPLEX ); - - rc = opal_hash_table_set_value_uint64( &ompi_mpi_f90_complex_hashtable, key, datatype ); - if (OMPI_SUCCESS != rc) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); - } - *newtype = datatype; - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_create_f90_complex.c.in b/ompi/mpi/c/type_create_f90_complex.c.in new file mode 100644 index 00000000000..b5b9713872b --- /dev/null +++ b/ompi/mpi/c/type_create_f90_complex.c.in @@ -0,0 +1,123 @@ +/* -*- 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-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-2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2008-2021 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/util/printf.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS Type_create_f90_complex(INT p, INT r, DATATYPE_OUT newtype) +{ + uint64_t key; + int p_key, r_key; + int sflt_dig = 3, sflt_max_10_exp = +5, sflt_min_10_exp = -4; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note: These functions accept negative integers for the p and r + * arguments. This is because for the SELECTED_COMPLEX_KIND, + * negative numbers are equivalent to zero values. See section + * 13.14.95 of the Fortran 95 standard. */ + + if ((MPI_UNDEFINED == p && MPI_UNDEFINED == r)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + /* if the user does not care about p or r set them to 0 so the + * test associate with them will always succeed. + */ + p_key = p; + r_key = r; + if( MPI_UNDEFINED == p ) p_key = 0; + if( MPI_UNDEFINED == r ) r_key = 0; + + /** + * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, + * page 295, line 47 we handle this nicely by caching the values in a hash table. + * However, as the value of might not always make sense, a little bit of optimization + * might be a good idea. Therefore, first we try to see if we can handle the value + * with some kind of default value, and if it's the case then we look into the + * cache. + */ + + if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; + else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_ldblcplex.dt; + else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_dblcplex.dt; + else if( ! OMPI_HAVE_FORTRAN_COMPLEX4 || + (sflt_dig < p) || (sflt_max_10_exp < r) || (-sflt_min_10_exp < r) ) *newtype = &ompi_mpi_cplex.dt; + else *newtype = &ompi_mpi_complex4.dt; + + if( *newtype != &ompi_mpi_datatype_null.dt ) { + ompi_datatype_t* datatype; + const int* a_i[2]; + int rc; + + key = (((uint64_t)p_key) << 32) | ((uint64_t)r_key); + if( OPAL_SUCCESS == opal_hash_table_get_value_uint64( &ompi_mpi_f90_complex_hashtable, + key, (void**)newtype ) ) { + return MPI_SUCCESS; + } + /* Create the duplicate type corresponding to selected type, then + * set the argument to be a COMBINER with the correct value of r + * and add it to the hash table. */ + if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { + OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, + MPI_ERR_INTERN, FUNC_NAME ); + } + /* Make sure the user is not allowed to free this datatype as specified + * in the MPI standard. + */ + datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; + /* Mark the datatype as a special F90 convenience type */ + snprintf(datatype->name, sizeof(datatype->name), + "COMBINER %s", (*newtype)->name); + + a_i[0] = &p; + a_i[1] = &r; + ompi_datatype_set_args( datatype, 2, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_COMPLEX ); + + rc = opal_hash_table_set_value_uint64( &ompi_mpi_f90_complex_hashtable, key, datatype ); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + *newtype = datatype; + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_create_f90_integer.c b/ompi/mpi/c/type_create_f90_integer.c deleted file mode 100644 index 628c2f3850a..00000000000 --- a/ompi/mpi/c/type_create_f90_integer.c +++ /dev/null @@ -1,122 +0,0 @@ -/* -*- 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-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-2009 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2008-2021 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "opal/util/printf.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_f90_integer = PMPI_Type_create_f90_integer -#endif -#define MPI_Type_create_f90_integer PMPI_Type_create_f90_integer -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_f90_integer"; - - -int MPI_Type_create_f90_integer(int r, MPI_Datatype *newtype) - -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note: These functions accept negative integers for the p and r - * arguments. This is because for the SELECTED_INTEGER_KIND, - * negative numbers are equivalent to zero values. See section - * 13.14.95 of the Fortran 95 standard. */ - } - - /** - * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, - * page 295, line 47 we handle this nicely by caching the values in a hash table. - * However, as the value of might not always make sense, a little bit of optimization - * might be a good idea. Therefore, first we try to see if we can handle the value - * with some kind of default value, and if it's the case then we look into the - * cache. - */ - - if (r > 38) *newtype = &ompi_mpi_datatype_null.dt; -#if OMPI_HAVE_FORTRAN_INTEGER16 - else if (r > 18) *newtype = &ompi_mpi_long_long_int.dt; -#else - else if (r > 18) *newtype = &ompi_mpi_datatype_null.dt; -#endif /* OMPI_HAVE_F90_INTEGER16 */ -#if SIZEOF_LONG > SIZEOF_INT - else if (r > 9) *newtype = &ompi_mpi_long.dt; -#else -#if SIZEOF_LONG_LONG > SIZEOF_INT - else if (r > 9) *newtype = &ompi_mpi_long_long_int.dt; -#else - else if (r > 9) *newtype = &ompi_mpi_datatype_null.dt; -#endif /* SIZEOF_LONG_LONG > SIZEOF_INT */ -#endif /* SIZEOF_LONG > SIZEOF_INT */ - else if (r > 4) *newtype = &ompi_mpi_int.dt; - else if (r > 2) *newtype = &ompi_mpi_short.dt; - else *newtype = &ompi_mpi_byte.dt; - - if( *newtype != &ompi_mpi_datatype_null.dt ) { - ompi_datatype_t* datatype; - const int* a_i[1]; - int rc; - - if( OPAL_SUCCESS == opal_hash_table_get_value_uint32( &ompi_mpi_f90_integer_hashtable, - r, (void**)newtype ) ) { - return MPI_SUCCESS; - } - /* Create the duplicate type corresponding to selected type, then - * set the argument to be a COMBINER with the correct value of r - * and add it to the hash table. */ - if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { - OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, - MPI_ERR_INTERN, FUNC_NAME ); - } - /* Make sure the user is not allowed to free this datatype as specified - * in the MPI standard. - */ - datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; - /* Mark the datatype as a special F90 convenience type */ - snprintf(datatype->name, sizeof(datatype->name), - "COMBINER %s", (*newtype)->name); - - a_i[0] = &r; - ompi_datatype_set_args( datatype, 1, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_INTEGER ); - - rc = opal_hash_table_set_value_uint32( &ompi_mpi_f90_integer_hashtable, r, datatype ); - if (OMPI_SUCCESS != rc) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); - } - *newtype = datatype; - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_create_f90_integer.c.in b/ompi/mpi/c/type_create_f90_integer.c.in new file mode 100644 index 00000000000..222794a9884 --- /dev/null +++ b/ompi/mpi/c/type_create_f90_integer.c.in @@ -0,0 +1,112 @@ +/* -*- 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-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-2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2008-2021 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "opal/util/printf.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS type_create_f90_integer(INT r, DATATYPE_OUT newtype) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note: These functions accept negative integers for the p and r + * arguments. This is because for the SELECTED_INTEGER_KIND, + * negative numbers are equivalent to zero values. See section + * 13.14.95 of the Fortran 95 standard. */ + } + + /** + * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, + * page 295, line 47 we handle this nicely by caching the values in a hash table. + * However, as the value of might not always make sense, a little bit of optimization + * might be a good idea. Therefore, first we try to see if we can handle the value + * with some kind of default value, and if it's the case then we look into the + * cache. + */ + + if (r > 38) *newtype = &ompi_mpi_datatype_null.dt; +#if OMPI_HAVE_FORTRAN_INTEGER16 + else if (r > 18) *newtype = &ompi_mpi_long_long_int.dt; +#else + else if (r > 18) *newtype = &ompi_mpi_datatype_null.dt; +#endif /* OMPI_HAVE_F90_INTEGER16 */ +#if SIZEOF_LONG > SIZEOF_INT + else if (r > 9) *newtype = &ompi_mpi_long.dt; +#else +#if SIZEOF_LONG_LONG > SIZEOF_INT + else if (r > 9) *newtype = &ompi_mpi_long_long_int.dt; +#else + else if (r > 9) *newtype = &ompi_mpi_datatype_null.dt; +#endif /* SIZEOF_LONG_LONG > SIZEOF_INT */ +#endif /* SIZEOF_LONG > SIZEOF_INT */ + else if (r > 4) *newtype = &ompi_mpi_int.dt; + else if (r > 2) *newtype = &ompi_mpi_short.dt; + else *newtype = &ompi_mpi_byte.dt; + + if( *newtype != &ompi_mpi_datatype_null.dt ) { + ompi_datatype_t* datatype; + const int* a_i[1]; + int rc; + + if( OPAL_SUCCESS == opal_hash_table_get_value_uint32( &ompi_mpi_f90_integer_hashtable, + r, (void**)newtype ) ) { + return MPI_SUCCESS; + } + /* Create the duplicate type corresponding to selected type, then + * set the argument to be a COMBINER with the correct value of r + * and add it to the hash table. */ + if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { + OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, + MPI_ERR_INTERN, FUNC_NAME ); + } + /* Make sure the user is not allowed to free this datatype as specified + * in the MPI standard. + */ + datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; + /* Mark the datatype as a special F90 convenience type */ + snprintf(datatype->name, sizeof(datatype->name), + "COMBINER %s", (*newtype)->name); + + a_i[0] = &r; + ompi_datatype_set_args( datatype, 1, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_INTEGER ); + + rc = opal_hash_table_set_value_uint32( &ompi_mpi_f90_integer_hashtable, r, datatype ); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + *newtype = datatype; + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_create_f90_real.c b/ompi/mpi/c/type_create_f90_real.c deleted file mode 100644 index 199186ff5aa..00000000000 --- a/ompi/mpi/c/type_create_f90_real.c +++ /dev/null @@ -1,129 +0,0 @@ -/* -*- 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-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-2009 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2008-2021 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. - * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include - -#include "opal/util/printf.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_f90_real = PMPI_Type_create_f90_real -#endif -#define MPI_Type_create_f90_real PMPI_Type_create_f90_real -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_f90_real"; - - -int MPI_Type_create_f90_real(int p, int r, MPI_Datatype *newtype) -{ - uint64_t key; - int p_key, r_key; - int sflt_dig = 3, sflt_max_10_exp = +5, sflt_min_10_exp = -4; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note: These functions accept negative integers for the p and r - * arguments. This is because for the SELECTED_REAL_KIND, - * negative numbers are equivalent to zero values. See section - * 13.14.95 of the Fortran 95 standard. */ - - if ((MPI_UNDEFINED == p && MPI_UNDEFINED == r)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - /* if the user does not care about p or r set them to 0 so the - * test associate with them will always succeed. - */ - p_key = p; - r_key = r; - if( MPI_UNDEFINED == p ) p_key = 0; - if( MPI_UNDEFINED == r ) r_key = 0; - - /** - * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, - * page 295, line 47 we handle this nicely by caching the values in a hash table. - * However, as the value of might not always make sense, a little bit of optimization - * might be a good idea. Therefore, first we try to see if we can handle the value - * with some kind of default value, and if it's the case then we look into the - * cache. - */ - - if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; - else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_long_double.dt; - else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_double.dt; - else if( ! OMPI_HAVE_FORTRAN_REAL2 || - (sflt_dig < p) || (sflt_max_10_exp < r) || (-sflt_min_10_exp < r) ) *newtype = &ompi_mpi_float.dt; - else *newtype = &ompi_mpi_real2.dt; - - if( *newtype != &ompi_mpi_datatype_null.dt ) { - ompi_datatype_t* datatype; - const int* a_i[2] = {&p, &r}; - int rc; - - key = (((uint64_t)p_key) << 32) | ((uint64_t)r_key); - if( OPAL_SUCCESS == opal_hash_table_get_value_uint64( &ompi_mpi_f90_real_hashtable, - key, (void**)newtype ) ) { - return MPI_SUCCESS; - } - /* Create the duplicate type corresponding to selected type, then - * set the argument to be a COMBINER with the correct value of r - * and add it to the hash table. */ - if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { - OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, - MPI_ERR_INTERN, FUNC_NAME ); - } - /* Make sure the user is not allowed to free this datatype as specified - * in the MPI standard. - */ - datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; - /* Mark the datatype as a special F90 convenience type */ - snprintf(datatype->name, sizeof(datatype->name), - "COMBINER %s", (*newtype)->name); - - ompi_datatype_set_args( datatype, 2, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_REAL ); - - rc = opal_hash_table_set_value_uint64( &ompi_mpi_f90_real_hashtable, key, datatype ); - if (OMPI_SUCCESS != rc) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); - } - *newtype = datatype; - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_create_f90_real.c.in b/ompi/mpi/c/type_create_f90_real.c.in new file mode 100644 index 00000000000..e7d2e28bde9 --- /dev/null +++ b/ompi/mpi/c/type_create_f90_real.c.in @@ -0,0 +1,121 @@ +/* -*- 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-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-2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2008-2021 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2018 Amazon.com, Inc. or its affiliates. All Rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/util/printf.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" + +PROTOTYPE ERROR_CLASS type_create_f90_real(INT p, INT r, DATATYPE_OUT newtype) +{ + uint64_t key; + int p_key, r_key; + int sflt_dig = 3, sflt_max_10_exp = +5, sflt_min_10_exp = -4; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note: These functions accept negative integers for the p and r + * arguments. This is because for the SELECTED_REAL_KIND, + * negative numbers are equivalent to zero values. See section + * 13.14.95 of the Fortran 95 standard. */ + + if ((MPI_UNDEFINED == p && MPI_UNDEFINED == r)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + /* if the user does not care about p or r set them to 0 so the + * test associate with them will always succeed. + */ + p_key = p; + r_key = r; + if( MPI_UNDEFINED == p ) p_key = 0; + if( MPI_UNDEFINED == r ) r_key = 0; + + /** + * With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx, + * page 295, line 47 we handle this nicely by caching the values in a hash table. + * However, as the value of might not always make sense, a little bit of optimization + * might be a good idea. Therefore, first we try to see if we can handle the value + * with some kind of default value, and if it's the case then we look into the + * cache. + */ + + if ( (LDBL_DIG < p) || (LDBL_MAX_10_EXP < r) || (-LDBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_datatype_null.dt; + else if( (DBL_DIG < p) || (DBL_MAX_10_EXP < r) || (-DBL_MIN_10_EXP < r) ) *newtype = &ompi_mpi_long_double.dt; + else if( (FLT_DIG < p) || (FLT_MAX_10_EXP < r) || (-FLT_MIN_10_EXP < r) ) *newtype = &ompi_mpi_double.dt; + else if( ! OMPI_HAVE_FORTRAN_REAL2 || + (sflt_dig < p) || (sflt_max_10_exp < r) || (-sflt_min_10_exp < r) ) *newtype = &ompi_mpi_float.dt; + else *newtype = &ompi_mpi_real2.dt; + + if( *newtype != &ompi_mpi_datatype_null.dt ) { + ompi_datatype_t* datatype; + const int* a_i[2] = {&p, &r}; + int rc; + + key = (((uint64_t)p_key) << 32) | ((uint64_t)r_key); + if( OPAL_SUCCESS == opal_hash_table_get_value_uint64( &ompi_mpi_f90_real_hashtable, + key, (void**)newtype ) ) { + return MPI_SUCCESS; + } + /* Create the duplicate type corresponding to selected type, then + * set the argument to be a COMBINER with the correct value of r + * and add it to the hash table. */ + if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) { + OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD, + MPI_ERR_INTERN, FUNC_NAME ); + } + /* Make sure the user is not allowed to free this datatype as specified + * in the MPI standard. + */ + datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED; + /* Mark the datatype as a special F90 convenience type */ + snprintf(datatype->name, sizeof(datatype->name), + "COMBINER %s", (*newtype)->name); + + ompi_datatype_set_args( datatype, 2, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_REAL ); + + rc = opal_hash_table_set_value_uint64( &ompi_mpi_f90_real_hashtable, key, datatype ); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + *newtype = datatype; + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_create_hindexed.c b/ompi/mpi/c/type_create_hindexed.c deleted file mode 100644 index 1de9d6d9cef..00000000000 --- a/ompi/mpi/c/type_create_hindexed.c +++ /dev/null @@ -1,92 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_hindexed = PMPI_Type_create_hindexed -#endif -#define MPI_Type_create_hindexed PMPI_Type_create_hindexed -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_hindexed"; - - -int MPI_Type_create_hindexed(int count, - const int array_of_blocklengths[], - const MPI_Aint array_of_displacements[], - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc, i; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME); - } else if ((count > 0) && (NULL == array_of_blocklengths || - NULL == array_of_displacements)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } else if (MPI_DATATYPE_NULL == oldtype || NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME); - } - for ( i = 0; i < count; i++ ) { - if (array_of_blocklengths[i] < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } - } - } - - rc = ompi_datatype_create_hindexed( count, array_of_blocklengths, array_of_displacements, - oldtype, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); - } - /* data description */ - { - const int* a_i[2] = {&count, array_of_blocklengths}; - - ompi_datatype_set_args( *newtype, count + 1, a_i, count, array_of_displacements, - 1, &oldtype, MPI_COMBINER_HINDEXED ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_create_hindexed.c.in b/ompi/mpi/c/type_create_hindexed.c.in new file mode 100644 index 00000000000..79e03f91bb2 --- /dev/null +++ b/ompi/mpi/c/type_create_hindexed.c.in @@ -0,0 +1,122 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + + +PROTOTYPE ERROR_CLASS type_create_hindexed(COUNT count, + COUNT_ARRAY array_of_blocklengths, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc, i; + int *iarray_of_blocklengths = NULL; + MPI_Aint *iarray_of_displacements = NULL; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME); + } else if ((count > 0) && (NULL == array_of_blocklengths || + NULL == array_of_displacements)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } else if (MPI_DATATYPE_NULL == oldtype || NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME); + } + for ( i = 0; i < count; i++ ) { + if (array_of_blocklengths[i] < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + } + +#if OMPI_BIGCOUNT_SRC + iarray_of_blocklengths = (int *)malloc(count * sizeof(int)); + if (NULL == iarray_of_blocklengths) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + iarray_of_displacements = (MPI_Aint *)malloc(count * sizeof(MPI_Aint)); + if (NULL == iarray_of_displacements) { + free( iarray_of_blocklengths); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (i = 0; i < (int)count; i++) { + iarray_of_blocklengths[i] = (int)array_of_blocklengths[i]; + iarray_of_displacements[i] = (MPI_Aint)array_of_displacements[i]; + } +#else + iarray_of_blocklengths = (int *)array_of_blocklengths; + iarray_of_displacements = (MPI_Aint *)array_of_displacements; +#endif + + rc = ompi_datatype_create_hindexed( count, iarray_of_blocklengths, iarray_of_displacements, + oldtype, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); + } + /* data description */ + { + const int* a_i[2] = {(int *)&count, iarray_of_blocklengths}; + + ompi_datatype_set_args( *newtype, count + 1, a_i, count, iarray_of_displacements, + 1, &oldtype, MPI_COMBINER_HINDEXED ); + } + +#if OMPI_BIGCOUNT_SRC + free(iarray_of_blocklengths); + free(iarray_of_displacements); +#endif + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_create_hindexed_block.c b/ompi/mpi/c/type_create_hindexed_block.c deleted file mode 100644 index 43ecaeaef5c..00000000000 --- a/ompi/mpi/c/type_create_hindexed_block.c +++ /dev/null @@ -1,76 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2012-2020 The University of Tennessee and The University - * of Tennessee Research Foundation. All rights - * reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_hindexed_block = PMPI_Type_create_hindexed_block -#endif -#define MPI_Type_create_hindexed_block PMPI_Type_create_hindexed_block -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_hindexed_block"; - - -int MPI_Type_create_hindexed_block(int count, - int blocklength, - const MPI_Aint array_of_displacements[], - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME); - } else if( (count > 0) && (blocklength < 0 || NULL == array_of_displacements) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - rc = ompi_datatype_create_hindexed_block( count, blocklength, array_of_displacements, - oldtype, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); - } - { - const int* a_i[2] = {&count, &blocklength}; - ompi_datatype_set_args( *newtype, 2, a_i, count, array_of_displacements, 1, &oldtype, - MPI_COMBINER_HINDEXED_BLOCK ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_create_hindexed_block.c.in b/ompi/mpi/c/type_create_hindexed_block.c.in new file mode 100644 index 00000000000..f7bbadd3631 --- /dev/null +++ b/ompi/mpi/c/type_create_hindexed_block.c.in @@ -0,0 +1,95 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2012-2020 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + +PROTOTYPE ERROR_CLASS type_create_hindexed_block(COUNT count, + COUNT blocklength, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc; + MPI_Aint *iarray_of_displacements = NULL; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME); + } else if( (count > 0) && (blocklength < 0 || NULL == array_of_displacements) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + } + +#if OMPI_BIGCOUNT_SRC + iarray_of_displacements = (MPI_Aint *)malloc(count * sizeof(MPI_Aint)); + if (NULL == iarray_of_displacements) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (int ii = 0; ii < (int)count; ii++) { + iarray_of_displacements[ii] = (MPI_Aint)array_of_displacements[ii]; + } +#else + iarray_of_displacements = (MPI_Aint *)array_of_displacements; +#endif + + rc = ompi_datatype_create_hindexed_block( count, blocklength, iarray_of_displacements, + oldtype, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); + } + { + const int* a_i[2] = {(int *)&count, (int *)&blocklength}; + ompi_datatype_set_args( *newtype, 2, a_i, count, iarray_of_displacements, 1, &oldtype, + MPI_COMBINER_HINDEXED_BLOCK ); + } +#if OMPI_BIGCOUNT_SRC + free(iarray_of_displacements); +#endif + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_create_hvector.c b/ompi/mpi/c/type_create_hvector.c deleted file mode 100644 index 6a7b259842c..00000000000 --- a/ompi/mpi/c/type_create_hvector.c +++ /dev/null @@ -1,82 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_hvector = PMPI_Type_create_hvector -#endif -#define MPI_Type_create_hvector PMPI_Type_create_hvector -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_hvector"; - - -int MPI_Type_create_hvector(int count, - int blocklength, - MPI_Aint stride, - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME ); - } else if( blocklength < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - rc = ompi_datatype_create_hvector ( count, blocklength, stride, oldtype, - newtype ); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); - - { - const int* a_i[2] = {&count, &blocklength}; - MPI_Aint a_a[1] = {stride}; - - ompi_datatype_set_args( *newtype, 2, a_i, 1, a_a, 1, &oldtype, MPI_COMBINER_HVECTOR ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_create_hvector.c.in b/ompi/mpi/c/type_create_hvector.c.in new file mode 100644 index 00000000000..cb93050d05c --- /dev/null +++ b/ompi/mpi/c/type_create_hvector.c.in @@ -0,0 +1,85 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + +PROTOTYPE ERROR_CLASS type_create_hvector(COUNT count, + COUNT blocklength, + AINT_COUNT stride, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME ); + } else if( blocklength < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + } + + rc = ompi_datatype_create_hvector ( count, blocklength, stride, oldtype, + newtype ); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); + + { + const int* a_i[2] = {(int *)&count, (int *)&blocklength}; + MPI_Aint a_a[1] = {stride}; + + ompi_datatype_set_args( *newtype, 2, a_i, 1, a_a, 1, &oldtype, MPI_COMBINER_HVECTOR ); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_create_indexed_block.c b/ompi/mpi/c/type_create_indexed_block.c deleted file mode 100644 index cec91fbfa5e..00000000000 --- a/ompi/mpi/c/type_create_indexed_block.c +++ /dev/null @@ -1,84 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_indexed_block = PMPI_Type_create_indexed_block -#endif -#define MPI_Type_create_indexed_block PMPI_Type_create_indexed_block -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_indexed_block"; - - -int MPI_Type_create_indexed_block(int count, - int blocklength, - const int array_of_displacements[], - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME); - } else if( (count > 0) && (blocklength < 0 || NULL == array_of_displacements) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - rc = ompi_datatype_create_indexed_block( count, blocklength, array_of_displacements, - oldtype, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); - } - { - const int* a_i[3] = {&count, &blocklength, array_of_displacements}; - - ompi_datatype_set_args( *newtype, 2 + count, a_i, 0, NULL, 1, &oldtype, - MPI_COMBINER_INDEXED_BLOCK ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_create_indexed_block.c.in b/ompi/mpi/c/type_create_indexed_block.c.in new file mode 100644 index 00000000000..24732bf5086 --- /dev/null +++ b/ompi/mpi/c/type_create_indexed_block.c.in @@ -0,0 +1,97 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + + +PROTOTYPE ERROR_CLASS type_create_indexed_block(COUNT count, + COUNT blocklength, + COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc; + int *iarray_of_displacements = NULL; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME); + } else if( (count > 0) && (blocklength < 0 || NULL == array_of_displacements) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } else if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } + } + +#if OMPI_BIGCOUNT_SRC + iarray_of_displacements = (int *)malloc(count * sizeof(int)); + if (NULL == iarray_of_displacements) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (int ii = 0; ii < (int)count; ii++) { + iarray_of_displacements[ii] = (int)array_of_displacements[ii]; + } +#else + iarray_of_displacements = (int *)array_of_displacements; +#endif + rc = ompi_datatype_create_indexed_block( count, blocklength, iarray_of_displacements, + oldtype, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); + } + { + const int* a_i[3] = {(int *)&count, (int *)&blocklength, iarray_of_displacements}; + + ompi_datatype_set_args( *newtype, 2 + count, a_i, 0, NULL, 1, &oldtype, + MPI_COMBINER_INDEXED_BLOCK ); + } + +#if OMPI_BIGCOUNT_SRC + free(iarray_of_displacements); +#endif + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_create_keyval.c b/ompi/mpi/c/type_create_keyval.c deleted file mode 100644 index 9844599eabf..00000000000 --- a/ompi/mpi/c/type_create_keyval.c +++ /dev/null @@ -1,69 +0,0 @@ -/* - * 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-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) 2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. - * All Rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_keyval = PMPI_Type_create_keyval -#endif -#define MPI_Type_create_keyval PMPI_Type_create_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_keyval"; - - -int MPI_Type_create_keyval(MPI_Type_copy_attr_function *type_copy_attr_fn, - MPI_Type_delete_attr_function *type_delete_attr_fn, - int *type_keyval, - void *extra_state) -{ - int ret; - ompi_attribute_fn_ptr_union_t copy_fn; - ompi_attribute_fn_ptr_union_t del_fn; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == type_copy_attr_fn) || (NULL == type_delete_attr_fn) || - (NULL == type_keyval)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_ARG, - FUNC_NAME); - } - } - - copy_fn.attr_datatype_copy_fn = type_copy_attr_fn; - del_fn.attr_datatype_delete_fn = type_delete_attr_fn; - - ret = ompi_attr_create_keyval(TYPE_ATTR, copy_fn, del_fn, - type_keyval, extra_state, 0, NULL); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); -} - - diff --git a/ompi/mpi/c/type_create_keyval.c.in b/ompi/mpi/c/type_create_keyval.c.in new file mode 100644 index 00000000000..ea5cff2542d --- /dev/null +++ b/ompi/mpi/c/type_create_keyval.c.in @@ -0,0 +1,61 @@ +/* + * 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-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) 2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. + * All Rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS type_create_keyval(TYPE_COPY_ATTR_FUNCTION type_copy_attr_fn, + TYPE_DELETE_ATTR_FUNCTION type_delete_attr_fn, + INT_OUT type_keyval, + BUFFER_OUT extra_state) +{ + int ret; + ompi_attribute_fn_ptr_union_t copy_fn; + ompi_attribute_fn_ptr_union_t del_fn; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == type_copy_attr_fn) || (NULL == type_delete_attr_fn) || + (NULL == type_keyval)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_ARG, + FUNC_NAME); + } + } + + copy_fn.attr_datatype_copy_fn = type_copy_attr_fn; + del_fn.attr_datatype_delete_fn = type_delete_attr_fn; + + ret = ompi_attr_create_keyval(TYPE_ATTR, copy_fn, del_fn, + type_keyval, extra_state, 0, NULL); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, ret, FUNC_NAME); +} + + diff --git a/ompi/mpi/c/type_create_resized.c b/ompi/mpi/c/type_create_resized.c deleted file mode 100644 index a88c5b9ad06..00000000000 --- a/ompi/mpi/c/type_create_resized.c +++ /dev/null @@ -1,76 +0,0 @@ -/* - * 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_resized = PMPI_Type_create_resized -#endif -#define MPI_Type_create_resized PMPI_Type_create_resized -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_resized"; - - -int MPI_Type_create_resized(MPI_Datatype oldtype, - MPI_Aint lb, - MPI_Aint extent, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - rc = ompi_datatype_create_resized( oldtype, lb, extent, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); - } - - { - MPI_Aint a_a[2]; - a_a[0] = lb; - a_a[1] = extent; - ompi_datatype_set_args( *newtype, 0, NULL, 2, a_a, 1, &oldtype, MPI_COMBINER_RESIZED ); - } - - return MPI_SUCCESS; -} - - diff --git a/ompi/mpi/c/type_create_resized.c.in b/ompi/mpi/c/type_create_resized.c.in new file mode 100644 index 00000000000..9e07109ec7b --- /dev/null +++ b/ompi/mpi/c/type_create_resized.c.in @@ -0,0 +1,68 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_create_resized(DATATYPE oldtype, + AINT_COUNT lb, + AINT_COUNT extent, + DATATYPE_OUT newtype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } + } + + rc = ompi_datatype_create_resized( oldtype, lb, extent, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); + } + + { + MPI_Aint a_a[2]; + a_a[0] = lb; + a_a[1] = extent; + ompi_datatype_set_args( *newtype, 0, NULL, 2, a_a, 1, &oldtype, MPI_COMBINER_RESIZED ); + } + + return MPI_SUCCESS; +} + + diff --git a/ompi/mpi/c/type_create_struct.c b/ompi/mpi/c/type_create_struct.c deleted file mode 100644 index ec199c27915..00000000000 --- a/ompi/mpi/c/type_create_struct.c +++ /dev/null @@ -1,99 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_struct = PMPI_Type_create_struct -#endif -#define MPI_Type_create_struct PMPI_Type_create_struct -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_struct"; - - -int MPI_Type_create_struct(int count, - const int array_of_blocklengths[], - const MPI_Aint array_of_displacements[], - const MPI_Datatype array_of_types[], - MPI_Datatype *newtype) -{ - int i, rc; - - if ( count > 0 ) { - for ( i = 0; i < count; i++ ) { - MEMCHECKER( - memchecker_datatype(array_of_types[i]); - ); - } - } - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME); - } else if( (count > 0) && (NULL == array_of_blocklengths || - NULL == array_of_displacements || - NULL == array_of_types) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } - for ( i = 0; i < count; i++ ){ - if (NULL == array_of_types[i] || - MPI_DATATYPE_NULL == array_of_types[i]) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME); - } else if (array_of_blocklengths[i] < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - } - - rc = ompi_datatype_create_struct( count, array_of_blocklengths, array_of_displacements, - array_of_types, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, - rc, FUNC_NAME ); - } - - { - const int* a_i[2] = {&count, array_of_blocklengths}; - - ompi_datatype_set_args( *newtype, count + 1, a_i, count, array_of_displacements, - count, array_of_types, MPI_COMBINER_STRUCT ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_create_struct.c.in b/ompi/mpi/c/type_create_struct.c.in new file mode 100644 index 00000000000..4db48918288 --- /dev/null +++ b/ompi/mpi/c/type_create_struct.c.in @@ -0,0 +1,124 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + +PROTOTYPE ERROR_CLASS type_create_struct(COUNT count, + COUNT_ARRAY array_of_blocklengths, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE_ARRAY array_of_types, + DATATYPE_OUT newtype) +{ + int i, rc; + int *iarray_of_blocklengths = NULL; + MPI_Aint *iarray_of_displacements = NULL; + + if ( count > 0 ) { + for ( i = 0; i < count; i++ ) { + MEMCHECKER( + memchecker_datatype(array_of_types[i]); + ); + } + } + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME); + } else if( (count > 0) && (NULL == array_of_blocklengths || + NULL == array_of_displacements || + NULL == array_of_types) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } + for ( i = 0; i < count; i++ ){ + if (NULL == array_of_types[i] || + MPI_DATATYPE_NULL == array_of_types[i]) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME); + } else if (array_of_blocklengths[i] < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + } + +#if OMPI_BIGCOUNT_SRC + iarray_of_blocklengths = (int *)malloc(count * sizeof(int)); + if (NULL == iarray_of_blocklengths) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + iarray_of_displacements = (MPI_Aint *)malloc(count * sizeof(MPI_Aint)); + if (NULL == iarray_of_displacements) { + free(iarray_of_blocklengths); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (int ii = 0; ii < (int)count; ii++) { + iarray_of_blocklengths[ii] = (int)array_of_blocklengths[ii]; + iarray_of_displacements[ii] = (MPI_Aint)array_of_displacements[ii]; + } +#else + iarray_of_blocklengths = (int *)array_of_blocklengths; + iarray_of_displacements = (MPI_Aint *)array_of_displacements; +#endif + rc = ompi_datatype_create_struct( count, iarray_of_blocklengths, iarray_of_displacements, + array_of_types, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); +#if OMPI_BIGCOUNT_SRC + free(iarray_of_blocklengths); + free(iarray_of_displacements); +#endif + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, + rc, FUNC_NAME ); + } + + { + const int* a_i[2] = {(int *)&count, iarray_of_blocklengths}; + + ompi_datatype_set_args( *newtype, count + 1, a_i, count, iarray_of_displacements, + count, array_of_types, MPI_COMBINER_STRUCT ); + } +#if OMPI_BIGCOUNT_SRC + free(iarray_of_blocklengths); + free(iarray_of_displacements); +#endif + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_create_subarray.c b/ompi/mpi/c/type_create_subarray.c deleted file mode 100644 index daa68e634e6..00000000000 --- a/ompi/mpi/c/type_create_subarray.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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) 2009 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_create_subarray = PMPI_Type_create_subarray -#endif -#define MPI_Type_create_subarray PMPI_Type_create_subarray -#endif - -static const char FUNC_NAME[] = "MPI_Type_create_subarray"; - - -int MPI_Type_create_subarray(int ndims, - const int size_array[], - const int subsize_array[], - const int start_array[], - int order, - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int32_t i, rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if( ndims < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); - } else if( (ndims > 0) && ((NULL == size_array) || (NULL == subsize_array) || (NULL == start_array)) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( (NULL == oldtype) || (MPI_DATATYPE_NULL == oldtype) || (NULL == newtype) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if( (MPI_ORDER_C != order) && (MPI_ORDER_FORTRAN != order) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - for( i = 0; i < ndims; i++ ) { - if( (subsize_array[i] < 1) || (subsize_array[i] > size_array[i]) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if( (start_array[i] < 0) || (start_array[i] > (size_array[i] - subsize_array[i])) ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - } - - rc = ompi_datatype_create_subarray( ndims, size_array, subsize_array, start_array, - order, oldtype, newtype); - if( OMPI_SUCCESS == rc ) { - const int* a_i[5] = {&ndims, size_array, subsize_array, start_array, &order}; - - ompi_datatype_set_args( *newtype, 3 * ndims + 2, a_i, 0, NULL, 1, &oldtype, - MPI_COMBINER_SUBARRAY ); - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_create_subarray.c.in b/ompi/mpi/c/type_create_subarray.c.in new file mode 100644 index 00000000000..d25cde247c4 --- /dev/null +++ b/ompi/mpi/c/type_create_subarray.c.in @@ -0,0 +1,133 @@ +/* -*- 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) 2009 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + +PROTOTYPE ERROR_CLASS type_create_subarray(INT ndims, + COUNT_ARRAY size_array, + COUNT_ARRAY subsize_array, + COUNT_ARRAY start_array, + INT order, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int32_t i, rc; + int *isize_array = NULL; + int *isubsize_array = NULL; + int *istart_array = NULL; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if( ndims < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); + } else if( (ndims > 0) && ((NULL == size_array) || (NULL == subsize_array) || (NULL == start_array)) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( (NULL == oldtype) || (MPI_DATATYPE_NULL == oldtype) || (NULL == newtype) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if( (MPI_ORDER_C != order) && (MPI_ORDER_FORTRAN != order) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + for( i = 0; i < ndims; i++ ) { +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, size_array[i]); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, subsize_array[i]); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, start_array[i]); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + if( (subsize_array[i] < 1) || (subsize_array[i] > size_array[i]) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if( (start_array[i] < 0) || (start_array[i] > (size_array[i] - subsize_array[i])) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + } + +#if OMPI_BIGCOUNT_SRC + isize_array = (int *)malloc(ndims * sizeof(int)); + if (NULL == isize_array) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + isubsize_array = (int *)malloc(ndims * sizeof(int)); + if (NULL == isubsize_array) { + free(isize_array); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + istart_array = (int *)malloc(ndims * sizeof(int)); + if (NULL == istart_array) { + free(isize_array); + free(isubsize_array); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + for (int ii = 0; ii < ndims; ii++) { + isize_array[ii] = (int)size_array[ii]; + isubsize_array[ii] = (int)subsize_array[ii]; + istart_array[ii] = (int)start_array[ii]; + } +#else + isize_array = (int *)size_array; + isubsize_array = (int *)subsize_array; + istart_array = (int *)start_array; +#endif + rc = ompi_datatype_create_subarray( ndims, isize_array, isubsize_array, istart_array, + order, oldtype, newtype); + if( OMPI_SUCCESS == rc ) { + const int* a_i[5] = {&ndims, isize_array, isubsize_array, istart_array, &order}; + + ompi_datatype_set_args( *newtype, 3 * ndims + 2, a_i, 0, NULL, 1, &oldtype, + MPI_COMBINER_SUBARRAY ); + } + +#if OMPI_BIGCOUNT_SRC + free(isize_array); + free(isubsize_array); + free(istart_array); +#endif + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_delete_attr.c b/ompi/mpi/c/type_delete_attr.c deleted file mode 100644 index 050df3586d0..00000000000 --- a/ompi/mpi/c/type_delete_attr.c +++ /dev/null @@ -1,62 +0,0 @@ -/* - * 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_delete_attr = PMPI_Type_delete_attr -#endif -#define MPI_Type_delete_attr PMPI_Type_delete_attr -#endif - -static const char FUNC_NAME[] = "MPI_Type_delete_attr"; - - -int MPI_Type_delete_attr (MPI_Datatype type, int type_keyval) -{ - int ret; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_TYPE, - FUNC_NAME); - } - } - - ret = ompi_attr_delete(TYPE_ATTR, type, type->d_keyhash, type_keyval, - false); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, - MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_delete_attr.c.in b/ompi/mpi/c/type_delete_attr.c.in new file mode 100644 index 00000000000..68de235978c --- /dev/null +++ b/ompi/mpi/c/type_delete_attr.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_delete_attr(DATATYPE type, INT type_keyval) +{ + int ret; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_TYPE, + FUNC_NAME); + } + } + + ret = ompi_attr_delete(TYPE_ATTR, type, type->d_keyhash, type_keyval, + false); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, + MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_dup.c b/ompi/mpi/c/type_dup.c deleted file mode 100644 index 27d3fae39cf..00000000000 --- a/ompi/mpi/c/type_dup.c +++ /dev/null @@ -1,83 +0,0 @@ -/* - * 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/attribute/attribute.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_dup = PMPI_Type_dup -#endif -#define MPI_Type_dup PMPI_Type_dup -#endif - -static const char FUNC_NAME[] = "MPI_Type_dup"; - - -int MPI_Type_dup (MPI_Datatype type, - MPI_Datatype *newtype) -{ - int ret; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - if (OMPI_SUCCESS != (ret = ompi_datatype_duplicate( type, newtype))) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( ret, ret, FUNC_NAME ); - } - - ompi_datatype_set_args( *newtype, 0, NULL, 0, NULL, 1, &type, MPI_COMBINER_DUP ); - - /* Copy all the old attributes, if there were any. This is done - here (vs. ompi_datatype_duplicate()) because MPI_TYPE_DUP is the - only MPI function that copies attributes. All other MPI - functions that take an old type and generate a newtype do not - copy attributes. Really. */ - if (NULL != type->d_keyhash) { - ompi_attr_hash_init(&(*newtype)->d_keyhash); - if (OMPI_SUCCESS != (ret = ompi_attr_copy_all(TYPE_ATTR, - type, *newtype, - type->d_keyhash, - (*newtype)->d_keyhash))) { - ompi_datatype_destroy(newtype); - OMPI_ERRHANDLER_NOHANDLE_RETURN( ret, ret, FUNC_NAME ); - } - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_dup.c.in b/ompi/mpi/c/type_dup.c.in new file mode 100644 index 00000000000..41abec68692 --- /dev/null +++ b/ompi/mpi/c/type_dup.c.in @@ -0,0 +1,74 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/attribute/attribute.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_dup (DATATYPE type, DATATYPE_OUT newtype) +{ + int ret; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } + } + + if (OMPI_SUCCESS != (ret = ompi_datatype_duplicate( type, newtype))) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( ret, ret, FUNC_NAME ); + } + + ompi_datatype_set_args( *newtype, 0, NULL, 0, NULL, 1, &type, MPI_COMBINER_DUP ); + + /* Copy all the old attributes, if there were any. This is done + here (vs. ompi_datatype_duplicate()) because MPI_TYPE_DUP is the + only MPI function that copies attributes. All other MPI + functions that take an old type and generate a newtype do not + copy attributes. Really. */ + if (NULL != type->d_keyhash) { + ompi_attr_hash_init(&(*newtype)->d_keyhash); + if (OMPI_SUCCESS != (ret = ompi_attr_copy_all(TYPE_ATTR, + type, *newtype, + type->d_keyhash, + (*newtype)->d_keyhash))) { + ompi_datatype_destroy(newtype); + OMPI_ERRHANDLER_NOHANDLE_RETURN( ret, ret, FUNC_NAME ); + } + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_f2c.c b/ompi/mpi/c/type_f2c.c deleted file mode 100644 index 2afa2909ddd..00000000000 --- a/ompi/mpi/c/type_f2c.c +++ /dev/null @@ -1,65 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; -*- */ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2007 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-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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_f2c = PMPI_Type_f2c -#endif -#define MPI_Type_f2c PMPI_Type_f2c -#endif - -static const char FUNC_NAME[] = "MPI_Type_f2c"; - - -MPI_Datatype MPI_Type_f2c(MPI_Fint datatype) -{ - int datatype_index = OMPI_FINT_2_INT(datatype); - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - /* Per MPI-2:4.12.4, do not invoke an error handler if we get an - invalid fortran handle. If we get an invalid fortran handle, - return an invalid C handle. */ - if (datatype_index < 0 || - datatype_index >= - opal_pointer_array_get_size(&ompi_datatype_f_to_c_table)) { - return NULL; - } - - return (MPI_Datatype)opal_pointer_array_get_item(&ompi_datatype_f_to_c_table, datatype_index); -} - diff --git a/ompi/mpi/c/type_f2c.c.in b/ompi/mpi/c/type_f2c.c.in new file mode 100644 index 00000000000..083e0dcae80 --- /dev/null +++ b/ompi/mpi/c/type_f2c.c.in @@ -0,0 +1,57 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2007 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-2012 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" +#include "ompi/memchecker.h" + +PROTOTYPE DATATYPE type_f2c(FINT datatype) +{ + int datatype_index = OMPI_FINT_2_INT(datatype); + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + /* Per MPI-2:4.12.4, do not invoke an error handler if we get an + invalid fortran handle. If we get an invalid fortran handle, + return an invalid C handle. */ + if (datatype_index < 0 || + datatype_index >= + opal_pointer_array_get_size(&ompi_datatype_f_to_c_table)) { + return NULL; + } + + return (MPI_Datatype)opal_pointer_array_get_item(&ompi_datatype_f_to_c_table, datatype_index); +} + diff --git a/ompi/mpi/c/type_free.c b/ompi/mpi/c/type_free.c deleted file mode 100644 index c7b562d961b..00000000000 --- a/ompi/mpi/c/type_free.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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) 2009 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_free = PMPI_Type_free -#endif -#define MPI_Type_free PMPI_Type_free -#endif - -static const char FUNC_NAME[] = "MPI_Type_free"; - - -int MPI_Type_free(MPI_Datatype *type) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(*type); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || NULL == *type || MPI_DATATYPE_NULL == *type || - ompi_datatype_is_predefined(*type)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } - } - - rc = ompi_datatype_destroy( type ); - if( rc != MPI_SUCCESS ) { - OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_INTERN, - MPI_ERR_INTERN, FUNC_NAME ); - } - *type = MPI_DATATYPE_NULL; - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_free.c.in b/ompi/mpi/c/type_free.c.in new file mode 100644 index 00000000000..fbdfb199434 --- /dev/null +++ b/ompi/mpi/c/type_free.c.in @@ -0,0 +1,58 @@ +/* + * 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) 2009 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_free(DATATYPE_OUT type) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(*type); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || NULL == *type || MPI_DATATYPE_NULL == *type || + ompi_datatype_is_predefined(*type)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } + } + + rc = ompi_datatype_destroy( type ); + if( rc != MPI_SUCCESS ) { + OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_INTERN, + MPI_ERR_INTERN, FUNC_NAME ); + } + *type = MPI_DATATYPE_NULL; + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_free_keyval.c b/ompi/mpi/c/type_free_keyval.c deleted file mode 100644 index 3ea276a1cf2..00000000000 --- a/ompi/mpi/c/type_free_keyval.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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) 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_free_keyval = PMPI_Type_free_keyval -#endif -#define MPI_Type_free_keyval PMPI_Type_free_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Type_free_keyval"; - - -int MPI_Type_free_keyval(int *type_keyval) -{ - int ret; - - /* Check for valid key pointer */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type_keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_ARG, - FUNC_NAME); - } - } - - ret = ompi_attr_free_keyval(TYPE_ATTR, type_keyval, 0); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, - MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_free_keyval.c.in b/ompi/mpi/c/type_free_keyval.c.in new file mode 100644 index 00000000000..1c08edd3351 --- /dev/null +++ b/ompi/mpi/c/type_free_keyval.c.in @@ -0,0 +1,50 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS type_free_keyval(INT_OUT type_keyval) +{ + int ret; + + /* Check for valid key pointer */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type_keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_ARG, + FUNC_NAME); + } + } + + ret = ompi_attr_free_keyval(TYPE_ATTR, type_keyval, 0); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, + MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_get_attr.c b/ompi/mpi/c/type_get_attr.c deleted file mode 100644 index 1b42b5c8122..00000000000 --- a/ompi/mpi/c/type_get_attr.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_attr = PMPI_Type_get_attr -#endif -#define MPI_Type_get_attr PMPI_Type_get_attr -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_attr"; - - -int MPI_Type_get_attr (MPI_Datatype type, - int type_keyval, - void *attribute_val, - int *flag) -{ - int ret; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } else if ((NULL == attribute_val) || (NULL == flag)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE( - MPI_ERR_ARG, - FUNC_NAME); - } else if (MPI_KEYVAL_INVALID == type_keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, - FUNC_NAME); - } - } - - /* This stuff is very confusing. Be sure to see - src/attribute/attribute.c for a lengthy comment explaining Open - MPI attribute behavior. */ - - ret = ompi_attr_get_c(type->d_keyhash, type_keyval, - (void**)attribute_val, flag); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, - MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_get_attr.c.in b/ompi/mpi/c/type_get_attr.c.in new file mode 100644 index 00000000000..506adb9bf9d --- /dev/null +++ b/ompi/mpi/c/type_get_attr.c.in @@ -0,0 +1,67 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_attr (DATATYPE type, + INT type_keyval, + BUFFER_OUT attribute_val, + INT_OUT flag) +{ + int ret; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if ((NULL == attribute_val) || (NULL == flag)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE( + MPI_ERR_ARG, + FUNC_NAME); + } else if (MPI_KEYVAL_INVALID == type_keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_KEYVAL, + FUNC_NAME); + } + } + + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(type->d_keyhash, type_keyval, + (void**)attribute_val, flag); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, + MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_get_contents_c.c b/ompi/mpi/c/type_get_contents_c.c new file mode 100644 index 00000000000..6be23ccc4c4 --- /dev/null +++ b/ompi/mpi/c/type_get_contents_c.c @@ -0,0 +1,95 @@ +/* + * 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_Type_get_contents_c = PMPI_Type_get_contents_c +#endif +#define MPI_Type_get_contents_c PMPI_Type_get_contents_c +#endif + +static const char FUNC_NAME[] = "MPI_Type_get_contents_c"; + + +int MPI_Type_get_contents_c(MPI_Datatype mtype, + MPI_Count max_integers, + MPI_Count max_addresses, + MPI_Count max_large_counts, + MPI_Count max_datatypes, + int array_of_integers[], + MPI_Aint array_of_addresses[], + MPI_Count array_of_large_counts[], + MPI_Datatype array_of_datatypes[]) +{ + int rc, i; + MPI_Datatype newtype; + + MEMCHECKER( + memchecker_datatype(mtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == mtype || MPI_DATATYPE_NULL == mtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if( ((NULL == array_of_integers) && (max_integers != 0)) || + ((NULL == array_of_addresses) && (max_addresses != 0)) || + ((NULL == array_of_datatypes) && (max_datatypes != 0)) ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + +/* TODO:BIGCOUNT: Need to embiggen ompi_datatype_get_args */ + rc = ompi_datatype_get_args( mtype, 1, (int *)&max_integers, array_of_integers, + (int *)&max_addresses, array_of_addresses, + (int *)&max_datatypes, array_of_datatypes, NULL ); + if( rc != MPI_SUCCESS ) { + OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_INTERN, + MPI_ERR_INTERN, FUNC_NAME ); + } + + for( i = 0; i < max_datatypes; i++ ) { + /* if we have a predefined datatype then we return directly a pointer to + * the datatype, otherwise we should create a copy and give back the copy. + */ + if( !(ompi_datatype_is_predefined(array_of_datatypes[i])) ) { + if( (rc = ompi_datatype_duplicate( array_of_datatypes[i], &newtype )) != MPI_SUCCESS ) { + ompi_datatype_destroy( &newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_INTERN, + MPI_ERR_INTERN, FUNC_NAME ); + } + ompi_datatype_copy_args( array_of_datatypes[i], newtype ); + array_of_datatypes[i] = newtype; + } + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_get_envelope.c.in b/ompi/mpi/c/type_get_envelope.c.in new file mode 100644 index 00000000000..e5395d796e4 --- /dev/null +++ b/ompi/mpi/c/type_get_envelope.c.in @@ -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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS Type_get_envelope(DATATYPE type, + INT_OUT num_integers, + INT_OUT num_addresses, + INT_OUT num_datatypes, + INT_OUT combiner) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if (NULL == num_integers || NULL == num_addresses || + NULL == num_datatypes || NULL == combiner) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + + rc = ompi_datatype_get_args( type, 0, num_integers, NULL, num_addresses, NULL, + num_datatypes, NULL, combiner ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_get_envelope_c.c b/ompi/mpi/c/type_get_envelope_c.c new file mode 100644 index 00000000000..24229e327cf --- /dev/null +++ b/ompi/mpi/c/type_get_envelope_c.c @@ -0,0 +1,69 @@ +/* + * 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +#if OMPI_BUILD_MPI_PROFILING +#if OPAL_HAVE_WEAK_SYMBOLS +#pragma weak MPI_Type_get_envelope_c = PMPI_Type_get_envelope_c +#endif +#define MPI_Type_get_envelope_c PMPI_Type_get_envelope_c +#endif + +static const char FUNC_NAME[] = "MPI_Type_get_envelope_c"; + +int MPI_Type_get_envelope_c(MPI_Datatype type, + MPI_Count *num_integers, + MPI_Count *num_addresses, + MPI_Count *num_large_counts, + MPI_Count *num_datatypes, + int *combiner) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if (NULL == num_integers || NULL == num_addresses || + NULL == num_datatypes || NULL == combiner) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + +/* TODO:BIGCOUNT: Need to embiggen ompi_datatype_get_args */ + rc = ompi_datatype_get_args( type, 0, (int *)num_integers, NULL, (int *)num_addresses, NULL, + (int *)num_datatypes, NULL, combiner ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, rc, FUNC_NAME ); +} + diff --git a/ompi/mpi/c/type_get_extent.c b/ompi/mpi/c/type_get_extent.c deleted file mode 100644 index 0fddff2b0cb..00000000000 --- a/ompi/mpi/c/type_get_extent.c +++ /dev/null @@ -1,60 +0,0 @@ -/* - * 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_extent = PMPI_Type_get_extent -#endif -#define MPI_Type_get_extent PMPI_Type_get_extent -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_extent"; - -int MPI_Type_get_extent(MPI_Datatype type, MPI_Aint *lb, MPI_Aint *extent) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if (NULL == lb || NULL == extent) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_datatype_get_extent( type, lb, extent ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_get_extent.c.in b/ompi/mpi/c/type_get_extent.c.in new file mode 100644 index 00000000000..a2b044c9e33 --- /dev/null +++ b/ompi/mpi/c/type_get_extent.c.in @@ -0,0 +1,57 @@ +/* + * 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_extent(DATATYPE type, AINT_COUNT_OUT lb, AINT_COUNT_OUT extent) +{ + int rc; + ptrdiff_t tmp_lb = 0; + ptrdiff_t tmp_extent = 0; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if (NULL == lb || NULL == extent) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_datatype_get_extent( type, &tmp_lb, &tmp_extent ); + *lb = tmp_lb; + *extent = tmp_extent; + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_get_extent_x.c b/ompi/mpi/c/type_get_extent_x.c deleted file mode 100644 index 5781a2f5468..00000000000 --- a/ompi/mpi/c/type_get_extent_x.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_extent_x = PMPI_Type_get_extent_x -#endif -#define MPI_Type_get_extent_x PMPI_Type_get_extent_x -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_extent_x"; - -int MPI_Type_get_extent_x(MPI_Datatype type, MPI_Count *lb, MPI_Count *extent) -{ - MPI_Aint alb, aextent; - int rc; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if (NULL == lb || NULL == extent) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - rc = ompi_datatype_get_extent( type, &alb, &aextent ); - if (OMPI_SUCCESS == rc) { - *lb = (MPI_Count) alb; - *extent = (MPI_Count) aextent; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_get_extent_x.c.in b/ompi/mpi/c/type_get_extent_x.c.in new file mode 100644 index 00000000000..4ee710708b5 --- /dev/null +++ b/ompi/mpi/c/type_get_extent_x.c.in @@ -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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_extent_x(DATATYPE type, ELEMENT_COUNT lb, ELEMENT_COUNT extent) +{ + MPI_Aint alb, aextent; + int rc; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if (NULL == lb || NULL == extent) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + rc = ompi_datatype_get_extent( type, &alb, &aextent ); + if (OMPI_SUCCESS == rc) { + *lb = (MPI_Count) alb; + *extent = (MPI_Count) aextent; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_get_name.c b/ompi/mpi/c/type_get_name.c deleted file mode 100644 index b38697a1bc1..00000000000 --- a/ompi/mpi/c/type_get_name.c +++ /dev/null @@ -1,76 +0,0 @@ -/* - * 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) 2008-2018 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 - -#include "opal/util/string_copy.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_name = PMPI_Type_get_name -#endif -#define MPI_Type_get_name PMPI_Type_get_name -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_name"; - - -int MPI_Type_get_name(MPI_Datatype type, char *type_name, int *resultlen) -{ - - MEMCHECKER( - memchecker_datatype(type); - ); - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } else if (NULL == type_name || NULL == resultlen) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } - } - - /* Note that MPI-2.1 requires: - - terminating the string with a \0 - - name[*resultlen] == '\0' - - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) - - The Fortran API version will pad to the right if necessary. - - Note that type->name is guaranteed to be \0-terminated and - able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., - name+\0). */ - *resultlen = (int)strlen(type->name); - opal_string_copy(type_name, type->name, MPI_MAX_OBJECT_NAME); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_get_name.c.in b/ompi/mpi/c/type_get_name.c.in new file mode 100644 index 00000000000..68358762dce --- /dev/null +++ b/ompi/mpi/c/type_get_name.c.in @@ -0,0 +1,68 @@ +/* + * 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) 2008-2018 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/util/string_copy.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_name(DATATYPE type, STRING_OUT type_name, INT_OUT resultlen) +{ + + MEMCHECKER( + memchecker_datatype(type); + ); + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if (NULL == type_name || NULL == resultlen) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + + /* Note that MPI-2.1 requires: + - terminating the string with a \0 + - name[*resultlen] == '\0' + - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) + + The Fortran API version will pad to the right if necessary. + + Note that type->name is guaranteed to be \0-terminated and + able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., + name+\0). */ + *resultlen = (int)strlen(type->name); + opal_string_copy(type_name, type->name, MPI_MAX_OBJECT_NAME); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_get_true_extent.c b/ompi/mpi/c/type_get_true_extent.c deleted file mode 100644 index f2a6377593c..00000000000 --- a/ompi/mpi/c/type_get_true_extent.c +++ /dev/null @@ -1,64 +0,0 @@ -/* - * 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_true_extent = PMPI_Type_get_true_extent -#endif -#define MPI_Type_get_true_extent PMPI_Type_get_true_extent -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_true_extent"; - -int MPI_Type_get_true_extent(MPI_Datatype datatype, - MPI_Aint *true_lb, - MPI_Aint *true_extent) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } else if (NULL == true_lb || NULL == true_extent) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } - } - - rc = ompi_datatype_get_true_extent( datatype, true_lb, true_extent ); - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_get_true_extent.c.in b/ompi/mpi/c/type_get_true_extent.c.in new file mode 100644 index 00000000000..ab8b2e2cddf --- /dev/null +++ b/ompi/mpi/c/type_get_true_extent.c.in @@ -0,0 +1,57 @@ +/* + * 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_true_extent(DATATYPE datatype, + AINT_COUNT_OUT true_lb, + AINT_COUNT_OUT true_extent) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if (NULL == true_lb || NULL == true_extent) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + + rc = ompi_datatype_get_true_extent( datatype, (MPI_Aint *)true_lb, (MPI_Aint *)true_extent ); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_get_true_extent_x.c b/ompi/mpi/c/type_get_true_extent_x.c deleted file mode 100644 index bbbe7197992..00000000000 --- a/ompi/mpi/c/type_get_true_extent_x.c +++ /dev/null @@ -1,70 +0,0 @@ -/* - * 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_get_true_extent_x = PMPI_Type_get_true_extent_x -#endif -#define MPI_Type_get_true_extent_x PMPI_Type_get_true_extent_x -#endif - -static const char FUNC_NAME[] = "MPI_Type_get_true_extent_x"; - -int MPI_Type_get_true_extent_x(MPI_Datatype datatype, - MPI_Count *true_lb, - MPI_Count *true_extent) -{ - MPI_Aint atrue_lb, atrue_extent; - int rc; - - MEMCHECKER( - memchecker_datatype(datatype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } else if (NULL == true_lb || NULL == true_extent) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME ); - } - } - - rc = ompi_datatype_get_true_extent( datatype, &atrue_lb, &atrue_extent ); - if (OMPI_SUCCESS == rc) { - *true_lb = (MPI_Count) atrue_lb; - *true_extent = (MPI_Count) atrue_extent; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); -} diff --git a/ompi/mpi/c/type_get_true_extent_x.c.in b/ompi/mpi/c/type_get_true_extent_x.c.in new file mode 100644 index 00000000000..8999e924165 --- /dev/null +++ b/ompi/mpi/c/type_get_true_extent_x.c.in @@ -0,0 +1,63 @@ +/* + * 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_get_true_extent_x(DATATYPE datatype, + ELEMENT_COUNT true_lb, + ELEMENT_COUNT true_extent) +{ + MPI_Aint atrue_lb, atrue_extent; + int rc; + + MEMCHECKER( + memchecker_datatype(datatype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == datatype || MPI_DATATYPE_NULL == datatype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if (NULL == true_lb || NULL == true_extent) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME ); + } + } + + rc = ompi_datatype_get_true_extent( datatype, &atrue_lb, &atrue_extent ); + if (OMPI_SUCCESS == rc) { + *true_lb = (MPI_Count) atrue_lb; + *true_extent = (MPI_Count) atrue_extent; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME ); +} diff --git a/ompi/mpi/c/type_indexed.c b/ompi/mpi/c/type_indexed.c deleted file mode 100644 index c4589d0583d..00000000000 --- a/ompi/mpi/c/type_indexed.c +++ /dev/null @@ -1,93 +0,0 @@ -/* -*- 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) 2012-2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_indexed = PMPI_Type_indexed -#endif -#define MPI_Type_indexed PMPI_Type_indexed -#endif - -static const char FUNC_NAME[] = "MPI_Type_indexed"; - -int MPI_Type_indexed(int count, - const int array_of_blocklengths[], - const int array_of_displacements[], - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc, i; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME); - } else if( count < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, - FUNC_NAME); - } else if ((count > 0) && (NULL == array_of_blocklengths || - NULL == array_of_displacements)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - for( i = 0; i < count; i++ ) { - if( array_of_blocklengths[i] < 0 ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - } - - rc = ompi_datatype_create_indexed ( count, array_of_blocklengths, - array_of_displacements, - oldtype, newtype ); - if( rc != MPI_SUCCESS ) { - ompi_datatype_destroy( newtype ); - OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, - rc, FUNC_NAME ); - } - - { - const int* a_i[3] = {&count, array_of_blocklengths, array_of_displacements}; - - ompi_datatype_set_args( *newtype, 2 * count + 1, a_i, 0, NULL, 1, &oldtype, - MPI_COMBINER_INDEXED ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_indexed.c.in b/ompi/mpi/c/type_indexed.c.in new file mode 100644 index 00000000000..c3ff80c1b1c --- /dev/null +++ b/ompi/mpi/c/type_indexed.c.in @@ -0,0 +1,123 @@ +/* -*- 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) 2012-2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + + +PROTOTYPE ERROR_CLASS type_indexed(COUNT count, + COUNT_ARRAY array_of_blocklengths, + COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc, i; + int *iarray_of_blocklengths; + int *iarray_of_displacements; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME); + } else if( count < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, + FUNC_NAME); + } else if ((count > 0) && (NULL == array_of_blocklengths || + NULL == array_of_displacements)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(rc, FUNC_NAME); + } +#endif + for( i = 0; i < count; i++ ) { + if( array_of_blocklengths[i] < 0 ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + } + +#if OMPI_BIGCOUNT_SRC + iarray_of_blocklengths = (int *)malloc(count * sizeof(int)); + if (NULL == iarray_of_blocklengths) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + iarray_of_displacements = (int *)malloc(count * sizeof(int)); + if (NULL == iarray_of_displacements) { + free(iarray_of_blocklengths); + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, FUNC_NAME); + } + + for (int ii = 0; ii < (int)count; ii++) { + iarray_of_blocklengths[ii] = (int)array_of_blocklengths[ii]; + iarray_of_displacements[ii] = (int)array_of_displacements[ii]; + } +#else + iarray_of_blocklengths = (int *)array_of_blocklengths; + iarray_of_displacements = (int *)array_of_displacements; +#endif + rc = ompi_datatype_create_indexed ( count, iarray_of_blocklengths, + iarray_of_displacements, + oldtype, newtype ); + if( rc != MPI_SUCCESS ) { + ompi_datatype_destroy( newtype ); + OMPI_ERRHANDLER_NOHANDLE_RETURN( rc, + rc, FUNC_NAME ); + } + + { + const int* a_i[3] = {(int *)&count, iarray_of_blocklengths, iarray_of_displacements}; + + ompi_datatype_set_args( *newtype, 2 * count + 1, a_i, 0, NULL, 1, &oldtype, + MPI_COMBINER_INDEXED ); + } +#if OMPI_BIGCOUNT_SRC + free(iarray_of_blocklengths); + free(iarray_of_displacements); +#endif + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_match_size.c b/ompi/mpi/c/type_match_size.c deleted file mode 100644 index d34f4825960..00000000000 --- a/ompi/mpi/c/type_match_size.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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-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) 2009 Sun Microsystems, 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/datatype/ompi_datatype_internal.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_match_size = PMPI_Type_match_size -#endif -#define MPI_Type_match_size PMPI_Type_match_size -#endif - -static const char FUNC_NAME[] = "MPI_Type_match_size"; - - -int MPI_Type_match_size(int typeclass, int size, MPI_Datatype *type) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - } - - switch( typeclass ) { - case MPI_TYPECLASS_REAL: - *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_FLOAT, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); - break; - case MPI_TYPECLASS_INTEGER: - *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_INT, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); - break; - case MPI_TYPECLASS_COMPLEX: - *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_COMPLEX, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); - break; - default: - *type = &ompi_mpi_datatype_null.dt; - } - - if( *type != &ompi_mpi_datatype_null.dt ) { - return MPI_SUCCESS; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); -} diff --git a/ompi/mpi/c/type_match_size.c.in b/ompi/mpi/c/type_match_size.c.in new file mode 100644 index 00000000000..cbb94a3305b --- /dev/null +++ b/ompi/mpi/c/type_match_size.c.in @@ -0,0 +1,58 @@ +/* + * 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-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) 2009 Sun Microsystems, 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/datatype/ompi_datatype_internal.h" + +PROTOTYPE ERROR_CLASS type_match_size(INT typeclass, INT size, DATATYPE_OUT type) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + } + + switch( typeclass ) { + case MPI_TYPECLASS_REAL: + *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_FLOAT, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); + break; + case MPI_TYPECLASS_INTEGER: + *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_INT, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); + break; + case MPI_TYPECLASS_COMPLEX: + *type = (MPI_Datatype)ompi_datatype_match_size( size, OMPI_DATATYPE_FLAG_DATA_COMPLEX, OMPI_DATATYPE_FLAG_DATA_FORTRAN ); + break; + default: + *type = &ompi_mpi_datatype_null.dt; + } + + if( *type != &ompi_mpi_datatype_null.dt ) { + return MPI_SUCCESS; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); +} diff --git a/ompi/mpi/c/type_set_attr.c b/ompi/mpi/c/type_set_attr.c deleted file mode 100644 index 6a4b2b3b27e..00000000000 --- a/ompi/mpi/c/type_set_attr.c +++ /dev/null @@ -1,64 +0,0 @@ -/* - * 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$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_set_attr = PMPI_Type_set_attr -#endif -#define MPI_Type_set_attr PMPI_Type_set_attr -#endif - -static const char FUNC_NAME[] = "MPI_Type_set_attr"; - - -int MPI_Type_set_attr (MPI_Datatype type, - int type_keyval, - void *attribute_val) -{ - int ret; - - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } - } - - ret = ompi_attr_set_c(TYPE_ATTR, type, &type->d_keyhash, - type_keyval, attribute_val, false); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, - MPI_ERR_OTHER, FUNC_NAME); - -} diff --git a/ompi/mpi/c/type_set_attr.c.in b/ompi/mpi/c/type_set_attr.c.in new file mode 100644 index 00000000000..9c3c88ea20a --- /dev/null +++ b/ompi/mpi/c/type_set_attr.c.in @@ -0,0 +1,55 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_set_attr (DATATYPE type, INT type_keyval, + BUFFER_OUT attribute_val) +{ + int ret; + + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } + } + + ret = ompi_attr_set_c(TYPE_ATTR, type, &type->d_keyhash, + type_keyval, attribute_val, false); + + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, + MPI_ERR_OTHER, FUNC_NAME); + +} diff --git a/ompi/mpi/c/type_set_name.c b/ompi/mpi/c/type_set_name.c deleted file mode 100644 index 86cb18d94a8..00000000000 --- a/ompi/mpi/c/type_set_name.c +++ /dev/null @@ -1,66 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018 Cisco Systems, Inc. All rights reserved - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include - -#include "opal/util/string_copy.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_set_name = PMPI_Type_set_name -#endif -#define MPI_Type_set_name PMPI_Type_set_name -#endif - -static const char FUNC_NAME[] = "MPI_Type_set_name"; - - -int MPI_Type_set_name (MPI_Datatype type, const char *type_name) -{ - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if (NULL == type_name) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - memset(type->name, 0, MPI_MAX_OBJECT_NAME); - opal_string_copy( type->name, type_name, MPI_MAX_OBJECT_NAME); - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_set_name.c.in b/ompi/mpi/c/type_set_name.c.in new file mode 100644 index 00000000000..6414bb4bb46 --- /dev/null +++ b/ompi/mpi/c/type_set_name.c.in @@ -0,0 +1,58 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "opal/util/string_copy.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_set_name (DATATYPE type, STRING type_name) +{ + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if (NULL == type_name) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + memset(type->name, 0, MPI_MAX_OBJECT_NAME); + opal_string_copy( type->name, type_name, MPI_MAX_OBJECT_NAME); + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_size.c b/ompi/mpi/c/type_size.c deleted file mode 100644 index 9d709624f49..00000000000 --- a/ompi/mpi/c/type_size.c +++ /dev/null @@ -1,64 +0,0 @@ -/* -*- 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) 2009 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_size = PMPI_Type_size -#endif -#define MPI_Type_size PMPI_Type_size -#endif - -static const char FUNC_NAME[] = "MPI_Type_size"; - -int MPI_Type_size(MPI_Datatype type, int *size) -{ - size_t type_size; - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if (NULL == size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - opal_datatype_type_size ( &type->super, &type_size); - - *size = (type_size > (size_t) INT_MAX) ? MPI_UNDEFINED : (int) type_size; - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_size.c.in b/ompi/mpi/c/type_size.c.in new file mode 100644 index 00000000000..6e0897dd7aa --- /dev/null +++ b/ompi/mpi/c/type_size.c.in @@ -0,0 +1,57 @@ +/* -*- 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) 2009 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_size(DATATYPE type, COUNT_OUT size) +{ + size_t type_size; + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if (NULL == size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + opal_datatype_type_size ( &type->super, &type_size); + + *size = (type_size > (size_t) INT_MAX) ? MPI_UNDEFINED : (int) type_size; + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_size_x.c b/ompi/mpi/c/type_size_x.c deleted file mode 100644 index 8a10be03606..00000000000 --- a/ompi/mpi/c/type_size_x.c +++ /dev/null @@ -1,64 +0,0 @@ -/* -*- 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) 2009 Oak Ridge National Labs. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_size_x = PMPI_Type_size_x -#endif -#define MPI_Type_size_x PMPI_Type_size_x -#endif - -static const char FUNC_NAME[] = "MPI_Type_size_x"; - -int MPI_Type_size_x(MPI_Datatype type, MPI_Count *size) -{ - size_t type_size; - MEMCHECKER( - memchecker_datatype(type); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == type || MPI_DATATYPE_NULL == type) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); - } else if (NULL == size) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } - } - - opal_datatype_type_size ( &type->super, &type_size); - - *size = (type_size > (size_t) MPI_COUNT_MAX) ? MPI_UNDEFINED : (MPI_Count) type_size; - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_size_x.c.in b/ompi/mpi/c/type_size_x.c.in new file mode 100644 index 00000000000..ded1005acc6 --- /dev/null +++ b/ompi/mpi/c/type_size_x.c.in @@ -0,0 +1,57 @@ +/* -*- 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) 2009 Oak Ridge National Labs. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS type_size_x(DATATYPE type, ELEMENT_COUNT size) +{ + size_t type_size; + MEMCHECKER( + memchecker_datatype(type); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == type || MPI_DATATYPE_NULL == type) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, FUNC_NAME); + } else if (NULL == size) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } + } + + opal_datatype_type_size ( &type->super, &type_size); + + *size = (type_size > (size_t) MPI_COUNT_MAX) ? MPI_UNDEFINED : (MPI_Count) type_size; + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/type_vector.c b/ompi/mpi/c/type_vector.c deleted file mode 100644 index 12524f26271..00000000000 --- a/ompi/mpi/c/type_vector.c +++ /dev/null @@ -1,79 +0,0 @@ -/* -*- 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) 2013 Los Alamos National Security, LLC. 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/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Type_vector = PMPI_Type_vector -#endif -#define MPI_Type_vector PMPI_Type_vector -#endif - -static const char FUNC_NAME[] = "MPI_Type_vector"; - -int MPI_Type_vector(int count, - int blocklength, - int stride, - MPI_Datatype oldtype, - MPI_Datatype *newtype) -{ - int rc; - - MEMCHECKER( - memchecker_datatype(oldtype); - ); - - if( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || - NULL == newtype) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, - FUNC_NAME ); - } else if( count < 0 ) { - OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_COUNT, - MPI_ERR_COUNT, FUNC_NAME ); - } else if( blocklength < 0) { - OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_ARG, - MPI_ERR_ARG, FUNC_NAME ); - } - } - - rc = ompi_datatype_create_vector ( count, blocklength, stride, oldtype, newtype ); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); - - { - const int* a_i[3] = {&count, &blocklength, &stride}; - - ompi_datatype_set_args( *newtype, 3, a_i, 0, NULL, 1, &oldtype, MPI_COMBINER_VECTOR ); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/type_vector.c.in b/ompi/mpi/c/type_vector.c.in new file mode 100644 index 00000000000..08bad80d75f --- /dev/null +++ b/ompi/mpi/c/type_vector.c.in @@ -0,0 +1,83 @@ +/* -*- 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) 2013 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/memchecker.h" + +/* + * TODO:BIGCOUNT this file will need to be updated once + * the datatype framework supports bigcount + */ + +PROTOTYPE ERROR_CLASS type_vector(COUNT count, + COUNT blocklength, + COUNT stride, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int rc; + + MEMCHECKER( + memchecker_datatype(oldtype); + ); + + if( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == oldtype || MPI_DATATYPE_NULL == oldtype || + NULL == newtype) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_TYPE, + FUNC_NAME ); + } else if( count < 0 ) { + OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_COUNT, + MPI_ERR_COUNT, FUNC_NAME ); + } else if( blocklength < 0) { + OMPI_ERRHANDLER_NOHANDLE_RETURN( MPI_ERR_ARG, + MPI_ERR_ARG, FUNC_NAME ); + } +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(rc, count); + if (OMPI_SUCCESS != rc) { + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); + } +#endif + } + + rc = ompi_datatype_create_vector ( count, blocklength, stride, oldtype, newtype ); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME ); + + { + const int* a_i[3] = {(int *)&count, (int *)&blocklength, (int *)&stride}; + + ompi_datatype_set_args( *newtype, 3, a_i, 0, NULL, 1, &oldtype, MPI_COMBINER_VECTOR ); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/unpack.c b/ompi/mpi/c/unpack.c deleted file mode 100644 index fb1d45204d7..00000000000 --- a/ompi/mpi/c/unpack.c +++ /dev/null @@ -1,129 +0,0 @@ -/* - * 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) 2006-2013 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015-2018 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 IBM Corporation. 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/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Unpack = PMPI_Unpack -#endif -#define MPI_Unpack PMPI_Unpack -#endif - -static const char FUNC_NAME[] = "MPI_Unpack"; - - -int MPI_Unpack(const void *inbuf, int insize, int *position, - void *outbuf, int outcount, MPI_Datatype datatype, - MPI_Comm comm) -{ - int rc = MPI_SUCCESS; - opal_convertor_t local_convertor; - struct iovec outvec; - unsigned int iov_count; - size_t size; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, inbuf, insize, MPI_PACKED); - memchecker_call(&opal_memchecker_base_isaddressable, outbuf, outcount, datatype); - memchecker_comm(comm); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_comm_invalid(comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - } - - if ((NULL == inbuf) || (NULL == position)) { /* outbuf can be MPI_BOTTOM */ - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); - } - - if (outcount < 0) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); - } - - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, outcount); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - OMPI_CHECK_USER_BUFFER(rc, outbuf, datatype, outcount); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - } - - /* - * If a datatype's description contains a single element that describes - * a large vector that path is reasonably optimized in pack/unpack. On - * the other hand if the count and datatype combined describe the same - * vector that is processed one element at a time. - * - * So at the top level we morph the call if the count and datatype look - * like a good vector. - */ - ompi_datatype_consolidate_t dtmod; - rc = ompi_datatype_consolidate_create(outcount, datatype, &dtmod, - OMPI_DATATYPE_CONSOLIDATE_THRESHOLD); - OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); - - if( insize > 0 ) { - int ret; - OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); - /* the resulting convertor will be set the the position ZERO */ - opal_convertor_copy_and_prepare_for_recv( ompi_mpi_local_convertor, - &(dtmod.dt->super), dtmod.count, - outbuf, 0, &local_convertor ); - - /* Check for truncation */ - opal_convertor_get_packed_size( &local_convertor, &size ); - if( (*position + size) > (unsigned int)insize ) { - OBJ_DESTRUCT( &local_convertor ); - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); - } - - /* Prepare the iovec with all information */ - outvec.iov_base = (char*) inbuf + (*position); - outvec.iov_len = size; - - /* Do the actual unpacking */ - iov_count = 1; - ret = opal_convertor_unpack( &local_convertor, &outvec, &iov_count, &size ); - *position += size; - OBJ_DESTRUCT( &local_convertor ); - /* All done. Note that the convertor returns 1 upon success, not - OPAL_SUCCESS. */ - if (1 != ret) { - rc = OMPI_ERROR; - } - } - - rc = ompi_datatype_consolidate_free(&dtmod); - - OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/unpack.c.in b/ompi/mpi/c/unpack.c.in new file mode 100644 index 00000000000..baf050539b9 --- /dev/null +++ b/ompi/mpi/c/unpack.c.in @@ -0,0 +1,124 @@ +/* + * 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) 2006-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2018 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS unpack(BUFFER inbuf, + COUNT insize, + COUNT_OUT position, + BUFFER_OUT outbuf, + COUNT outcount, DATATYPE datatype, + COMM comm) +{ + int rc = MPI_SUCCESS; + opal_convertor_t local_convertor; + struct iovec outvec; + unsigned int iov_count; + size_t size; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, inbuf, insize, MPI_PACKED); + memchecker_call(&opal_memchecker_base_isaddressable, outbuf, outcount, datatype); + memchecker_comm(comm); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_comm_invalid(comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + } + + if ((NULL == inbuf) || (NULL == position)) { /* outbuf can be MPI_BOTTOM */ + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG, FUNC_NAME); + } + + if (outcount < 0) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COUNT, FUNC_NAME); + } + + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, outcount); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + OMPI_CHECK_USER_BUFFER(rc, outbuf, datatype, outcount); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + } + + /* + * If a datatype's description contains a single element that describes + * a large vector that path is reasonably optimized in pack/unpack. On + * the other hand if the count and datatype combined describe the same + * vector that is processed one element at a time. + * + * So at the top level we morph the call if the count and datatype look + * like a good vector. + */ + ompi_datatype_consolidate_t dtmod; + rc = ompi_datatype_consolidate_create(outcount, datatype, &dtmod, + OMPI_DATATYPE_CONSOLIDATE_THRESHOLD); + OMPI_ERRHANDLER_CHECK(rc, comm, rc, FUNC_NAME); + + if( insize > 0 ) { + int ret; + OBJ_CONSTRUCT( &local_convertor, opal_convertor_t ); + /* the resulting convertor will be set the the position ZERO */ + opal_convertor_copy_and_prepare_for_recv( ompi_mpi_local_convertor, + &(dtmod.dt->super), dtmod.count, + outbuf, 0, &local_convertor ); + + /* Check for truncation */ + opal_convertor_get_packed_size( &local_convertor, &size ); + if( (*position + size) > (unsigned int)insize ) { + OBJ_DESTRUCT( &local_convertor ); + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_TRUNCATE, FUNC_NAME); + } + + /* Prepare the iovec with all information */ + outvec.iov_base = (char*) inbuf + (*position); + outvec.iov_len = size; + + /* Do the actual unpacking */ + iov_count = 1; + ret = opal_convertor_unpack( &local_convertor, &outvec, &iov_count, &size ); + *position += size; + OBJ_DESTRUCT( &local_convertor ); + /* All done. Note that the convertor returns 1 upon success, not + OPAL_SUCCESS. */ + if (1 != ret) { + rc = OMPI_ERROR; + } + } + + rc = ompi_datatype_consolidate_free(&dtmod); + + OMPI_ERRHANDLER_RETURN(rc, comm, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/unpack_external.c b/ompi/mpi/c/unpack_external.c deleted file mode 100644 index 579f8b912f1..00000000000 --- a/ompi/mpi/c/unpack_external.c +++ /dev/null @@ -1,73 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/datatype/ompi_datatype.h" -#include "opal/datatype/opal_convertor.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Unpack_external = PMPI_Unpack_external -#endif -#define MPI_Unpack_external PMPI_Unpack_external -#endif - -static const char FUNC_NAME[] = "MPI_Unpack_external"; - - -int MPI_Unpack_external (const char datarep[], const void *inbuf, MPI_Aint insize, - MPI_Aint *position, void *outbuf, int outcount, - MPI_Datatype datatype) -{ - int rc = MPI_SUCCESS; - - MEMCHECKER( - memchecker_datatype(datatype); - memchecker_call(&opal_memchecker_base_isdefined, outbuf, outcount, datatype); - ); - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == inbuf) || (NULL == position)) { /* outbuf can be MPI_BOTTOM */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); - } else if (outcount < 0) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); - } - OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, outcount); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - OMPI_CHECK_USER_BUFFER(rc, outbuf, datatype, outcount); - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - rc = ompi_datatype_unpack_external(datarep, inbuf, insize, - position, outbuf, outcount, - datatype); - - OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/unpack_external.c.in b/ompi/mpi/c/unpack_external.c.in new file mode 100644 index 00000000000..645031cfd32 --- /dev/null +++ b/ompi/mpi/c/unpack_external.c.in @@ -0,0 +1,64 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/datatype/ompi_datatype.h" +#include "opal/datatype/opal_convertor.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS unpack_external (STRING datarep, BUFFER inbuf, AINT_COUNT insize, + AINT_COUNT_OUT position, BUFFER_OUT outbuf, COUNT outcount, + DATATYPE datatype) +{ + int rc = MPI_SUCCESS; + + MEMCHECKER( + memchecker_datatype(datatype); + memchecker_call(&opal_memchecker_base_isdefined, outbuf, outcount, datatype); + ); + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == inbuf) || (NULL == position)) { /* outbuf can be MPI_BOTTOM */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, FUNC_NAME); + } else if (outcount < 0) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COUNT, FUNC_NAME); + } + OMPI_CHECK_DATATYPE_FOR_RECV(rc, datatype, outcount); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + OMPI_CHECK_USER_BUFFER(rc, outbuf, datatype, outcount); + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + rc = ompi_datatype_unpack_external(datarep, inbuf, insize, + (MPI_Aint *)position, outbuf, outcount, + datatype); + OMPI_ERRHANDLER_NOHANDLE_RETURN(rc, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/unpublish_name.c b/ompi/mpi/c/unpublish_name.c deleted file mode 100644 index 800853df0da..00000000000 --- a/ompi/mpi/c/unpublish_name.c +++ /dev/null @@ -1,126 +0,0 @@ -/* -*- 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-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) 2012-2013 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" -#include - -#include "opal/class/opal_list.h" -#include "opal/mca/pmix/pmix-internal.h" -#include "opal/util/argv.h" -#include "opal/util/show_help.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Unpublish_name = PMPI_Unpublish_name -#endif -#define MPI_Unpublish_name PMPI_Unpublish_name -#endif - -static const char FUNC_NAME[] = "MPI_Unpublish_name"; - - -int MPI_Unpublish_name(const char *service_name, MPI_Info info, - const char *port_name) -{ - int ret; - opal_cstring_t *info_str; - int flag=0; - pmix_status_t rc; - pmix_info_t pinfo; - pmix_data_range_t rng = PMIX_RANGE_SESSION; - char **keys = NULL; - - if ( MPI_PARAM_CHECK ) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if ( NULL == port_name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if ( NULL == service_name ) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, - FUNC_NAME); - } - } - - /* OMPI supports info keys to pass the range to - * be searched for the given key */ - if (MPI_INFO_NULL != info) { - ompi_info_get (info, "range", &info_str, &flag); - if (flag) { - if (0 == strcmp(info_str->string, "nspace")) { - rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace - } else if (0 == strcmp(info_str->string, "session")) { - rng = PMIX_RANGE_SESSION; // share only with procs in same session - } else { - /* unrecognized scope */ - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - OBJ_RELEASE(info_str); - } - } - - /* unpublish the service_name */ - opal_argv_append_nosize(&keys, service_name); - PMIX_INFO_LOAD(&pinfo, PMIX_RANGE, &rng, PMIX_DATA_RANGE); - - rc = PMIx_Unpublish(keys, &pinfo, 1); - opal_argv_free(keys); - PMIX_INFO_DESTRUCT(&pinfo); - - if ( PMIX_SUCCESS != rc ) { - if (PMIX_ERR_NOT_FOUND == rc) { - /* service couldn't be found */ - ret = MPI_ERR_SERVICE; - } else if (PMIX_ERR_NO_PERMISSIONS == rc) { - /* this process didn't own the specified service */ - ret = MPI_ERR_ACCESS; - } else if (PMIX_ERR_NOT_SUPPORTED == rc) { - /* this PMIX environment doesn't support publishing */ - ret = OMPI_ERR_NOT_SUPPORTED; - opal_show_help("help-mpi-api.txt", - "MPI function not supported", - true, - FUNC_NAME, - "Underlying runtime environment does not support name publishing functionality"); - } else { - ret = MPI_ERR_INTERN; - } - - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/unpublish_name.c.in b/ompi/mpi/c/unpublish_name.c.in new file mode 100644 index 00000000000..ca4aa92f7a8 --- /dev/null +++ b/ompi/mpi/c/unpublish_name.c.in @@ -0,0 +1,118 @@ +/* -*- 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-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) 2012-2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Intel, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" +#include + +#include "opal/class/opal_list.h" +#include "opal/mca/pmix/pmix-internal.h" +#include "opal/util/argv.h" +#include "opal/util/show_help.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" + +PROTOTYPE ERROR_CLASS unpublish_name(STRING service_name, INFO info, + STRING port_name) +{ + int ret; + opal_cstring_t *info_str; + int flag=0; + pmix_status_t rc; + pmix_info_t pinfo; + pmix_data_range_t rng = PMIX_RANGE_SESSION; + char **keys = NULL; + + if ( MPI_PARAM_CHECK ) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if ( NULL == port_name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if ( NULL == service_name ) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_INFO, + FUNC_NAME); + } + } + + /* OMPI supports info keys to pass the range to + * be searched for the given key */ + if (MPI_INFO_NULL != info) { + ompi_info_get (info, "range", &info_str, &flag); + if (flag) { + if (0 == strcmp(info_str->string, "nspace")) { + rng = PMIX_RANGE_NAMESPACE; // share only with procs in same nspace + } else if (0 == strcmp(info_str->string, "session")) { + rng = PMIX_RANGE_SESSION; // share only with procs in same session + } else { + /* unrecognized scope */ + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + OBJ_RELEASE(info_str); + } + } + + /* unpublish the service_name */ + opal_argv_append_nosize(&keys, service_name); + PMIX_INFO_LOAD(&pinfo, PMIX_RANGE, &rng, PMIX_DATA_RANGE); + + rc = PMIx_Unpublish(keys, &pinfo, 1); + opal_argv_free(keys); + PMIX_INFO_DESTRUCT(&pinfo); + + if ( PMIX_SUCCESS != rc ) { + if (PMIX_ERR_NOT_FOUND == rc) { + /* service couldn't be found */ + ret = MPI_ERR_SERVICE; + } else if (PMIX_ERR_NO_PERMISSIONS == rc) { + /* this process didn't own the specified service */ + ret = MPI_ERR_ACCESS; + } else if (PMIX_ERR_NOT_SUPPORTED == rc) { + /* this PMIX environment doesn't support publishing */ + ret = OMPI_ERR_NOT_SUPPORTED; + opal_show_help("help-mpi-api.txt", + "MPI function not supported", + true, + FUNC_NAME, + "Underlying runtime environment does not support name publishing functionality"); + } else { + ret = MPI_ERR_INTERN; + } + + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(ret, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/wait.c b/ompi/mpi/c/wait.c deleted file mode 100644 index 0145eb7187d..00000000000 --- a/ompi/mpi/c/wait.c +++ /dev/null @@ -1,90 +0,0 @@ -/* - * 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Wait = PMPI_Wait -#endif -#define MPI_Wait PMPI_Wait -#endif - -static const char FUNC_NAME[] = "MPI_Wait"; - - -int MPI_Wait(MPI_Request *request, MPI_Status *status) -{ - SPC_RECORD(OMPI_SPC_WAIT, 1); - - MEMCHECKER( - memchecker_request(request); - ); - - if ( MPI_PARAM_CHECK ) { - int rc = MPI_SUCCESS; - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (request == NULL) { - rc = MPI_ERR_REQUEST; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (MPI_REQUEST_NULL == *request) { - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_status_empty, false); - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - ); - } - return MPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_wait(request, status)) { - /* - * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls - */ - MEMCHECKER( - if (MPI_STATUS_IGNORE != status) { - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - } - ); - return MPI_SUCCESS; - } - - MEMCHECKER( - if (MPI_STATUS_IGNORE != status) { - opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); - } - ); - return ompi_errhandler_request_invoke(1, request, FUNC_NAME); -} diff --git a/ompi/mpi/c/wait.c.in b/ompi/mpi/c/wait.c.in new file mode 100644 index 00000000000..d2db5ab726f --- /dev/null +++ b/ompi/mpi/c/wait.c.in @@ -0,0 +1,84 @@ +/* + * 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS wait(REQUEST_INOUT request, STATUS_OUT status) +{ + SPC_RECORD(OMPI_SPC_WAIT, 1); + + MEMCHECKER( + memchecker_request(request); + ); + + if ( MPI_PARAM_CHECK ) { + int rc = MPI_SUCCESS; + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (request == NULL) { + rc = MPI_ERR_REQUEST; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (MPI_REQUEST_NULL == *request) { + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + ); + } + return MPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_wait(request, status)) { + /* + * Per MPI-1, the MPI_ERROR field is not defined for single-completion calls + */ + MEMCHECKER( + if (MPI_STATUS_IGNORE != status) { + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + } + ); + return MPI_SUCCESS; + } + + MEMCHECKER( + if (MPI_STATUS_IGNORE != status) { + opal_memchecker_base_mem_undefined(&status->MPI_ERROR, sizeof(int)); + } + ); + return ompi_errhandler_request_invoke(1, request, FUNC_NAME); +} diff --git a/ompi/mpi/c/waitall.c b/ompi/mpi/c/waitall.c deleted file mode 100644 index ce2353dfc9b..00000000000 --- a/ompi/mpi/c/waitall.c +++ /dev/null @@ -1,88 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Waitall = PMPI_Waitall -#endif -#define MPI_Waitall PMPI_Waitall -#endif - -static const char FUNC_NAME[] = "MPI_Waitall"; - - -int MPI_Waitall(int count, MPI_Request requests[], MPI_Status statuses[]) -{ - SPC_RECORD(OMPI_SPC_WAITALL, 1); - - 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) && (0 != count) ) { - rc = MPI_ERR_REQUEST; - } else { - if(!ompi_request_check_same_instance(requests, count) ) { - rc = MPI_ERR_REQUEST; - } - } - if (count < 0) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (OPAL_UNLIKELY(0 == count)) { - return MPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_wait_all(count, requests, statuses)) { - return MPI_SUCCESS; - } - - if (MPI_SUCCESS != - ompi_errhandler_request_invoke(count, requests, FUNC_NAME)) { - return MPI_ERR_IN_STATUS; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/waitall.c.in b/ompi/mpi/c/waitall.c.in new file mode 100644 index 00000000000..b2f3c4fe7a1 --- /dev/null +++ b/ompi/mpi/c/waitall.c.in @@ -0,0 +1,82 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS waitall(INT count, REQUEST_INOUT requests:count, + STATUS_OUT statuses:count) +{ + SPC_RECORD(OMPI_SPC_WAITALL, 1); + + 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) && (0 != count) ) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, count) ) { + rc = MPI_ERR_REQUEST; + } + } + if (count < 0) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == count)) { + return MPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_wait_all(count, requests, statuses)) { + return MPI_SUCCESS; + } + + if (MPI_SUCCESS != + ompi_errhandler_request_invoke(count, requests, FUNC_NAME)) { + return MPI_ERR_IN_STATUS; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/waitany.c b/ompi/mpi/c/waitany.c deleted file mode 100644 index 83c7fdf2a9e..00000000000 --- a/ompi/mpi/c/waitany.c +++ /dev/null @@ -1,89 +0,0 @@ -/* - * 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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2014-2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Waitany = PMPI_Waitany -#endif -#define MPI_Waitany PMPI_Waitany -#endif - -static const char FUNC_NAME[] = "MPI_Waitany"; - - -int MPI_Waitany(int count, MPI_Request requests[], int *indx, MPI_Status *status) -{ - SPC_RECORD(OMPI_SPC_WAITANY, 1); - - 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) && (0 != count)) { - rc = MPI_ERR_REQUEST; - } else { - if(!ompi_request_check_same_instance(requests, count) ) { - rc = MPI_ERR_REQUEST; - } - } - if ((NULL == indx && count > 0) || - count < 0) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (OPAL_UNLIKELY(0 == count)) { - *indx = MPI_UNDEFINED; - if (MPI_STATUS_IGNORE != status) { - OMPI_COPY_STATUS(status, ompi_status_empty, false); - } - return MPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_wait_any(count, requests, indx, status)) { - return MPI_SUCCESS; - } - - return ompi_errhandler_request_invoke(count, requests, FUNC_NAME); -} diff --git a/ompi/mpi/c/waitany.c.in b/ompi/mpi/c/waitany.c.in new file mode 100644 index 00000000000..5d2fb4424eb --- /dev/null +++ b/ompi/mpi/c/waitany.c.in @@ -0,0 +1,81 @@ +/* + * 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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2014-2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS waitany(INT count, REQUEST_INOUT requests, INT_OUT indx, STATUS_OUT status) +{ + SPC_RECORD(OMPI_SPC_WAITANY, 1); + + 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) && (0 != count)) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, count) ) { + rc = MPI_ERR_REQUEST; + } + } + if ((NULL == indx && count > 0) || + count < 0) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == count)) { + *indx = MPI_UNDEFINED; + if (MPI_STATUS_IGNORE != status) { + OMPI_COPY_STATUS(status, ompi_status_empty, false); + } + return MPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_wait_any(count, requests, indx, status)) { + return MPI_SUCCESS; + } + + return ompi_errhandler_request_invoke(count, requests, FUNC_NAME); +} diff --git a/ompi/mpi/c/waitsome.c b/ompi/mpi/c/waitsome.c deleted file mode 100644 index 3b5b7ea3cc3..00000000000 --- a/ompi/mpi/c/waitsome.c +++ /dev/null @@ -1,94 +0,0 @@ -/* - * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. - * Copyright (c) 2012 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2021 Triad National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. 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/memchecker.h" -#include "ompi/runtime/ompi_spc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Waitsome = PMPI_Waitsome -#endif -#define MPI_Waitsome PMPI_Waitsome -#endif - -static const char FUNC_NAME[] = "MPI_Waitsome"; - - -int MPI_Waitsome(int incount, MPI_Request requests[], - int *outcount, int indices[], - MPI_Status statuses[]) -{ - SPC_RECORD(OMPI_SPC_WAITSOME, 1); - - 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) && (0 != incount)) { - rc = MPI_ERR_REQUEST; - } else { - if(!ompi_request_check_same_instance(requests, incount) ) { - rc = MPI_ERR_REQUEST; - } - } - if (((NULL == outcount || NULL == indices) && incount > 0) || - incount < 0) { - rc = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); - } - - if (OPAL_UNLIKELY(0 == incount)) { - *outcount = MPI_UNDEFINED; - return MPI_SUCCESS; - } - - if (OMPI_SUCCESS == ompi_request_wait_some( incount, requests, - outcount, indices, statuses )) { - return MPI_SUCCESS; - } - - if (MPI_SUCCESS != - ompi_errhandler_request_invoke(incount, requests, FUNC_NAME)) { - return MPI_ERR_IN_STATUS; - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/waitsome.c.in b/ompi/mpi/c/waitsome.c.in new file mode 100644 index 00000000000..ce25d1f47e8 --- /dev/null +++ b/ompi/mpi/c/waitsome.c.in @@ -0,0 +1,86 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2012 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2021-2024 Triad National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/request/request.h" +#include "ompi/memchecker.h" +#include "ompi/runtime/ompi_spc.h" + +PROTOTYPE ERROR_CLASS waitsome(INT incount, REQUEST_INOUT requests:incount, + INT_OUT outcount, INT_OUT indices:incount, + STATUS_OUT statuses:incount) +{ + SPC_RECORD(OMPI_SPC_WAITSOME, 1); + + 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) && (0 != incount)) { + rc = MPI_ERR_REQUEST; + } else { + if(!ompi_request_check_same_instance(requests, incount) ) { + rc = MPI_ERR_REQUEST; + } + } + if (((NULL == outcount || NULL == indices) && incount > 0) || + incount < 0) { + rc = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_NOHANDLE_CHECK(rc, rc, FUNC_NAME); + } + + if (OPAL_UNLIKELY(0 == incount)) { + *outcount = MPI_UNDEFINED; + return MPI_SUCCESS; + } + + if (OMPI_SUCCESS == ompi_request_wait_some( incount, requests, + outcount, indices, statuses )) { + return MPI_SUCCESS; + } + + if (MPI_SUCCESS != + ompi_errhandler_request_invoke(incount, requests, FUNC_NAME)) { + return MPI_ERR_IN_STATUS; + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_allocate.c b/ompi/mpi/c/win_allocate.c deleted file mode 100644 index 6db2837a3a2..00000000000 --- a/ompi/mpi/c/win_allocate.c +++ /dev/null @@ -1,87 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_allocate = PMPI_Win_allocate -#endif -#define MPI_Win_allocate PMPI_Win_allocate -#endif - -static const char FUNC_NAME[] = "MPI_Win_allocate"; - - -int MPI_Win_allocate(MPI_Aint size, int disp_unit, MPI_Info info, - MPI_Comm comm, void *baseptr, MPI_Win *win) -{ - int ret = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - } else if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - - } else if (NULL == win) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } else if ( size < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); - } else if ( disp_unit <= 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_DISP, FUNC_NAME); - } - } - - /* communicator must be an intracommunicator */ - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); - } - - /* create window and return */ - ret = ompi_win_allocate((size_t)size, disp_unit, &(info->super), - comm, baseptr, win); - if (OMPI_SUCCESS != ret) { - *win = MPI_WIN_NULL; - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_allocate.c.in b/ompi/mpi/c/win_allocate.c.in new file mode 100644 index 00000000000..b1f40905b11 --- /dev/null +++ b/ompi/mpi/c/win_allocate.c.in @@ -0,0 +1,93 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_allocate(AINT size, DISP disp_unit, INFO info, + COMM comm, BUFFER_OUT baseptr, WIN_OUT win) +{ + int ret = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + } else if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + + } else if (NULL == win) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } else if ( size < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); + } else if ( disp_unit <= 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_DISP, FUNC_NAME); + } + } + + /* communicator must be an intracommunicator */ + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); + } + +/* + * TODO:BIGCOUNT remove this check once ompi-rma supports bigcount + */ +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(ret, disp_unit); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, ret, FUNC_NAME); + } +#endif + + /* create window and return */ +/* + * TODO:BIGCOUNT remove (int) before disp_unit once ompi-rma supports bigcount + */ + ret = ompi_win_allocate((size_t)size, (int)disp_unit, &(info->super), + comm, baseptr, win); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_allocate_shared.c b/ompi/mpi/c/win_allocate_shared.c deleted file mode 100644 index aa6b72c2fcb..00000000000 --- a/ompi/mpi/c/win_allocate_shared.c +++ /dev/null @@ -1,88 +0,0 @@ -/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2014 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_allocate_shared = PMPI_Win_allocate_shared -#endif -#define MPI_Win_allocate_shared PMPI_Win_allocate_shared -#endif - -static const char FUNC_NAME[] = "MPI_Win_allocate_shared"; - - -int MPI_Win_allocate_shared(MPI_Aint size, int disp_unit, MPI_Info info, - MPI_Comm comm, void *baseptr, MPI_Win *win) -{ - int ret = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - } else if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - - } else if (NULL == win) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } else if ( size < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); - } - } - - /* communicator must be an intracommunicator */ - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); - } - - /* create window and return */ - ret = ompi_win_allocate_shared((size_t)size, disp_unit, &(info->super), - comm, baseptr, win); - if (OMPI_SUCCESS != ret) { - *win = MPI_WIN_NULL; - OMPI_ERRHANDLER_RETURN (ret, comm, ret, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_allocate_shared.c.in b/ompi/mpi/c/win_allocate_shared.c.in new file mode 100644 index 00000000000..bcec8b3a761 --- /dev/null +++ b/ompi/mpi/c/win_allocate_shared.c.in @@ -0,0 +1,93 @@ +/* -*- 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_allocate_shared(AINT size, DISP disp_unit, INFO info, + COMM comm, BUFFER_OUT baseptr, WIN_OUT win) +{ + int ret = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + } else if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + + } else if (NULL == win) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } else if ( size < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); + } +/* + * TODO:BIGCOUNT remove this check once ompi-rma supports bigcount + */ +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(ret, disp_unit); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, ret, FUNC_NAME); + } +#endif + } + + /* communicator must be an intracommunicator */ + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); + } + + /* create window and return */ +/* + * TODO:BIGCOUNT remove (int) from disp_unit once ompi-rma supports bigcount + */ + ret = ompi_win_allocate_shared((size_t)size, (int)disp_unit, &(info->super), + comm, baseptr, win); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + OMPI_ERRHANDLER_RETURN (ret, comm, ret, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_attach.c b/ompi/mpi/c/win_attach.c deleted file mode 100644 index 927a1b6278a..00000000000 --- a/ompi/mpi/c/win_attach.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_attach = PMPI_Win_attach -#endif -#define MPI_Win_attach PMPI_Win_attach -#endif - -static const char FUNC_NAME[] = "MPI_Win_attach"; - -int MPI_Win_attach(MPI_Win win, void *base, MPI_Aint size) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (NULL == base) { - ret = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_win_attach(win, base, size); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_attach.c.in b/ompi/mpi/c/win_attach.c.in new file mode 100644 index 00000000000..18529108967 --- /dev/null +++ b/ompi/mpi/c/win_attach.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_attach(WIN win, BUFFER_OUT base, AINT size) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (NULL == base) { + ret = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_win_attach(win, base, size); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_c2f.c b/ompi/mpi/c/win_c2f.c deleted file mode 100644 index 67a5f47b3be..00000000000 --- a/ompi/mpi/c/win_c2f.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * Copyright (c) 2004-2007 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) 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$ - */ -#include "ompi_config.h" - -#include - -#include "ompi/win/win.h" -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_c2f = PMPI_Win_c2f -#endif -#define MPI_Win_c2f PMPI_Win_c2f -#endif - -static const char FUNC_NAME[] = "MPI_Win_c2f"; - - -MPI_Fint MPI_Win_c2f(MPI_Win win) -{ - if ( MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - /* Note that ompi_win_invalid() explicitly checks for - MPI_WIN_NULL, but MPI_WIN_C2F is supposed to treat - MPI_WIN_NULL as a valid window (and therefore return - a valid Fortran handle for it). Hence, this function - should not return an error if MPI_WIN_NULL is passed in. - - See a big comment in ompi/communicator/communicator.h about - this (I know that's not win.h, but the issues are related, - and that's where the explanation is). */ - if (ompi_win_invalid(win) && MPI_WIN_NULL != win) { - return OMPI_INT_2_FINT(-1); - } - } - - return OMPI_INT_2_FINT(win->w_f_to_c_index); -} diff --git a/ompi/mpi/c/win_c2f.c.in b/ompi/mpi/c/win_c2f.c.in new file mode 100644 index 00000000000..cb1e0fb0562 --- /dev/null +++ b/ompi/mpi/c/win_c2f.c.in @@ -0,0 +1,54 @@ +/* + * Copyright (c) 2004-2007 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) 2006-2012 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include + +#include "ompi/win/win.h" +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +PROTOTYPE ERROR_CLASS win_c2f(WIN win) +{ + if ( MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + /* Note that ompi_win_invalid() explicitly checks for + MPI_WIN_NULL, but MPI_WIN_C2F is supposed to treat + MPI_WIN_NULL as a valid window (and therefore return + a valid Fortran handle for it). Hence, this function + should not return an error if MPI_WIN_NULL is passed in. + + See a big comment in ompi/communicator/communicator.h about + this (I know that's not win.h, but the issues are related, + and that's where the explanation is). */ + if (ompi_win_invalid(win) && MPI_WIN_NULL != win) { + return OMPI_INT_2_FINT(-1); + } + } + + return OMPI_INT_2_FINT(win->w_f_to_c_index); +} diff --git a/ompi/mpi/c/win_call_errhandler.c b/ompi/mpi/c/win_call_errhandler.c deleted file mode 100644 index 7584653c501..00000000000 --- a/ompi/mpi/c/win_call_errhandler.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_call_errhandler = PMPI_Win_call_errhandler -#endif -#define MPI_Win_call_errhandler PMPI_Win_call_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Win_call_errhandler"; - - -int MPI_Win_call_errhandler(MPI_Win win, int errorcode) -{ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, - FUNC_NAME); - } - } - - /* Invoke the errhandler */ - OMPI_ERRHANDLER_INVOKE(win, errorcode, FUNC_NAME); - - /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_call_errhandler.c.in b/ompi/mpi/c/win_call_errhandler.c.in new file mode 100644 index 00000000000..644b0e5e93d --- /dev/null +++ b/ompi/mpi/c/win_call_errhandler.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_call_errhandler(WIN win, INT errorcode) +{ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, + FUNC_NAME); + } + } + + /* Invoke the errhandler */ + OMPI_ERRHANDLER_INVOKE(win, errorcode, FUNC_NAME); + + /* See MPI-2 8.5 why this function has to return MPI_SUCCESS */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_complete.c b/ompi/mpi/c/win_complete.c deleted file mode 100644 index 98cc831af7c..00000000000 --- a/ompi/mpi/c/win_complete.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_complete = PMPI_Win_complete -#endif -#define MPI_Win_complete PMPI_Win_complete -#endif - -static const char FUNC_NAME[] = "MPI_Win_complete"; - - -int MPI_Win_complete(MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_complete(win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_complete.c.in b/ompi/mpi/c/win_complete.c.in new file mode 100644 index 00000000000..a9fd3d2b2a9 --- /dev/null +++ b/ompi/mpi/c/win_complete.c.in @@ -0,0 +1,46 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_complete(WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_complete(win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_create.c b/ompi/mpi/c/win_create.c deleted file mode 100644 index 419ff3ddf9f..00000000000 --- a/ompi/mpi/c/win_create.c +++ /dev/null @@ -1,87 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_create = PMPI_Win_create -#endif -#define MPI_Win_create PMPI_Win_create -#endif - -static const char FUNC_NAME[] = "MPI_Win_create"; - - -int MPI_Win_create(void *base, MPI_Aint size, int disp_unit, - MPI_Info info, MPI_Comm comm, MPI_Win *win) -{ - int ret = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - } else if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - - } else if (NULL == win) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } else if ( size < 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); - } else if ( disp_unit <= 0 ) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_DISP, FUNC_NAME); - } - } - - /* communicator must be an intracommunicator */ - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); - } - - /* create window and return */ - ret = ompi_win_create(base, (size_t)size, disp_unit, comm, - &(info->super), win); - if (OMPI_SUCCESS != ret) { - *win = MPI_WIN_NULL; - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_create.c.in b/ompi/mpi/c/win_create.c.in new file mode 100644 index 00000000000..c737d22370f --- /dev/null +++ b/ompi/mpi/c/win_create.c.in @@ -0,0 +1,92 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_create(BUFFER_OUT base, AINT size, DISP disp_unit, + INFO info, COMM comm, WIN_OUT win) +{ + int ret = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + } else if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + + } else if (NULL == win) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } else if ( size < 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_SIZE, FUNC_NAME); + } else if ( disp_unit <= 0 ) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_DISP, FUNC_NAME); + } +/* + * TODO:BIGCOUNT remove this check once ompi-rma supports bigcount + */ +#if OMPI_BIGCOUNT_SRC + OMPI_CHECK_MPI_COUNT_INT_CONVERSION_OVERFLOW(ret, disp_unit); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, ret, FUNC_NAME); + } +#endif + } + + /* communicator must be an intracommunicator */ + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); + } + +/* + * TODO:BIGCOUNT remove (int) before disp_unit once ompi-rma supports bigcount + */ + /* create window and return */ + ret = ompi_win_create(base, (size_t)size, (int)disp_unit, comm, + &(info->super), win); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_create_dynamic.c b/ompi/mpi/c/win_create_dynamic.c deleted file mode 100644 index a8b218e2b90..00000000000 --- a/ompi/mpi/c/win_create_dynamic.c +++ /dev/null @@ -1,82 +0,0 @@ -/* - * 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) 2006 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. 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/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_create_dynamic = PMPI_Win_create_dynamic -#endif -#define MPI_Win_create_dynamic PMPI_Win_create_dynamic -#endif - -static const char FUNC_NAME[] = "MPI_Win_create_dynamic"; - - -int MPI_Win_create_dynamic(MPI_Info info, MPI_Comm comm, MPI_Win *win) -{ - int ret = MPI_SUCCESS; - - MEMCHECKER( - memchecker_comm(comm); - ); - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_comm_invalid (comm)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, - FUNC_NAME); - - } else if (NULL == info || ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, - FUNC_NAME); - - } else if (NULL == win) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } - } - - /* communicator must be an intracommunicator */ - if (OMPI_COMM_IS_INTER(comm)) { - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); - } - - /* create_dynamic window and return */ - ret = ompi_win_create_dynamic(&(info->super), comm, win); - if (OMPI_SUCCESS != ret) { - *win = MPI_WIN_NULL; - return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); - } - - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_create_dynamic.c.in b/ompi/mpi/c/win_create_dynamic.c.in new file mode 100644 index 00000000000..f50a2d697ff --- /dev/null +++ b/ompi/mpi/c/win_create_dynamic.c.in @@ -0,0 +1,73 @@ +/* + * 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) 2006 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_create_dynamic(INFO info, COMM comm, WIN_OUT win) +{ + int ret = MPI_SUCCESS; + + MEMCHECKER( + memchecker_comm(comm); + ); + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_comm_invalid (comm)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_COMM, + FUNC_NAME); + + } else if (NULL == info || ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_INFO, + FUNC_NAME); + + } else if (NULL == win) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } + } + + /* communicator must be an intracommunicator */ + if (OMPI_COMM_IS_INTER(comm)) { + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_COMM, FUNC_NAME); + } + + /* create_dynamic window and return */ + ret = ompi_win_create_dynamic(&(info->super), comm, win); + if (OMPI_SUCCESS != ret) { + *win = MPI_WIN_NULL; + return OMPI_ERRHANDLER_INVOKE(comm, MPI_ERR_WIN, FUNC_NAME); + } + + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_create_errhandler.c b/ompi/mpi/c/win_create_errhandler.c deleted file mode 100644 index 16c9262ff4e..00000000000 --- a/ompi/mpi/c/win_create_errhandler.c +++ /dev/null @@ -1,67 +0,0 @@ -/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2018-2021 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_create_errhandler = PMPI_Win_create_errhandler -#endif -#define MPI_Win_create_errhandler PMPI_Win_create_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Win_create_errhandler"; - - -int MPI_Win_create_errhandler(MPI_Win_errhandler_function *function, - MPI_Errhandler *errhandler) -{ - int err = MPI_SUCCESS; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == function || - NULL == errhandler) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - /* Create and cache the errhandler. Sets a refcount of 1. */ - *errhandler = - ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_WIN, - (ompi_errhandler_generic_handler_fn_t*) function, - OMPI_ERRHANDLER_LANG_C); - if (NULL == *errhandler) { - err = MPI_ERR_INTERN; - } - - OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_create_errhandler.c.in b/ompi/mpi/c/win_create_errhandler.c.in new file mode 100644 index 00000000000..27a48e33aa4 --- /dev/null +++ b/ompi/mpi/c/win_create_errhandler.c.in @@ -0,0 +1,57 @@ +/* -*- 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-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-2009 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018-2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_create_errhandler(WIN_ERRHANLDER_FUNCTION function, + ERRHANDLER_OUT errhandler) +{ + int err = MPI_SUCCESS; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == function || + NULL == errhandler) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + /* Create and cache the errhandler. Sets a refcount of 1. */ + *errhandler = + ompi_errhandler_create(OMPI_ERRHANDLER_TYPE_WIN, + (ompi_errhandler_generic_handler_fn_t*) function, + OMPI_ERRHANDLER_LANG_C); + if (NULL == *errhandler) { + err = MPI_ERR_INTERN; + } + + OMPI_ERRHANDLER_NOHANDLE_RETURN(err, MPI_ERR_INTERN, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_create_keyval.c b/ompi/mpi/c/win_create_keyval.c deleted file mode 100644 index 33b368bdba7..00000000000 --- a/ompi/mpi/c/win_create_keyval.c +++ /dev/null @@ -1,65 +0,0 @@ -/* - * 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-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) 2007 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. - * 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/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_create_keyval = PMPI_Win_create_keyval -#endif -#define MPI_Win_create_keyval PMPI_Win_create_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Win_create_keyval"; - - -int MPI_Win_create_keyval(MPI_Win_copy_attr_function *win_copy_attr_fn, - MPI_Win_delete_attr_function *win_delete_attr_fn, - int *win_keyval, void *extra_state) -{ - int ret; - ompi_attribute_fn_ptr_union_t copy_fn; - ompi_attribute_fn_ptr_union_t del_fn; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if ((NULL == win_copy_attr_fn) || (NULL == win_delete_attr_fn) || - (NULL == win_keyval)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - copy_fn.attr_win_copy_fn = win_copy_attr_fn; - del_fn.attr_win_delete_fn = win_delete_attr_fn; - - ret = ompi_attr_create_keyval(WIN_ATTR, copy_fn, del_fn, - win_keyval, extra_state, 0, NULL); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_create_keyval.c.in b/ompi/mpi/c/win_create_keyval.c.in new file mode 100644 index 00000000000..f58401685bf --- /dev/null +++ b/ompi/mpi/c/win_create_keyval.c.in @@ -0,0 +1,57 @@ +/* + * 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-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) 2007 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2022 Amazon.com, Inc. or its affiliates. + * All Rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS win_create_keyval(WIN_COPY_ATTR_FUNCTION win_copy_attr_fn, + WIN_DELETE_ATTR_FUNCTION win_delete_attr_fn, + INT_OUT win_keyval, BUFFER_OUT extra_state) +{ + int ret; + ompi_attribute_fn_ptr_union_t copy_fn; + ompi_attribute_fn_ptr_union_t del_fn; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if ((NULL == win_copy_attr_fn) || (NULL == win_delete_attr_fn) || + (NULL == win_keyval)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + copy_fn.attr_win_copy_fn = win_copy_attr_fn; + del_fn.attr_win_delete_fn = win_delete_attr_fn; + + ret = ompi_attr_create_keyval(WIN_ATTR, copy_fn, del_fn, + win_keyval, extra_state, 0, NULL); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_delete_attr.c b/ompi/mpi/c/win_delete_attr.c deleted file mode 100644 index e6bfbd3f9a2..00000000000 --- a/ompi/mpi/c/win_delete_attr.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/attribute/attribute.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_delete_attr = PMPI_Win_delete_attr -#endif -#define MPI_Win_delete_attr PMPI_Win_delete_attr -#endif - -static const char FUNC_NAME[] = "MPI_Win_delete_attr"; - - -int MPI_Win_delete_attr(MPI_Win win, int win_keyval) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - ret = ompi_attr_delete(WIN_ATTR, win, win->w_keyhash, win_keyval, - false); - OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_delete_attr.c.in b/ompi/mpi/c/win_delete_attr.c.in new file mode 100644 index 00000000000..0baa3cc01c3 --- /dev/null +++ b/ompi/mpi/c/win_delete_attr.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_delete_attr(WIN win, INT win_keyval) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + ret = ompi_attr_delete(WIN_ATTR, win, win->w_keyhash, win_keyval, + false); + OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_detach.c b/ompi/mpi/c/win_detach.c deleted file mode 100644 index 00dd0eec52a..00000000000 --- a/ompi/mpi/c/win_detach.c +++ /dev/null @@ -1,61 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_detach = PMPI_Win_detach -#endif -#define MPI_Win_detach PMPI_Win_detach -#endif - -static const char FUNC_NAME[] = "MPI_Win_detach"; - -int MPI_Win_detach(MPI_Win win, const void *base) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (NULL == base) { - ret = MPI_ERR_ARG; - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_win_detach(win, base); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_detach.c.in b/ompi/mpi/c/win_detach.c.in new file mode 100644 index 00000000000..e6b6836adec --- /dev/null +++ b/ompi/mpi/c/win_detach.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_detach(WIN win, BUFFER base) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (NULL == base) { + ret = MPI_ERR_ARG; + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_win_detach(win, base); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_f2c.c b/ompi/mpi/c/win_f2c.c index bc8bdb7dcab..82bf2b9cc71 100644 --- a/ompi/mpi/c/win_f2c.c +++ b/ompi/mpi/c/win_f2c.c @@ -36,7 +36,6 @@ static const char FUNC_NAME[] = "MPI_Win_f2c"; - MPI_Win MPI_Win_f2c(MPI_Fint win) { int o_index= OMPI_FINT_2_INT(win); diff --git a/ompi/mpi/c/win_fence.c b/ompi/mpi/c/win_fence.c deleted file mode 100644 index 33458afb207..00000000000 --- a/ompi/mpi/c/win_fence.c +++ /dev/null @@ -1,60 +0,0 @@ -/* -*- 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) 2014 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_fence = PMPI_Win_fence -#endif -#define MPI_Win_fence PMPI_Win_fence -#endif - -static const char FUNC_NAME[] = "MPI_Win_fence"; - - -int MPI_Win_fence(int mpi_assert, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (0 != (mpi_assert & ~(MPI_MODE_NOSTORE | MPI_MODE_NOPUT | - MPI_MODE_NOPRECEDE | MPI_MODE_NOSUCCEED))) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_fence(mpi_assert, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_fence.c.in b/ompi/mpi/c/win_fence.c.in new file mode 100644 index 00000000000..e71ad6831b6 --- /dev/null +++ b/ompi/mpi/c/win_fence.c.in @@ -0,0 +1,52 @@ +/* -*- 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) 2014 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_fence(INT mpi_assert, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (0 != (mpi_assert & ~(MPI_MODE_NOSTORE | MPI_MODE_NOPUT | + MPI_MODE_NOPRECEDE | MPI_MODE_NOSUCCEED))) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_fence(mpi_assert, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_flush.c b/ompi/mpi/c/win_flush.c deleted file mode 100644 index 99030dffc06..00000000000 --- a/ompi/mpi/c/win_flush.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_flush = PMPI_Win_flush -#endif -#define MPI_Win_flush PMPI_Win_flush -#endif - -static const char FUNC_NAME[] = "MPI_Win_flush"; - -int MPI_Win_flush(int rank, MPI_Win win) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_flush(rank, win); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_flush.c.in b/ompi/mpi/c/win_flush.c.in new file mode 100644 index 00000000000..01a78419822 --- /dev/null +++ b/ompi/mpi/c/win_flush.c.in @@ -0,0 +1,52 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_flush(INT rank, WIN win) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_flush(rank, win); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_flush_all.c b/ompi/mpi/c/win_flush_all.c deleted file mode 100644 index d21f86fdf92..00000000000 --- a/ompi/mpi/c/win_flush_all.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_flush_all = PMPI_Win_flush_all -#endif -#define MPI_Win_flush_all PMPI_Win_flush_all -#endif - -static const char FUNC_NAME[] = "MPI_Win_flush_all"; - -int MPI_Win_flush_all(MPI_Win win) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_flush_all(win); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_flush_all.c.in b/ompi/mpi/c/win_flush_all.c.in new file mode 100644 index 00000000000..559d99926f6 --- /dev/null +++ b/ompi/mpi/c/win_flush_all.c.in @@ -0,0 +1,52 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_flush_all(WIN win) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_flush_all(win); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_flush_local.c b/ompi/mpi/c/win_flush_local.c deleted file mode 100644 index 07fa1d689dd..00000000000 --- a/ompi/mpi/c/win_flush_local.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_flush_local = PMPI_Win_flush_local -#endif -#define MPI_Win_flush_local PMPI_Win_flush_local -#endif - -static const char FUNC_NAME[] = "MPI_Win_flush_local"; - -int MPI_Win_flush_local(int rank, MPI_Win win) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_flush_local(rank, win); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_flush_local.c.in b/ompi/mpi/c/win_flush_local.c.in new file mode 100644 index 00000000000..a61afa2542e --- /dev/null +++ b/ompi/mpi/c/win_flush_local.c.in @@ -0,0 +1,52 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_flush_local(INT rank, WIN win) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_flush_local(rank, win); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_flush_local_all.c b/ompi/mpi/c/win_flush_local_all.c deleted file mode 100644 index 4498a98ca83..00000000000 --- a/ompi/mpi/c/win_flush_local_all.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_flush_local_all = PMPI_Win_flush_local_all -#endif -#define MPI_Win_flush_local_all PMPI_Win_flush_local_all -#endif - -static const char FUNC_NAME[] = "MPI_Win_flush_local_all"; - -int MPI_Win_flush_local_all(MPI_Win win) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); - } - - /* create window and return */ - ret = win->w_osc_module->osc_flush_local_all(win); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_flush_local_all.c.in b/ompi/mpi/c/win_flush_local_all.c.in new file mode 100644 index 00000000000..5d43b5b4bcf --- /dev/null +++ b/ompi/mpi/c/win_flush_local_all.c.in @@ -0,0 +1,52 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_flush_local_all(WIN win) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + OMPI_ERRHANDLER_CHECK(ret, win, ret, FUNC_NAME); + } + + /* create window and return */ + ret = win->w_osc_module->osc_flush_local_all(win); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_free.c b/ompi/mpi/c/win_free.c deleted file mode 100644 index 809b5dbd702..00000000000 --- a/ompi/mpi/c/win_free.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_free = PMPI_Win_free -#endif -#define MPI_Win_free PMPI_Win_free -#endif - -static const char FUNC_NAME[] = "MPI_Win_free"; - - -int MPI_Win_free(MPI_Win *win) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(*win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - ret = ompi_win_free(*win); - if (OMPI_SUCCESS == ret) { - *win = MPI_WIN_NULL; - } - - OMPI_ERRHANDLER_RETURN(ret, *win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_free.c.in b/ompi/mpi/c/win_free.c.in new file mode 100644 index 00000000000..fb8604f6688 --- /dev/null +++ b/ompi/mpi/c/win_free.c.in @@ -0,0 +1,49 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_free(WIN_OUT win) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(*win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + ret = ompi_win_free(*win); + if (OMPI_SUCCESS == ret) { + *win = MPI_WIN_NULL; + } + + OMPI_ERRHANDLER_RETURN(ret, *win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_free_keyval.c b/ompi/mpi/c/win_free_keyval.c deleted file mode 100644 index 1ef42ec7e38..00000000000 --- a/ompi/mpi/c/win_free_keyval.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/attribute/attribute.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_free_keyval = PMPI_Win_free_keyval -#endif -#define MPI_Win_free_keyval PMPI_Win_free_keyval -#endif - -static const char FUNC_NAME[] = "MPI_Win_free_keyval"; - - -int MPI_Win_free_keyval(int *win_keyval) -{ - int ret; - - /* Check for valid key pointer */ - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (NULL == win_keyval) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, - FUNC_NAME); - } - } - - ret = ompi_attr_free_keyval(WIN_ATTR, win_keyval, 0); - OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_free_keyval.c.in b/ompi/mpi/c/win_free_keyval.c.in new file mode 100644 index 00000000000..8b7b5448cac --- /dev/null +++ b/ompi/mpi/c/win_free_keyval.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" + +PROTOTYPE ERROR_CLASS win_free_keyval(INT_OUT win_keyval) +{ + int ret; + + /* Check for valid key pointer */ + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (NULL == win_keyval) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_ARG, + FUNC_NAME); + } + } + + ret = ompi_attr_free_keyval(WIN_ATTR, win_keyval, 0); + OMPI_ERRHANDLER_NOHANDLE_RETURN(ret, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_get_attr.c b/ompi/mpi/c/win_get_attr.c deleted file mode 100644 index cf89c3fa1bd..00000000000 --- a/ompi/mpi/c/win_get_attr.c +++ /dev/null @@ -1,68 +0,0 @@ -/* -*- 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-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) 2015 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/attribute/attribute.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_get_attr = PMPI_Win_get_attr -#endif -#define MPI_Win_get_attr PMPI_Win_get_attr -#endif - -static const char FUNC_NAME[] = "MPI_Win_get_attr"; - - -int MPI_Win_get_attr(MPI_Win win, int win_keyval, - void *attribute_val, int *flag) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if ((NULL == attribute_val) || (NULL == flag)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } else if (MPI_KEYVAL_INVALID == win_keyval) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_KEYVAL, FUNC_NAME); - } - } - - /* This stuff is very confusing. Be sure to see - src/attribute/attribute.c for a lengthy comment explaining Open - MPI attribute behavior. */ - - ret = ompi_attr_get_c(win->w_keyhash, win_keyval, - (void**)attribute_val, flag); - - OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_get_attr.c.in b/ompi/mpi/c/win_get_attr.c.in new file mode 100644 index 00000000000..bcca259625c --- /dev/null +++ b/ompi/mpi/c/win_get_attr.c.in @@ -0,0 +1,60 @@ +/* -*- 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-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) 2015 Los Alamos National Security, LLC. 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$ + * + * 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/attribute/attribute.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_get_attr(WIN win, INT win_keyval, + BUFFER_OUT attribute_val, INT_OUT flag) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if ((NULL == attribute_val) || (NULL == flag)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } else if (MPI_KEYVAL_INVALID == win_keyval) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_KEYVAL, FUNC_NAME); + } + } + + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(win->w_keyhash, win_keyval, + (void**)attribute_val, flag); + + OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_get_errhandler.c b/ompi/mpi/c/win_get_errhandler.c deleted file mode 100644 index 292f3c706af..00000000000 --- a/ompi/mpi/c/win_get_errhandler.c +++ /dev/null @@ -1,74 +0,0 @@ -/* -*- 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-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-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 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2020 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/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/instance/instance.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_get_errhandler = PMPI_Win_get_errhandler -#endif -#define MPI_Win_get_errhandler PMPI_Win_get_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Win_get_errhandler"; - - -int MPI_Win_get_errhandler(MPI_Win win, MPI_Errhandler *errhandler) -{ - int ret = MPI_SUCCESS; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, - FUNC_NAME); - } else if (NULL == errhandler) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, - FUNC_NAME); - } - } - - OPAL_THREAD_LOCK(&win->w_lock); - /* Retain the errhandler, corresponding to object refcount - decrease in errhandler_free.c. */ - OBJ_RETAIN(win->error_handler); - *errhandler = win->error_handler; - OPAL_THREAD_UNLOCK(&win->w_lock); - - /* make sure the infrastructure is initialized */ - ret = ompi_mpi_instance_retain (); - - - /* All done */ - return ret; -} diff --git a/ompi/mpi/c/win_get_errhandler.c.in b/ompi/mpi/c/win_get_errhandler.c.in new file mode 100644 index 00000000000..8a027da4fd1 --- /dev/null +++ b/ompi/mpi/c/win_get_errhandler.c.in @@ -0,0 +1,64 @@ +/* -*- 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-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-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 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2020-2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/instance/instance.h" + +PROTOTYPE ERROR_CLASS win_get_errhandler(WIN win, ERRHANDLER_OUT errhandler) +{ + int ret = MPI_SUCCESS; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, + FUNC_NAME); + } else if (NULL == errhandler) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, + FUNC_NAME); + } + } + + OPAL_THREAD_LOCK(&win->w_lock); + /* Retain the errhandler, corresponding to object refcount + decrease in errhandler_free.c. */ + OBJ_RETAIN(win->error_handler); + *errhandler = win->error_handler; + OPAL_THREAD_UNLOCK(&win->w_lock); + + /* make sure the infrastructure is initialized */ + ret = ompi_mpi_instance_retain (); + + + /* All done */ + return ret; +} diff --git a/ompi/mpi/c/win_get_group.c b/ompi/mpi/c/win_get_group.c deleted file mode 100644 index d4b895ece57..00000000000 --- a/ompi/mpi/c/win_get_group.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_get_group = PMPI_Win_get_group -#endif -#define MPI_Win_get_group PMPI_Win_get_group -#endif - -static const char FUNC_NAME[] = "MPI_Win_get_group"; - - -int MPI_Win_get_group(MPI_Win win, MPI_Group *group) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (NULL == group) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } - } - - ret = ompi_win_group(win, (ompi_group_t**) group); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_get_group.c.in b/ompi/mpi/c/win_get_group.c.in new file mode 100644 index 00000000000..5330d2dbbec --- /dev/null +++ b/ompi/mpi/c/win_get_group.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_get_group(WIN win, GROUP_OUT group) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (NULL == group) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } + } + + ret = ompi_win_group(win, (ompi_group_t**) group); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_get_info.c b/ompi/mpi/c/win_get_info.c deleted file mode 100644 index a982b5986e1..00000000000 --- a/ompi/mpi/c/win_get_info.c +++ /dev/null @@ -1,66 +0,0 @@ -/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ -/* - * Copyright (c) 2013 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2015 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "opal/util/info.h" -#include "opal/util/info_subscriber.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_get_info = PMPI_Win_get_info -#endif -#define MPI_Win_get_info PMPI_Win_get_info -#endif - -static const char FUNC_NAME[] = "MPI_Win_get_info"; - -int MPI_Win_get_info(MPI_Win win, MPI_Info *info_used) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - - if (NULL == info_used) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } - } - - if (NULL == win->super.s_info) { - /* - * Setup any defaults if MPI_Win_set_info was never called - */ - opal_infosubscribe_change_info(&win->super, &MPI_INFO_NULL->super); - } - - *info_used = ompi_info_allocate (); - if (NULL == (*info_used)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_NO_MEM, FUNC_NAME); - } - opal_info_t *opal_info_used = &(*info_used)->super; - - ret = opal_info_dup_public(win->super.s_info, &opal_info_used); - - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_get_info.c.in b/ompi/mpi/c/win_get_info.c.in new file mode 100644 index 00000000000..abd1622756f --- /dev/null +++ b/ompi/mpi/c/win_get_info.c.in @@ -0,0 +1,59 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2013 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2015 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "opal/util/info.h" +#include "opal/util/info_subscriber.h" + +PROTOTYPE ERROR_CLASS win_get_info(WIN win, INFO_OUT info_used) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + + if (NULL == info_used) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } + } + + if (NULL == win->super.s_info) { + /* + * Setup any defaults if MPI_Win_set_info was never called + */ + opal_infosubscribe_change_info(&win->super, &MPI_INFO_NULL->super); + } + + *info_used = ompi_info_allocate (); + if (NULL == (*info_used)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_NO_MEM, FUNC_NAME); + } + opal_info_t *opal_info_used = &(*info_used)->super; + + ret = opal_info_dup_public(win->super.s_info, &opal_info_used); + + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_get_name.c b/ompi/mpi/c/win_get_name.c deleted file mode 100644 index 6d745c05a5f..00000000000 --- a/ompi/mpi/c/win_get_name.c +++ /dev/null @@ -1,66 +0,0 @@ -/* - * 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-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 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_get_name = PMPI_Win_get_name -#endif -#define MPI_Win_get_name PMPI_Win_get_name -#endif - -static const char FUNC_NAME[] = "MPI_Win_get_name"; - - -int MPI_Win_get_name(MPI_Win win, char *win_name, int *resultlen) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (NULL == win_name || NULL == resultlen) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } - } - - /* Note that MPI-2.1 requires: - - terminating the string with a \0 - - name[*resultlen] == '\0' - - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) - - The Fortran API version will pad to the right if necessary. - - Note that win->name is guaranteed to be \0-terminated and - able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., - name+\0). ompi_win_get_name() does the Right things. */ - ret = ompi_win_get_name(win, win_name, resultlen); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_get_name.c.in b/ompi/mpi/c/win_get_name.c.in new file mode 100644 index 00000000000..49ab8b8fd75 --- /dev/null +++ b/ompi/mpi/c/win_get_name.c.in @@ -0,0 +1,58 @@ +/* + * 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-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 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$ + * + * 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/win/win.h" + +PROTOTYPE ERROR_CLASS win_get_name(WIN win, STRING_OUT win_name, INT_OUT resultlen) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (NULL == win_name || NULL == resultlen) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Note that MPI-2.1 requires: + - terminating the string with a \0 + - name[*resultlen] == '\0' + - and therefore (*resultlen) cannot be > (MPI_MAX_OBJECT_NAME-1) + + The Fortran API version will pad to the right if necessary. + + Note that win->name is guaranteed to be \0-terminated and + able to completely fit into MPI_MAX_OBJECT_NAME bytes (i.e., + name+\0). ompi_win_get_name() does the Right things. */ + ret = ompi_win_get_name(win, win_name, resultlen); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_lock.c b/ompi/mpi/c/win_lock.c deleted file mode 100644 index 78408291611..00000000000 --- a/ompi/mpi/c/win_lock.c +++ /dev/null @@ -1,66 +0,0 @@ -/* -*- 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-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) 2014 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_lock = PMPI_Win_lock -#endif -#define MPI_Win_lock PMPI_Win_lock -#endif - -static const char FUNC_NAME[] = "MPI_Win_lock"; - - -int MPI_Win_lock(int lock_type, int rank, int mpi_assert, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (lock_type != MPI_LOCK_EXCLUSIVE && - lock_type != MPI_LOCK_SHARED) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_LOCKTYPE, FUNC_NAME); - } else if (ompi_win_peer_invalid(win, rank)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); - } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); - } else if (! ompi_win_allow_locks(win)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_lock(lock_type, rank, mpi_assert, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_lock.c.in b/ompi/mpi/c/win_lock.c.in new file mode 100644 index 00000000000..34aa454026b --- /dev/null +++ b/ompi/mpi/c/win_lock.c.in @@ -0,0 +1,58 @@ +/* -*- 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-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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_lock(INT lock_type, INT rank, INT mpi_assert, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (lock_type != MPI_LOCK_EXCLUSIVE && + lock_type != MPI_LOCK_SHARED) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_LOCKTYPE, FUNC_NAME); + } else if (ompi_win_peer_invalid(win, rank)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); + } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); + } else if (! ompi_win_allow_locks(win)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_lock(lock_type, rank, mpi_assert, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_lock_all.c b/ompi/mpi/c/win_lock_all.c deleted file mode 100644 index 6c26a761ed9..00000000000 --- a/ompi/mpi/c/win_lock_all.c +++ /dev/null @@ -1,58 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_lock_all = PMPI_Win_lock_all -#endif -#define MPI_Win_lock_all PMPI_Win_lock_all -#endif - -static const char FUNC_NAME[] = "MPI_Win_lock_all"; - - -int MPI_Win_lock_all(int mpi_assert, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); - } else if (! ompi_win_allow_locks(win)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_lock_all(mpi_assert, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_lock_all.c.in b/ompi/mpi/c/win_lock_all.c.in new file mode 100644 index 00000000000..3dde356ec4d --- /dev/null +++ b/ompi/mpi/c/win_lock_all.c.in @@ -0,0 +1,50 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_lock_all(INT mpi_assert, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); + } else if (! ompi_win_allow_locks(win)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RMA_SYNC, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_lock_all(mpi_assert, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_post.c b/ompi/mpi/c/win_post.c deleted file mode 100644 index 3e5d223a508..00000000000 --- a/ompi/mpi/c/win_post.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_post = PMPI_Win_post -#endif -#define MPI_Win_post PMPI_Win_post -#endif - -static const char FUNC_NAME[] = "MPI_Win_post"; - - -int MPI_Win_post(MPI_Group group, int mpi_assert, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK | MPI_MODE_NOSTORE | - MPI_MODE_NOPUT))) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_post(group, mpi_assert, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_post.c.in b/ompi/mpi/c/win_post.c.in new file mode 100644 index 00000000000..be0587aacd5 --- /dev/null +++ b/ompi/mpi/c/win_post.c.in @@ -0,0 +1,49 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_post(GROUP group, INT mpi_assert, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK | MPI_MODE_NOSTORE | + MPI_MODE_NOPUT))) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_post(group, mpi_assert, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_set_attr.c b/ompi/mpi/c/win_set_attr.c deleted file mode 100644 index bdb41cb3e1e..00000000000 --- a/ompi/mpi/c/win_set_attr.c +++ /dev/null @@ -1,55 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/attribute/attribute.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_set_attr = PMPI_Win_set_attr -#endif -#define MPI_Win_set_attr PMPI_Win_set_attr -#endif - -static const char FUNC_NAME[] = "MPI_Win_set_attr"; - - -int MPI_Win_set_attr(MPI_Win win, int win_keyval, void *attribute_val) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - ret = ompi_attr_set_c(WIN_ATTR, win, &win->w_keyhash, - win_keyval, attribute_val, false); - OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_set_attr.c.in b/ompi/mpi/c/win_set_attr.c.in new file mode 100644 index 00000000000..0776b8b1966 --- /dev/null +++ b/ompi/mpi/c/win_set_attr.c.in @@ -0,0 +1,47 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/attribute/attribute.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_set_attr(WIN win, INT win_keyval, BUFFER_OUT attribute_val) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + ret = ompi_attr_set_c(WIN_ATTR, win, &win->w_keyhash, + win_keyval, attribute_val, false); + OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_set_errhandler.c b/ompi/mpi/c/win_set_errhandler.c deleted file mode 100644 index 820ba51b330..00000000000 --- a/ompi/mpi/c/win_set_errhandler.c +++ /dev/null @@ -1,73 +0,0 @@ -/* -*- 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-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-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$ - * - * 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/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_set_errhandler = PMPI_Win_set_errhandler -#endif -#define MPI_Win_set_errhandler PMPI_Win_set_errhandler -#endif - -static const char FUNC_NAME[] = "MPI_Win_set_errhandler"; - - -int MPI_Win_set_errhandler(MPI_Win win, MPI_Errhandler errhandler) -{ - MPI_Errhandler tmp; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, - FUNC_NAME); - } else if (NULL == errhandler || - MPI_ERRHANDLER_NULL == errhandler || - (OMPI_ERRHANDLER_TYPE_WIN != errhandler->eh_mpi_object_type && - OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } - } - - /* Prepare the new error handler */ - OBJ_RETAIN(errhandler); - - OPAL_THREAD_LOCK(&win->w_lock); - /* Ditch the old errhandler, and decrement its refcount. */ - tmp = win->error_handler; - win->error_handler = errhandler; - OBJ_RELEASE(tmp); - OPAL_THREAD_UNLOCK(&win->w_lock); - - /* All done */ - return MPI_SUCCESS; -} diff --git a/ompi/mpi/c/win_set_errhandler.c.in b/ompi/mpi/c/win_set_errhandler.c.in new file mode 100644 index 00000000000..80a71e34aad --- /dev/null +++ b/ompi/mpi/c/win_set_errhandler.c.in @@ -0,0 +1,65 @@ +/* -*- 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-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-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) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" + +PROTOTYPE ERROR_CLASS win_set_errhandler(WIN win, ERRHANDLER errhandler) +{ + MPI_Errhandler tmp; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, + FUNC_NAME); + } else if (NULL == errhandler || + MPI_ERRHANDLER_NULL == errhandler || + (OMPI_ERRHANDLER_TYPE_WIN != errhandler->eh_mpi_object_type && + OMPI_ERRHANDLER_TYPE_PREDEFINED != errhandler->eh_mpi_object_type) ) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } + } + + /* Prepare the new error handler */ + OBJ_RETAIN(errhandler); + + OPAL_THREAD_LOCK(&win->w_lock); + /* Ditch the old errhandler, and decrement its refcount. */ + tmp = win->error_handler; + win->error_handler = errhandler; + OBJ_RELEASE(tmp); + OPAL_THREAD_UNLOCK(&win->w_lock); + + /* All done */ + return MPI_SUCCESS; +} diff --git a/ompi/mpi/c/win_set_info.c b/ompi/mpi/c/win_set_info.c deleted file mode 100644 index bb9c6bb572b..00000000000 --- a/ompi/mpi/c/win_set_info.c +++ /dev/null @@ -1,52 +0,0 @@ -/* - * Copyright (c) 2013 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ - -#include "ompi_config.h" - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" -#include "ompi/communicator/communicator.h" -#include "opal/util/info_subscriber.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_set_info = PMPI_Win_set_info -#endif -#define MPI_Win_set_info PMPI_Win_set_info -#endif - -static const char FUNC_NAME[] = "MPI_Win_set_info"; - - -int MPI_Win_set_info(MPI_Win win, MPI_Info info) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - - if (NULL == info || MPI_INFO_NULL == info || - ompi_info_is_freed(info)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_INFO, FUNC_NAME); - } - } - - ret = opal_infosubscribe_change_info(&(win->super), &(info->super)); - - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_set_info.c.in b/ompi/mpi/c/win_set_info.c.in new file mode 100644 index 00000000000..d1b376ca305 --- /dev/null +++ b/ompi/mpi/c/win_set_info.c.in @@ -0,0 +1,44 @@ +/* + * Copyright (c) 2013 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2016-2017 IBM Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/params.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/communicator/communicator.h" +#include "opal/util/info_subscriber.h" + +PROTOTYPE ERROR_CLASS win_set_info(WIN win, INFO info) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + + if (NULL == info || MPI_INFO_NULL == info || + ompi_info_is_freed(info)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_INFO, FUNC_NAME); + } + } + + ret = opal_infosubscribe_change_info(&(win->super), &(info->super)); + + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_set_name.c b/ompi/mpi/c/win_set_name.c deleted file mode 100644 index 2d20c5a4d10..00000000000 --- a/ompi/mpi/c/win_set_name.c +++ /dev/null @@ -1,59 +0,0 @@ -/* -*- 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-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 Cisco Systems, Inc. All rights reserved. - * Copyright (c) 2013 Los Alamos National Security, LLC. 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/win/win.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_set_name = PMPI_Win_set_name -#endif -#define MPI_Win_set_name PMPI_Win_set_name -#endif - -static const char FUNC_NAME[] = "MPI_Win_set_name"; - - -int MPI_Win_set_name(MPI_Win win, const char *win_name) -{ - int ret; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (NULL == win_name) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); - } - } - - ret = ompi_win_set_name(win, win_name); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_set_name.c.in b/ompi/mpi/c/win_set_name.c.in new file mode 100644 index 00000000000..fdbd842fe57 --- /dev/null +++ b/ompi/mpi/c/win_set_name.c.in @@ -0,0 +1,51 @@ +/* -*- 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-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 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2013 Los Alamos National Security, LLC. 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$ + * + * 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/win/win.h" + +PROTOTYPE ERROR_CLASS win_set_name(WIN win, STRING win_name) +{ + int ret; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (NULL == win_name) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ARG, FUNC_NAME); + } + } + + ret = ompi_win_set_name(win, win_name); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_shared_query.c b/ompi/mpi/c/win_shared_query.c deleted file mode 100644 index e9293047689..00000000000 --- a/ompi/mpi/c/win_shared_query.c +++ /dev/null @@ -1,59 +0,0 @@ -/* - * Copyright (c) 2012-2013 Sandia National Laboratories. All rights reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2024 The University of Tennessee and The University - * of Tennessee Research Foundation. 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_shared_query = PMPI_Win_shared_query -#endif -#define MPI_Win_shared_query PMPI_Win_shared_query -#endif - -static const char FUNC_NAME[] = "MPI_Win_shared_query"; - - -int MPI_Win_shared_query(MPI_Win win, int rank, MPI_Aint *size, int *disp_unit, void *baseptr) -{ - int rc; - size_t tsize; - ptrdiff_t du; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (MPI_PROC_NULL != rank && ompi_win_peer_invalid(win, rank)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); - } - } - - if (NULL != win->w_osc_module->osc_win_shared_query) { - rc = win->w_osc_module->osc_win_shared_query(win, rank, &tsize, &du, baseptr); - *size = tsize; - *disp_unit = du; - } else { - rc = MPI_ERR_RMA_FLAVOR; - } - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_shared_query.c.in b/ompi/mpi/c/win_shared_query.c.in new file mode 100644 index 00000000000..ad88189428f --- /dev/null +++ b/ompi/mpi/c/win_shared_query.c.in @@ -0,0 +1,51 @@ +/* + * Copyright (c) 2012-2013 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_shared_query(WIN win, INT rank, AINT_OUT size, INT_AINT_OUT disp_unit, BUFFER_OUT baseptr) +{ + int rc; + size_t tsize; + ptrdiff_t du; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (MPI_PROC_NULL != rank && ompi_win_peer_invalid(win, rank)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); + } + } + + if (NULL != win->w_osc_module->osc_win_shared_query) { + rc = win->w_osc_module->osc_win_shared_query(win, rank, &tsize, &du, baseptr); + *size = tsize; + *disp_unit = du; + } else { + rc = MPI_ERR_RMA_FLAVOR; + } + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_start.c b/ompi/mpi/c/win_start.c deleted file mode 100644 index bd9cbe776b6..00000000000 --- a/ompi/mpi/c/win_start.c +++ /dev/null @@ -1,56 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_start = PMPI_Win_start -#endif -#define MPI_Win_start PMPI_Win_start -#endif - -static const char FUNC_NAME[] = "MPI_Win_start"; - - -int MPI_Win_start(MPI_Group group, int mpi_assert, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_start(group, mpi_assert, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_start.c.in b/ompi/mpi/c/win_start.c.in new file mode 100644 index 00000000000..ae7254c8f10 --- /dev/null +++ b/ompi/mpi/c/win_start.c.in @@ -0,0 +1,48 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_start(GROUP group, INT mpi_assert, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (0 != (mpi_assert & ~(MPI_MODE_NOCHECK))) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_ASSERT, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_start(group, mpi_assert, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_sync.c b/ompi/mpi/c/win_sync.c deleted file mode 100644 index 11f05e47c01..00000000000 --- a/ompi/mpi/c/win_sync.c +++ /dev/null @@ -1,57 +0,0 @@ -/* - * 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) 2006 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 - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/params.h" -#include "ompi/communicator/communicator.h" -#include "ompi/errhandler/errhandler.h" -#include "ompi/info/info.h" -#include "ompi/win/win.h" -#include "ompi/memchecker.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_sync = PMPI_Win_sync -#endif -#define MPI_Win_sync PMPI_Win_sync -#endif - -static const char FUNC_NAME[] = "MPI_Win_sync"; - -int MPI_Win_sync(MPI_Win win) -{ - int ret = MPI_SUCCESS; - - /* argument checking */ - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - ret = win->w_osc_module->osc_sync(win); - OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_sync.c.in b/ompi/mpi/c/win_sync.c.in new file mode 100644 index 00000000000..ad28415a559 --- /dev/null +++ b/ompi/mpi/c/win_sync.c.in @@ -0,0 +1,50 @@ +/* + * 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) 2006 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$ + * + * 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/info/info.h" +#include "ompi/win/win.h" +#include "ompi/memchecker.h" + +PROTOTYPE ERROR_CLASS win_sync(WIN win) +{ + int ret = MPI_SUCCESS; + + /* argument checking */ + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + ret = win->w_osc_module->osc_sync(win); + OMPI_ERRHANDLER_RETURN(ret, win, ret, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_test.c b/ompi/mpi/c/win_test.c deleted file mode 100644 index a2ef3c8b448..00000000000 --- a/ompi/mpi/c/win_test.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_test = PMPI_Win_test -#endif -#define MPI_Win_test PMPI_Win_test -#endif - -static const char FUNC_NAME[] = "MPI_Win_test"; - - -int MPI_Win_test(MPI_Win win, int *flag) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_test(win, flag); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_test.c.in b/ompi/mpi/c/win_test.c.in new file mode 100644 index 00000000000..b3cb93a155b --- /dev/null +++ b/ompi/mpi/c/win_test.c.in @@ -0,0 +1,46 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_test(WIN win, INT_OUT flag) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_test(win, flag); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_unlock.c b/ompi/mpi/c/win_unlock.c deleted file mode 100644 index 3e08087b553..00000000000 --- a/ompi/mpi/c/win_unlock.c +++ /dev/null @@ -1,59 +0,0 @@ -/* -*- 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-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) 2014 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2015-2017 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_unlock = PMPI_Win_unlock -#endif -#define MPI_Win_unlock PMPI_Win_unlock -#endif - -static const char FUNC_NAME[] = "MPI_Win_unlock"; - - -int MPI_Win_unlock(int rank, MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } else if (ompi_win_peer_invalid(win, rank)) { - return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_unlock(rank, win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_unlock.c.in b/ompi/mpi/c/win_unlock.c.in new file mode 100644 index 00000000000..7beaa304b00 --- /dev/null +++ b/ompi/mpi/c/win_unlock.c.in @@ -0,0 +1,51 @@ +/* -*- 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-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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_unlock(INT rank, WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } else if (ompi_win_peer_invalid(win, rank)) { + return OMPI_ERRHANDLER_INVOKE(win, MPI_ERR_RANK, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_unlock(rank, win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_unlock_all.c b/ompi/mpi/c/win_unlock_all.c deleted file mode 100644 index cbf01986a78..00000000000 --- a/ompi/mpi/c/win_unlock_all.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_unlock_all = PMPI_Win_unlock_all -#endif -#define MPI_Win_unlock_all PMPI_Win_unlock_all -#endif - -static const char FUNC_NAME[] = "MPI_Win_unlock_all"; - - -int MPI_Win_unlock_all(MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_unlock_all(win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_unlock_all.c.in b/ompi/mpi/c/win_unlock_all.c.in new file mode 100644 index 00000000000..a3d0b094f75 --- /dev/null +++ b/ompi/mpi/c/win_unlock_all.c.in @@ -0,0 +1,46 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_unlock_all(WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_unlock_all(win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/win_wait.c b/ompi/mpi/c/win_wait.c deleted file mode 100644 index d55ad56f999..00000000000 --- a/ompi/mpi/c/win_wait.c +++ /dev/null @@ -1,54 +0,0 @@ -/* - * 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-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) 2015 Research Organization for Information Science - * and Technology (RIST). 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/win/win.h" -#include "ompi/mca/osc/osc.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Win_wait = PMPI_Win_wait -#endif -#define MPI_Win_wait PMPI_Win_wait -#endif - -static const char FUNC_NAME[] = "MPI_Win_wait"; - - -int MPI_Win_wait(MPI_Win win) -{ - int rc; - - if (MPI_PARAM_CHECK) { - OMPI_ERR_INIT_FINALIZE(FUNC_NAME); - - if (ompi_win_invalid(win)) { - return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); - } - } - - rc = win->w_osc_module->osc_wait(win); - OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); -} diff --git a/ompi/mpi/c/win_wait.c.in b/ompi/mpi/c/win_wait.c.in new file mode 100644 index 00000000000..7ad43c67337 --- /dev/null +++ b/ompi/mpi/c/win_wait.c.in @@ -0,0 +1,46 @@ +/* + * 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-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) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 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/communicator/communicator.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/win/win.h" +#include "ompi/mca/osc/osc.h" + +PROTOTYPE ERROR_CLASS win_wait(WIN win) +{ + int rc; + + if (MPI_PARAM_CHECK) { + OMPI_ERR_INIT_FINALIZE(FUNC_NAME); + + if (ompi_win_invalid(win)) { + return OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_WIN, FUNC_NAME); + } + } + + rc = win->w_osc_module->osc_wait(win); + OMPI_ERRHANDLER_RETURN(rc, win, rc, FUNC_NAME); +} diff --git a/ompi/mpi/c/wtime.c b/ompi/mpi/c/wtime.c deleted file mode 100644 index 1d7c672de59..00000000000 --- a/ompi/mpi/c/wtime.c +++ /dev/null @@ -1,68 +0,0 @@ -/* - * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana - * University Research and Technology - * Corporation. All rights reserved. - * Copyright (c) 2004-2018 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-2022 Cisco Systems, Inc. All rights reserved - * Copyright (c) 2015 Research Organization for Information Science - * and Technology (RIST). All rights reserved. - * Copyright (c) 2017 IBM Corporation. All rights reserved. - * Copyright (c) 2017 Los Alamos National Security, LLC. All rights - * reserved. - * Copyright (c) 2024 NVIDIA Corporation. All rights reserved. - * $COPYRIGHT$ - * - * Additional copyrights may follow - * - * $HEADER$ - */ -#include "ompi_config.h" - -#ifdef HAVE_SYS_TIME_H -#include -#endif -#include -#ifdef HAVE_TIME_H -#include -#endif /* HAVE_TIME_H */ - -#include "ompi/mpi/c/bindings.h" -#include "ompi/runtime/mpiruntime.h" -#include "ompi/runtime/ompi_spc.h" - -#include "opal/util/clock_gettime.h" - -#if OMPI_BUILD_MPI_PROFILING -#if OPAL_HAVE_WEAK_SYMBOLS -#pragma weak MPI_Wtime = PMPI_Wtime -#endif -#define MPI_Wtime PMPI_Wtime -#endif -/** - * Use this as a base time set early during MPI initialization to improve the range - * and accuracy of the user visible timer. - * More info: https://github.com/mpi-forum/mpi-issues/issues/77#issuecomment-369663119 - */ -extern struct timespec ompi_wtime_time_origin; - -double MPI_Wtime(void) -{ - double wtime; - - SPC_RECORD(OMPI_SPC_WTIME, 1); - - // We intentionally don't use the OPAL timer framework here. See - // https://github.com/open-mpi/ompi/issues/3003 for more details. - struct timespec tp; - (void) opal_clock_gettime(&tp); - wtime = (double)(tp.tv_nsec - ompi_wtime_time_origin.tv_nsec)/1.0e+9; - wtime += (tp.tv_sec - ompi_wtime_time_origin.tv_sec); - - return wtime; -} diff --git a/ompi/mpi/c/wtime.c.in b/ompi/mpi/c/wtime.c.in new file mode 100644 index 00000000000..e31db4d630e --- /dev/null +++ b/ompi/mpi/c/wtime.c.in @@ -0,0 +1,64 @@ +/* + * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana + * University Research and Technology + * Corporation. All rights reserved. + * Copyright (c) 2004-2018 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-2022 Cisco Systems, Inc. All rights reserved + * Copyright (c) 2015 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2017 IBM Corporation. All rights reserved. + * Copyright (c) 2017 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2024 NVIDIA Corporation. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ +#include "ompi_config.h" + +#ifdef HAVE_SYS_TIME_H +#include +#endif +#include +#ifdef HAVE_TIME_H +#include +#endif /* HAVE_TIME_H */ + +#include "ompi/mpi/c/bindings.h" +#include "ompi/runtime/mpiruntime.h" +#include "ompi/runtime/ompi_spc.h" + +#include "opal/util/clock_gettime.h" + +/** + * Use this as a base time set early during MPI initialization to improve the range + * and accuracy of the user visible timer. + * More info: https://github.com/mpi-forum/mpi-issues/issues/77#issuecomment-369663119 + */ +extern struct timespec ompi_wtime_time_origin; + +PROTOTYPE DOUBLE wtime() +{ + double wtime; + + SPC_RECORD(OMPI_SPC_WTIME, 1); + + // We intentionally don't use the OPAL timer framework here. See + // https://github.com/open-mpi/ompi/issues/3003 for more details. + struct timespec tp; + (void) opal_clock_gettime(&tp); + wtime = (double)(tp.tv_nsec - ompi_wtime_time_origin.tv_nsec)/1.0e+9; + wtime += (tp.tv_sec - ompi_wtime_time_origin.tv_sec); + + return wtime; +} diff --git a/ompi/mpi/fortran/base/fint_2_int.h b/ompi/mpi/fortran/base/fint_2_int.h index 3cffe37a719..15b55eaa867 100644 --- a/ompi/mpi/fortran/base/fint_2_int.h +++ b/ompi/mpi/fortran/base/fint_2_int.h @@ -33,21 +33,22 @@ */ #if OMPI_SIZEOF_FORTRAN_INTEGER == SIZEOF_INT - #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL - #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2] + #define OMPI_ARRAY_NAME_DECL(a) + #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) #define OMPI_SINGLE_NAME_DECL(a) - #define OMPI_ARRAY_NAME_CONVERT(a) c_##a + #define OMPI_ARRAY_NAME_CONVERT(a) a #define OMPI_SINGLE_NAME_CONVERT(a) a #define OMPI_INT_2_FINT(a) a #define OMPI_FINT_2_INT(a) a #define OMPI_PFINT_2_PINT(a) a - #define OMPI_ARRAY_FINT_2_INT_ALLOC(in, n) { OMPI_ARRAY_NAME_CONVERT(in) = in; } - #define OMPI_ARRAY_FINT_2_INT(in, n) { OMPI_ARRAY_NAME_CONVERT(in) = in; } - #define OMPI_2_DIM_ARRAY_FINT_2_INT(in, n, dim2) { OMPI_ARRAY_NAME_CONVERT(in) = in; } + #define OMPI_ARRAY_FINT_2_INT_ALLOC(in, n) + #define OMPI_ARRAY_FINT_2_INT(in, n) + #define OMPI_2_DIM_ARRAY_FINT_2_INT(in, n, dim2) #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) #define OMPI_SINGLE_FINT_2_INT(in) #define OMPI_SINGLE_INT_2_FINT(in) #define OMPI_ARRAY_INT_2_FINT(in, n) + #define OMPI_COND_STATEMENT(a) #elif OMPI_SIZEOF_FORTRAN_INTEGER > SIZEOF_INT #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL @@ -87,7 +88,8 @@ /* This is for IN parameters. Does only free */ #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \ - free(OMPI_ARRAY_NAME_CONVERT(in)) + if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \ + free(OMPI_ARRAY_NAME_CONVERT(in)) /* This is for single IN parameter */ #define OMPI_SINGLE_FINT_2_INT(in) \ @@ -106,6 +108,8 @@ } \ free(OMPI_ARRAY_NAME_CONVERT(in)); \ } while (0) + + #define OMPI_COND_STATEMENT(a) a #else /* int > MPI_Fint */ #define OMPI_ARRAY_NAME_DECL(a) int *c_##a = NULL #define OMPI_2_DIM_ARRAY_NAME_DECL(a, dim2) int (*c_##a)[dim2], dim2_index @@ -141,7 +145,8 @@ } while (0) #define OMPI_ARRAY_FINT_2_INT_CLEANUP(in) \ - free(OMPI_ARRAY_NAME_CONVERT(in)) + if (NULL != OMPI_ARRAY_NAME_CONVERT(in)) \ + free(OMPI_ARRAY_NAME_CONVERT(in)) #define OMPI_SINGLE_FINT_2_INT(in) \ OMPI_ARRAY_NAME_CONVERT(in) = *(in) @@ -158,6 +163,7 @@ free(OMPI_ARRAY_NAME_CONVERT(in)); \ } while (0) + #define OMPI_COND_STATEMENT(a) a #endif /* diff --git a/ompi/mpi/fortran/configure-fortran-output.h.in b/ompi/mpi/fortran/configure-fortran-output.h.in index 2c96d83a2b6..ed239693b15 100644 --- a/ompi/mpi/fortran/configure-fortran-output.h.in +++ b/ompi/mpi/fortran/configure-fortran-output.h.in @@ -43,6 +43,9 @@ ! Line 2 of the ignore TKR syntax #define OMPI_FORTRAN_IGNORE_TKR_TYPE @OMPI_FORTRAN_IGNORE_TKR_TYPE@ +! f08 TKR syntax (w/o TS 29113) +#define OMPI_F08_IGNORE_TKR_PREDECL @OMPI_F08_IGNORE_TKR_PREDECL@ +#define OMPI_F08_IGNORE_TKR_TYPE @OMPI_F08_IGNORE_TKR_TYPE@ #define OMPI_FORTRAN_BUILD_SIZEOF @OMPI_FORTRAN_BUILD_SIZEOF@ ! Integers diff --git a/ompi/mpi/fortran/mpif-h/type_get_envelope_f_c.c b/ompi/mpi/fortran/mpif-h/type_get_envelope_f_c.c new file mode 100644 index 00000000000..ba088345f57 --- /dev/null +++ b/ompi/mpi/fortran/mpif-h/type_get_envelope_f_c.c @@ -0,0 +1,53 @@ +/* + * 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$ + */ + +#include "ompi_config.h" + +#include "ompi/mpi/fortran/mpif-h/bindings.h" + +void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers, + MPI_Count *num_addresses, + MPI_Count *num_large_counts, + MPI_Count *num_datatypes, MPI_Fint *combiner, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*type); + OMPI_SINGLE_NAME_DECL(num_integers); + OMPI_SINGLE_NAME_DECL(num_addresses); + OMPI_SINGLE_NAME_DECL(num_datatypes); + OMPI_SINGLE_NAME_DECL(combiner); + + c_ierr = PMPI_Type_get_envelope_c(c_type, + OMPI_SINGLE_NAME_CONVERT(num_integers), + OMPI_SINGLE_NAME_CONVERT(num_addresses), + OMPI_SINGLE_NAME_CONVERT(num_large_counts), + OMPI_SINGLE_NAME_CONVERT(num_datatypes), + OMPI_SINGLE_NAME_CONVERT(combiner)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(num_integers); + OMPI_SINGLE_INT_2_FINT(num_addresses); + OMPI_SINGLE_INT_2_FINT(num_datatypes); + OMPI_SINGLE_INT_2_FINT(combiner); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/Makefile.am index 93e503c03c4..593feca0480 100644 --- a/ompi/mpi/fortran/use-mpi-f08/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.am @@ -23,8 +23,6 @@ # $HEADER$ # -SUBDIRS = profile - include $(top_srcdir)/Makefile.ompi-rules # Note that Automake's Fortran-buidling rules uses CPPFLAGS and @@ -36,6 +34,20 @@ AM_CPPFLAGS = # This Makefile is only relevant if we're building the "use mpi_f08" # MPI bindings. + +# Profiling entry points are generated using a combination of the +# the mod/mpi-f08-rename.h file and the OMPI_BUILD_MPI_PROFILING +# define flag. This approach is used both for the generated +# F08 entry points like MPI_SEND and ones that are still built +# using *.F90 files like COMM_SET_ERRHANDLER. +# +# When adding a new function, if it involves big count arguments and/or +# involves a user supplied buffer(s), and hence the need to generate +# either assumed rank or assumed shape arrays with possible async +# attributes, the *.c.in method needs to be used. Otherwise a *.F90 +# file can be used. In addition, the mod/mpi-f08-rename.h file +# will need to be updated to include a rename line for the new method. +# if OMPI_BUILD_FORTRAN_USEMPIF08_BINDINGS AM_FCFLAGS = -I$(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mod \ @@ -45,14 +57,14 @@ AM_FCFLAGS = -I$(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mod \ $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/mpi/fortran/use-mpi-ignore-tkr \ $(OMPI_FC_MODULE_FLAG)mod \ $(OMPI_FC_MODULE_FLAG)bindings \ - -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) \ - -DOMPI_BUILD_MPI_PROFILING=0 + -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) MOSTLYCLEANFILES = *.mod CLEANFILES += *.i90 lib_LTLIBRARIES = lib@OMPI_LIBMPI_NAME@_usempif08.la +noinst_LTLIBRARIES = lib@OMPI_LIBMPI_NAME@_usempif08_profile.la module_sentinel_files = \ mod/libforce_usempif08_internal_modules_to_be_built.la \ @@ -97,9 +109,9 @@ sizeof_f08.f90: --complex4=$(OMPI_HAVE_FORTRAN_COMPLEX4) \ --complex32=$(OMPI_HAVE_FORTRAN_COMPLEX32) -profile/psizeof_f08.f90: $(top_builddir)/config.status -profile/psizeof_f08.f90: $(sizeof_pl) -profile/psizeof_f08.f90: +psizeof_f08.f90: $(top_builddir)/config.status +psizeof_f08.f90: $(sizeof_pl) +psizeof_f08.f90: $(OMPI_V_GEN) $(sizeof_pl) \ --impl=$@ --ierror=optional --pmpi \ --maxrank=$(OMPI_FORTRAN_MAX_ARRAY_RANK) \ @@ -110,37 +122,18 @@ profile/psizeof_f08.f90: --complex4=$(OMPI_HAVE_FORTRAN_COMPLEX4) \ --complex32=$(OMPI_HAVE_FORTRAN_COMPLEX32) -CLEANFILES += sizeof_f08.h sizeof_f08.f90 profile/psizeof_f08.f90 +CLEANFILES += sizeof_f08.h sizeof_f08.f90 psizeof_f08.f90 mpi_api_files = \ abort_f08.F90 \ - accumulate_f08.F90 \ add_error_class_f08.F90 \ add_error_code_f08.F90 \ add_error_string_f08.F90 \ aint_add_f08.F90 \ aint_diff_f08.F90 \ - allgather_f08.F90 \ - allgather_init_f08.F90 \ - allgatherv_f08.F90 \ - allgatherv_init_f08.F90 \ alloc_mem_f08.F90 \ - allreduce_f08.F90 \ - allreduce_init_f08.F90 \ - alltoall_f08.F90 \ - alltoall_init_f08.F90 \ - alltoallv_f08.F90 \ - alltoallv_init_f08.F90 \ - alltoallw_f08.F90 \ - alltoallw_init_f08.F90 \ barrier_f08.F90 \ barrier_init_f08.F90 \ - bcast_f08.F90 \ - bcast_init_f08.F90 \ - bsend_f08.F90 \ - bsend_init_f08.F90 \ - buffer_attach_f08.F90 \ - buffer_detach_f08.F90 \ cancel_f08.F90 \ cart_coords_f08.F90 \ cart_create_f08.F90 \ @@ -188,7 +181,6 @@ mpi_api_files = \ comm_split_f08.F90 \ comm_split_type_f08.F90 \ comm_test_inter_f08.F90 \ - compare_and_swap_f08.F90 \ dist_graph_create_adjacent_f08.F90 \ dist_graph_create_f08.F90 \ dist_graph_neighbors_count_f08.F90 \ @@ -197,10 +189,6 @@ mpi_api_files = \ errhandler_free_f08.F90 \ error_class_f08.F90 \ error_string_f08.F90 \ - exscan_f08.F90 \ - exscan_init_f08.F90 \ - f_sync_reg_f08.F90 \ - fetch_and_op_f08.F90 \ file_call_errhandler_f08.F90 \ file_close_f08.F90 \ file_create_errhandler_f08.F90 \ @@ -216,30 +204,8 @@ mpi_api_files = \ file_get_size_f08.F90 \ file_get_type_extent_f08.F90 \ file_get_view_f08.F90 \ - file_iread_at_f08.F90 \ - file_iread_f08.F90 \ - file_iread_at_all_f08.F90 \ - file_iread_all_f08.F90 \ - file_iread_shared_f08.F90 \ - file_iwrite_at_f08.F90 \ - file_iwrite_f08.F90 \ - file_iwrite_at_all_f08.F90 \ - file_iwrite_all_f08.F90 \ - file_iwrite_shared_f08.F90 \ file_open_f08.F90 \ file_preallocate_f08.F90 \ - file_read_all_begin_f08.F90 \ - file_read_all_end_f08.F90 \ - file_read_all_f08.F90 \ - file_read_at_all_begin_f08.F90 \ - file_read_at_all_end_f08.F90 \ - file_read_at_all_f08.F90 \ - file_read_at_f08.F90 \ - file_read_f08.F90 \ - file_read_ordered_begin_f08.F90 \ - file_read_ordered_end_f08.F90 \ - file_read_ordered_f08.F90 \ - file_read_shared_f08.F90 \ file_seek_f08.F90 \ file_seek_shared_f08.F90 \ file_set_atomicity_f08.F90 \ @@ -248,31 +214,9 @@ mpi_api_files = \ file_set_size_f08.F90 \ file_set_view_f08.F90 \ file_sync_f08.F90 \ - file_write_all_begin_f08.F90 \ - file_write_all_end_f08.F90 \ - file_write_all_f08.F90 \ - file_write_at_all_begin_f08.F90 \ - file_write_at_all_end_f08.F90 \ - file_write_at_all_f08.F90 \ - file_write_at_f08.F90 \ - file_write_f08.F90 \ - file_write_ordered_begin_f08.F90 \ - file_write_ordered_end_f08.F90 \ - file_write_ordered_f08.F90 \ - file_write_shared_f08.F90 \ finalized_f08.F90 \ finalize_f08.F90 \ - free_mem_f08.F90 \ - gather_f08.F90 \ - gather_init_f08.F90 \ - gatherv_f08.F90 \ - gatherv_init_f08.F90 \ - get_accumulate_f08.F90 \ - get_address_f08.F90 \ - get_count_f08.F90 \ - get_elements_f08.F90 \ get_elements_x_f08.F90 \ - get_f08.F90 \ get_library_version_f08.F90 \ get_processor_name_f08.F90 \ get_version_f08.F90 \ @@ -297,25 +241,8 @@ mpi_api_files = \ group_size_f08.F90 \ group_translate_ranks_f08.F90 \ group_union_f08.F90 \ - iallgather_f08.F90 \ - iallgatherv_f08.F90 \ - iallreduce_f08.F90 \ - ialltoall_f08.F90 \ - ialltoallv_f08.F90 \ - ialltoallw_f08.F90 \ ibarrier_f08.F90 \ - ibcast_f08.F90 \ - ibsend_f08.F90 \ - iexscan_f08.F90 \ - igather_f08.F90 \ - igatherv_f08.F90 \ improbe_f08.F90 \ - imrecv_f08.F90 \ - ineighbor_allgather_f08.F90 \ - ineighbor_allgatherv_f08.F90 \ - ineighbor_alltoall_f08.F90 \ - ineighbor_alltoallv_f08.F90 \ - ineighbor_alltoallw_f08.F90 \ info_create_f08.F90 \ info_create_env_f08.F90 \ info_delete_f08.F90 \ @@ -334,79 +261,24 @@ mpi_api_files = \ intercomm_create_from_groups_f08.F90 \ intercomm_merge_f08.F90 \ iprobe_f08.F90 \ - irecv_f08.F90 \ - ireduce_f08.F90 \ - ireduce_scatter_f08.F90 \ - ireduce_scatter_block_f08.F90 \ - irsend_f08.F90 \ - iscan_f08.F90 \ - iscatter_f08.F90 \ - iscatterv_f08.F90 \ - isend_f08.F90 \ - isendrecv_f08.F90 \ - isendrecv_replace_f08.F90 \ - issend_f08.F90 \ is_thread_main_f08.F90 \ lookup_name_f08.F90 \ mprobe_f08.F90 \ - mrecv_f08.F90 \ - neighbor_allgather_f08.F90 \ - neighbor_allgather_init_f08.F90 \ - neighbor_allgatherv_f08.F90 \ - neighbor_allgatherv_init_f08.F90 \ - neighbor_alltoall_f08.F90 \ - neighbor_alltoall_init_f08.F90 \ - neighbor_alltoallv_f08.F90 \ - neighbor_alltoallv_init_f08.F90 \ - neighbor_alltoallw_f08.F90 \ - neighbor_alltoallw_init_f08.F90 \ op_commutative_f08.F90 \ op_create_f08.F90 \ open_port_f08.F90 \ op_free_f08.F90 \ - pack_external_f08.F90 \ - pack_external_size_f08.F90 \ - pack_f08.F90 \ - pack_size_f08.F90 \ parrived_f08.F90 \ pcontrol_f08.F90 \ pready_f08.F90 \ pready_range_f08.F90 \ pready_list_f08.F90 \ - precv_init_f08.F90 \ probe_f08.F90 \ - psend_init_f08.F90 \ publish_name_f08.F90 \ - put_f08.F90 \ query_thread_f08.F90 \ - raccumulate_f08.F90 \ - recv_f08.F90 \ - recv_init_f08.F90 \ - reduce_f08.F90 \ - reduce_init_f08.F90 \ - reduce_local_f08.F90 \ - reduce_scatter_f08.F90 \ - reduce_scatter_init_f08.F90 \ - reduce_scatter_block_f08.F90 \ - reduce_scatter_block_init_f08.F90 \ register_datarep_f08.F90 \ request_free_f08.F90 \ request_get_status_f08.F90 \ - rget_f08.F90 \ - rget_accumulate_f08.F90 \ - rput_f08.F90 \ - rsend_f08.F90 \ - rsend_init_f08.F90 \ - scan_f08.F90 \ - scan_init_f08.F90 \ - scatter_f08.F90 \ - scatter_init_f08.F90 \ - scatterv_f08.F90 \ - scatterv_init_f08.F90 \ - send_f08.F90 \ - 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\ @@ -417,72 +289,50 @@ mpi_api_files = \ session_init_f08.F90 \ session_finalize_f08.F90 \ session_set_errhandler_f08.F90\ - ssend_f08.F90 \ - ssend_init_f08.F90 \ startall_f08.F90 \ start_f08.F90 \ status_f082f_f08.F90 \ status_f2f08_f08.F90 \ status_set_cancelled_f08.F90 \ - status_set_elements_f08.F90 \ status_set_elements_x_f08.F90 \ testall_f08.F90 \ - testany_f08.F90 \ test_cancelled_f08.F90 \ test_f08.F90 \ testsome_f08.F90 \ topo_test_f08.F90 \ type_commit_f08.F90 \ - type_contiguous_f08.F90 \ - type_create_darray_f08.F90 \ type_create_f90_complex_f08.F90 \ type_create_f90_integer_f08.F90 \ type_create_f90_real_f08.F90 \ - type_create_hindexed_f08.F90 \ - type_create_hvector_f08.F90 \ - type_create_indexed_block_f08.F90 \ - type_create_hindexed_block_f08.F90 \ type_create_keyval_f08.F90 \ type_create_resized_f08.F90 \ - type_create_struct_f08.F90 \ - type_create_subarray_f08.F90 \ type_delete_attr_f08.F90 \ type_dup_f08.F90 \ type_free_f08.F90 \ type_free_keyval_f08.F90 \ type_get_attr_f08.F90 \ type_get_contents_f08.F90 \ - type_get_envelope_f08.F90 \ + type_get_contents_f08_c.F90 \ type_get_extent_f08.F90 \ type_get_extent_x_f08.F90 \ type_get_name_f08.F90 \ - type_get_true_extent_f08.F90 \ type_get_true_extent_x_f08.F90 \ - type_indexed_f08.F90 \ + type_get_envelope_f08.F90 \ + type_get_envelope_f08_c.F90 \ type_match_size_f08.F90 \ type_set_attr_f08.F90 \ type_set_name_f08.F90 \ - type_size_f08.F90 \ type_size_x_f08.F90 \ - type_vector_f08.F90 \ - unpack_external_f08.F90 \ - unpack_f08.F90 \ unpublish_name_f08.F90 \ - waitall_f08.F90 \ waitany_f08.F90 \ wait_f08.F90 \ waitsome_f08.F90 \ - win_allocate_f08.F90 \ - win_allocate_shared_f08.F90 \ - win_attach_f08.F90 \ win_call_errhandler_f08.F90 \ win_complete_f08.F90 \ win_create_dynamic_f08.F90 \ win_create_errhandler_f08.F90 \ - win_create_f08.F90 \ win_create_keyval_f08.F90 \ win_delete_attr_f08.F90 \ - win_detach_f08.F90 \ win_fence_f08.F90 \ win_flush_f08.F90 \ win_flush_all_f08.F90 \ @@ -502,34 +352,30 @@ mpi_api_files = \ win_set_errhandler_f08.F90 \ win_set_info_f08.F90 \ win_set_name_f08.F90 \ - win_shared_query_f08.F90 \ win_start_f08.F90 \ win_sync_f08.F90 \ win_test_f08.F90 \ win_unlock_f08.F90 \ win_unlock_all_f08.F90 \ - win_wait_f08.F90 - -# JMS Somehow this variable substitution isn't quite working, and I -# don't have time to figure it out. So just wholesale copy the file -# list. :-( -#pmpi_api_files = $(mpi_api_files:%=profile/p%) + win_wait_f08.F90 \ + api_f08_generated.F90 lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = \ $(mpi_api_files) \ mpi-f08.F90 -# These are generated; do not ship them -nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = - if BUILD_FORTRAN_SIZEOF SIZEOF_H = sizeof_f08.h -nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES += \ +nodist_lib@OMPI_LIBMPI_NAME@_usempif08_la_SOURCES = \ sizeof_f08.h \ sizeof_f08.f90 \ - profile/psizeof_f08.f90 + psizeof_f08.f90 endif +lib@OMPI_LIBMPI_NAME@_usempif08_la_FCFLAGS = \ + $(AM_FCFLAGS) \ + -DOMPI_BUILD_MPI_PROFILING=0 + # # Include the mpi_f08-based MPI extensions in libmpi_usempif08, too. # @@ -539,13 +385,20 @@ endif # lib@OMPI_LIBMPI_NAME@_usempif08_la_LIBADD = \ - profile/libmpi_usempif08_pmpi.la \ + lib@OMPI_LIBMPI_NAME@_usempif08_profile.la \ $(OMPI_MPIEXT_USEMPIF08_LIBS) \ $(top_builddir)/ompi/mpi/fortran/mpif-h/lib@OMPI_LIBMPI_NAME@_mpifh.la \ $(top_builddir)/ompi/lib@OMPI_LIBMPI_NAME@.la \ mod/libusempif08_internal_modules.la \ base/libusempif08_ccode.la -lib@OMPI_LIBMPI_NAME@_usempif08_la_DEPENDENCIES = $(module_sentinel_files) + +# +# Make sure to build the profile library before this library, since adding it +# to LIBADD doesn't enforce any ordering +# +lib@OMPI_LIBMPI_NAME@_usempif08_la_DEPENDENCIES = \ + $(module_sentinel_files) \ + lib@OMPI_LIBMPI_NAME@_usempif08_profile.la lib@OMPI_LIBMPI_NAME@_usempif08_la_LDFLAGS = -version-info $(libmpi_usempif08_so_version) # @@ -558,6 +411,46 @@ mpi_api_lo_files = $(mpi_api_files:.F90=.lo) $(mpi_api_lo_files): bindings/libforce_usempif08_internal_bindings_to_be_built.la mpi-f08.lo: $(module_sentinel_files) $(SIZEOF_H) +mpi-f08.F90: $(SIZEOF_H) + +# +# Profiling interface +# + +lib@OMPI_LIBMPI_NAME@_usempif08_profile_la_SOURCES = \ + $(mpi_api_files) + +lib@OMPI_LIBMPI_NAME@_usempif08_profile_la_FCFLAGS = \ + $(AM_FCFLAGS) \ + -DOMPI_BUILD_MPI_PROFILING=1 + + +# +# Generate the Fortran bindings and C wrapper functions for bindings with a +# *.in template. +# + +if OMPI_GENERATE_BINDINGS + +include Makefile.prototype_files +template_files =${prototype_files:%=$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/%} + +api_f08_generated.F90: $(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 \ + code \ + --lang fortran \ + --prototype-files $(template_files) + +EXTRA_DIST = $(prototype_files) + +endif + +# Delete generated file on maintainer-clean +MAINTAINERCLEANFILES = api_f08_generated.F90 ########################################################################### diff --git a/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files new file mode 100644 index 00000000000..f17f7edefa9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files @@ -0,0 +1,169 @@ +# +# Shared list of prototype files to avoid listing dependencies multiple times. +# + +prototype_files = \ + accumulate_ts.c.in \ + allgather_init_ts.c.in \ + allgather_ts.c.in \ + allgatherv_init_ts.c.in \ + allgatherv_ts.c.in \ + allreduce_init_ts.c.in \ + allreduce_ts.c.in \ + alltoall_init_ts.c.in \ + alltoall_ts.c.in \ + alltoallv_init_ts.c.in \ + alltoallv_ts.c.in \ + alltoallw_init_ts.c.in \ + alltoallw_ts.c.in \ + bcast_init_ts.c.in \ + bcast_ts.c.in \ + bsend_init_ts.c.in \ + bsend_ts.c.in \ + buffer_attach_ts.c.in \ + buffer_detach.c.in \ + compare_and_swap_ts.c.in \ + exscan_init_ts.c.in \ + exscan_ts.c.in \ + fetch_and_op_ts.c.in \ + file_iread_all_ts.c.in \ + file_iread_at_all_ts.c.in \ + file_iread_at_ts.c.in \ + file_iread_shared_ts.c.in \ + file_iread_ts.c.in \ + file_iwrite_all_ts.c.in \ + file_iwrite_at_all_ts.c.in \ + file_iwrite_at_ts.c.in \ + file_iwrite_shared_ts.c.in \ + file_iwrite_ts.c.in \ + file_read_all_begin_ts.c.in \ + file_read_all_end_ts.c.in \ + file_read_all_ts.c.in \ + file_read_at_all_begin_ts.c.in \ + file_read_at_all_end_ts.c.in \ + file_read_at_all_ts.c.in \ + file_read_at_ts.c.in \ + file_read_ordered_begin_ts.c.in \ + file_read_ordered_end_ts.c.in \ + file_read_ordered_ts.c.in \ + file_read_shared_ts.c.in \ + file_read_ts.c.in \ + file_write_all_begin_ts.c.in \ + file_write_all_end_ts.c.in \ + file_write_all_ts.c.in \ + file_write_at_all_begin_ts.c.in \ + file_write_at_all_end_ts.c.in \ + file_write_at_all_ts.c.in \ + file_write_at_ts.c.in \ + file_write_ordered_begin_ts.c.in \ + file_write_ordered_end_ts.c.in \ + file_write_ordered_ts.c.in \ + file_write_shared_ts.c.in \ + file_write_ts.c.in \ + free_mem_ts.c.in \ + f_sync_reg_ts.c.in \ + gather_init_ts.c.in \ + gather_ts.c.in \ + gatherv_init_ts.c.in \ + gatherv_ts.c.in \ + get_accumulate_ts.c.in \ + get_address_ts.c.in \ + get_count.c.in \ + get_elements.c.in \ + get_ts.c.in \ + iallgather_ts.c.in \ + iallgatherv_ts.c.in \ + iallreduce_ts.c.in \ + ialltoall_ts.c.in \ + ialltoallv_ts.c.in \ + ialltoallw_ts.c.in \ + ibcast_ts.c.in \ + ibsend_ts.c.in \ + iexscan_ts.c.in \ + igather_ts.c.in \ + igatherv_ts.c.in \ + imrecv_ts.c.in \ + ineighbor_allgather_ts.c.in \ + ineighbor_allgatherv_ts.c.in \ + ineighbor_alltoall_ts.c.in \ + ineighbor_alltoallv_ts.c.in \ + ineighbor_alltoallw_ts.c.in \ + irecv_ts.c.in \ + ireduce_scatter_block_ts.c.in \ + ireduce_scatter_ts.c.in \ + ireduce_ts.c.in \ + irsend_ts.c.in \ + iscan_ts.c.in \ + iscatter_ts.c.in \ + iscatterv_ts.c.in \ + isendrecv_replace_ts.c.in \ + isendrecv_ts.c.in \ + isend_ts.c.in \ + issend_ts.c.in \ + mrecv_ts.c.in \ + neighbor_allgather_init_ts.c.in \ + neighbor_allgather_ts.c.in \ + neighbor_allgatherv_init_ts.c.in \ + neighbor_allgatherv_ts.c.in \ + neighbor_alltoall_init_ts.c.in \ + neighbor_alltoall_ts.c.in \ + neighbor_alltoallv_init_ts.c.in \ + neighbor_alltoallv_ts.c.in \ + neighbor_alltoallw_init_ts.c.in \ + neighbor_alltoallw_ts.c.in \ + pack_external_size.c.in \ + pack_external_ts.c.in \ + pack_size.c.in \ + pack_ts.c.in \ + precv_init_ts.c.in \ + psend_init_ts.c.in \ + put_ts.c.in \ + raccumulate_ts.c.in \ + recv_init_ts.c.in \ + recv_ts.c.in \ + reduce_init_ts.c.in \ + reduce_local_ts.c.in \ + reduce_scatter_block_init_ts.c.in \ + reduce_scatter_block_ts.c.in \ + reduce_scatter_init_ts.c.in \ + reduce_scatter_ts.c.in \ + reduce_ts.c.in \ + rget_accumulate_ts.c.in \ + rget_ts.c.in \ + rput_ts.c.in \ + rsend_init_ts.c.in \ + rsend_ts.c.in \ + scan_init_ts.c.in \ + scan_ts.c.in \ + scatter_init_ts.c.in \ + scatter_ts.c.in \ + scatterv_init_ts.c.in \ + scatterv_ts.c.in \ + send_init_ts.c.in \ + sendrecv_replace_ts.c.in \ + sendrecv_ts.c.in \ + send_ts.c.in \ + ssend_init_ts.c.in \ + ssend_ts.c.in \ + testany.c.in \ + type_contiguous.c.in \ + type_create_darray.c.in \ + type_create_hindexed_block.c.in \ + type_create_hindexed.c.in \ + type_create_hvector.c.in \ + type_create_indexed_block.c.in \ + type_create_struct.c.in \ + type_create_subarray.c.in \ + type_get_true_extent.c.in \ + type_indexed.c.in \ + type_size.c.in \ + type_vector.c.in \ + unpack_external_ts.c.in \ + unpack_ts.c.in \ + waitall.c.in \ + win_allocate.c.in \ + win_allocate_shared.c.in \ + win_attach_ts.c.in \ + win_create_ts.c.in \ + win_detach_ts.c.in \ + win_shared_query.c.in diff --git a/ompi/mpi/fortran/use-mpi-f08/accumulate_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/accumulate_f08.F90 deleted file mode 100644 index cf5f9ada671..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/accumulate_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Accumulate_f08(origin_addr,origin_count,origin_datatype,& - target_rank,target_disp,target_count, & - target_datatype,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_accumulate_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_accumulate_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,& - op%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Accumulate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in new file mode 100644 index 00000000000..b2d9495b025 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/accumulate_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID accumulate(BUFFER x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win) +{ + int c_ierr; + + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + int c_origin_count = OMPI_INT_2_FINT(*origin_count); + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 deleted file mode 100644 index ed2aefbad59..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgather_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allgather_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgather_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgather_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgather_init_f08.F90 deleted file mode 100644 index 8fe93a449d0..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgather_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_allgather_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgather_init_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgather_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in new file mode 100644 index 00000000000..215c880f1df --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in @@ -0,0 +1,79 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID allgather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Request c_req; + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_senddatatype = NULL; + MPI_Info c_info; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_senddatatype = c_sendtype; + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + (@COUNT_TYPE@) *recvcount, + c_recvtype, c_comm, c_info, &c_req); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in new file mode 100644 index 00000000000..db3305b9057 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in @@ -0,0 +1,71 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + OMPI_FINT_2_INT(*recvcount), + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 deleted file mode 100644 index 260b89a986b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgatherv_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allgatherv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgatherv_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgatherv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_f08.F90 deleted file mode 100644 index 97f1b223350..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_allgatherv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allgatherv_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allgatherv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_ts.c.in new file mode 100644 index 00000000000..c559a5f107a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgatherv_init_ts.c.in @@ -0,0 +1,100 @@ +/* + * Copyright (c) 2004-2005 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-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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID allgatherv_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, + INFO info, REQUEST_OUT request) +{ + MPI_Comm c_comm; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL, c_recvtype = NULL; + MPI_Request c_request; + MPI_Info c_info; + int size, idx = 0, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + if (OMPI_COMM_IS_INTER(c_comm)) { + size = ompi_comm_remote_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + size = ompi_comm_size(c_comm); + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, c_comm, c_info, &c_request); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(displs, tmp_displs, c_request, c_ierr, idx); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in new file mode 100644 index 00000000000..bccc21b864e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allgatherv_ts.c.in @@ -0,0 +1,93 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID allgatherv(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int size = 0; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + if (OMPI_COMM_IS_INTER(c_comm)) { + size = ompi_comm_remote_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + size = ompi_comm_size(c_comm); + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 deleted file mode 100644 index 0e98b9e171a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allreduce_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_allreduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allreduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allreduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/allreduce_init_f08.F90 deleted file mode 100644 index 85b67cac49c..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/allreduce_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Allreduce_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_allreduce_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_allreduce_init_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Allreduce_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allreduce_init_ts.c.in new file mode 100644 index 00000000000..7a12727f921 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allreduce_init_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID allreduce_init(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_type; + MPI_Info c_info; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, c_comm, c_info, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in new file mode 100644 index 00000000000..05039409c59 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/allreduce_ts.c.in @@ -0,0 +1,58 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID allreduce(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int c_ierr; + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + c_count, + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 deleted file mode 100644 index f201dd2f769..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoall_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoall_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoall_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoall_init_f08.F90 deleted file mode 100644 index 513ef505d00..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoall_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoall_init_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_alltoall_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoall_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoall_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in new file mode 100644 index 00000000000..63e45a47080 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in @@ -0,0 +1,72 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID alltoall_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Request c_req; + MPI_Datatype c_sendtype, c_recvtype; + MPI_Info c_info; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + (@COUNT_TYPE@) *sendcount, + c_sendtype, + recvbuf, + (@COUNT_TYPE@) *recvcount, + c_recvtype, c_comm, c_info, &c_req); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in new file mode 100644 index 00000000000..b1412f45932 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in @@ -0,0 +1,66 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +PROTOTYPE VOID alltoall(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + int c_sendcount = 0, c_recvcount = OMPI_FINT_2_INT(*recvcount); + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, c_comm); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 deleted file mode 100644 index 0acf0fd03a5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallv_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoallv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoallv_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_f08.F90 deleted file mode 100644 index 49bf9e97d01..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallv_init_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_alltoallv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_alltoallv_init_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in new file mode 100644 index 00000000000..5bdd4155294 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in @@ -0,0 +1,90 @@ +/* + * Copyright (c) 2004-2005 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-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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoallv_init(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_OUT request) +{ + MPI_Comm c_comm; + MPI_Datatype c_sendtype, c_recvtype; + MPI_Info c_info; + MPI_Request c_request; + int size, idx = 0, c_ierr; + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + + PMPI_Comm_size(c_comm, &size); + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_ARRAY_FINT_2_INT(sendcounts, size); + OMPI_ARRAY_FINT_2_INT(sdispls, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, c_comm, c_info, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sendcounts, tmp_sendcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sdispls, tmp_sdispls, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(rdispls, tmp_rdispls, c_request, c_ierr, idx); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in new file mode 100644 index 00000000000..bac6148455f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in @@ -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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoallv(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + int size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, c_comm); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_IN_PLACE == sendbuf) { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 deleted file mode 100644 index f63ac4842f7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallw_f08.F90 +++ /dev/null @@ -1,42 +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) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_alltoallw_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*) - TYPE(MPI_Datatype), INTENT(IN) :: recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - ! Note that we pass a scalar here for both the sendtypes and - ! recvtypes arguments, even though the real Alltoallw function - ! expects an array of integers. This is a hack: we know that - ! [send|recv]types(1)%MPI_VAL will pass the address of the first - ! integer in the array of Type(MPI_Datatype) derived types. And - ! since Type(MPI_Datatype) are exactly memory-equivalent to a - ! single INTEGER, passing the address of the first one is the same - ! as passing the address to an array of integers. To be clear: the - ! back-end ompi_alltoallw_f is expecting a pointer to an array of - ! integers. So it all works out (but is a hack :-\ ). - call ompi_alltoallw_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallw_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_f08.F90 deleted file mode 100644 index ce2dbd88532..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_f08.F90 +++ /dev/null @@ -1,44 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Alltoallw_init_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_alltoallw_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - ! Note that we pass a scalar here for both the sendtypes and - ! recvtypes arguments, even though the real Alltoallw function - ! expects an array of integers. This is a hack: we know that - ! [send|recv]types(1)%MPI_VAL will pass the address of the first - ! integer in the array of Type(MPI_Datatype) derived types. And - ! since Type(MPI_Datatype) are exactly memory-equivalent to a - ! single INTEGER, passing the address of the first one is the same - ! as passing the address to an array of integers. To be clear: the - ! back-end ompi_alltoallw_f is expecting a pointer to an array of - ! integers. So it all works out (but is a hack :-\ ). - call ompi_alltoallw_init_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Alltoallw_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_ts.c.in new file mode 100644 index 00000000000..34765cd1af1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/alltoallw_init_ts.c.in @@ -0,0 +1,99 @@ +/* + * Copyright (c) 2004-2005 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-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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID alltoallw_init(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, + DISP_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes, + COMM comm, INFO info, REQUEST_OUT request) +{ + MPI_Comm c_comm; + MPI_Datatype *c_sendtypes = NULL, *c_recvtypes; + MPI_Info c_info; + MPI_Request c_request; + int size, idx = 0, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + c_comm = PMPI_Comm_f2c(*comm); + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + + if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + for (int i=0; idata.release_arrays[(idx)++] = tmp_array; \ + } \ + nb_request->data.release_arrays[idx] = NULL; \ + } else { \ + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP((array), (tmp_array)); \ + } \ + } while (0) diff --git a/ompi/mpi/fortran/use-mpi-f08/base/buffer_detach.c b/ompi/mpi/fortran/use-mpi-f08/base/buffer_detach.c deleted file mode 100644 index 5d2cfa849f7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/base/buffer_detach.c +++ /dev/null @@ -1,77 +0,0 @@ -/* - * 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) 2007 Sun Microsystems, Inc. All rights reserved. - * Copyright (c) 2011-2015 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 "mpi.h" -#include "ompi/mpi/fortran/base/fint_2_int.h" - -/* - * This function implemented in this file is only called from Fortran, - * so we never bothered to put a prototype for it in any C header - * file. To avoid compiler warnings about no prototype, we prototype - * it here. - */ -OMPI_DECLSPEC void ompi_buffer_detach_f08(char *buffer, MPI_Fint *size, - MPI_Fint *ierr); - -OMPI_DECLSPEC void pompi_buffer_detach_f08(char *buffer, MPI_Fint *size, - MPI_Fint *ierr); - -/* (this comment is repeated in ompi/mpi/fortran/mpif-h/buffer_detach_f.c) - * - * MPI-3.1 section 3.6, page 45, states that the mpif.h and mpi module - * interfaces for MPI_BUFFER_DETACH ignore the buffer argument. - * Therefore, for the mpif.h and mpi module interfaces, we use a dummy - * variable and leave the value handed in alone. - * - * The mpi_f08 implementation for MPI_BUFFER_DETACH therefore is a - * separate routine in the use-mpi-f08 directory (it's not built in - * the mpif-h directory because of all the different combinations of - * supporting weak symbols (or not), building the profiling layer (or - * not), etc.). - * - * Note that we only need to build this function once -- the F08 - * interfaces for MPI_BUFFER_ATTACH and PMPI_BUFFER_ATTACH both - * bind(C) to the name ompi_buffer_detach_f08. - */ -void ompi_buffer_detach_f08(char *buffer, MPI_Fint *size, MPI_Fint *ierr) -{ - int c_ierr; - void *dummy; - OMPI_SINGLE_NAME_DECL(size); - - c_ierr = PMPI_Buffer_detach(&dummy, OMPI_SINGLE_NAME_CONVERT(size)); - if (NULL != ierr) { - *ierr = OMPI_INT_2_FINT(c_ierr); - } - - if (MPI_SUCCESS == c_ierr) { - OMPI_SINGLE_INT_2_FINT(size); - *(void **)buffer = dummy; - } -} - -void pompi_buffer_detach_f08(char *buffer, MPI_Fint *size, MPI_Fint *ierr) -{ - ompi_buffer_detach_f08(buffer, size, ierr); -} diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_contents_f_c.c b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_contents_f_c.c new file mode 100644 index 00000000000..c40551be2c7 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_contents_f_c.c @@ -0,0 +1,126 @@ +/* + * 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 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/errhandler/errhandler.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +/* + * big count entry point, only needed by F08 bindings. + */ + +static const char FUNC_NAME[] = "MPI_TYPE_GET_CONTENTS_C"; + +void ompi_type_get_contents_f_c(MPI_Fint *mtype, MPI_Count *max_integers, + MPI_Count *max_addresses, MPI_Count *max_large_counts, + MPI_Count *max_datatypes, + MPI_Fint *array_of_integers, + MPI_Aint *array_of_addresses, + MPI_Count *array_of_large_counts, + MPI_Fint *array_of_datatypes, MPI_Fint *ierr); +void ompi_type_get_contents_f_c(MPI_Fint *mtype, MPI_Count *max_integers, + MPI_Count *max_addresses, MPI_Count *max_large_counts, + MPI_Count *max_datatypes, + MPI_Fint *array_of_integers, + MPI_Aint *array_of_addresses, + MPI_Count *array_of_large_counts, + MPI_Fint *array_of_datatypes, MPI_Fint *ierr) +{ + MPI_Aint *c_address_array = NULL; + MPI_Count *c_large_counts_array = NULL; + MPI_Datatype *c_datatype_array = NULL; + MPI_Datatype c_mtype = PMPI_Type_f2c(*mtype); + int i, c_ierr; + OMPI_ARRAY_NAME_DECL(array_of_integers); + + if (*max_datatypes) { + c_datatype_array = (MPI_Datatype *) malloc(*max_datatypes * sizeof(MPI_Datatype)); + if (NULL == c_datatype_array) { + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + } + + if (*max_addresses) { + c_address_array = (MPI_Aint *) malloc(*max_addresses * sizeof(MPI_Aint)); + if (NULL == c_address_array) { + if (NULL != c_datatype_array) { + free(c_datatype_array); + } + + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + } + + if (*max_large_counts) { + c_large_counts_array = (MPI_Count *) malloc(*max_large_counts * sizeof(MPI_Count)); + if (NULL == c_large_counts_array) { + if (NULL != c_datatype_array) { + free(c_datatype_array); + } + if (NULL != c_address_array) { + free(c_address_array); + } + + c_ierr = OMPI_ERRHANDLER_NOHANDLE_INVOKE(MPI_ERR_NO_MEM, + FUNC_NAME); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + } + + OMPI_ARRAY_FINT_2_INT(array_of_integers, *max_integers); + + c_ierr = PMPI_Type_get_contents_c(c_mtype, + OMPI_FINT_2_INT(*max_integers), + OMPI_FINT_2_INT(*max_addresses), + OMPI_FINT_2_INT(*max_datatypes), + OMPI_FINT_2_INT(*max_large_counts), + OMPI_ARRAY_NAME_CONVERT(array_of_integers), + c_address_array, c_large_counts_array, + c_datatype_array); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + for (i = 0; i < *max_addresses; i++) { + array_of_addresses[i] = c_address_array[i]; + } + for (i = 0; i < *max_large_counts; i++) { + array_of_large_counts[i] = c_large_counts_array[i]; + } + for (i = 0; i < *max_datatypes; i++) { + array_of_datatypes[i] = PMPI_Type_c2f(c_datatype_array[i]); + } + } + free(c_address_array); + free(c_datatype_array); + free(c_large_counts_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_integers); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_envelope_f_c.c b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_envelope_f_c.c new file mode 100644 index 00000000000..414aaf62987 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_envelope_f_c.c @@ -0,0 +1,62 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + + +#include "ompi_config.h" + +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers, + MPI_Count *num_addresses, + MPI_Count *num_large_counts, + MPI_Count *num_datatypes, MPI_Fint *combiner, + MPI_Fint *ierr); +void ompi_type_get_envelope_f_c(MPI_Fint *type, MPI_Count *num_integers, + MPI_Count *num_addresses, + MPI_Count *num_large_counts, + MPI_Count *num_datatypes, MPI_Fint *combiner, + MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*type); + OMPI_SINGLE_NAME_DECL(num_integers); + OMPI_SINGLE_NAME_DECL(num_addresses); + OMPI_SINGLE_NAME_DECL(num_datatypes); + OMPI_SINGLE_NAME_DECL(combiner); + + c_ierr = PMPI_Type_get_envelope_c(c_type, + OMPI_SINGLE_NAME_CONVERT(num_integers), + OMPI_SINGLE_NAME_CONVERT(num_addresses), + OMPI_SINGLE_NAME_CONVERT(num_large_counts), + OMPI_SINGLE_NAME_CONVERT(num_datatypes), + OMPI_SINGLE_NAME_CONVERT(combiner)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(num_integers); + OMPI_SINGLE_INT_2_FINT(num_addresses); + OMPI_SINGLE_INT_2_FINT(num_datatypes); + OMPI_SINGLE_INT_2_FINT(combiner); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_extent_f_c.c b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_extent_f_c.c new file mode 100644 index 00000000000..5eea206fc04 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ompi_type_get_extent_f_c.c @@ -0,0 +1,42 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +/* + * big count entry point, only needed by F08 bindings. + */ +void ompi_type_get_extent_f_c(MPI_Fint *type, MPI_Count *lb, + MPI_Count *extent, MPI_Fint *ierr); +void ompi_type_get_extent_f_c(MPI_Fint *type, MPI_Count *lb, + MPI_Count *extent, MPI_Fint *ierr) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*type); + + c_ierr = PMPI_Type_get_extent_c(c_type, lb, extent); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ts.c b/ompi/mpi/fortran/use-mpi-f08/base/ts.c new file mode 100644 index 00000000000..4ff011db7ef --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ts.c @@ -0,0 +1,138 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2014 Argonne National Laboratory. + * Copyright (c) 2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ts.h" + +#include + +int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype) +{ + const int MAX_RANK = 15; /* Fortran 2008 specifies a maximum rank of 15 */ + MPI_Datatype types[MAX_RANK + 1]; /* Use a fixed size array to avoid malloc. + 1 for oldtype */ + int mpi_errno = MPI_SUCCESS; + int accum_elems = 1; + int accum_sm = cdesc->elem_len; + int done = false; /* Have we created a datatype for oldcount of oldtype? */ + int last; /* Index of the last successfully created datatype in types[] */ + int extent; + int i, j; + +#if OPAL_ENABLE_DEBUG + { + size_t size; + assert(cdesc->rank <= MAX_RANK); + ompi_datatype_type_size(oldtype, &size); + /* When cdesc->elem_len != size, things suddenly become complicated. Generally, it is hard to create + * a composite datatype based on two datatypes. Currently we don't support it and doubt it is useful. + */ + assert(cdesc->elem_len == size); + } +#endif + + types[0] = oldtype; + i = 0; + done = false; + while (i < cdesc->rank && !done) { + if (oldcount % accum_elems) { + /* oldcount should be a multiple of accum_elems, otherwise we might need an + * MPI indexed datatype to describle the irregular region, which is not supported yet. + */ + mpi_errno = MPI_ERR_INTERN; + last = i; + goto fn_exit; + } + + extent = oldcount / accum_elems; + if (extent > cdesc->dim[i].extent) { + extent = cdesc->dim[i].extent; + } else { + /* Up to now, we have accumlated enough elements */ + done = true; + } + + if (cdesc->dim[i].sm == accum_sm) { + mpi_errno = PMPI_Type_contiguous(extent, types[i], &types[i+1]); + } else { + mpi_errno = PMPI_Type_create_hvector(extent, 1, cdesc->dim[i].sm, types[i], &types[i+1]); + } + if (mpi_errno != MPI_SUCCESS) { + last = i; + goto fn_exit; + } + + accum_sm = cdesc->dim[i].sm * cdesc->dim[i].extent; + accum_elems *= cdesc->dim[i].extent; + i++; + } + + if (done) { + *newtype = types[i]; + MPI_Type_commit(newtype); + last = i - 1; /* To avoid freeing newtype */ + mpi_errno = MPI_SUCCESS; + } else { + /* If # of elements given by "oldcount oldtype" is bigger than + * what cdesc describles, then we will reach here. + */ + last = i; + mpi_errno = MPI_ERR_ARG; + goto fn_exit; + } + +fn_exit: + for (j = 1; j <= last; j++) { + PMPI_Type_free(&types[j]); + } + return mpi_errno; +} + +static void copy(CFI_dim_t *dim, int rank, char * base, char **dest, size_t len) { + for (CFI_index_t i=0; iextent; i++) { + if (rank > 1) { + copy(dim-1, rank-1, base, dest, len); + } else { + memcpy(*dest, base, len); + *dest += len; + } + base += dim->sm; + } +} + +int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer) { + copy(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len); + return OMPI_SUCCESS; +} + +static void copy_back(CFI_dim_t *dim, int rank, char * base, char **source, size_t len) { + for (CFI_index_t i=0; iextent; i++) { + if (rank > 1) { + copy_back(dim-1, rank-1, base, source, len); + } else { + memcpy(base, *source, len); + *source += len; + } + base += dim->sm; + } +} + +int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc) { + copy_back(&cdesc->dim[cdesc->rank - 1], cdesc->rank, cdesc->base_addr, &buffer, cdesc->elem_len); + return OMPI_SUCCESS; +} + +size_t ompi_ts_size(CFI_cdesc_t *cdesc) { + size_t res = cdesc->elem_len; + for (int i=0; irank; i++) { + res *= cdesc->dim[i].extent; + } + return res; +} diff --git a/ompi/mpi/fortran/use-mpi-f08/base/ts.h b/ompi/mpi/fortran/use-mpi-f08/base/ts.h new file mode 100644 index 00000000000..b6cbd73d31e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/base/ts.h @@ -0,0 +1,158 @@ +/* -*- Mode: C; c-basic-offset:4 ; -*- */ +/* + * Copyright (c) 2014 Argonne National Laboratory. + * Copyright (c) 2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#include "ompi_config.h" + +#include "ompi/datatype/ompi_datatype.h" +#include "ompi/mpi/fortran/base/fint_2_int.h" + +#if OMPI_FORTRAN_HAVE_TS + +#include + +#define OMPI_CFI_BUFFER CFI_cdesc_t + +extern int ompi_ts_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype); + +extern size_t ompi_ts_size(CFI_cdesc_t *cdesc); + +extern int ompi_ts_copy_back(char *buffer, CFI_cdesc_t *cdesc); + +extern int ompi_ts_copy(CFI_cdesc_t *cdesc, char *buffer); + +#define OMPI_CFI_BASE_ADDR(x) (x)->base_addr + +#define OMPI_CFI_2_C(x, count, type, datatype, rc) \ + do { \ + datatype = type; \ + if (x->rank != 0 && !CFI_is_contiguous(x)) { \ + rc = ompi_ts_create_datatype(x, count, type, &datatype); \ + if (OPAL_LIKELY(MPI_SUCCESS == rc)) { \ + count = 1; \ + } \ + } else { \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_CFI_2_C_ALLOC(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + if (x->rank != 0 && !CFI_is_contiguous(x)) { \ + size_t size = ompi_ts_size(x); \ + buffer = malloc(size); \ + if (OPAL_UNLIKELY(NULL == buffer)) { \ + rc = MPI_ERR_NO_MEM; \ + } else { \ + rc = MPI_SUCCESS; \ + } \ + } else { \ + buffer = x->base_addr; \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_CFI_2_C_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + if (x->rank != 0 && !CFI_is_contiguous(x)) { \ + size_t size = ompi_ts_size(x); \ + buffer = malloc(size); \ + if (OPAL_UNLIKELY(NULL == buffer)) { \ + rc = MPI_ERR_NO_MEM; \ + } else { \ + rc = ompi_ts_copy(x, buffer); \ + } \ + } else { \ + buffer = x->base_addr; \ + rc = MPI_SUCCESS; \ + } \ + } while (0) + +#define OMPI_C_2_CFI_FREE(x, buffer, count, type, datatype, rc) \ + do { \ + if (buffer != x->base_addr) { \ + free(buffer); \ + } \ + if (type != datatype) { \ + rc = PMPI_Type_free(&datatype); \ + } \ + } while (0) + +#define OMPI_C_2_CFI_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + if (buffer != x->base_addr) { \ + rc = ompi_ts_copy_back(buffer, x); \ + free(buffer); \ + } \ + if (type != datatype) { \ + rc = PMPI_Type_free(&datatype); \ + } \ + } while (0) + +#define OMPI_CFI_IS_CONTIGUOUS(x) \ + (0 == x->rank || CFI_is_contiguous(x)) + +#define OMPI_CFI_CHECK_CONTIGUOUS(x, rc) \ + do { \ + if (OMPI_CFI_IS_CONTIGUOUS(x)) { \ + rc = MPI_SUCCESS; \ + } else { \ + rc = MPI_ERR_INTERN; \ + } \ + } while (0) + +#else + +/* + * Macros for compilers not supporting TS 29113. + */ + +#define OMPI_CFI_BUFFER char + +#define OMPI_CFI_BASE_ADDR(x) (x) + +#define OMPI_CFI_2_C(x, count, type, datatype, rc) \ + do { \ + datatype = type; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_CFI_2_C_ALLOC(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + buffer = x; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_CFI_2_C_COPY(x, buffer, count, type, datatype, rc) \ + do { \ + datatype = type; \ + buffer = x; \ + rc = MPI_SUCCESS; \ + } while (0) + +#define OMPI_C_2_CFI_FREE(x, buffer, count, type, datatype, rc) \ + do {} while (0) + +#define OMPI_C_2_CFI_COPY(x, buffer, count, type, datatype, rc) \ + do {} while (0) + +#define OMPI_CFI_IS_CONTIGUOUS(x) 1 + +#define OMPI_CFI_CHECK_CONTIGUOUS(x, rc) \ + do { \ + rc = MPI_SUCCESS; \ + } while (0) +#endif /* OMPI_FORTRAN_HAVE_TS */ + +#define OMPI_COUNT_CONVERT(fcount) diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 deleted file mode 100644 index 1a5e5001411..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bcast_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bcast_f08(buffer,count,datatype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_bcast_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bcast_f(buffer,count,datatype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bcast_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bcast_init_f08.F90 deleted file mode 100644 index 997d28263e3..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bcast_init_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bcast_init_f08(buffer,count,datatype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_bcast_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bcast_init_f(buffer,count,datatype%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bcast_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bcast_init_ts.c.in new file mode 100644 index 00000000000..e872a72d8ec --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bcast_init_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bcast_init(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, + RANK root, COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Info c_info; + MPI_Request c_req; + MPI_Datatype c_type, c_datatype = MPI_DATATYPE_NULL; + void *buffer = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + int c_root = OMPI_FINT_2_INT(*root); + + c_comm = PMPI_Comm_f2c(*comm); + c_type = PMPI_Type_f2c(*datatype); + c_info = PMPI_Info_f2c(*info); + + if (OMPI_COMM_IS_INTRA(c_comm) || MPI_PROC_NULL != c_root) { + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buffer), + c_count, + (c_datatype == MPI_DATATYPE_NULL) ? c_type : c_datatype, + c_root, + c_comm, + c_info, + &c_req); + if (MPI_DATATYPE_NULL != c_datatype && c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in new file mode 100644 index 00000000000..8dedd051ae1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bcast_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bcast(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK root, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype = NULL, c_type = NULL; + int c_root = OMPI_FINT_2_INT(*root); + void *buffer = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + if (OMPI_COMM_IS_INTRA(c_comm) || MPI_PROC_NULL != c_root) { + c_type = PMPI_Type_f2c(*datatype); + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buffer), + c_count, + c_datatype, + c_root, + c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/bindings.h b/ompi/mpi/fortran/use-mpi-f08/bindings.h new file mode 100644 index 00000000000..7452a5e9bd1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bindings.h @@ -0,0 +1,219 @@ +/* + * Copyright (c) 2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +#ifndef OMPI_CDESC_BINDINGS_H +#define OMPI_CDESC_BINDINGS_H + +#include "ompi_config.h" + +#include "ts.h" + +#include "mpi.h" + +void ompi_bsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_bsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_buffer_attach_ts(CFI_cdesc_t *x, MPI_Fint *size, MPI_Fint *ierr); + +void ompi_ibsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_irecv_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_irsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_isend_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_issend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_recv_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *status, MPI_Fint *ierr); + +void ompi_recv_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *source, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_rsend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_rsend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *dest, + MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_send_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_sendrecv_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + MPI_Fint *dest, MPI_Fint *sendtag, CFI_cdesc_t* x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *source, MPI_Fint *recvtag, MPI_Fint *comm, + MPI_Fint *status, MPI_Fint *ierr); + +void ompi_sendrecv_replace_ts(CFI_cdesc_t* x, 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); + +void ompi_send_init_ts(CFI_cdesc_t *x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, MPI_Fint *comm, + MPI_Fint *request, MPI_Fint *ierr); + +void ompi_ssend_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_ssend_init_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *dest, MPI_Fint *tag, + MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr); + +void ompi_get_address_ts(CFI_cdesc_t *x, MPI_Aint *address, MPI_Fint *ierr); + +void ompi_pack_ts(CFI_cdesc_t* x1, MPI_Fint *incount, MPI_Fint *datatype, + CFI_cdesc_t* x2, MPI_Fint *outsize, MPI_Fint *position, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_pack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Fint *incount, + MPI_Fint *datatype, CFI_cdesc_t* x2, + MPI_Aint *outsize, MPI_Aint *position, + MPI_Fint *ierr, int datarep_len); + +void ompi_unpack_ts(CFI_cdesc_t* x1, MPI_Fint *insize, MPI_Fint *position, + CFI_cdesc_t* x2, MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_unpack_external_ts(char *datarep, CFI_cdesc_t* x1, MPI_Aint *insize, + MPI_Aint *position, CFI_cdesc_t* x2, + MPI_Fint *outcount, MPI_Fint *datatype, + MPI_Fint *ierr, int datarep_len); + +void ompi_allgather_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_allreduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_alltoall_ts(CFI_cdesc_t* x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t* x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_alltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_alltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_bcast_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_exscan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_gather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_gatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *root, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_reduce_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_reduce_local_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *ierr); + +void ompi_reduce_scatter_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcounts, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_reduce_scatter_block_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *datatype, + MPI_Fint *op, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_scan_ts(CFI_cdesc_t *x1, CFI_cdesc_t *x2, MPI_Fint *count, + MPI_Fint *datatype, MPI_Fint *op, MPI_Fint *comm, + MPI_Fint *ierr); + +void ompi_scatter_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, + MPI_Fint *sendtype, CFI_cdesc_t *x2, + MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *root, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_scatterv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Fint *displs, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, + MPI_Fint *recvtype, MPI_Fint *root, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_free_mem_ts(CFI_cdesc_t *x, MPI_Fint *ierr); + +void ompi_f_sync_reg_ts(CFI_cdesc_t *x); + +void ompi_imrecv_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *message, MPI_Fint *request, MPI_Fint *ierr); + +void ompi_mrecv_ts(CFI_cdesc_t* x, MPI_Fint *count, MPI_Fint *datatype, + MPI_Fint *message, MPI_Fint *status, MPI_Fint *ierr); + +void ompi_neighbor_allgather_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_allgatherv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, MPI_Fint *displs, + MPI_Fint *recvtype, MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoall_ts(CFI_cdesc_t *x1, MPI_Fint *sendcount, MPI_Fint *sendtype, + CFI_cdesc_t *x2, MPI_Fint *recvcount, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoallv_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, MPI_Fint *sdispls, + MPI_Fint *sendtype, CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Fint *rdispls, MPI_Fint *recvtype, + MPI_Fint *comm, MPI_Fint *ierr); + +void ompi_neighbor_alltoallw_ts(CFI_cdesc_t *x1, MPI_Fint *sendcounts, + MPI_Aint *sdispls, MPI_Fint *sendtypes, + CFI_cdesc_t *x2, MPI_Fint *recvcounts, + MPI_Aint *rdispls, MPI_Fint *recvtypes, + MPI_Fint *comm, MPI_Fint *ierr); + +#endif /* OMPI_CDESC_BINDINGS_H */ 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 2de875ade72..f88264f8805 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 @@ -771,6 +771,21 @@ subroutine ompi_type_get_contents_f(datatype,max_integers,max_addresses, & INTEGER, INTENT(OUT) :: ierror end subroutine ompi_type_get_contents_f +subroutine ompi_type_get_contents_f_c(datatype,max_integers,max_addresses, & + max_large_counts, max_datatypes,array_of_integers,array_of_addresses, & + array_of_large_counts, array_of_datatypes,ierror) & + BIND(C, name="ompi_type_get_contents_f_c") + use :: mpi_f08_types, only : MPI_ADDRESS_KIND, MPI_COUNT_KIND + implicit none + INTEGER, INTENT(IN) :: datatype + INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, max_large_counts, max_datatypes + INTEGER, INTENT(OUT) :: array_of_integers(max_integers) + INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses) + INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts) + INTEGER, INTENT(OUT) :: array_of_datatypes(max_datatypes) + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_type_get_contents_f_c + subroutine ompi_type_get_envelope_f(datatype,num_integers, & num_addresses,num_datatypes,combiner,ierror) & BIND(C, name="ompi_type_get_envelope_f") @@ -780,6 +795,17 @@ subroutine ompi_type_get_envelope_f(datatype,num_integers, & INTEGER, INTENT(OUT) :: ierror end subroutine ompi_type_get_envelope_f +subroutine ompi_type_get_envelope_f_c(datatype,num_integers, num_addresses, & + num_large_counts, num_datatypes,combiner,ierror) & + BIND(C, name="ompi_type_get_envelope_f_c") + use :: mpi_f08_types, only : MPI_COUNT_KIND + implicit none + INTEGER, INTENT(IN) :: datatype + INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_large_counts, num_addresses, & + num_datatypes, combiner + INTEGER, INTENT(OUT) :: ierror +end subroutine ompi_type_get_envelope_f_c + subroutine ompi_type_get_extent_f(datatype,lb,extent,ierror) & BIND(C, name="ompi_type_get_extent_f") use :: mpi_f08_types, only : MPI_ADDRESS_KIND diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 deleted file mode 100644 index d35900bacc1..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bsend_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_bsend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bsend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bsend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/bsend_init_f08.F90 deleted file mode 100644 index 78e48fc1240..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/bsend_init_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Bsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_bsend_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_bsend_init_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL, & - request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Bsend_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in new file mode 100644 index 00000000000..fd25c5e2315 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bsend_init_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bsend_init(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in new file mode 100644 index 00000000000..4b9812d8e80 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/bsend_ts.c.in @@ -0,0 +1,47 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID bsend(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/buffer_attach_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/buffer_attach_f08.F90 deleted file mode 100644 index d5491bc753e..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/buffer_attach_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Buffer_attach_f08(buffer,size,ierror) - use :: ompi_mpifh_bindings, only : ompi_buffer_attach_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS:: buffer - INTEGER, INTENT(IN) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_buffer_attach_f(buffer,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Buffer_attach_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in new file mode 100644 index 00000000000..e8982631431 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/buffer_attach_ts.c.in @@ -0,0 +1,34 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID buffer_attach(BUFFER_ASYNC x, COUNT size) +{ + int c_ierr; + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Buffer_attach(OMPI_CFI_BASE_ADDR(x), OMPI_FINT_2_INT(*size)); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/buffer_detach.c.in b/ompi/mpi/fortran/use-mpi-f08/buffer_detach.c.in new file mode 100644 index 00000000000..ec2f80d7b85 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/buffer_detach.c.in @@ -0,0 +1,37 @@ +/* + * 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) 2007 Sun Microsystems, Inc. All rights reserved. + * Copyright (c) 2011-2015 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID buffer_detach(C_PTR_OUT buffer, COUNT size) +{ + int c_ierr; + void *dummy; + OMPI_SINGLE_NAME_DECL(size); + + c_ierr = @INNER_CALL@(&dummy, OMPI_SINGLE_NAME_CONVERT(size)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(size); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/buffer_detach_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/buffer_detach_f08.F90 deleted file mode 100644 index 53cb423b4b7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/buffer_detach_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2015 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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Buffer_detach_f08(buffer_addr,size,ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: ompi_mpifh_bindings, only : ompi_buffer_detach_f - implicit none - TYPE(C_PTR), INTENT(OUT) :: buffer_addr - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_buffer_detach_f(buffer_addr,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Buffer_detach_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_f08.F90 deleted file mode 100644 index 07f9080087b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Compare_and_swap_f08(origin_addr,compare_addr,result_addr,& - datatype,target_rank,target_disp,win,& - ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_compare_and_swap_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr, compare_addr - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: target_rank - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_compare_and_swap_f(origin_addr,compare_addr,result_addr,datatype%MPI_VAL,& - target_rank,target_disp,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Compare_and_swap_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in new file mode 100644 index 00000000000..62308b358ca --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/compare_and_swap_ts.c.in @@ -0,0 +1,60 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID compare_and_swap(BUFFER x1, BUFFER x2, BUFFER_ASYNC x3, + DATATYPE datatype, RANK target_rank, AINT target_disp, + WIN win) +{ + int c_ierr; + MPI_Datatype c_datatype = PMPI_Type_f2c(*datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1), *compare_addr = OMPI_CFI_BASE_ADDR(x2), *result_addr = OMPI_CFI_BASE_ADDR(x3); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x3, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + return; + } + c_ierr = PMPI_Compare_and_swap(OMPI_F2C_BOTTOM(origin_addr), + OMPI_F2C_BOTTOM(compare_addr), + OMPI_F2C_BOTTOM(result_addr), + c_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/exscan_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/exscan_f08.F90 deleted file mode 100644 index cf78dc016c5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/exscan_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Exscan_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_exscan_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_exscan_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Exscan_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/exscan_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/exscan_init_f08.F90 deleted file mode 100644 index 3669eb7d454..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/exscan_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Exscan_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_exscan_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_exscan_init_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Exscan_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/exscan_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/exscan_init_ts.c.in new file mode 100644 index 00000000000..af0d924d304 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/exscan_init_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID exscan_init(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_type; + MPI_Info c_info; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM (sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM (recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, c_comm, c_info, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in new file mode 100644 index 00000000000..234037053ad --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/exscan_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID exscan(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM (sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM (recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in new file mode 100644 index 00000000000..08d72b85a82 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/f_sync_reg_ts.c.in @@ -0,0 +1,29 @@ +/* + * 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) 2012 University of Oregon. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID f_sync_reg(BUFFER x) +{ + /* This is a noop in C to disable potential Fortran optimizations. */ + return; +} diff --git a/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_f08.F90 deleted file mode 100644 index 4958a4019ac..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Fetch_and_op_f08(origin_addr,result_addr,datatype,target_rank, & - target_disp,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_fetch_and_op_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: target_rank - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_fetch_and_op_f(origin_addr,result_addr,datatype%MPI_VAL,target_rank,& - target_disp,op%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Fetch_and_op_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in new file mode 100644 index 00000000000..c6ca7e55415 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/fetch_and_op_ts.c.in @@ -0,0 +1,55 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID fetch_and_op(BUFFER x1, BUFFER_OUT x2, DATATYPE datatype, + RANK target_rank, AINT target_disp, + OP op, WIN win) +{ + int c_ierr; + MPI_Datatype c_datatype = PMPI_Type_f2c(*datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1), *result_addr = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = PMPI_Fetch_and_op(OMPI_F2C_BOTTOM(origin_addr), + OMPI_F2C_BOTTOM(result_addr), + c_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, c_op, c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iread_all_f08.F90 deleted file mode 100644 index 88a2f714bef..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iread_all_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iread_all_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iread_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iread_all_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iread_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in new file mode 100644 index 00000000000..23c828f3a6c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_all_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iread_all(FILE fh, BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_f08.F90 deleted file mode 100644 index b62a3de3ce4..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iread_at_all_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_iread_at_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iread_at_all_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iread_at_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in new file mode 100644 index 00000000000..b5fcb9ce8a3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_all_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iread_at_all(FILE fh, OFFSET offset, + BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in new file mode 100644 index 00000000000..c89829cac80 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_at_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iread_at(FILE fh, OFFSET offset, + BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iread_f08.F90 deleted file mode 100644 index 4b403188c9d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iread_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iread_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iread_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iread_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iread_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_f08.F90 deleted file mode 100644 index 91e40cc4e52..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iread_shared_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iread_shared_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iread_shared_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iread_shared_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in new file mode 100644 index 00000000000..6decb21234d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_shared_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iread_shared(FILE fh, BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in new file mode 100644 index 00000000000..b1c4aabad12 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iread_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iread(FILE fh, BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_f08.F90 deleted file mode 100644 index e42f494ab10..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iwrite_all_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iwrite_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iwrite_all_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iwrite_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in new file mode 100644 index 00000000000..3f11d68db89 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_all_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iwrite_all(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_f08.F90 deleted file mode 100644 index 149c7ba6d5b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iwrite_at_all_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_iwrite_at_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iwrite_at_all_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iwrite_at_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in new file mode 100644 index 00000000000..09a8bb39598 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_all_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iwrite_at_all(FILE fh, OFFSET offset, BUFFER x, + COUNT count, DATATYPE datatype, + REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_f08.F90 deleted file mode 100644 index 08135a0bd2b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iwrite_at_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_iwrite_at_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iwrite_at_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iwrite_at_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in new file mode 100644 index 00000000000..e6e09c1c560 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_at_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iwrite_at(FILE fh, OFFSET offset, BUFFER x, + COUNT count, DATATYPE datatype, + REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, + OMPI_F2C_BOTTOM(buf), + c_count, + c_datatype, + &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_f08.F90 deleted file mode 100644 index e6e17ad77f3..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iwrite_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iwrite_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iwrite_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iwrite_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_f08.F90 deleted file mode 100644 index de15107a306..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_iwrite_shared_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_file_iwrite_shared_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_iwrite_shared_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_iwrite_shared_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in new file mode 100644 index 00000000000..0e5a236cbef --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_shared_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iwrite_shared(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in new file mode 100644 index 00000000000..c994d7cad3c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_iwrite_ts.c.in @@ -0,0 +1,52 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_iwrite(FILE fh, BUFFER x, COUNT count, DATATYPE datatype, + REQUEST_OUT request) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + MPI_Request c_request; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, &c_request); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_f08.F90 deleted file mode 100644 index a2b2060e246..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_all_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_file_read_all_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_all_begin_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_all_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in new file mode 100644 index 00000000000..f962e2e3566 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_begin_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_all_begin(FILE fh, BUFFER_ASYNC x, + COUNT count, DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_f08.F90 deleted file mode 100644 index 0a5d251a128..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_all_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_all_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_all_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in new file mode 100644 index 00000000000..40aedf00e4c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_end_ts.c.in @@ -0,0 +1,39 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_all_end(FILE fh, BUFFER_ASYNC x, STATUS_OUT status) +{ + int c_ierr; + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_File c_fh = PMPI_File_f2c(*fh); + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_all_f08.F90 deleted file mode 100644 index 4a917a50265..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_all_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_all_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_all_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in new file mode 100644 index 00000000000..4116d175198 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_all_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_all(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_f08.F90 deleted file mode 100644 index 8d4527e19bd..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_at_all_begin_f08(fh,offset,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_read_at_all_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_at_all_begin_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_at_all_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in new file mode 100644 index 00000000000..23b60e81f5e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_begin_ts.c.in @@ -0,0 +1,48 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_at_all_begin(FILE fh, OFFSET offset, + BUFFER_ASYNC x, COUNT count, + DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, OMPI_F2C_BOTTOM(buf), + c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_f08.F90 deleted file mode 100644 index 0cf1a58bda5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_at_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_at_all_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_at_all_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_at_all_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in new file mode 100644 index 00000000000..5193f23e8b9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_end_ts.c.in @@ -0,0 +1,39 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_at_all_end(FILE fh, BUFFER_ASYNC x, + STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_at_all_end(c_fh, buf, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_f08.F90 deleted file mode 100644 index e358b7dbbaf..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_at_all_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_read_at_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_at_all_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_at_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in new file mode 100644 index 00000000000..d9ec1042113 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_all_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_at_all(FILE fh, OFFSET offset, + BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, OMPI_F2C_BOTTOM(buf), + c_count, c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_at_f08.F90 deleted file mode 100644 index e7004c759e0..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_at_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_at_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_read_at_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_at_f(fh%MPI_VAL,offset,buf,count,datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_at_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in new file mode 100644 index 00000000000..054ae0cba1f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_at_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_at(FILE fh, OFFSET offset, BUFFER x, + COUNT count, DATATYPE datatype, + STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, buf, c_count, + c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_f08.F90 deleted file mode 100644 index 3f67832e930..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_ordered_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_file_read_ordered_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_ordered_begin_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_ordered_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in new file mode 100644 index 00000000000..c48b13cbe15 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_begin_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_ordered_begin(FILE fh, BUFFER_ASYNC x, COUNT count, + DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_f08.F90 deleted file mode 100644 index 8ddde76a44d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_ordered_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_ordered_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_ordered_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_ordered_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in new file mode 100644 index 00000000000..06a486b7006 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_end_ts.c.in @@ -0,0 +1,38 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_ordered_end(FILE fh, BUFFER_ASYNC x, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_read_ordered_end(c_fh, buf, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_f08.F90 deleted file mode 100644 index c9947619c16..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_ordered_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_ordered_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_ordered_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_ordered_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in new file mode 100644 index 00000000000..c59e581b627 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ordered_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_ordered(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_shared_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_read_shared_f08.F90 deleted file mode 100644 index a6bd046f497..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_read_shared_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_read_shared_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_read_shared_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_read_shared_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_read_shared_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in new file mode 100644 index 00000000000..b47b0a46a46 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_shared_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read_shared(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in new file mode 100644 index 00000000000..3c36266af7b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_read_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2006-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_read(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_f08.F90 deleted file mode 100644 index 6bdbc0ec7ca..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_all_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_file_write_all_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_all_begin_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_all_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in new file mode 100644 index 00000000000..1f79c0c43b9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_begin_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_all_begin(FILE fh, BUFFER_ASYNC x, + COUNT count, DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_f08.F90 deleted file mode 100644 index 8a42355052a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_all_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_all_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_all_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in new file mode 100644 index 00000000000..186df951f9a --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_end_ts.c.in @@ -0,0 +1,39 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_all_end(FILE fh, BUFFER_ASYNC x, STATUS_OUT status) +{ + int c_ierr; + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_File c_fh = PMPI_File_f2c(*fh); + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_all_f08.F90 deleted file mode 100644 index af975304c94..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_all_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_all_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_all_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in new file mode 100644 index 00000000000..9c07a808bef --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_all_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_all(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_f08.F90 deleted file mode 100644 index 22a80139d15..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_at_all_begin_f08(fh,offset,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_write_at_all_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_at_all_begin_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_at_all_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in new file mode 100644 index 00000000000..242f066e0d9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_begin_ts.c.in @@ -0,0 +1,48 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_at_all_begin(FILE fh, OFFSET offset, + BUFFER_ASYNC x, COUNT count, + DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, OMPI_F2C_BOTTOM(buf), + c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_f08.F90 deleted file mode 100644 index 5a180b34252..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_at_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_at_all_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_at_all_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_at_all_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in new file mode 100644 index 00000000000..3883cc5634b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_end_ts.c.in @@ -0,0 +1,39 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_at_all_end(FILE fh, BUFFER_ASYNC x, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_at_all_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_f08.F90 deleted file mode 100644 index 6973a334bae..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_at_all_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_write_at_all_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_at_all_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_at_all_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in new file mode 100644 index 00000000000..4ecd1486336 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_all_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_at_all(FILE fh, OFFSET offset, + BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, OMPI_F2C_BOTTOM(buf), + c_count, c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_at_f08.F90 deleted file mode 100644 index 1ad8f65703e..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_at_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_at_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - use :: ompi_mpifh_bindings, only : ompi_file_write_at_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_at_f(fh%MPI_VAL,offset,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_at_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in new file mode 100644 index 00000000000..771cb58392f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_at_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_at(FILE fh, OFFSET offset, + BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, (MPI_Offset) *offset, OMPI_F2C_BOTTOM(buf), + c_count, c_datatype, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 deleted file mode 100644 index 8dd3c49496d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_f08.F90 deleted file mode 100644 index cec70707280..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_ordered_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_file_write_ordered_begin_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_ordered_begin_f(fh%MPI_VAL,buf,count,datatype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_ordered_begin_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in new file mode 100644 index 00000000000..2c8483667f1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_begin_ts.c.in @@ -0,0 +1,46 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_ordered_begin(FILE fh, BUFFER_ASYNC x, + COUNT count, DATATYPE datatype) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_f08.F90 deleted file mode 100644 index 2226ec5b5d8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_ordered_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_ordered_end_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_ordered_end_f(fh%MPI_VAL,buf,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_ordered_end_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in new file mode 100644 index 00000000000..c1fe3feffda --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_end_ts.c.in @@ -0,0 +1,39 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_ordered_end(FILE fh, BUFFER_ASYNC x, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + void *buf = OMPI_CFI_BASE_ADDR(x); + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = PMPI_File_write_ordered_end(c_fh, buf, c_status); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_f08.F90 deleted file mode 100644 index 8087420e5ff..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_ordered_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_ordered_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_ordered_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_ordered_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in new file mode 100644 index 00000000000..2e67e4b142f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ordered_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_ordered(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_shared_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/file_write_shared_f08.F90 deleted file mode 100644 index f2e4400dda9..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/file_write_shared_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_File_write_shared_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_file_write_shared_f - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_file_write_shared_f(fh%MPI_VAL,buf,count,& - datatype%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_File_write_shared_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in new file mode 100644 index 00000000000..62b5c80b456 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_shared_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write_shared(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), c_count, c_datatype, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in new file mode 100644 index 00000000000..f2b97e4a55b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/file_write_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID file_write(FILE fh, BUFFER x, COUNT count, + DATATYPE datatype, STATUS_OUT status) +{ + int c_ierr; + MPI_File c_fh = PMPI_File_f2c(*fh); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ __opal_attribute_unused__ c_count = (@COUNT_TYPE@) *count; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_fh, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + c_ierr = @INNER_CALL@(c_fh, OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*count), + c_type, c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/free_mem_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/free_mem_f08.F90 deleted file mode 100644 index 02a4006e5d2..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/free_mem_f08.F90 +++ /dev/null @@ -1,22 +0,0 @@ -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2015-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Free_mem_f08(base,ierror) - use :: ompi_mpifh_bindings, only : ompi_free_mem_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: base - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_free_mem_f(base,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Free_mem_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in new file mode 100644 index 00000000000..deced5f5920 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/free_mem_ts.c.in @@ -0,0 +1,34 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID free_mem(BUFFER x) +{ + int c_ierr; + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Free_mem(OMPI_CFI_BASE_ADDR(x)); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/gather_f08.F90 deleted file mode 100644 index f238c103fbb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/gather_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Gather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,& - recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_gather_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_gather_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcount,& - recvtype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Gather_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/gather_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/gather_init_f08.F90 deleted file mode 100644 index d18bfd1bc19..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/gather_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Gather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,& - recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_gather_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_gather_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcount,& - recvtype%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Gather_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/gather_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gather_init_ts.c.in new file mode 100644 index 00000000000..85ad3eb9bc4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gather_init_ts.c.in @@ -0,0 +1,96 @@ +/* + * 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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID gather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, DATATYPE recvtype, + RANK root, COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_sendtype, c_recvtype; + MPI_Datatype c_senddatatype = MPI_DATATYPE_NULL; + MPI_Info c_info; + MPI_Request c_request; + int c_root = OMPI_FINT_2_INT(*root); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, c_sendcount, + c_senddatatype, + recvbuf, + c_recvcount, + c_recvtype, + c_root, + c_comm, c_info, &c_request); + if (MPI_DATATYPE_NULL != c_senddatatype && c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in new file mode 100644 index 00000000000..ac41efbb91c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gather_ts.c.in @@ -0,0 +1,98 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID gather(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER x2, COUNT recvcount, DATATYPE recvtype, + RANK root, COMM comm) +{ + int c_root, c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_senddatatype = NULL, c_sendtype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + int c_sendcount = 0, c_recvcount = 0; + MPI_Datatype c_recvtype = NULL; + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_comm = PMPI_Comm_f2c(*comm); + c_root = OMPI_FINT_2_INT(*root); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + + c_ierr = PMPI_Gather(sendbuf, c_sendcount, + c_senddatatype, recvbuf, + c_recvcount, + c_recvtype, + c_root, + c_comm); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/gatherv_f08.F90 deleted file mode 100644 index b53fa2e00e7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/gatherv_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Gatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_gatherv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, root - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_gatherv_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Gatherv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/gatherv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/gatherv_init_f08.F90 deleted file mode 100644 index 5ab996416ed..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/gatherv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Gatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_gatherv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_gatherv_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Gatherv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/gatherv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gatherv_init_ts.c.in new file mode 100644 index 00000000000..10e8b8bb5d0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gatherv_init_ts.c.in @@ -0,0 +1,118 @@ +/* + * Copyright (c) 2004-2005 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-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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID gatherv_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, RANK root, COMM comm, + INFO info, REQUEST_OUT request) +{ + MPI_Comm c_comm; + MPI_Datatype c_sendtype, c_recvtype; + MPI_Datatype c_senddatatype = MPI_DATATYPE_NULL; + MPI_Info c_info; + MPI_Request c_request; + int idx = 0, c_ierr; + int c_root = OMPI_FINT_2_INT(*root); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + c_comm = PMPI_Comm_f2c(*comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + c_info = PMPI_Info_f2c(*info); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + int size = ompi_comm_remote_size(c_comm); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } else if (MPI_PROC_NULL != c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + int size = ompi_comm_size(c_comm); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, + c_root, + c_comm, c_info, &c_request); + if (MPI_DATATYPE_NULL != c_senddatatype && c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } else { + OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts); + OMPI_ARRAY_FINT_2_INT_CLEANUP(displs); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(displs, tmp_displs, c_request, c_ierr, idx); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in new file mode 100644 index 00000000000..bb4c827c4d5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/gatherv_ts.c.in @@ -0,0 +1,102 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID gatherv(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, RANK root, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_senddatatype = NULL, c_sendtype = NULL, c_recvtype = NULL; + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + int size = ompi_comm_remote_size(c_comm); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } else if (MPI_PROC_NULL != c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + int size = ompi_comm_size(c_comm); + c_recvtype = PMPI_Type_f2c(*recvtype); + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, c_sendcount, + c_senddatatype, recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, + c_root, + c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_accumulate_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/get_accumulate_f08.F90 deleted file mode 100644 index 9fd4f2ead5b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/get_accumulate_f08.F90 +++ /dev/null @@ -1,39 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Get_accumulate_f08(origin_addr,origin_count,origin_datatype,& - result_addr,result_count,result_datatype,& - target_rank,target_disp,target_count, & - target_datatype,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_get_accumulate_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, result_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: result_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_get_accumulate_f(origin_addr,origin_count,origin_datatype%MPI_VAL,& - result_addr,result_count,result_datatype%MPI_VAL,& - target_rank,target_disp,target_count,target_datatype%MPI_VAL,& - op%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Get_accumulate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in new file mode 100644 index 00000000000..3b3b00d39f0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_accumulate_ts.c.in @@ -0,0 +1,77 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID get_accumulate(BUFFER_ASYNC x1, COUNT origin_count, + DATATYPE origin_datatype, BUFFER_ASYNC_OUT x2, + COUNT result_count, DATATYPE result_datatype, + RANK target_rank, DISP target_disp, + COUNT target_count, DATATYPE target_datatype, + OP op, WIN win) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_result_datatype, c_result_type = PMPI_Type_f2c(*result_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + char *result_addr = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_result_count = (@COUNT_TYPE@) *result_count; + + OMPI_CFI_2_C(x1, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x2, c_result_count, c_result_type, c_result_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_F2C_BOTTOM(result_addr), + c_result_count, + c_result_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_op, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (c_result_datatype != c_result_type) { + ompi_datatype_destroy(&c_result_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_address_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/get_address_f08.F90 deleted file mode 100644 index 187086d0fc5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/get_address_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Get_address_f08(location,address,ierror) - use :: mpi_f08_types, only : MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_get_address_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: location - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: address - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_get_address_f(location,address,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Get_address_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in new file mode 100644 index 00000000000..d672e8c1139 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_address_ts.c.in @@ -0,0 +1,35 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID get_address(BUFFER_ASYNC x, AINT address) +{ + int c_ierr; + MPI_Aint c_address; + + c_ierr = PMPI_Get_address(OMPI_F2C_BOTTOM(OMPI_CFI_BASE_ADDR(x)), &c_address); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *address = (MPI_Aint) c_address; + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_count.c.in b/ompi/mpi/fortran/use-mpi-f08/get_count.c.in new file mode 100644 index 00000000000..bd2c67eab4e --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_count.c.in @@ -0,0 +1,44 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID get_count(STATUS status, DATATYPE datatype, COUNT count) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*datatype); + MPI_Status c_status; + OMPI_SINGLE_NAME_DECL(count); + + if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + *count = OMPI_INT_2_FINT(0); + c_ierr = MPI_SUCCESS; + } else { + c_ierr = PMPI_Status_f2c(status, &c_status); + + if (MPI_SUCCESS == c_ierr) { + c_ierr = @INNER_CALL@(&c_status, c_type, + OMPI_SINGLE_NAME_CONVERT(count)); + OMPI_SINGLE_INT_2_FINT(count); + } + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_count_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/get_count_f08.F90 deleted file mode 100644 index 63333becea8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/get_count_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Get_count_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_get_count_f - implicit none - TYPE(MPI_Status), INTENT(IN) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_get_count_f(status,datatype%MPI_VAL,count,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Get_count_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/get_elements.c.in b/ompi/mpi/fortran/use-mpi-f08/get_elements.c.in new file mode 100644 index 00000000000..6bc81b7b1dd --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_elements.c.in @@ -0,0 +1,44 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID get_elements(STATUS status, DATATYPE datatype, COUNT_OUT count) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*datatype); + MPI_Status c_status; + OMPI_SINGLE_NAME_DECL(count); + + if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + *count = OMPI_INT_2_FINT(0); + c_ierr = MPI_SUCCESS; + } else { + c_ierr = PMPI_Status_f2c(status, &c_status); + + if (MPI_SUCCESS == c_ierr) { + c_ierr = @INNER_CALL@(&c_status, c_type, + OMPI_SINGLE_NAME_CONVERT(count)); + OMPI_SINGLE_INT_2_FINT(count); + } + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/get_elements_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/get_elements_f08.F90 deleted file mode 100644 index 472e3089183..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/get_elements_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Get_elements_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_get_elements_f - implicit none - TYPE(MPI_Status), INTENT(IN) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_get_elements_f(status,datatype%MPI_VAL,count,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Get_elements_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/get_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/get_f08.F90 deleted file mode 100644 index a51ca425ccd..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/get_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2018 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Get_f08(origin_addr,origin_count,origin_datatype,target_rank,& - target_disp,target_count,target_datatype,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_get_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_get_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Get_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in new file mode 100644 index 00000000000..c47dc0622b6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/get_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID get(BUFFER_ASYNC x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + OMPI_FINT_2_INT(*target_count), + c_target_datatype, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iallgather_f08.F90 deleted file mode 100644 index f178b948529..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iallgather_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iallgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iallgather_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iallgather_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iallgather_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in new file mode 100644 index 00000000000..8730f5980a4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallgather_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iallgather(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Request c_req; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_sendcount = 0; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvtype, + c_comm, &c_req); + + if (c_senddatatype != c_sendtype && c_senddatatype != NULL) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_req); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iallgatherv_f08.F90 deleted file mode 100644 index 3d44e27b0c7..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iallgatherv_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iallgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iallgatherv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iallgatherv_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iallgatherv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in new file mode 100644 index 00000000000..cacd6ec6356 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallgatherv_ts.c.in @@ -0,0 +1,96 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iallgatherv(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + @COUNT_TYPE@ c_sendcount = 0; + MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + int size; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + if (OMPI_COMM_IS_INTER(c_comm)) { + size = ompi_comm_remote_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } else { + size = ompi_comm_size(c_comm); + if (OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + sendbuf = MPI_IN_PLACE; + } else { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + c_ierr = @INNER_CALL@(sendbuf, c_sendcount, c_sendtype, + recvbuf, + OMPI_ARRAY_NAME_CONVERT(recvcounts), + OMPI_ARRAY_NAME_CONVERT(displs), + c_recvtype, + c_comm, &c_request); + + if (c_senddatatype != c_sendtype && NULL != c_senddatatype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iallreduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iallreduce_f08.F90 deleted file mode 100644 index e0bbffec347..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iallreduce_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iallreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iallreduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iallreduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iallreduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in new file mode 100644 index 00000000000..5f803ada126 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iallreduce_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iallreduce(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + @COUNT_TYPE@ c_count = (@COUNT_TYPE@)*count; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + c_count, + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ialltoall_f08.F90 deleted file mode 100644 index 3df84b0352d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ialltoall_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ialltoall_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ialltoall_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ialltoall_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ialltoall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.c.in new file mode 100644 index 00000000000..1a9c39a8725 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoall_ts.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-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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ialltoall(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = 0, c_recvcount = (@COUNT_TYPE@)*recvcount; + MPI_Request c_request; + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@)*sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, c_comm, &c_request); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ialltoallv_f08.F90 deleted file mode 100644 index 65bc9858931..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ialltoallv_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ialltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ialltoallv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ialltoallv_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ialltoallv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in new file mode 100644 index 00000000000..bd8255f1ad3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoallv_ts.c.in @@ -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) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ialltoallv(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype); + MPI_Request c_request; + int size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + } else { + sendbuf = MPI_IN_PLACE; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, c_comm, &c_request); + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + if (MPI_IN_PLACE == sendbuf) { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallw_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ialltoallw_f08.F90 deleted file mode 100644 index c5432df5815..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ialltoallw_f08.F90 +++ /dev/null @@ -1,43 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ialltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ialltoallw_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - ! Note that we pass a scalar here for both the sendtypes and - ! recvtypes arguments, even though the real Alltoallw function - ! expects an array of integers. This is a hack: we know that - ! [send|recv]types(1)%MPI_VAL will pass the address of the first - ! integer in the array of Type(MPI_Datatype) derived types. And - ! since Type(MPI_Datatype) are exactly memory-equivalent to a - ! single INTEGER, passing the address of the first one is the same - ! as passing the address to an array of integers. To be clear: the - ! back-end ompi_alltoallw_f is expecting a pointer to an array of - ! integers. So it all works out (but is a hack :-\ ). - call ompi_ialltoallw_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ialltoallw_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in new file mode 100644 index 00000000000..dbeebf41910 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ialltoallw_ts.c.in @@ -0,0 +1,93 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ialltoallw(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, + DISP_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_ASYNC_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes, + COMM comm, REQUEST_OUT request) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes = NULL, *c_recvtypes; + MPI_Request c_request; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm); + + if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) { + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + for (int i=0; i 0) { + c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]); + c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]); + --size; + } + + /* Ineighbor_alltoallw does not support MPI_IN_PLACE */ + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + sdispls, + c_sendtypes, + recvbuf, + tmp_recvcounts, + rdispls, + c_recvtypes, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + free(c_sendtypes); + free(c_recvtypes); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in new file mode 100644 index 00000000000..19048b01ae5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/irecv_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE void irecv(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK source, TAG tag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*tag), c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ireduce_f08.F90 deleted file mode 100644 index f69dd777fb9..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ireduce_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ireduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ireduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ireduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,root,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ireduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_f08.F90 deleted file mode 100644 index 0e2a3906131..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ireduce_scatter_block_f08(sendbuf,recvbuf,recvcount,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ireduce_scatter_block_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ireduce_scatter_block_f(sendbuf,recvbuf,recvcount,& - datatype%MPI_VAL,op%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ireduce_scatter_block_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in new file mode 100644 index 00000000000..1d5e0e853ca --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_block_ts.c.in @@ -0,0 +1,63 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ireduce_scatter_block(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, + COUNT recvcount, DATATYPE datatype, + OP op, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, (@COUNT_TYPE@) *recvcount, + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_f08.F90 deleted file mode 100644 index 8f1c4db8d46..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ireduce_scatter_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ireduce_scatter_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ireduce_scatter_f(sendbuf,recvbuf,recvcounts,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ireduce_scatter_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in new file mode 100644 index 00000000000..e6c319b03e3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_scatter_ts.c.in @@ -0,0 +1,66 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ireduce_scatter(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, + COUNT_ARRAY recvcounts, DATATYPE datatype, + OP op, COMM comm, REQUEST_OUT request) +{ + int c_ierr, idx = 0; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_recvcounts = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, tmp_recvcounts, + c_type, c_op, c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in new file mode 100644 index 00000000000..48d8e40fd45 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ireduce_ts.c.in @@ -0,0 +1,62 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ireduce(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, COUNT count, + DATATYPE datatype, OP op, + RANK root, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, + OMPI_FINT_2_INT(*root), + c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/irsend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/irsend_f08.F90 deleted file mode 100644 index b87f025b284..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/irsend_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Irsend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_irsend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_irsend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Irsend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in new file mode 100644 index 00000000000..f21a428af52 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/irsend_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID irsend(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm, + &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscan_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iscan_f08.F90 deleted file mode 100644 index 5504b6f16c0..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iscan_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iscan_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iscan_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iscan_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iscan_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in new file mode 100644 index 00000000000..158ed781796 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscan_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iscan(BUFFER_ASYNC x1, BUFFER_ASYNC_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Request c_request; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, + c_comm, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatter_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iscatter_f08.F90 deleted file mode 100644 index 3849525959e..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iscatter_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iscatter_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iscatter_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iscatter_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcount,& - recvtype%MPI_VAL,root,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iscatter_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in new file mode 100644 index 00000000000..58ef0785162 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscatter_ts.c.in @@ -0,0 +1,97 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iscatter(BUFFER_ASYNC x1, COUNT sendcount, + DATATYPE sendtype, BUFFER_ASYNC_OUT x2, + COUNT recvcount, DATATYPE recvtype, + RANK root, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + @COUNT_TYPE@ c_sendcount = 0, c_recvcount = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = OMPI_FINT_2_INT(*sendcount); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + recvbuf = (char *) OMPI_F2C_IN_PLACE(recvbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + + c_ierr = @INNER_CALL@(sendbuf, c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm, &c_request); + + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatterv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/iscatterv_f08.F90 deleted file mode 100644 index ddc1b429a69..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/iscatterv_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Iscatterv_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,& - recvcount,recvtype,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_iscatterv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_iscatterv_f(sendbuf,sendcounts,displs,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,root,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Iscatterv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in new file mode 100644 index 00000000000..d6462d7e83b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/iscatterv_ts.c.in @@ -0,0 +1,111 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID iscatterv(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, + DISP_ARRAY displs, DATATYPE sendtype, + BUFFER_ASYNC_OUT x2, COUNT recvcount, + DATATYPE recvtype, RANK root, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype __opal_attribute_unused__ c_recvdatatype = MPI_DATATYPE_NULL; + MPI_Datatype c_sendtype = MPI_DATATYPE_NULL, c_recvtype = MPI_DATATYPE_NULL; + @COUNT_TYPE@ c_recvcount = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Request c_request; + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = OMPI_FINT_2_INT(*recvcount); + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + } + } + + recvbuf = (char *) OMPI_F2C_IN_PLACE(recvbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_displs, + c_sendtype, + recvbuf, + c_recvcount, + (c_recvdatatype == MPI_DATATYPE_NULL) ? c_recvtype : c_recvdatatype, + c_root, c_comm, &c_request); + if (c_recvdatatype != MPI_DATATYPE_NULL && c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in new file mode 100644 index 00000000000..fb9844eb2d4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isend_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID isend(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/isendrecv_f08.F90 deleted file mode 100644 index 0975c50f4ab..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/isendrecv_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Isendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & - recvcount,recvtype,source,recvtag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_isendrecv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, dest, sendtag, recvcount, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_isendrecv_f(sendbuf,sendcount,sendtype%MPI_VAL,dest,sendtag,recvbuf, & - recvcount,recvtype%MPI_VAL,source,recvtag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Isendrecv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_f08.F90 deleted file mode 100644 index 91a18ca4ac6..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! Copyright (c) 2019 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Isendrecv_replace_f08(buf,count,datatype,dest,sendtag,source, & - recvtag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_isendrecv_replace_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buf - INTEGER, INTENT(IN) :: count, dest, sendtag, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_isendrecv_replace_f(buf,count,datatype%MPI_VAL,dest,sendtag,source, & - recvtag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Isendrecv_replace_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in new file mode 100644 index 00000000000..d11e6127fa0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isendrecv_replace_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID isendrecv_replace(BUFFER_ASYNC_OUT x, COUNT count, DATATYPE datatype, + RANK dest, TAG sendtag, + RANK source, TAG recvtag, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Request c_req; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ __opal_attribute_unused__ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*count), + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in new file mode 100644 index 00000000000..cbf9b4aca9c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/isendrecv_ts.c.in @@ -0,0 +1,75 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID isendrecv(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype, + RANK dest, TAG sendtag, BUFFER_ASYNC_OUT x2, + COUNT recvcount, DATATYPE recvtype, + RANK source, TAG recvtag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + MPI_Request c_req; + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(sendbuf), c_sendcount, + c_senddatatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_F2C_BOTTOM(recvbuf), c_recvcount, + c_recvdatatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_req); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/issend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/issend_f08.F90 deleted file mode 100644 index d9ba894d04d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/issend_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Issend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_issend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_issend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Issend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in new file mode 100644 index 00000000000..56ea0d70652 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/issend_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID issend(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am index f6907627cc7..9a72cf2ee88 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am +++ b/ompi/mpi/fortran/use-mpi-f08/mod/Makefile.am @@ -10,6 +10,8 @@ # Copyright (c) 2015-2020 Research Organization for Information Science # and Technology (RIST). All rights reserved. # Copyright (c) 2016 IBM Corporation. All rights reserved. +# Copyright (C) 2024 Triad National Security, LLC. All rights +# reserved. # # $COPYRIGHT$ # @@ -64,7 +66,9 @@ libforce_usempif08_internal_modules_to_be_built_la_SOURCES = \ nodist_noinst_HEADERS = mpi-f08-interfaces.h -noinst_HEADERS = mpi-f08-rename.h +noinst_HEADERS = \ + mpi-f08-rename.h \ + mpi-f08-interfaces-generated.h libforce_usempi_internal_modules_to_be_built.la: libusempif08_internal_modules.la @@ -72,6 +76,25 @@ config_h = \ $(top_builddir)/ompi/mpi/fortran/configure-fortran-output.h \ $(top_srcdir)/ompi/mpi/fortran/configure-fortran-output-bottom.h +# Generate the Fortran interfaces +if OMPI_GENERATE_BINDINGS + +include ../Makefile.prototype_files +template_files =${prototype_files:%=$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/%} + +mpi-f08-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 \ + interface \ + --prototype-files $(template_files) + +endif +# Delete generated file on maintainer-clean +MAINTAINERCLEANFILES = mpi-f08-interfaces-generated.h + # # Automake doesn't do Fortran dependency analysis, so must list them # manually here. Bummer! @@ -83,6 +106,7 @@ mpi-f08-interfaces.lo: $(config_h) mpi-f08-interfaces.lo: mpi-f08-interfaces.F90 mpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo mpi-f08-interfaces.lo: mpi-f08-interfaces.h +mpi-f08-interfaces.lo: mpi-f08-interfaces-generated.h mpi-f08-interfaces-callbacks.lo: $(config_h) mpi-f08-interfaces-callbacks.lo: mpi-f08-interfaces-callbacks.F90 mpi-f08-interfaces-callbacks.lo: mpi-f08-types.lo @@ -94,6 +118,7 @@ pmpi-f08-interfaces.lo: pmpi-f08-interfaces.F90 pmpi-f08-interfaces.lo: mpi-f08-interfaces-callbacks.lo pmpi-f08-interfaces.lo: mpi-f08-interfaces.h pmpi-f08-interfaces.lo: mpi-f08-rename.h +pmpi-f08-interfaces.lo: mpi-f08-interfaces-generated.h ########################################################################### diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 index 71cefb1f128..ad4a92223b0 100644 --- a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 +++ b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.F90 @@ -24,6 +24,7 @@ module mpi_f08_interfaces #include "mpi-f08-interfaces.h" +#include "mpi-f08-interfaces-generated.h" ! MPI_Wtick is not a wrapper function ! 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 c66f92d1332..9b462537a25 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 @@ -19,53 +19,6 @@ ! and the name for tools ("MPI_Init_f08") and the back-end implementation ! name (e.g., "MPI_Init_f08"). -interface MPI_Bsend -subroutine MPI_Bsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bsend_f08 -end interface MPI_Bsend - -interface MPI_Bsend_init -subroutine MPI_Bsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bsend_init_f08 -end interface MPI_Bsend_init - -interface MPI_Buffer_attach -subroutine MPI_Buffer_attach_f08(buffer,size,ierror) - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buffer - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buffer - INTEGER, INTENT(IN) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Buffer_attach_f08 -end interface MPI_Buffer_attach - -interface MPI_Buffer_detach -subroutine MPI_Buffer_detach_f08(buffer_addr,size,ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - implicit none - TYPE(C_PTR), INTENT(OUT) :: buffer_addr - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Buffer_detach_f08 -end interface MPI_Buffer_detach - interface MPI_Cancel subroutine MPI_Cancel_f08(request,ierror) use :: mpi_f08_types, only : MPI_Request @@ -75,31 +28,6 @@ subroutine MPI_Cancel_f08(request,ierror) end subroutine MPI_Cancel_f08 end interface MPI_Cancel -interface MPI_Get_count -subroutine MPI_Get_count_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - implicit none - TYPE(MPI_Status), INTENT(IN) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Get_count_f08 -end interface MPI_Get_count - -interface MPI_Ibsend -subroutine MPI_Ibsend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ibsend_f08 -end interface MPI_Ibsend - interface MPI_Iprobe subroutine MPI_Iprobe_f08(source,tag,comm,flag,status,ierror) use :: mpi_f08_types, only : MPI_Comm, MPI_Status @@ -112,131 +40,6 @@ subroutine MPI_Iprobe_f08(source,tag,comm,flag,status,ierror) end subroutine MPI_Iprobe_f08 end interface MPI_Iprobe -interface MPI_Irecv -subroutine MPI_Irecv_f08(buf,count,datatype,source,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Irecv_f08 -end interface MPI_Irecv - -interface MPI_Irsend -subroutine MPI_Irsend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Irsend_f08 -end interface MPI_Irsend - -interface MPI_Isend -subroutine MPI_Isend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Isend_f08 -end interface MPI_Isend - -interface MPI_Isendrecv -subroutine MPI_Isendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & - recvcount,recvtype,source,recvtag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, dest, sendtag, recvcount, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Isendrecv_f08 -end interface MPI_Isendrecv - -interface MPI_Isendrecv_replace -subroutine MPI_Isendrecv_replace_f08(buf,count,datatype,dest,sendtag,source,recvtag, & - comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count, dest, sendtag, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Isendrecv_replace_f08 -end interface MPI_Isendrecv_replace - -interface MPI_Issend -subroutine MPI_Issend_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Issend_f08 -end interface MPI_Issend - -interface MPI_Precv_init -subroutine MPI_Precv_init_f08(buf,partitions,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request, MPI_COUNT_KIND - implicit none - !DEC$ ATTRIBUTES NO_ARG_CHECK :: buf - !GCC$ ATTRIBUTES NO_ARG_CHECK :: buf - !$PRAGMA IGNORE_TKR buf - !DIR$ IGNORE_TKR buf - !IBM* IGNORE_TKR buf - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: partitions, dest, tag - INTEGER(MPI_COUNT_KIND), INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Precv_init_f08 -end interface MPI_Precv_init - -interface MPI_Psend_init -subroutine MPI_Psend_init_f08(buf,partitions,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request, MPI_COUNT_KIND - implicit none - !DEC$ ATTRIBUTES NO_ARG_CHECK :: buf - !GCC$ ATTRIBUTES NO_ARG_CHECK :: buf - !$PRAGMA IGNORE_TKR buf - !DIR$ IGNORE_TKR buf - !IBM* IGNORE_TKR buf - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: partitions, dest, tag - INTEGER(MPI_COUNT_KIND), INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Psend_init_f08 -end interface MPI_Psend_init - interface MPI_Pready subroutine MPI_Pready_f08(partition,request,ierror) use :: mpi_f08_types, only : MPI_Request @@ -290,34 +93,6 @@ subroutine MPI_Probe_f08(source,tag,comm,status,ierror) end subroutine MPI_Probe_f08 end interface MPI_Probe -interface MPI_Recv -subroutine MPI_Recv_f08(buf,count,datatype,source,tag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Recv_f08 -end interface MPI_Recv - -interface MPI_Recv_init -subroutine MPI_Recv_init_f08(buf,count,datatype,source,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Recv_init_f08 -end interface MPI_Recv_init - interface MPI_Request_free subroutine MPI_Request_free_f08(request,ierror) use :: mpi_f08_types, only : MPI_Request @@ -338,91 +113,6 @@ subroutine MPI_Request_get_status_f08(request,flag,status,ierror) end subroutine MPI_Request_get_status_f08 end interface MPI_Request_get_status -interface MPI_Rsend -subroutine MPI_Rsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Rsend_f08 -end interface MPI_Rsend - -interface MPI_Rsend_init -subroutine MPI_Rsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Rsend_init_f08 -end interface MPI_Rsend_init - -interface MPI_Send -subroutine MPI_Send_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Send_f08 -end interface MPI_Send - -interface MPI_Sendrecv -subroutine MPI_Sendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & - recvcount,recvtype,source,recvtag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, dest, sendtag, recvcount, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Sendrecv_f08 -end interface MPI_Sendrecv - -interface MPI_Sendrecv_replace -subroutine MPI_Sendrecv_replace_f08(buf,count,datatype,dest,sendtag,source,recvtag, & - comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count, dest, sendtag, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Sendrecv_replace_f08 -end interface MPI_Sendrecv_replace - -interface MPI_Send_init -subroutine MPI_Send_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: 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 @@ -529,33 +219,6 @@ subroutine MPI_Session_set_errhandler_f08(session,errhandler,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 - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ssend_f08 -end interface MPI_Ssend - -interface MPI_Ssend_init -subroutine MPI_Ssend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ssend_init_f08 -end interface MPI_Ssend_init - interface MPI_Start subroutine MPI_Start_f08(request,ierror) use :: mpi_f08_types, only : MPI_Request @@ -598,19 +261,6 @@ subroutine MPI_Testall_f08(count,array_of_requests,flag,array_of_statuses,ierror end subroutine MPI_Testall_f08 end interface MPI_Testall -interface MPI_Testany -subroutine MPI_Testany_f08(count,array_of_requests,index,flag,status,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - INTEGER, INTENT(OUT) :: index - LOGICAL, INTENT(OUT) :: flag - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Testany_f08 -end interface MPI_Testany - interface MPI_Testsome subroutine MPI_Testsome_f08(incount,array_of_requests,outcount, & array_of_indices,array_of_statuses,ierror) @@ -644,17 +294,6 @@ subroutine MPI_Wait_f08(request,status,ierror) end subroutine MPI_Wait_f08 end interface MPI_Wait -interface MPI_Waitall -subroutine MPI_Waitall_f08(count,array_of_requests,array_of_statuses,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - TYPE(MPI_Status) :: array_of_statuses(*) - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Waitall_f08 -end interface MPI_Waitall - interface MPI_Waitany subroutine MPI_Waitany_f08(count,array_of_requests,index,status,ierror) use :: mpi_f08_types, only : MPI_Request, MPI_Status @@ -680,28 +319,6 @@ subroutine MPI_Waitsome_f08(incount,array_of_requests,outcount, & end subroutine MPI_Waitsome_f08 end interface MPI_Waitsome -interface MPI_Get_address -subroutine MPI_Get_address_f08(location,address,ierror) - use :: mpi_f08_types, only : MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ location - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: location - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: address - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Get_address_f08 -end interface MPI_Get_address - -interface MPI_Get_elements -subroutine MPI_Get_elements_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - implicit none - TYPE(MPI_Status), INTENT(IN) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Get_elements_f08 -end interface MPI_Get_elements - interface MPI_Get_elements_x subroutine MPI_Get_elements_x_f08(status,datatype,count,ierror) use :: mpi_f08_types, only : MPI_Status, MPI_Datatype, MPI_COUNT_KIND @@ -713,63 +330,6 @@ subroutine MPI_Get_elements_x_f08(status,datatype,count,ierror) end subroutine MPI_Get_elements_x_f08 end interface MPI_Get_elements_x -interface MPI_Pack -subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf - INTEGER, INTENT(IN) :: incount, outsize - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(INOUT) :: position - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Pack_f08 -end interface MPI_Pack - -interface MPI_Pack_external -subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize, & - position,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - CHARACTER(LEN=*), INTENT(IN) :: datarep - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf - INTEGER, INTENT(IN) :: incount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize - INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Pack_external_f08 -end interface MPI_Pack_external - -interface MPI_Pack_external_size -subroutine MPI_Pack_external_size_f08(datarep,incount,datatype,size,ierror & - ) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: incount - CHARACTER(LEN=*), INTENT(IN) :: datarep - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Pack_external_size_f08 -end interface MPI_Pack_external_size - -interface MPI_Pack_size -subroutine MPI_Pack_size_f08(incount,datatype,comm,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - INTEGER, INTENT(IN) :: incount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Pack_size_f08 -end interface MPI_Pack_size - interface MPI_Type_commit subroutine MPI_Type_commit_f08(datatype,ierror) use :: mpi_f08_types, only : MPI_Datatype @@ -779,84 +339,6 @@ subroutine MPI_Type_commit_f08(datatype,ierror) end subroutine MPI_Type_commit_f08 end interface MPI_Type_commit -interface MPI_Type_contiguous -subroutine MPI_Type_contiguous_f08(count,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_contiguous_f08 -end interface MPI_Type_contiguous - -interface MPI_Type_create_darray -subroutine MPI_Type_create_darray_f08(size,rank,ndims,array_of_gsizes, & - array_of_distribs,array_of_dargs,array_of_psizes,order, & - oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: size, rank, ndims, order - INTEGER, INTENT(IN) :: array_of_gsizes(ndims), array_of_distribs(ndims) - INTEGER, INTENT(IN) :: array_of_dargs(ndims), array_of_psizes(ndims) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_darray_f08 -end interface MPI_Type_create_darray - -interface MPI_Type_create_hindexed -subroutine MPI_Type_create_hindexed_f08(count,array_of_blocklengths, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_hindexed_f08 -end interface MPI_Type_create_hindexed - -interface MPI_Type_create_hvector -subroutine MPI_Type_create_hvector_f08(count,blocklength,stride,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: stride - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_hvector_f08 -end interface MPI_Type_create_hvector - -interface MPI_Type_create_indexed_block -subroutine MPI_Type_create_indexed_block_f08(count,blocklength, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER, INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_indexed_block_f08 -end interface MPI_Type_create_indexed_block - -interface MPI_Type_create_hindexed_block -subroutine MPI_Type_create_hindexed_block_f08(count,blocklength, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_hindexed_block_f08 -end interface MPI_Type_create_hindexed_block - interface MPI_Type_create_resized subroutine MPI_Type_create_resized_f08(oldtype,lb,extent,newtype,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND @@ -868,34 +350,6 @@ subroutine MPI_Type_create_resized_f08(oldtype,lb,extent,newtype,ierror) end subroutine MPI_Type_create_resized_f08 end interface MPI_Type_create_resized -interface MPI_Type_create_struct -subroutine MPI_Type_create_struct_f08(count,array_of_blocklengths, & - array_of_displacements,array_of_types,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: array_of_types(count) - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_struct_f08 -end interface MPI_Type_create_struct - -interface MPI_Type_create_subarray -subroutine MPI_Type_create_subarray_f08(ndims,array_of_sizes,array_of_subsizes, & - array_of_starts,order,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: ndims, order - INTEGER, INTENT(IN) :: array_of_sizes(ndims), array_of_subsizes(ndims) - INTEGER, INTENT(IN) :: array_of_starts(ndims) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_create_subarray_f08 -end interface MPI_Type_create_subarray - interface MPI_Type_dup subroutine MPI_Type_dup_f08(oldtype,newtype,ierror) use :: mpi_f08_types, only : MPI_Datatype @@ -928,6 +382,20 @@ subroutine MPI_Type_get_contents_f08(datatype,max_integers,max_addresses,max_dat TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes) INTEGER, OPTIONAL, INTENT(OUT) :: ierror end subroutine MPI_Type_get_contents_f08 +subroutine MPI_Type_get_contents_f08_c(datatype, max_integers, max_addresses, max_large_counts, & + max_datatypes, array_of_integers, array_of_addresses, & + array_of_large_counts, array_of_datatypes, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND + implicit none + TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, & + max_large_counts, max_datatypes + INTEGER, INTENT(OUT) :: array_of_integers(max_integers) + INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses) + INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts) + TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes) + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Type_get_contents_f08_c end interface MPI_Type_get_contents interface MPI_Type_get_envelope @@ -939,6 +407,15 @@ subroutine MPI_Type_get_envelope_f08(datatype,num_integers,num_addresses,num_dat INTEGER, INTENT(OUT) :: num_integers, num_addresses, num_datatypes, combiner INTEGER, OPTIONAL, INTENT(OUT) :: ierror end subroutine MPI_Type_get_envelope_f08 +subroutine MPI_Type_get_envelope_f08_c(datatype,num_integers,num_addresses,num_large_counts,num_datatypes, & + combiner,ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_COUNT_KIND + implicit none + TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_addresses, num_large_counts, num_datatypes + INTEGER, INTENT(OUT) :: combiner + INTEGER, OPTIONAL, INTENT(OUT) :: ierror +end subroutine MPI_Type_get_envelope_f08_c end interface MPI_Type_get_envelope interface MPI_Type_get_extent @@ -961,16 +438,6 @@ subroutine MPI_Type_get_extent_x_f08(datatype,lb,extent,ierror) end subroutine MPI_Type_get_extent_x_f08 end interface MPI_Type_get_extent_x -interface MPI_Type_get_true_extent -subroutine MPI_Type_get_true_extent_f08(datatype,true_lb,true_extent,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: true_lb, true_extent - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_get_true_extent_f08 -end interface MPI_Type_get_true_extent - interface MPI_Type_get_true_extent_x subroutine MPI_Type_get_true_extent_x_f08(datatype,true_lb,true_extent,ierror) use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND @@ -981,32 +448,9 @@ subroutine MPI_Type_get_true_extent_x_f08(datatype,true_lb,true_extent,ierror) end subroutine MPI_Type_get_true_extent_x_f08 end interface MPI_Type_get_true_extent_x -interface MPI_Type_indexed -subroutine MPI_Type_indexed_f08(count,array_of_blocklengths, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count), array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_indexed_f08 -end interface MPI_Type_indexed - -interface MPI_Type_size -subroutine MPI_Type_size_f08(datatype,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_size_f08 -end interface MPI_Type_size - -interface MPI_Type_size_x -subroutine MPI_Type_size_x_f08(datatype,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_COUNT_KIND +interface MPI_Type_size_x +subroutine MPI_Type_size_x_f08(datatype,size,ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_COUNT_KIND implicit none TYPE(MPI_Datatype), INTENT(IN) :: datatype INTEGER(MPI_COUNT_KIND), INTENT(OUT) :: size @@ -1014,342 +458,6 @@ subroutine MPI_Type_size_x_f08(datatype,size,ierror) end subroutine MPI_Type_size_x_f08 end interface MPI_Type_size_x -interface MPI_Type_vector -subroutine MPI_Type_vector_f08(count,blocklength,stride,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - implicit none - INTEGER, INTENT(IN) :: count, blocklength, stride - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Type_vector_f08 -end interface MPI_Type_vector - -interface MPI_Unpack -subroutine MPI_Unpack_f08(inbuf,insize,position,outbuf,outcount,datatype,comm, & - ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf - INTEGER, INTENT(IN) :: insize, outcount - INTEGER, INTENT(INOUT) :: position - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Unpack_f08 -end interface MPI_Unpack - -interface MPI_Unpack_external -subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount, & - datatype,ierror & - ) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - implicit none - CHARACTER(LEN=*), INTENT(IN) :: datarep - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, outbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: outbuf - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize - INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position - INTEGER, INTENT(IN) :: outcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Unpack_external_f08 -end interface MPI_Unpack_external - -interface MPI_Allgather -subroutine MPI_Allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgather_f08 -end interface MPI_Allgather - -interface MPI_Iallgather -subroutine MPI_Iallgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iallgather_f08 -end interface MPI_Iallgather - -interface MPI_Allgather_init -subroutine MPI_Allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgather_init_f08 -end interface MPI_Allgather_init - -interface MPI_Allgatherv -subroutine MPI_Allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgatherv_f08 -end interface MPI_Allgatherv - -interface MPI_Iallgatherv -subroutine MPI_Iallgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iallgatherv_f08 -end interface MPI_Iallgatherv - -interface MPI_Allgatherv_init -subroutine MPI_Allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allgatherv_init_f08 -end interface MPI_Allgatherv_init - -interface MPI_Allreduce -subroutine MPI_Allreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allreduce_f08 -end interface MPI_Allreduce - -interface MPI_Iallreduce -subroutine MPI_Iallreduce_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iallreduce_f08 -end interface MPI_Iallreduce - -interface MPI_Allreduce_init -subroutine MPI_Allreduce_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Allreduce_init_f08 -end interface MPI_Allreduce_init - -interface MPI_Alltoall -subroutine MPI_Alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoall_f08 -end interface MPI_Alltoall - -interface MPI_Ialltoall -subroutine MPI_Ialltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ialltoall_f08 -end interface MPI_Ialltoall - -interface MPI_Alltoall_init -subroutine MPI_Alltoall_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoall_init_f08 -end interface MPI_Alltoall_init - -interface MPI_Alltoallv -subroutine MPI_Alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallv_f08 -end interface MPI_Alltoallv - -interface MPI_Ialltoallv -subroutine MPI_Ialltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ialltoallv_f08 -end interface MPI_Ialltoallv - -interface MPI_Alltoallv_init -subroutine MPI_Alltoallv_init_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallv_init_f08 -end interface MPI_Alltoallv_init - -interface MPI_Alltoallw -subroutine MPI_Alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallw_f08 -end interface MPI_Alltoallw - -interface MPI_Ialltoallw -subroutine MPI_Ialltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ialltoallw_f08 -end interface MPI_Ialltoallw - -interface MPI_Alltoallw_init -subroutine MPI_Alltoallw_init_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Alltoallw_init_f08 -end interface MPI_Alltoallw_init - interface MPI_Barrier subroutine MPI_Barrier_f08(comm,ierror) use :: mpi_f08_types, only : MPI_Comm @@ -1380,195 +488,6 @@ subroutine MPI_Barrier_init_f08(comm,info,request,ierror) end subroutine MPI_Barrier_init_f08 end interface MPI_Barrier_init -interface MPI_Bcast -subroutine MPI_Bcast_f08(buffer,count,datatype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buffer - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bcast_f08 -end interface MPI_Bcast - -interface MPI_Ibcast -subroutine MPI_Ibcast_f08(buffer,count,datatype,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buffer - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ibcast_f08 -end interface MPI_Ibcast - -interface MPI_Bcast_init -subroutine MPI_Bcast_init_f08(buffer,count,datatype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buffer - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buffer - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Bcast_init_f08 -end interface MPI_Bcast_init - -interface MPI_Exscan -subroutine MPI_Exscan_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Exscan_f08 -end interface MPI_Exscan - -interface MPI_Iexscan -subroutine MPI_Iexscan_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iexscan_f08 -end interface MPI_Iexscan - -interface MPI_Exscan_init -subroutine MPI_Exscan_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Exscan_init_f08 -end interface MPI_Exscan_init - -interface MPI_Gather -subroutine MPI_Gather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Gather_f08 -end interface MPI_Gather - -interface MPI_Igather -subroutine MPI_Igather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Igather_f08 -end interface MPI_Igather - -interface MPI_Gather_init -subroutine MPI_Gather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Gather_init_f08 -end interface MPI_Gather_init - -interface MPI_Gatherv -subroutine MPI_Gatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, root - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Gatherv_f08 -end interface MPI_Gatherv - -interface MPI_Igatherv -subroutine MPI_Igatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Igatherv_f08 -end interface MPI_Igatherv - -interface MPI_Gatherv_init -subroutine MPI_Gatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Gatherv_init_f08 -end interface MPI_Gatherv_init - interface MPI_Op_commutative subroutine MPI_Op_commutative_f08(op,commute,ierror) use :: mpi_f08_types, only : MPI_Op @@ -1600,317 +519,6 @@ subroutine MPI_Op_free_f08(op,ierror) end subroutine MPI_Op_free_f08 end interface MPI_Op_free -interface MPI_Reduce -subroutine MPI_Reduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_f08 -end interface MPI_Reduce - -interface MPI_Ireduce -subroutine MPI_Ireduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ireduce_f08 -end interface MPI_Ireduce - -interface MPI_Reduce_init -subroutine MPI_Reduce_init_f08(sendbuf,recvbuf,count,datatype,op,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_init_f08 -end interface MPI_Reduce_init - -interface MPI_Reduce_local -subroutine MPI_Reduce_local_f08(inbuf,inoutbuf,count,datatype,op,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ inbuf, inoutbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: inbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: inoutbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_local_f08 -end interface MPI_Reduce_local - -interface MPI_Reduce_scatter -subroutine MPI_Reduce_scatter_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm, & - ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_scatter_f08 -end interface MPI_Reduce_scatter - -interface MPI_Ireduce_scatter -subroutine MPI_Ireduce_scatter_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm, & - request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ireduce_scatter_f08 -end interface MPI_Ireduce_scatter - -interface MPI_Reduce_scatter_init -subroutine MPI_Reduce_scatter_init_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm, & - info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_scatter_init_f08 -end interface MPI_Reduce_scatter_init - -interface MPI_Reduce_scatter_block -subroutine MPI_Reduce_scatter_block_f08(sendbuf,recvbuf,recvcount,datatype,op,comm, & - ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_scatter_block_f08 -end interface MPI_Reduce_scatter_block - -interface MPI_Ireduce_scatter_block -subroutine MPI_Ireduce_scatter_block_f08(sendbuf,recvbuf,recvcount,datatype,op,comm, & - request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ireduce_scatter_block_f08 -end interface MPI_Ireduce_scatter_block - -interface MPI_Reduce_scatter_block_init -subroutine MPI_Reduce_scatter_block_init_f08(sendbuf,recvbuf,recvcount,datatype,op,comm, & - info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Reduce_scatter_block_init_f08 -end interface MPI_Reduce_scatter_block_init - -interface MPI_Scan -subroutine MPI_Scan_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scan_f08 -end interface MPI_Scan - -interface MPI_Iscan -subroutine MPI_Iscan_f08(sendbuf,recvbuf,count,datatype,op,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iscan_f08 -end interface MPI_Iscan - -interface MPI_Scan_init -subroutine MPI_Scan_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scan_init_f08 -end interface MPI_Scan_init - -interface MPI_Scatter -subroutine MPI_Scatter_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scatter_f08 -end interface MPI_Scatter - -interface MPI_Iscatter -subroutine MPI_Iscatter_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iscatter_f08 -end interface MPI_Iscatter - -interface MPI_Scatter_init -subroutine MPI_Scatter_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scatter_init_f08 -end interface MPI_Scatter_init - -interface MPI_Scatterv -subroutine MPI_Scatterv_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,recvcount, & - recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scatterv_f08 -end interface MPI_Scatterv - -interface MPI_Iscatterv -subroutine MPI_Iscatterv_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,recvcount, & - recvtype,root,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Iscatterv_f08 -end interface MPI_Iscatterv - -interface MPI_Scatterv_init -subroutine MPI_Scatterv_init_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,recvcount, & - recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Scatterv_init_f08 -end interface MPI_Scatterv_init - interface MPI_Comm_compare subroutine MPI_Comm_compare_f08(comm1,comm2,result,ierror) use :: mpi_f08_types, only : MPI_Comm @@ -2417,36 +1025,6 @@ subroutine MPI_Type_set_name_f08(datatype,type_name,ierror) end subroutine MPI_Type_set_name_f08 end interface MPI_Type_set_name -interface MPI_Win_allocate -subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, & - baseptr, win, ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(C_PTR), INTENT(OUT) :: baseptr - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_allocate_f08 -end interface MPI_Win_allocate - -interface MPI_Win_allocate_shared -subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, & - baseptr, win, ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(C_PTR), INTENT(OUT) :: baseptr - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_allocate_shared_f08 -end interface MPI_Win_allocate_shared - interface MPI_Win_create_keyval subroutine MPI_Win_create_keyval_f08(win_copy_attr_fn,win_delete_attr_fn,win_keyval, & extra_state,ierror) @@ -2968,18 +1546,6 @@ subroutine MPI_Finalized_f08(flag,ierror) end subroutine MPI_Finalized_f08 end interface MPI_Finalized -! ASYNCHRONOUS had to removed from the base argument because -! the dummy argument is not an assumed-shape array. This will -! be okay once the Interop TR is implemented. -interface MPI_Free_mem -subroutine MPI_Free_mem_f08(base,ierror) - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ base - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: base - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Free_mem_f08 -end interface MPI_Free_mem - interface MPI_Get_processor_name subroutine MPI_Get_processor_name_f08(name,resultlen,ierror) use :: mpi_f08_types, only : MPI_MAX_PROCESSOR_NAME @@ -3265,220 +1831,44 @@ end interface MPI_Comm_spawn_multiple interface MPI_Lookup_name subroutine MPI_Lookup_name_f08(service_name,info,port_name,ierror) - use :: mpi_f08_types, only : MPI_Info, MPI_MAX_PORT_NAME - implicit none - CHARACTER(LEN=*), INTENT(IN) :: service_name - TYPE(MPI_Info), INTENT(IN) :: info - CHARACTER(LEN=MPI_MAX_PORT_NAME), INTENT(OUT) :: port_name - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Lookup_name_f08 -end interface MPI_Lookup_name - -interface MPI_Open_port -subroutine MPI_Open_port_f08(info,port_name,ierror) - use :: mpi_f08_types, only : MPI_Info, MPI_MAX_PORT_NAME - implicit none - TYPE(MPI_Info), INTENT(IN) :: info - CHARACTER(LEN=MPI_MAX_PORT_NAME), INTENT(OUT) :: port_name - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Open_port_f08 -end interface MPI_Open_port - -interface MPI_Publish_name -subroutine MPI_Publish_name_f08(service_name,info,port_name,ierror) - use :: mpi_f08_types, only : MPI_Info - implicit none - TYPE(MPI_Info), INTENT(IN) :: info - CHARACTER(LEN=*), INTENT(IN) :: service_name, port_name - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Publish_name_f08 -end interface MPI_Publish_name - -interface MPI_Unpublish_name -subroutine MPI_Unpublish_name_f08(service_name,info,port_name,ierror) - use :: mpi_f08_types, only : MPI_Info - implicit none - CHARACTER(LEN=*), INTENT(IN) :: service_name, port_name - TYPE(MPI_Info), INTENT(IN) :: info - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Unpublish_name_f08 -end interface MPI_Unpublish_name - -interface MPI_Accumulate -subroutine MPI_Accumulate_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Accumulate_f08 -end interface MPI_Accumulate - -interface MPI_Raccumulate -subroutine MPI_Raccumulate_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,op,win,request, & - ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Raccumulate_f08 -end interface MPI_Raccumulate - -interface MPI_Get -subroutine MPI_Get_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Get_f08 -end interface MPI_Get - -interface MPI_Rget -subroutine MPI_Rget_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Request, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Rget_f08 -end interface MPI_Rget - -interface MPI_Get_accumulate -subroutine MPI_Get_accumulate_f08(origin_addr,origin_count,origin_datatype,result_addr, & - result_count,result_datatype,target_rank,target_disp, & - target_count,target_datatype,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr,result_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, result_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: result_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Get_accumulate_f08 -end interface MPI_Get_accumulate - -interface MPI_Rget_accumulate -subroutine MPI_Rget_accumulate_f08(origin_addr,origin_count,origin_datatype,result_addr, & - result_count,result_datatype,target_rank,target_disp, & - target_count,target_datatype,op,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Request, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr,result_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, result_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: result_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Rget_accumulate_f08 -end interface MPI_Rget_accumulate - -interface MPI_Put -subroutine MPI_Put_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND + use :: mpi_f08_types, only : MPI_Info, MPI_MAX_PORT_NAME implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win + CHARACTER(LEN=*), INTENT(IN) :: service_name + TYPE(MPI_Info), INTENT(IN) :: info + CHARACTER(LEN=MPI_MAX_PORT_NAME), INTENT(OUT) :: port_name INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Put_f08 -end interface MPI_Put +end subroutine MPI_Lookup_name_f08 +end interface MPI_Lookup_name -interface MPI_Rput -subroutine MPI_Rput_f08(origin_addr,origin_count,origin_datatype,target_rank, & - target_disp,target_count,target_datatype,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_Request, MPI_ADDRESS_KIND +interface MPI_Open_port +subroutine MPI_Open_port_f08(info,port_name,ierror) + use :: mpi_f08_types, only : MPI_Info, MPI_MAX_PORT_NAME implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request + TYPE(MPI_Info), INTENT(IN) :: info + CHARACTER(LEN=MPI_MAX_PORT_NAME), INTENT(OUT) :: port_name INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Rput_f08 -end interface MPI_Rput +end subroutine MPI_Open_port_f08 +end interface MPI_Open_port -interface MPI_Fetch_and_op -subroutine MPI_Fetch_and_op_f08(origin_addr,result_addr,datatype,target_rank, & - target_disp,op,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_ADDRESS_KIND +interface MPI_Publish_name +subroutine MPI_Publish_name_f08(service_name,info,port_name,ierror) + use :: mpi_f08_types, only : MPI_Info implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr,result_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: target_rank - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win + TYPE(MPI_Info), INTENT(IN) :: info + CHARACTER(LEN=*), INTENT(IN) :: service_name, port_name INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Fetch_and_op_f08 -end interface MPI_Fetch_and_op +end subroutine MPI_Publish_name_f08 +end interface MPI_Publish_name -interface MPI_Compare_and_swap -subroutine MPI_Compare_and_swap_f08(origin_addr,compare_addr,result_addr,datatype, & - target_rank,target_disp,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND +interface MPI_Unpublish_name +subroutine MPI_Unpublish_name_f08(service_name,info,port_name,ierror) + use :: mpi_f08_types, only : MPI_Info implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ origin_addr,compare_addr,result_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr,compare_addr - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: target_rank - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Win), INTENT(IN) :: win + CHARACTER(LEN=*), INTENT(IN) :: service_name, port_name + TYPE(MPI_Info), INTENT(IN) :: info INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Compare_and_swap_f08 -end interface MPI_Compare_and_swap +end subroutine MPI_Unpublish_name_f08 +end interface MPI_Unpublish_name interface MPI_Win_complete subroutine MPI_Win_complete_f08(win,ierror) @@ -3489,21 +1879,6 @@ subroutine MPI_Win_complete_f08(win,ierror) end subroutine MPI_Win_complete_f08 end interface MPI_Win_complete -interface MPI_Win_create -subroutine MPI_Win_create_f08(base,size,disp_unit,info,comm,win,ierror) - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ base - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_create_f08 -end interface MPI_Win_create - interface MPI_Win_create_dynamic subroutine MPI_Win_create_dynamic_f08(info,comm,win,ierror) use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win @@ -3515,29 +1890,6 @@ subroutine MPI_Win_create_dynamic_f08(info,comm,win,ierror) end subroutine MPI_Win_create_dynamic_f08 end interface MPI_Win_create_dynamic -interface MPI_Win_attach -subroutine MPI_Win_attach_f08(win,base,size,ierror) - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ base - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_attach_f08 -end interface MPI_Win_attach - -interface MPI_Win_detach -subroutine MPI_Win_detach_f08(win,base,ierror) - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ base - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: base - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_detach_f08 -end interface MPI_Win_detach - interface MPI_Win_fence subroutine MPI_Win_fence_f08(assert,win,ierror) use :: mpi_f08_types, only : MPI_Win @@ -3598,20 +1950,6 @@ subroutine MPI_Win_post_f08(group,assert,win,ierror) end subroutine MPI_Win_post_f08 end interface MPI_Win_post -interface MPI_Win_shared_query -subroutine MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr,& - ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, INTENT(IN) :: rank - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT) :: size - INTEGER, INTENT(OUT) :: disp_unit - TYPE(C_PTR), INTENT(OUT) :: baseptr - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Win_shared_query_f08 -end interface MPI_Win_shared_query - interface MPI_Win_start subroutine MPI_Win_start_f08(group,assert,win,ierror) use :: mpi_f08_types, only : MPI_Group, MPI_Win @@ -3769,17 +2107,6 @@ subroutine MPI_Status_set_cancelled_f08(status,flag,ierror) end subroutine MPI_Status_set_cancelled_f08 end interface MPI_Status_set_cancelled -interface MPI_Status_set_elements -subroutine MPI_Status_set_elements_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - implicit none - TYPE(MPI_Status), INTENT(INOUT) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Status_set_elements_f08 -end interface MPI_Status_set_elements - interface MPI_Status_set_elements_x subroutine MPI_Status_set_elements_x_f08(status,datatype,count,ierror) use :: mpi_f08_types, only : MPI_Status, MPI_Datatype, MPI_COUNT_KIND @@ -3835,414 +2162,108 @@ subroutine MPI_File_get_byte_offset_f08(fh,offset,disp,ierror) use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: disp - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_byte_offset_f08 -end interface MPI_File_get_byte_offset - -interface MPI_File_get_group -subroutine MPI_File_get_group_f08(fh,group,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Group - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - TYPE(MPI_Group), INTENT(OUT) :: group - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_group_f08 -end interface MPI_File_get_group - -interface MPI_File_get_info -subroutine MPI_File_get_info_f08(fh,info_used,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Info - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - TYPE(MPI_Info), INTENT(OUT) :: info_used - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_info_f08 -end interface MPI_File_get_info - -interface MPI_File_get_position -subroutine MPI_File_get_position_f08(fh,offset,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: offset - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_position_f08 -end interface MPI_File_get_position - -interface MPI_File_get_position_shared -subroutine MPI_File_get_position_shared_f08(fh,offset,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: offset - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_position_shared_f08 -end interface MPI_File_get_position_shared - -interface MPI_File_get_size -subroutine MPI_File_get_size_f08(fh,size,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_size_f08 -end interface MPI_File_get_size - -interface MPI_File_get_type_extent -subroutine MPI_File_get_type_extent_f08(fh,datatype,extent,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_ADDRESS_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: extent - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_type_extent_f08 -end interface MPI_File_get_type_extent - -interface MPI_File_get_view -subroutine MPI_File_get_view_f08(fh,disp,etype,filetype,datarep,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: disp - TYPE(MPI_Datatype), INTENT(OUT) :: etype - TYPE(MPI_Datatype), INTENT(OUT) :: filetype - CHARACTER(LEN=*), INTENT(OUT) :: datarep - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_get_view_f08 -end interface MPI_File_get_view - -interface MPI_File_iread -subroutine MPI_File_iread_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iread_f08 -end interface MPI_File_iread - -interface MPI_File_iread_at -subroutine MPI_File_iread_at_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iread_at_f08 -end interface MPI_File_iread_at - -interface MPI_File_iread_all -subroutine MPI_File_iread_all_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iread_all_f08 -end interface MPI_File_iread_all - -interface MPI_File_iread_at_all -subroutine MPI_File_iread_at_all_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iread_at_all_f08 -end interface MPI_File_iread_at_all - -interface MPI_File_iread_shared -subroutine MPI_File_iread_shared_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iread_shared_f08 -end interface MPI_File_iread_shared - -interface MPI_File_iwrite -subroutine MPI_File_iwrite_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iwrite_f08 -end interface MPI_File_iwrite - -interface MPI_File_iwrite_at -subroutine MPI_File_iwrite_at_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iwrite_at_f08 -end interface MPI_File_iwrite_at - -interface MPI_File_iwrite_all -subroutine MPI_File_iwrite_all_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iwrite_all_f08 -end interface MPI_File_iwrite_all - -interface MPI_File_iwrite_at_all -subroutine MPI_File_iwrite_at_all_f08(fh,offset,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iwrite_at_all_f08 -end interface MPI_File_iwrite_at_all - -interface MPI_File_iwrite_shared -subroutine MPI_File_iwrite_shared_f08(fh,buf,count,datatype,request,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_iwrite_shared_f08 -end interface MPI_File_iwrite_shared - -interface MPI_File_open -subroutine MPI_File_open_f08(comm,filename,amode,info,fh,ierror) - use :: mpi_f08_types, only : MPI_Comm, MPI_Info, MPI_File - implicit none - TYPE(MPI_Comm), INTENT(IN) :: comm - CHARACTER(LEN=*), INTENT(IN) :: filename - INTEGER, INTENT(IN) :: amode - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_File), INTENT(OUT) :: fh - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_open_f08 -end interface MPI_File_open - -interface MPI_File_preallocate -subroutine MPI_File_preallocate_f08(fh,size,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_preallocate_f08 -end interface MPI_File_preallocate - -interface MPI_File_read -subroutine MPI_File_read_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_f08 -end interface MPI_File_read - -interface MPI_File_read_all -subroutine MPI_File_read_all_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_all_f08 -end interface MPI_File_read_all - -interface MPI_File_read_all_begin -subroutine MPI_File_read_all_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset + INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: disp INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_all_begin_f08 -end interface MPI_File_read_all_begin +end subroutine MPI_File_get_byte_offset_f08 +end interface MPI_File_get_byte_offset -interface MPI_File_read_all_end -subroutine MPI_File_read_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status +interface MPI_File_get_group +subroutine MPI_File_get_group_f08(fh,group,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_Group implicit none TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status + TYPE(MPI_Group), INTENT(OUT) :: group INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_all_end_f08 -end interface MPI_File_read_all_end +end subroutine MPI_File_get_group_f08 +end interface MPI_File_get_group -interface MPI_File_read_at -subroutine MPI_File_read_at_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND +interface MPI_File_get_info +subroutine MPI_File_get_info_f08(fh,info_used,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_Info implicit none TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status + TYPE(MPI_Info), INTENT(OUT) :: info_used INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_at_f08 -end interface MPI_File_read_at +end subroutine MPI_File_get_info_f08 +end interface MPI_File_get_info -interface MPI_File_read_at_all -subroutine MPI_File_read_at_all_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND +interface MPI_File_get_position +subroutine MPI_File_get_position_f08(fh,offset,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status + INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: offset INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_at_all_f08 -end interface MPI_File_read_at_all +end subroutine MPI_File_get_position_f08 +end interface MPI_File_get_position -interface MPI_File_read_at_all_begin -subroutine MPI_File_read_at_all_begin_f08(fh,offset,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND +interface MPI_File_get_position_shared +subroutine MPI_File_get_position_shared_f08(fh,offset,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: offset INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_at_all_begin_f08 -end interface MPI_File_read_at_all_begin +end subroutine MPI_File_get_position_shared_f08 +end interface MPI_File_get_position_shared -interface MPI_File_read_at_all_end -subroutine MPI_File_read_at_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status +interface MPI_File_get_size +subroutine MPI_File_get_size_f08(fh,size,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status + INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: size INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_at_all_end_f08 -end interface MPI_File_read_at_all_end +end subroutine MPI_File_get_size_f08 +end interface MPI_File_get_size -interface MPI_File_read_ordered -subroutine MPI_File_read_ordered_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status +interface MPI_File_get_type_extent +subroutine MPI_File_get_type_extent_f08(fh,datatype,extent,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_ADDRESS_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status + INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: extent INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_ordered_f08 -end interface MPI_File_read_ordered +end subroutine MPI_File_get_type_extent_f08 +end interface MPI_File_get_type_extent -interface MPI_File_read_ordered_begin -subroutine MPI_File_read_ordered_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype +interface MPI_File_get_view +subroutine MPI_File_get_view_f08(fh,disp,etype,filetype,datarep,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(MPI_OFFSET_KIND), INTENT(OUT) :: disp + TYPE(MPI_Datatype), INTENT(OUT) :: etype + TYPE(MPI_Datatype), INTENT(OUT) :: filetype + CHARACTER(LEN=*), INTENT(OUT) :: datarep INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_ordered_begin_f08 -end interface MPI_File_read_ordered_begin +end subroutine MPI_File_get_view_f08 +end interface MPI_File_get_view -interface MPI_File_read_ordered_end -subroutine MPI_File_read_ordered_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status +interface MPI_File_open +subroutine MPI_File_open_f08(comm,filename,amode,info,fh,ierror) + use :: mpi_f08_types, only : MPI_Comm, MPI_Info, MPI_File implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status + TYPE(MPI_Comm), INTENT(IN) :: comm + CHARACTER(LEN=*), INTENT(IN) :: filename + INTEGER, INTENT(IN) :: amode + TYPE(MPI_Info), INTENT(IN) :: info + TYPE(MPI_File), INTENT(OUT) :: fh INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_ordered_end_f08 -end interface MPI_File_read_ordered_end +end subroutine MPI_File_open_f08 +end interface MPI_File_open -interface MPI_File_read_shared -subroutine MPI_File_read_shared_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status +interface MPI_File_preallocate +subroutine MPI_File_preallocate_f08(fh,size,ierror) + use :: mpi_f08_types, only : MPI_File, MPI_OFFSET_KIND implicit none TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status + INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: size INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_read_shared_f08 -end interface MPI_File_read_shared +end subroutine MPI_File_preallocate_f08 +end interface MPI_File_preallocate interface MPI_File_seek subroutine MPI_File_seek_f08(fh,offset,whence,ierror) @@ -4319,168 +2340,6 @@ subroutine MPI_File_sync_f08(fh,ierror) end subroutine MPI_File_sync_f08 end interface MPI_File_sync -interface MPI_File_write -subroutine MPI_File_write_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_f08 -end interface MPI_File_write - -interface MPI_File_write_all -subroutine MPI_File_write_all_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_all_f08 -end interface MPI_File_write_all - -interface MPI_File_write_all_begin -subroutine MPI_File_write_all_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_all_begin_f08 -end interface MPI_File_write_all_begin - -interface MPI_File_write_all_end -subroutine MPI_File_write_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_all_end_f08 -end interface MPI_File_write_all_end - -interface MPI_File_write_at -subroutine MPI_File_write_at_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_at_f08 -end interface MPI_File_write_at - -interface MPI_File_write_at_all -subroutine MPI_File_write_at_all_f08(fh,offset,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_at_all_f08 -end interface MPI_File_write_at_all - -interface MPI_File_write_at_all_begin -subroutine MPI_File_write_at_all_begin_f08(fh,offset,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_OFFSET_KIND - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - INTEGER(MPI_OFFSET_KIND), INTENT(IN) :: offset - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_at_all_begin_f08 -end interface MPI_File_write_at_all_begin - -interface MPI_File_write_at_all_end -subroutine MPI_File_write_at_all_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_at_all_end_f08 -end interface MPI_File_write_at_all_end - -interface MPI_File_write_ordered -subroutine MPI_File_write_ordered_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_ordered_f08 -end interface MPI_File_write_ordered - -interface MPI_File_write_ordered_begin -subroutine MPI_File_write_ordered_begin_f08(fh,buf,count,datatype,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_ordered_begin_f08 -end interface MPI_File_write_ordered_begin - -interface MPI_File_write_ordered_end -subroutine MPI_File_write_ordered_end_f08(fh,buf,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: buf - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_ordered_end_f08 -end interface MPI_File_write_ordered_end - -interface MPI_File_write_shared -subroutine MPI_File_write_shared_f08(fh,buf,count,datatype,status,ierror) - use :: mpi_f08_types, only : MPI_File, MPI_Datatype, MPI_Status - implicit none - TYPE(MPI_File), INTENT(IN) :: fh - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_File_write_shared_f08 -end interface MPI_File_write_shared - interface MPI_Register_datarep subroutine MPI_Register_datarep_f08(datarep,read_conversion_fn,write_conversion_fn, & dtype_file_extent_fn,extra_state,ierror) @@ -4575,14 +2434,6 @@ subroutine MPI_Comm_split_type_f08(comm,split_type,key,info,newcomm,ierror) end subroutine MPI_Comm_split_type_f08 end interface MPI_Comm_split_type -interface MPI_F_sync_reg -subroutine MPI_F_sync_reg_f08(buf) - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf -end subroutine MPI_F_sync_reg_f08 -end interface MPI_F_sync_reg - interface MPI_Get_library_version subroutine MPI_Get_library_version_f08(version,resultlen,ierror) use :: mpi_f08_types, only : MPI_MAX_LIBRARY_VERSION_STRING @@ -4618,280 +2469,6 @@ subroutine MPI_Improbe_f08(source,tag,comm,flag,message,status,ierror) end subroutine MPI_Improbe_f08 end interface MPI_Improbe -interface MPI_Imrecv -subroutine MPI_Imrecv_f08(buf,count,datatype,message,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Message, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Message), INTENT(INOUT) :: message - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Imrecv_f08 -end interface MPI_Imrecv - -interface MPI_Mrecv -subroutine MPI_Mrecv_f08(buf,count,datatype,message,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Message, MPI_Status - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ buf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Message), INTENT(INOUT) :: message - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Mrecv_f08 -end interface MPI_Mrecv - -interface MPI_Neighbor_allgather -subroutine MPI_Neighbor_allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_allgather_f08 -end interface MPI_Neighbor_allgather - -interface MPI_Ineighbor_allgather -subroutine MPI_Ineighbor_allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ineighbor_allgather_f08 -end interface MPI_Ineighbor_allgather - -interface MPI_Neighbor_allgather_init -subroutine MPI_Neighbor_allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_allgather_init_f08 -end interface MPI_Neighbor_allgather_init - -interface MPI_Neighbor_allgatherv -subroutine MPI_Neighbor_allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_allgatherv_f08 -end interface MPI_Neighbor_allgatherv - -interface MPI_Ineighbor_allgatherv -subroutine MPI_Ineighbor_allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ineighbor_allgatherv_f08 -end interface MPI_Ineighbor_allgatherv - -interface MPI_Neighbor_allgatherv_init -subroutine MPI_Neighbor_allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,displs, & - recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_allgatherv_init_f08 -end interface MPI_Neighbor_allgatherv_init - -interface MPI_Neighbor_alltoall -subroutine MPI_Neighbor_alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoall_f08 -end interface MPI_Neighbor_alltoall - -interface MPI_Ineighbor_alltoall -subroutine MPI_Ineighbor_alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ineighbor_alltoall_f08 -end interface MPI_Ineighbor_alltoall - -interface MPI_Neighbor_alltoall_init -subroutine MPI_Neighbor_alltoall_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, & - comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoall_init_f08 -end interface MPI_Neighbor_alltoall_init - -interface MPI_Neighbor_alltoallv -subroutine MPI_Neighbor_alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoallv_f08 -end interface MPI_Neighbor_alltoallv - -interface MPI_Ineighbor_alltoallv -subroutine MPI_Ineighbor_alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ineighbor_alltoallv_f08 -end interface MPI_Ineighbor_alltoallv - -interface MPI_Neighbor_alltoallv_init -subroutine MPI_Neighbor_alltoallv_init_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,recvcounts, & - rdispls,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoallv_init_f08 -end interface MPI_Neighbor_alltoallv_init - -interface MPI_Neighbor_alltoallw -subroutine MPI_Neighbor_alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), recvcounts(*) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: sdispls(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoallw_f08 -end interface MPI_Neighbor_alltoallw - -interface MPI_Ineighbor_alltoallw -subroutine MPI_Ineighbor_alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), recvcounts(*) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) OMPI_ASYNCHRONOUS :: sdispls(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Ineighbor_alltoallw_f08 -end interface MPI_Ineighbor_alltoallw - -interface MPI_Neighbor_alltoallw_init -subroutine MPI_Neighbor_alltoallw_init_f08(sendbuf,sendcounts,sdispls,sendtypes,recvbuf,recvcounts, & - rdispls,recvtypes,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request, MPI_ADDRESS_KIND - implicit none - @OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) :: sendbuf - @OMPI_FORTRAN_IGNORE_TKR_TYPE@ :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), recvcounts(*) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: sdispls(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*), recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror -end subroutine MPI_Neighbor_alltoallw_init_f08 -end interface MPI_Neighbor_alltoallw_init - interface MPI_Status_f2f08 subroutine MPI_Status_f2f08_f08(f_status,f08_status,ierror) use :: mpi_f08_types, only : MPI_Status, MPI_STATUS_SIZE 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 41e747e975c..1ed460e7259 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 @@ -5,800 +5,804 @@ #if OMPI_BUILD_MPI_PROFILING -#define MPI_Bsend PMPI_Bsend -#define MPI_Bsend_f08 PMPI_Bsend_f08 -#define MPI_Bsend_init PMPI_Bsend_init -#define MPI_Bsend_init_f08 PMPI_Bsend_init_f08 -#define MPI_Buffer_attach PMPI_Buffer_attach -#define MPI_Buffer_attach_f08 PMPI_Buffer_attach_f08 -#define MPI_Buffer_detach PMPI_Buffer_detach -#define MPI_Buffer_detach_f08 PMPI_Buffer_detach_f08 -#define MPI_Cancel PMPI_Cancel -#define MPI_Cancel_f08 PMPI_Cancel_f08 -#define MPI_Get_count PMPI_Get_count -#define MPI_Get_count_f08 PMPI_Get_count_f08 -#define MPI_Ibsend PMPI_Ibsend -#define MPI_Ibsend_f08 PMPI_Ibsend_f08 -#define MPI_Iprobe PMPI_Iprobe -#define MPI_Iprobe_f08 PMPI_Iprobe_f08 -#define MPI_Irecv PMPI_Irecv -#define MPI_Irecv_f08 PMPI_Irecv_f08 -#define MPI_Irsend PMPI_Irsend -#define MPI_Irsend_f08 PMPI_Irsend_f08 -#define MPI_Isend PMPI_Isend -#define MPI_Isend_f08 PMPI_Isend_f08 -#define MPI_Isendrecv PMPI_Isendrecv -#define MPI_Isendrecv_f08 PMPI_Isendrecv_f08 -#define MPI_Isendrecv_replace PMPI_Isendrecv_replace -#define MPI_Isendrecv_replace_f08 PMPI_Isendrecv_replace_f08 -#define MPI_Issend PMPI_Issend -#define MPI_Issend_f08 PMPI_Issend_f08 -#define MPI_Precv_init PMPI_Precv_init -#define MPI_Precv_init_f08 PMPI_Precv_init_f08 -#define MPI_Psend_init PMPI_Psend_init -#define MPI_Psend_init_f08 PMPI_Psend_init_f08 -#define MPI_Pready PMPI_Pready -#define MPI_Pready_f08 PMPI_Pready_f08 -#define MPI_Pready_list PMPI_Pready_list -#define MPI_Pready_list_f08 PMPI_Pready_list_f08 -#define MPI_Pready_range PMPI_Pready_range -#define MPI_Pready_range_f08 PMPI_Pready_range_f08 -#define MPI_Parrived PMPI_Parrived -#define MPI_Parrived_f08 PMPI_Parrived_f08 -#define MPI_Probe PMPI_Probe -#define MPI_Probe_f08 PMPI_Probe_f08 -#define MPI_Recv PMPI_Recv -#define MPI_Recv_f08 PMPI_Recv_f08 -#define MPI_Recv_init PMPI_Recv_init -#define MPI_Recv_init_f08 PMPI_Recv_init_f08 -#define MPI_Request_free PMPI_Request_free -#define MPI_Request_free_f08 PMPI_Request_free_f08 -#define MPI_Request_get_status PMPI_Request_get_status -#define MPI_Request_get_status_f08 PMPI_Request_get_status_f08 -#define MPI_Rsend PMPI_Rsend -#define MPI_Rsend_f08 PMPI_Rsend_f08 -#define MPI_Rsend_init PMPI_Rsend_init -#define MPI_Rsend_init_f08 PMPI_Rsend_init_f08 -#define MPI_Send PMPI_Send -#define MPI_Send_f08 PMPI_Send_f08 -#define MPI_Sendrecv PMPI_Sendrecv -#define MPI_Sendrecv_f08 PMPI_Sendrecv_f08 -#define MPI_Sendrecv_replace PMPI_Sendrecv_replace -#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 -#define MPI_Session_get_nth_pset_f08 PMPI_Session_get_nth_pset_f08 -#define MPI_Session_get_nth_psetlen PMPI_Session_get_nth_psetlen -#define MPI_Session_get_nth_psetlen_f08 PMPI_Session_get_nth_psetlen_f08 -#define MPI_Session_get_num_psets PMPI_Session_get_num_psets -#define MPI_Session_get_num_psets_f08 PMPI_Session_get_num_psets_f08 -#define MPI_Session_get_pset_info PMPI_Session_get_pset_info -#define MPI_Session_get_pset_info_f08 PMPI_Session_get_pset_info_f08 -#define MPI_Session_init PMPI_Session_init -#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 -#define MPI_Ssend_init_f08 PMPI_Ssend_init_f08 -#define MPI_Start PMPI_Start -#define MPI_Start_f08 PMPI_Start_f08 -#define MPI_Startall PMPI_Startall -#define MPI_Startall_f08 PMPI_Startall_f08 -#define MPI_Test PMPI_Test -#define MPI_Test_f08 PMPI_Test_f08 -#define MPI_Testall PMPI_Testall -#define MPI_Testall_f08 PMPI_Testall_f08 -#define MPI_Testany PMPI_Testany -#define MPI_Testany_f08 PMPI_Testany_f08 -#define MPI_Testsome PMPI_Testsome -#define MPI_Testsome_f08 PMPI_Testsome_f08 -#define MPI_Test_cancelled PMPI_Test_cancelled -#define MPI_Test_cancelled_f08 PMPI_Test_cancelled_f08 -#define MPI_Wait PMPI_Wait -#define MPI_Wait_f08 PMPI_Wait_f08 -#define MPI_Waitall PMPI_Waitall -#define MPI_Waitall_f08 PMPI_Waitall_f08 -#define MPI_Waitany PMPI_Waitany -#define MPI_Waitany_f08 PMPI_Waitany_f08 -#define MPI_Waitsome PMPI_Waitsome -#define MPI_Waitsome_f08 PMPI_Waitsome_f08 -#define MPI_Get_address PMPI_Get_address -#define MPI_Get_address_f08 PMPI_Get_address_f08 -#define MPI_Get_elements PMPI_Get_elements -#define MPI_Get_elements_f08 PMPI_Get_elements_f08 -#define MPI_Get_elements_x PMPI_Get_elements_x -#define MPI_Get_elements_x_f08 PMPI_Get_elements_x_f08 -#define MPI_Pack PMPI_Pack -#define MPI_Pack_f08 PMPI_Pack_f08 -#define MPI_Pack_external PMPI_Pack_external -#define MPI_Pack_external_f08 PMPI_Pack_external_f08 -#define MPI_Pack_external_size PMPI_Pack_external_size -#define MPI_Pack_external_size_f08 PMPI_Pack_external_size_f08 -#define MPI_Pack_size PMPI_Pack_size -#define MPI_Pack_size_f08 PMPI_Pack_size_f08 -#define MPI_Type_commit PMPI_Type_commit -#define MPI_Type_commit_f08 PMPI_Type_commit_f08 -#define MPI_Type_contiguous PMPI_Type_contiguous -#define MPI_Type_contiguous_f08 PMPI_Type_contiguous_f08 -#define MPI_Type_create_darray PMPI_Type_create_darray -#define MPI_Type_create_darray_f08 PMPI_Type_create_darray_f08 -#define MPI_Type_create_hindexed PMPI_Type_create_hindexed -#define MPI_Type_create_hindexed_f08 PMPI_Type_create_hindexed_f08 -#define MPI_Type_create_hvector PMPI_Type_create_hvector -#define MPI_Type_create_hvector_f08 PMPI_Type_create_hvector_f08 -#define MPI_Type_create_indexed_block PMPI_Type_create_indexed_block -#define MPI_Type_create_indexed_block_f08 PMPI_Type_create_indexed_block_f08 -#define MPI_Type_create_hindexed_block PMPI_Type_create_hindexed_block -#define MPI_Type_create_hindexed_block_f08 PMPI_Type_create_hindexed_block_f08 -#define MPI_Type_create_resized PMPI_Type_create_resized -#define MPI_Type_create_resized_f08 PMPI_Type_create_resized_f08 -#define MPI_Type_create_struct PMPI_Type_create_struct -#define MPI_Type_create_struct_f08 PMPI_Type_create_struct_f08 -#define MPI_Type_create_subarray PMPI_Type_create_subarray -#define MPI_Type_create_subarray_f08 PMPI_Type_create_subarray_f08 -#define MPI_Type_dup PMPI_Type_dup -#define MPI_Type_dup_f08 PMPI_Type_dup_f08 -#define MPI_Type_free PMPI_Type_free -#define MPI_Type_free_f08 PMPI_Type_free_f08 -#define MPI_Type_get_contents PMPI_Type_get_contents -#define MPI_Type_get_contents_f08 PMPI_Type_get_contents_f08 -#define MPI_Type_get_envelope PMPI_Type_get_envelope -#define MPI_Type_get_envelope_f08 PMPI_Type_get_envelope_f08 -#define MPI_Type_get_extent PMPI_Type_get_extent -#define MPI_Type_get_extent_f08 PMPI_Type_get_extent_f08 -#define MPI_Type_get_extent_x PMPI_Type_get_extent_x -#define MPI_Type_get_extent_x_f08 PMPI_Type_get_extent_x_f08 -#define MPI_Type_get_true_extent PMPI_Type_get_true_extent -#define MPI_Type_get_true_extent_f08 PMPI_Type_get_true_extent_f08 -#define MPI_Type_get_true_extent_x PMPI_Type_get_true_extent_x -#define MPI_Type_get_true_extent_x_f08 PMPI_Type_get_true_extent_x_f08 -#define MPI_Type_indexed PMPI_Type_indexed -#define MPI_Type_indexed_f08 PMPI_Type_indexed_f08 -#define MPI_Type_size PMPI_Type_size -#define MPI_Type_size_f08 PMPI_Type_size_f08 -#define MPI_Type_size_x PMPI_Type_size_x -#define MPI_Type_size_x_f08 PMPI_Type_size_x_f08 -#define MPI_Type_vector PMPI_Type_vector -#define MPI_Type_vector_f08 PMPI_Type_vector_f08 -#define MPI_Unpack PMPI_Unpack -#define MPI_Unpack_f08 PMPI_Unpack_f08 -#define MPI_Unpack_external PMPI_Unpack_external -#define MPI_Unpack_external_f08 PMPI_Unpack_external_f08 -#define MPI_Allgather PMPI_Allgather +#define MPI_Abort_f08 PMPI_Abort_f08 +#define MPI_Abort PMPI_Abort +#define MPI_Accumulate_f08 PMPI_Accumulate_f08 +#define MPI_Accumulate PMPI_Accumulate +#define MPI_Add_error_class_f08 PMPI_Add_error_class_f08 +#define MPI_Add_error_class PMPI_Add_error_class +#define MPI_Add_error_code_f08 PMPI_Add_error_code_f08 +#define MPI_Add_error_code PMPI_Add_error_code +#define MPI_Add_error_string_f08 PMPI_Add_error_string_f08 +#define MPI_Add_error_string PMPI_Add_error_string +#define MPI_Aint_add_f08 PMPI_Aint_add_f08 +#define MPI_Aint_add PMPI_Aint_add +#define MPI_Aint_diff_f08 PMPI_Aint_diff_f08 +#define MPI_Aint_diff PMPI_Aint_diff #define MPI_Allgather_f08 PMPI_Allgather_f08 -#define MPI_Iallgather PMPI_Iallgather -#define MPI_Iallgather_f08 PMPI_Iallgather_f08 -#define MPI_Allgather_init PMPI_Allgather_init #define MPI_Allgather_init_f08 PMPI_Allgather_init_f08 -#define MPI_Allgatherv PMPI_Allgatherv +#define MPI_Allgather_init PMPI_Allgather_init +#define MPI_Allgather PMPI_Allgather #define MPI_Allgatherv_f08 PMPI_Allgatherv_f08 -#define MPI_Iallgatherv PMPI_Iallgatherv -#define MPI_Iallgatherv_f08 PMPI_Iallgatherv_f08 -#define MPI_Allgatherv_init PMPI_Allgatherv_init #define MPI_Allgatherv_init_f08 PMPI_Allgatherv_init_f08 -#define MPI_Allreduce PMPI_Allreduce +#define MPI_Allgatherv_init PMPI_Allgatherv_init +#define MPI_Allgatherv PMPI_Allgatherv +#define MPI_Alloc_mem_f08 PMPI_Alloc_mem_f08 +#define MPI_Alloc_mem PMPI_Alloc_mem #define MPI_Allreduce_f08 PMPI_Allreduce_f08 -#define MPI_Iallreduce PMPI_Iallreduce -#define MPI_Iallreduce_f08 PMPI_Iallreduce_f08 -#define MPI_Allreduce_init PMPI_Allreduce_init #define MPI_Allreduce_init_f08 PMPI_Allreduce_init_f08 -#define MPI_Alltoall PMPI_Alltoall +#define MPI_Allreduce_init PMPI_Allreduce_init +#define MPI_Allreduce PMPI_Allreduce #define MPI_Alltoall_f08 PMPI_Alltoall_f08 -#define MPI_Ialltoall PMPI_Ialltoall -#define MPI_Ialltoall_f08 PMPI_Ialltoall_f08 -#define MPI_Alltoall_init PMPI_Alltoall_init #define MPI_Alltoall_init_f08 PMPI_Alltoall_init_f08 -#define MPI_Alltoallv PMPI_Alltoallv +#define MPI_Alltoall_init PMPI_Alltoall_init +#define MPI_Alltoall PMPI_Alltoall #define MPI_Alltoallv_f08 PMPI_Alltoallv_f08 -#define MPI_Ialltoallv PMPI_Ialltoallv -#define MPI_Ialltoallv_f08 PMPI_Ialltoallv_f08 -#define MPI_Alltoallv_init PMPI_Alltoallv_init #define MPI_Alltoallv_init_f08 PMPI_Alltoallv_init_f08 -#define MPI_Alltoallw PMPI_Alltoallw +#define MPI_Alltoallv_init PMPI_Alltoallv_init +#define MPI_Alltoallv PMPI_Alltoallv #define MPI_Alltoallw_f08 PMPI_Alltoallw_f08 -#define MPI_Ialltoallw PMPI_Ialltoallw -#define MPI_Ialltoallw_f08 PMPI_Ialltoallw_f08 -#define MPI_Alltoallw_init PMPI_Alltoallw_init #define MPI_Alltoallw_init_f08 PMPI_Alltoallw_init_f08 -#define MPI_Barrier PMPI_Barrier +#define MPI_Alltoallw_init PMPI_Alltoallw_init +#define MPI_Alltoallw PMPI_Alltoallw #define MPI_Barrier_f08 PMPI_Barrier_f08 -#define MPI_Ibarrier PMPI_Ibarrier -#define MPI_Ibarrier_f08 PMPI_Ibarrier_f08 -#define MPI_Barrier_init PMPI_Barrier_init #define MPI_Barrier_init_f08 PMPI_Barrier_init_f08 -#define MPI_Bcast PMPI_Bcast +#define MPI_Barrier_init PMPI_Barrier_init +#define MPI_Barrier PMPI_Barrier #define MPI_Bcast_f08 PMPI_Bcast_f08 -#define MPI_Ibcast PMPI_Ibcast -#define MPI_Ibcast_f08 PMPI_Ibcast_f08 -#define MPI_Bcast_init PMPI_Bcast_init #define MPI_Bcast_init_f08 PMPI_Bcast_init_f08 -#define MPI_Exscan PMPI_Exscan -#define MPI_Exscan_f08 PMPI_Exscan_f08 -#define MPI_Iexscan PMPI_Iexscan -#define MPI_Iexscan_f08 PMPI_Iexscan_f08 -#define MPI_Exscan_init PMPI_Exscan_init -#define MPI_Exscan_init_f08 PMPI_Exscan_init_f08 -#define MPI_Gather PMPI_Gather -#define MPI_Gather_f08 PMPI_Gather_f08 -#define MPI_Igather PMPI_Igather -#define MPI_Igather_f08 PMPI_Igather_f08 -#define MPI_Gather_init PMPI_Gather_init -#define MPI_Gather_init_f08 PMPI_Gather_init_f08 -#define MPI_Gatherv PMPI_Gatherv -#define MPI_Gatherv_f08 PMPI_Gatherv_f08 -#define MPI_Igatherv PMPI_Igatherv -#define MPI_Igatherv_f08 PMPI_Igatherv_f08 -#define MPI_Gatherv_init PMPI_Gatherv_init -#define MPI_Gatherv_init_f08 PMPI_Gatherv_init_f08 -#define MPI_Op_commutative PMPI_Op_commutative -#define MPI_Op_commutative_f08 PMPI_Op_commutative_f08 -#define MPI_Op_create PMPI_Op_create -#define MPI_Op_create_f08 PMPI_Op_create_f08 -#define MPI_Op_free PMPI_Op_free -#define MPI_Op_free_f08 PMPI_Op_free_f08 -#define MPI_Reduce PMPI_Reduce -#define MPI_Reduce_f08 PMPI_Reduce_f08 -#define MPI_Ireduce PMPI_Ireduce -#define MPI_Ireduce_f08 PMPI_Ireduce_f08 -#define MPI_Reduce_init PMPI_Reduce_init -#define MPI_Reduce_init_f08 PMPI_Reduce_init_f08 -#define MPI_Reduce_local PMPI_Reduce_local -#define MPI_Reduce_local_f08 PMPI_Reduce_local_f08 -#define MPI_Reduce_scatter PMPI_Reduce_scatter -#define MPI_Reduce_scatter_f08 PMPI_Reduce_scatter_f08 -#define MPI_Ireduce_scatter PMPI_Ireduce_scatter -#define MPI_Ireduce_scatter_f08 PMPI_Ireduce_scatter_f08 -#define MPI_Reduce_scatter_init PMPI_Reduce_scatter_init -#define MPI_Reduce_scatter_init_f08 PMPI_Reduce_scatter_init_f08 -#define MPI_Reduce_scatter_block PMPI_Reduce_scatter_block -#define MPI_Reduce_scatter_block_f08 PMPI_Reduce_scatter_block_f08 -#define MPI_Ireduce_scatter_block PMPI_Ireduce_scatter_block -#define MPI_Ireduce_scatter_block_f08 PMPI_Ireduce_scatter_block_f08 -#define MPI_Reduce_scatter_block_init PMPI_Reduce_scatter_block_init -#define MPI_Reduce_scatter_block_init_f08 PMPI_Reduce_scatter_block_init_f08 -#define MPI_Scan PMPI_Scan -#define MPI_Scan_f08 PMPI_Scan_f08 -#define MPI_Iscan PMPI_Iscan -#define MPI_Iscan_f08 PMPI_Iscan_f08 -#define MPI_Scan_init PMPI_Scan_init -#define MPI_Scan_init_f08 PMPI_Scan_init_f08 -#define MPI_Scatter PMPI_Scatter -#define MPI_Scatter_f08 PMPI_Scatter_f08 -#define MPI_Iscatter PMPI_Iscatter -#define MPI_Iscatter_f08 PMPI_Iscatter_f08 -#define MPI_Scatter_init PMPI_Scatter_init -#define MPI_Scatter_init_f08 PMPI_Scatter_init_f08 -#define MPI_Scatterv PMPI_Scatterv -#define MPI_Scatterv_f08 PMPI_Scatterv_f08 -#define MPI_Iscatterv PMPI_Iscatterv -#define MPI_Iscatterv_f08 PMPI_Iscatterv_f08 -#define MPI_Scatterv_init PMPI_Scatterv_init -#define MPI_Scatterv_init_f08 PMPI_Scatterv_init_f08 -#define MPI_Comm_compare PMPI_Comm_compare +#define MPI_Bcast_init PMPI_Bcast_init +#define MPI_Bcast PMPI_Bcast +#define MPI_Bsend_f08 PMPI_Bsend_f08 +#define MPI_Bsend_init_f08 PMPI_Bsend_init_f08 +#define MPI_Bsend_init PMPI_Bsend_init +#define MPI_Bsend PMPI_Bsend +#define MPI_Buffer_attach_f08 PMPI_Buffer_attach_f08 +#define MPI_Buffer_attach PMPI_Buffer_attach +#define MPI_Buffer_detach_f08 PMPI_Buffer_detach_f08 +#define MPI_Buffer_detach PMPI_Buffer_detach +#define MPI_Cancel_f08 PMPI_Cancel_f08 +#define MPI_Cancel PMPI_Cancel +#define MPI_Cart_coords_f08 PMPI_Cart_coords_f08 +#define MPI_Cart_coords PMPI_Cart_coords +#define MPI_Cart_create_f08 PMPI_Cart_create_f08 +#define MPI_Cart_create PMPI_Cart_create +#define MPI_Cartdim_get_f08 PMPI_Cartdim_get_f08 +#define MPI_Cartdim_get PMPI_Cartdim_get +#define MPI_Cart_get_f08 PMPI_Cart_get_f08 +#define MPI_Cart_get PMPI_Cart_get +#define MPI_Cart_map_f08 PMPI_Cart_map_f08 +#define MPI_Cart_map PMPI_Cart_map +#define MPI_Cart_rank_f08 PMPI_Cart_rank_f08 +#define MPI_Cart_rank PMPI_Cart_rank +#define MPI_Cart_shift_f08 PMPI_Cart_shift_f08 +#define MPI_Cart_shift PMPI_Cart_shift +#define MPI_Cart_sub_f08 PMPI_Cart_sub_f08 +#define MPI_Cart_sub PMPI_Cart_sub +#define MPI_Close_port_f08 PMPI_Close_port_f08 +#define MPI_Close_port PMPI_Close_port +#define MPI_Comm_accept_f08 PMPI_Comm_accept_f08 +#define MPI_Comm_accept PMPI_Comm_accept +#define MPI_Comm_call_errhandler_f08 PMPI_Comm_call_errhandler_f08 +#define MPI_Comm_call_errhandler PMPI_Comm_call_errhandler #define MPI_Comm_compare_f08 PMPI_Comm_compare_f08 -#define MPI_Comm_create PMPI_Comm_create +#define MPI_Comm_compare PMPI_Comm_compare +#define MPI_Comm_connect_f08 PMPI_Comm_connect_f08 +#define MPI_Comm_connect PMPI_Comm_connect +#define MPI_Comm_create_errhandler_f08 PMPI_Comm_create_errhandler_f08 +#define MPI_Comm_create_errhandler PMPI_Comm_create_errhandler #define MPI_Comm_create_f08 PMPI_Comm_create_f08 -#define MPI_Comm_create_group PMPI_Comm_create_group -#define MPI_Comm_create_group_f08 PMPI_Comm_create_group_f08 -#define MPI_Comm_create_from_group PMPI_Comm_create_from_group #define MPI_Comm_create_from_group_f08 PMPI_Comm_create_from_group_f08 -#define MPI_Comm_create_keyval PMPI_Comm_create_keyval +#define MPI_Comm_create_from_group PMPI_Comm_create_from_group +#define MPI_Comm_create_group_f08 PMPI_Comm_create_group_f08 +#define MPI_Comm_create_group PMPI_Comm_create_group #define MPI_Comm_create_keyval_f08 PMPI_Comm_create_keyval_f08 -#define MPI_Comm_delete_attr PMPI_Comm_delete_attr +#define MPI_Comm_create_keyval PMPI_Comm_create_keyval +#define MPI_Comm_create PMPI_Comm_create #define MPI_Comm_delete_attr_f08 PMPI_Comm_delete_attr_f08 -#define MPI_Comm_dup PMPI_Comm_dup +#define MPI_Comm_delete_attr PMPI_Comm_delete_attr +#define MPI_Comm_disconnect_f08 PMPI_Comm_disconnect_f08 +#define MPI_Comm_disconnect PMPI_Comm_disconnect #define MPI_Comm_dup_f08 PMPI_Comm_dup_f08 -#define MPI_Comm_dup_with_info PMPI_Comm_dup_with_info +#define MPI_Comm_dup PMPI_Comm_dup #define MPI_Comm_dup_with_info_f08 PMPI_Comm_dup_with_info_f08 -#define MPI_Comm_idup PMPI_Comm_idup -#define MPI_Comm_idup_f08 PMPI_Comm_idup_f08 -#define MPI_Comm_idup_with_info PMPI_Comm_idup_with_info -#define MPI_Comm_idup_with_info_f08 PMPI_Comm_idup_with_info_f08 -#define MPI_Comm_free PMPI_Comm_free +#define MPI_Comm_dup_with_info PMPI_Comm_dup_with_info #define MPI_Comm_free_f08 PMPI_Comm_free_f08 -#define MPI_Comm_free_keyval PMPI_Comm_free_keyval #define MPI_Comm_free_keyval_f08 PMPI_Comm_free_keyval_f08 -#define MPI_Comm_get_attr PMPI_Comm_get_attr +#define MPI_Comm_free_keyval PMPI_Comm_free_keyval +#define MPI_Comm_free PMPI_Comm_free #define MPI_Comm_get_attr_f08 PMPI_Comm_get_attr_f08 -#define MPI_Comm_get_info PMPI_Comm_get_info +#define MPI_Comm_get_attr PMPI_Comm_get_attr +#define MPI_Comm_get_errhandler_f08 PMPI_Comm_get_errhandler_f08 +#define MPI_Comm_get_errhandler PMPI_Comm_get_errhandler #define MPI_Comm_get_info_f08 PMPI_Comm_get_info_f08 -#define MPI_Comm_get_name PMPI_Comm_get_name +#define MPI_Comm_get_info PMPI_Comm_get_info #define MPI_Comm_get_name_f08 PMPI_Comm_get_name_f08 -#define MPI_Comm_group PMPI_Comm_group +#define MPI_Comm_get_name PMPI_Comm_get_name +#define MPI_Comm_get_parent_f08 PMPI_Comm_get_parent_f08 +#define MPI_Comm_get_parent PMPI_Comm_get_parent #define MPI_Comm_group_f08 PMPI_Comm_group_f08 -#define MPI_Comm_rank PMPI_Comm_rank +#define MPI_Comm_group PMPI_Comm_group +#define MPI_Comm_idup_f08 PMPI_Comm_idup_f08 +#define MPI_Comm_idup PMPI_Comm_idup +#define MPI_Comm_idup_with_info_f08 PMPI_Comm_idup_with_info_f08 +#define MPI_Comm_idup_with_info PMPI_Comm_idup_with_info +#define MPI_Comm_join_f08 PMPI_Comm_join_f08 +#define MPI_Comm_join PMPI_Comm_join #define MPI_Comm_rank_f08 PMPI_Comm_rank_f08 -#define MPI_Comm_remote_group PMPI_Comm_remote_group +#define MPI_Comm_rank PMPI_Comm_rank #define MPI_Comm_remote_group_f08 PMPI_Comm_remote_group_f08 -#define MPI_Comm_remote_size PMPI_Comm_remote_size +#define MPI_Comm_remote_group PMPI_Comm_remote_group #define MPI_Comm_remote_size_f08 PMPI_Comm_remote_size_f08 -#define MPI_Comm_set_attr PMPI_Comm_set_attr +#define MPI_Comm_remote_size PMPI_Comm_remote_size #define MPI_Comm_set_attr_f08 PMPI_Comm_set_attr_f08 -#define MPI_Comm_set_info PMPI_Comm_set_info +#define MPI_Comm_set_attr PMPI_Comm_set_attr +#define MPI_Comm_set_errhandler_f08 PMPI_Comm_set_errhandler_f08 +#define MPI_Comm_set_errhandler PMPI_Comm_set_errhandler #define MPI_Comm_set_info_f08 PMPI_Comm_set_info_f08 -#define MPI_Comm_set_name PMPI_Comm_set_name +#define MPI_Comm_set_info PMPI_Comm_set_info #define MPI_Comm_set_name_f08 PMPI_Comm_set_name_f08 -#define MPI_Comm_size PMPI_Comm_size +#define MPI_Comm_set_name PMPI_Comm_set_name #define MPI_Comm_size_f08 PMPI_Comm_size_f08 -#define MPI_Comm_split PMPI_Comm_split +#define MPI_Comm_size PMPI_Comm_size +#define MPI_Comm_spawn_f08 PMPI_Comm_spawn_f08 +#define MPI_Comm_spawn_multiple_f08 PMPI_Comm_spawn_multiple_f08 +#define MPI_Comm_spawn_multiple PMPI_Comm_spawn_multiple +#define MPI_Comm_spawn PMPI_Comm_spawn #define MPI_Comm_split_f08 PMPI_Comm_split_f08 -#define MPI_Comm_test_inter PMPI_Comm_test_inter +#define MPI_Comm_split PMPI_Comm_split +#define MPI_Comm_split_type_f08 PMPI_Comm_split_type_f08 +#define MPI_Comm_split_type PMPI_Comm_split_type #define MPI_Comm_test_inter_f08 PMPI_Comm_test_inter_f08 -#define MPI_Group_compare PMPI_Group_compare -#define MPI_Group_compare_f08 PMPI_Group_compare_f08 -#define MPI_Group_difference PMPI_Group_difference -#define MPI_Group_difference_f08 PMPI_Group_difference_f08 -#define MPI_Group_excl PMPI_Group_excl -#define MPI_Group_excl_f08 PMPI_Group_excl_f08 -#define MPI_Group_from_session_pset PMPI_Group_from_session_pset -#define MPI_Group_from_session_pset_f08 PMPI_Group_from_session_pset_f08 -#define MPI_Group_free PMPI_Group_free -#define MPI_Group_free_f08 PMPI_Group_free_f08 -#define MPI_Group_incl PMPI_Group_incl -#define MPI_Group_incl_f08 PMPI_Group_incl_f08 -#define MPI_Group_intersection PMPI_Group_intersection -#define MPI_Group_intersection_f08 PMPI_Group_intersection_f08 -#define MPI_Group_range_excl PMPI_Group_range_excl -#define MPI_Group_range_excl_f08 PMPI_Group_range_excl_f08 -#define MPI_Group_range_incl PMPI_Group_range_incl -#define MPI_Group_range_incl_f08 PMPI_Group_range_incl_f08 -#define MPI_Group_rank PMPI_Group_rank -#define MPI_Group_rank_f08 PMPI_Group_rank_f08 -#define MPI_Group_size PMPI_Group_size -#define MPI_Group_size_f08 PMPI_Group_size_f08 -#define MPI_Group_translate_ranks PMPI_Group_translate_ranks -#define MPI_Group_translate_ranks_f08 PMPI_Group_translate_ranks_f08 -#define MPI_Group_union PMPI_Group_union -#define MPI_Group_union_f08 PMPI_Group_union_f08 -#define MPI_Intercomm_create PMPI_Intercomm_create -#define MPI_Intercomm_create_f08 PMPI_Intercomm_create_f08 -#define MPI_Intercomm_create_from_groups PMPI_Intercomm_create_from_groups -#define MPI_Intercomm_create_from_groups_f08 PMPI_Intercomm_create_from_groups_f08 -#define MPI_Intercomm_merge PMPI_Intercomm_merge -#define MPI_Intercomm_merge_f08 PMPI_Intercomm_merge_f08 -#define MPI_Type_create_keyval PMPI_Type_create_keyval -#define MPI_Type_create_keyval_f08 PMPI_Type_create_keyval_f08 -#define MPI_Type_delete_attr PMPI_Type_delete_attr -#define MPI_Type_delete_attr_f08 PMPI_Type_delete_attr_f08 -#define MPI_Type_free_keyval PMPI_Type_free_keyval -#define MPI_Type_free_keyval_f08 PMPI_Type_free_keyval_f08 -#define MPI_Type_get_attr PMPI_Type_get_attr -#define MPI_Type_get_attr_f08 PMPI_Type_get_attr_f08 -#define MPI_Type_get_name PMPI_Type_get_name -#define MPI_Type_get_name_f08 PMPI_Type_get_name_f08 -#define MPI_Type_set_attr PMPI_Type_set_attr -#define MPI_Type_set_attr_f08 PMPI_Type_set_attr_f08 -#define MPI_Type_set_name PMPI_Type_set_name -#define MPI_Type_set_name_f08 PMPI_Type_set_name_f08 -#define MPI_Win_allocate PMPI_Win_allocate -#define MPI_Win_allocate_f08 PMPI_Win_allocate_f08 -#define MPI_Win_allocate_shared PMPI_Win_allocate_shared -#define MPI_Win_allocate_shared_f08 PMPI_Win_allocate_shared_f08 -#define MPI_Win_create_keyval PMPI_Win_create_keyval -#define MPI_Win_create_keyval_f08 PMPI_Win_create_keyval_f08 -#define MPI_Win_delete_attr PMPI_Win_delete_attr -#define MPI_Win_delete_attr_f08 PMPI_Win_delete_attr_f08 -#define MPI_Win_free_keyval PMPI_Win_free_keyval -#define MPI_Win_free_keyval_f08 PMPI_Win_free_keyval_f08 -#define MPI_Win_get_attr PMPI_Win_get_attr -#define MPI_Win_get_attr_f08 PMPI_Win_get_attr_f08 -#define MPI_Win_get_info PMPI_Win_get_info -#define MPI_Win_get_info_f08 PMPI_Win_get_info_f08 -#define MPI_Win_get_name PMPI_Win_get_name -#define MPI_Win_get_name_f08 PMPI_Win_get_name_f08 -#define MPI_Win_set_attr PMPI_Win_set_attr -#define MPI_Win_set_attr_f08 PMPI_Win_set_attr_f08 -#define MPI_Win_set_info PMPI_Win_set_info -#define MPI_Win_set_info_f08 PMPI_Win_set_info_f08 -#define MPI_Win_set_name PMPI_Win_set_name -#define MPI_Win_set_name_f08 PMPI_Win_set_name_f08 -#define MPI_Cartdim_get PMPI_Cartdim_get -#define MPI_Cartdim_get_f08 PMPI_Cartdim_get_f08 -#define MPI_Cart_coords PMPI_Cart_coords -#define MPI_Cart_coords_f08 PMPI_Cart_coords_f08 -#define MPI_Cart_create PMPI_Cart_create -#define MPI_Cart_create_f08 PMPI_Cart_create_f08 -#define MPI_Cart_get PMPI_Cart_get -#define MPI_Cart_get_f08 PMPI_Cart_get_f08 -#define MPI_Cart_map PMPI_Cart_map -#define MPI_Cart_map_f08 PMPI_Cart_map_f08 -#define MPI_Cart_rank PMPI_Cart_rank -#define MPI_Cart_rank_f08 PMPI_Cart_rank_f08 -#define MPI_Cart_shift PMPI_Cart_shift -#define MPI_Cart_shift_f08 PMPI_Cart_shift_f08 -#define MPI_Cart_sub PMPI_Cart_sub -#define MPI_Cart_sub_f08 PMPI_Cart_sub_f08 -#define MPI_Dims_create PMPI_Dims_create +#define MPI_Comm_test_inter PMPI_Comm_test_inter +#define MPI_Compare_and_swap_f08 PMPI_Compare_and_swap_f08 +#define MPI_Compare_and_swap PMPI_Compare_and_swap #define MPI_Dims_create_f08 PMPI_Dims_create_f08 -#define MPI_Dist_graph_create PMPI_Dist_graph_create -#define MPI_Dist_graph_create_f08 PMPI_Dist_graph_create_f08 -#define MPI_Dist_graph_create_adjacent PMPI_Dist_graph_create_adjacent +#define MPI_Dims_create PMPI_Dims_create #define MPI_Dist_graph_create_adjacent_f08 PMPI_Dist_graph_create_adjacent_f08 -#define MPI_Dist_graph_neighbors PMPI_Dist_graph_neighbors -#define MPI_Dist_graph_neighbors_f08 PMPI_Dist_graph_neighbors_f08 -#define MPI_Dist_graph_neighbors_count PMPI_Dist_graph_neighbors_count +#define MPI_Dist_graph_create_adjacent PMPI_Dist_graph_create_adjacent +#define MPI_Dist_graph_create_f08 PMPI_Dist_graph_create_f08 +#define MPI_Dist_graph_create PMPI_Dist_graph_create #define MPI_Dist_graph_neighbors_count_f08 PMPI_Dist_graph_neighbors_count_f08 -#define MPI_Graphdims_get PMPI_Graphdims_get -#define MPI_Graphdims_get_f08 PMPI_Graphdims_get_f08 -#define MPI_Graph_create PMPI_Graph_create -#define MPI_Graph_create_f08 PMPI_Graph_create_f08 -#define MPI_Graph_get PMPI_Graph_get -#define MPI_Graph_get_f08 PMPI_Graph_get_f08 -#define MPI_Graph_map PMPI_Graph_map -#define MPI_Graph_map_f08 PMPI_Graph_map_f08 -#define MPI_Graph_neighbors PMPI_Graph_neighbors -#define MPI_Graph_neighbors_f08 PMPI_Graph_neighbors_f08 -#define MPI_Graph_neighbors_count PMPI_Graph_neighbors_count -#define MPI_Graph_neighbors_count_f08 PMPI_Graph_neighbors_count_f08 -#define MPI_Topo_test PMPI_Topo_test -#define MPI_Topo_test_f08 PMPI_Topo_test_f08 -#define MPI_Aint_add PMPI_Aint_add -#define MPI_Aint_add_f08 PMPI_Aint_add_f08 -#define MPI_Aint_diff PMPI_Aint_diff -#define MPI_Aint_diff_f08 PMPI_Aint_diff_f08 -#define MPI_Abort PMPI_Abort -#define MPI_Abort_f08 PMPI_Abort_f08 -#define MPI_Add_error_class PMPI_Add_error_class -#define MPI_Add_error_class_f08 PMPI_Add_error_class_f08 -#define MPI_Add_error_code PMPI_Add_error_code -#define MPI_Add_error_code_f08 PMPI_Add_error_code_f08 -#define MPI_Add_error_string PMPI_Add_error_string -#define MPI_Add_error_string_f08 PMPI_Add_error_string_f08 -#define MPI_Alloc_mem PMPI_Alloc_mem -#define MPI_Alloc_mem_f08 PMPI_Alloc_mem_f08 -#define MPI_Comm_call_errhandler PMPI_Comm_call_errhandler -#define MPI_Comm_call_errhandler_f08 PMPI_Comm_call_errhandler_f08 -#define MPI_Comm_create_errhandler PMPI_Comm_create_errhandler -#define MPI_Comm_create_errhandler_f08 PMPI_Comm_create_errhandler_f08 -#define MPI_Comm_get_errhandler PMPI_Comm_get_errhandler -#define MPI_Comm_get_errhandler_f08 PMPI_Comm_get_errhandler_f08 -#define MPI_Comm_set_errhandler PMPI_Comm_set_errhandler -#define MPI_Comm_set_errhandler_f08 PMPI_Comm_set_errhandler_f08 -#define MPI_Errhandler_free PMPI_Errhandler_free +#define MPI_Dist_graph_neighbors_count PMPI_Dist_graph_neighbors_count +#define MPI_Dist_graph_neighbors_f08 PMPI_Dist_graph_neighbors_f08 +#define MPI_Dist_graph_neighbors PMPI_Dist_graph_neighbors #define MPI_Errhandler_free_f08 PMPI_Errhandler_free_f08 -#define MPI_Error_class PMPI_Error_class +#define MPI_Errhandler_free PMPI_Errhandler_free #define MPI_Error_class_f08 PMPI_Error_class_f08 -#define MPI_Error_string PMPI_Error_string +#define MPI_Error_class PMPI_Error_class #define MPI_Error_string_f08 PMPI_Error_string_f08 -#define MPI_File_call_errhandler PMPI_File_call_errhandler -#define MPI_File_call_errhandler_f08 PMPI_File_call_errhandler_f08 -#define MPI_File_create_errhandler PMPI_File_create_errhandler -#define MPI_File_create_errhandler_f08 PMPI_File_create_errhandler_f08 -#define MPI_File_get_errhandler PMPI_File_get_errhandler -#define MPI_File_get_errhandler_f08 PMPI_File_get_errhandler_f08 -#define MPI_File_set_errhandler PMPI_File_set_errhandler -#define MPI_File_set_errhandler_f08 PMPI_File_set_errhandler_f08 -#define MPI_Finalize PMPI_Finalize -#define MPI_Finalize_f08 PMPI_Finalize_f08 -#define MPI_Finalized PMPI_Finalized -#define MPI_Finalized_f08 PMPI_Finalized_f08 -#define MPI_Free_mem PMPI_Free_mem -#define MPI_Free_mem_f08 PMPI_Free_mem_f08 -#define MPI_Get_processor_name PMPI_Get_processor_name -#define MPI_Get_processor_name_f08 PMPI_Get_processor_name_f08 -#define MPI_Get_version PMPI_Get_version -#define MPI_Get_version_f08 PMPI_Get_version_f08 -#define MPI_Init PMPI_Init -#define MPI_Init_f08 PMPI_Init_f08 -#define MPI_Initialized PMPI_Initialized -#define MPI_Initialized_f08 PMPI_Initialized_f08 -#define MPI_Win_call_errhandler PMPI_Win_call_errhandler -#define MPI_Win_call_errhandler_f08 PMPI_Win_call_errhandler_f08 -#define MPI_Win_create_errhandler PMPI_Win_create_errhandler -#define MPI_Win_create_errhandler_f08 PMPI_Win_create_errhandler_f08 -#define MPI_Win_get_errhandler PMPI_Win_get_errhandler -#define MPI_Win_get_errhandler_f08 PMPI_Win_get_errhandler_f08 -#define MPI_Win_set_errhandler PMPI_Win_set_errhandler -#define MPI_Win_set_errhandler_f08 PMPI_Win_set_errhandler_f08 -#define MPI_Info_create PMPI_Info_create -#define MPI_Info_create_f08 PMPI_Info_create_f08 -#define MPI_Info_create_env PMPI_Info_create_env -#define MPI_Info_create_env_f08 PMPI_Info_create_env_f08 -#define MPI_Info_delete PMPI_Info_delete -#define MPI_Info_delete_f08 PMPI_Info_delete_f08 -#define MPI_Info_dup PMPI_Info_dup -#define MPI_Info_dup_f08 PMPI_Info_dup_f08 -#define MPI_Info_free PMPI_Info_free -#define MPI_Info_free_f08 PMPI_Info_free_f08 -#define MPI_Info_get PMPI_Info_get -#define MPI_Info_get_f08 PMPI_Info_get_f08 -#define MPI_Info_get_nkeys PMPI_Info_get_nkeys -#define MPI_Info_get_nkeys_f08 PMPI_Info_get_nkeys_f08 -#define MPI_Info_get_nthkey PMPI_Info_get_nthkey -#define MPI_Info_get_nthkey_f08 PMPI_Info_get_nthkey_f08 -#define MPI_Info_get_string PMPI_Info_get_string -#define MPI_Info_get_string_f08 PMPI_Info_get_string_f08 -#define MPI_Info_get_valuelen PMPI_Info_get_valuelen -#define MPI_Info_get_valuelen_f08 PMPI_Info_get_valuelen_f08 -#define MPI_Info_set PMPI_Info_set -#define MPI_Info_set_f08 PMPI_Info_set_f08 -#define MPI_Close_port PMPI_Close_port -#define MPI_Close_port_f08 PMPI_Close_port_f08 -#define MPI_Comm_accept PMPI_Comm_accept -#define MPI_Comm_accept_f08 PMPI_Comm_accept_f08 -#define MPI_Comm_connect PMPI_Comm_connect -#define MPI_Comm_connect_f08 PMPI_Comm_connect_f08 -#define MPI_Comm_disconnect PMPI_Comm_disconnect -#define MPI_Comm_disconnect_f08 PMPI_Comm_disconnect_f08 -#define MPI_Comm_get_parent PMPI_Comm_get_parent -#define MPI_Comm_get_parent_f08 PMPI_Comm_get_parent_f08 -#define MPI_Comm_join PMPI_Comm_join -#define MPI_Comm_join_f08 PMPI_Comm_join_f08 -#define MPI_Comm_spawn PMPI_Comm_spawn -#define MPI_Comm_spawn_f08 PMPI_Comm_spawn_f08 -#define MPI_Comm_spawn_multiple PMPI_Comm_spawn_multiple -#define MPI_Comm_spawn_multiple_f08 PMPI_Comm_spawn_multiple_f08 -#define MPI_Lookup_name PMPI_Lookup_name -#define MPI_Lookup_name_f08 PMPI_Lookup_name_f08 -#define MPI_Open_port PMPI_Open_port -#define MPI_Open_port_f08 PMPI_Open_port_f08 -#define MPI_Publish_name PMPI_Publish_name -#define MPI_Publish_name_f08 PMPI_Publish_name_f08 -#define MPI_Unpublish_name PMPI_Unpublish_name -#define MPI_Unpublish_name_f08 PMPI_Unpublish_name_f08 -#define MPI_Accumulate PMPI_Accumulate -#define MPI_Accumulate_f08 PMPI_Accumulate_f08 -#define MPI_Raccumulate PMPI_Raccumulate -#define MPI_Raccumulate_f08 PMPI_Raccumulate_f08 -#define MPI_Get PMPI_Get -#define MPI_Get_f08 PMPI_Get_f08 -#define MPI_Rget PMPI_Rget -#define MPI_Rget_f08 PMPI_Rget_f08 -#define MPI_Get_accumulate PMPI_Get_accumulate -#define MPI_Get_accumulate_f08 PMPI_Get_accumulate_f08 -#define MPI_Rget_accumulate PMPI_Rget_accumulate -#define MPI_Rget_accumulate_f08 PMPI_Rget_accumulate_f08 -#define MPI_Put PMPI_Put -#define MPI_Put_f08 PMPI_Put_f08 -#define MPI_Rput PMPI_Rput -#define MPI_Rput_f08 PMPI_Rput_f08 -#define MPI_Fetch_and_op PMPI_Fetch_and_op +#define MPI_Error_string PMPI_Error_string +#define MPI_Exscan_f08 PMPI_Exscan_f08 +#define MPI_Exscan_init_f08 PMPI_Exscan_init_f08 +#define MPI_Exscan_init PMPI_Exscan_init +#define MPI_Exscan PMPI_Exscan #define MPI_Fetch_and_op_f08 PMPI_Fetch_and_op_f08 -#define MPI_Compare_and_swap PMPI_Compare_and_swap -#define MPI_Compare_and_swap_f08 PMPI_Compare_and_swap_f08 -#define MPI_Win_complete PMPI_Win_complete -#define MPI_Win_complete_f08 PMPI_Win_complete_f08 -#define MPI_Win_create PMPI_Win_create -#define MPI_Win_create_f08 PMPI_Win_create_f08 -#define MPI_Win_create_dynamic PMPI_Win_create_dynamic -#define MPI_Win_create_dynamic_f08 PMPI_Win_create_dynamic_f08 -#define MPI_Win_attach PMPI_Win_attach -#define MPI_Win_attach_f08 PMPI_Win_attach_f08 -#define MPI_Win_detach PMPI_Win_detach -#define MPI_Win_detach_f08 PMPI_Win_detach_f08 -#define MPI_Win_fence PMPI_Win_fence -#define MPI_Win_fence_f08 PMPI_Win_fence_f08 -#define MPI_Win_free PMPI_Win_free -#define MPI_Win_free_f08 PMPI_Win_free_f08 -#define MPI_Win_get_group PMPI_Win_get_group -#define MPI_Win_get_group_f08 PMPI_Win_get_group_f08 -#define MPI_Win_lock PMPI_Win_lock -#define MPI_Win_lock_f08 PMPI_Win_lock_f08 -#define MPI_Win_lock_all PMPI_Win_lock_all -#define MPI_Win_lock_all_f08 PMPI_Win_lock_all_f08 -#define MPI_Win_post PMPI_Win_post -#define MPI_Win_post_f08 PMPI_Win_post_f08 -#define MPI_Win_shared_query PMPI_Win_shared_query -#define MPI_Win_shared_query_f08 PMPI_Win_shared_query_f08 -#define MPI_Win_start PMPI_Win_start -#define MPI_Win_start_f08 PMPI_Win_start_f08 -#define MPI_Win_sync PMPI_Win_sync -#define MPI_Win_sync_f08 PMPI_Win_sync_f08 -#define MPI_Win_test PMPI_Win_test -#define MPI_Win_test_f08 PMPI_Win_test_f08 -#define MPI_Win_unlock PMPI_Win_unlock -#define MPI_Win_unlock_f08 PMPI_Win_unlock_f08 -#define MPI_Win_unlock_all PMPI_Win_unlock_all -#define MPI_Win_unlock_all_f08 PMPI_Win_unlock_all_f08 -#define MPI_Win_wait PMPI_Win_wait -#define MPI_Win_wait_f08 PMPI_Win_wait_f08 -#define MPI_Win_flush PMPI_Win_flush -#define MPI_Win_flush_f08 PMPI_Win_flush_f08 -#define MPI_Win_flush_local PMPI_Win_flush_local -#define MPI_Win_flush_local_f08 PMPI_Win_flush_local_f08 -#define MPI_Win_flush_local_all PMPI_Win_flush_local_all -#define MPI_Win_flush_local_all_f08 PMPI_Win_flush_local_all_f08 -#define MPI_Win_flush_all PMPI_Win_flush_all -#define MPI_Win_flush_all_f08 PMPI_Win_flush_all_f08 -#define MPI_Grequest_complete PMPI_Grequest_complete -#define MPI_Grequest_complete_f08 PMPI_Grequest_complete_f08 -#define MPI_Grequest_start PMPI_Grequest_start -#define MPI_Grequest_start_f08 PMPI_Grequest_start_f08 -#define MPI_Init_thread PMPI_Init_thread -#define MPI_Init_thread_f08 PMPI_Init_thread_f08 -#define MPI_Is_thread_main PMPI_Is_thread_main -#define MPI_Is_thread_main_f08 PMPI_Is_thread_main_f08 -#define MPI_Query_thread PMPI_Query_thread -#define MPI_Query_thread_f08 PMPI_Query_thread_f08 -#define MPI_Status_f082f PMPI_Status_f082f -#define MPI_Status_f082f_f08 PMPI_Status_f082f_f08 -#define MPI_Status_f2f08 PMPI_Status_f2f08 -#define MPI_Status_f2f08_f08 PMPI_Status_f2f08_f08 -#define MPI_Status_set_cancelled PMPI_Status_set_cancelled -#define MPI_Status_set_cancelled_f08 PMPI_Status_set_cancelled_f08 -#define MPI_Status_set_elements PMPI_Status_set_elements -#define MPI_Status_set_elements_f08 PMPI_Status_set_elements_f08 -#define MPI_Status_set_elements_x PMPI_Status_set_elements_x -#define MPI_Status_set_elements_x_f08 PMPI_Status_set_elements_x_f08 -#define MPI_File_close PMPI_File_close +#define MPI_Fetch_and_op PMPI_Fetch_and_op +#define MPI_File_call_errhandler_f08 PMPI_File_call_errhandler_f08 +#define MPI_File_call_errhandler PMPI_File_call_errhandler #define MPI_File_close_f08 PMPI_File_close_f08 -#define MPI_File_delete PMPI_File_delete +#define MPI_File_close PMPI_File_close +#define MPI_File_create_errhandler_f08 PMPI_File_create_errhandler_f08 +#define MPI_File_create_errhandler PMPI_File_create_errhandler #define MPI_File_delete_f08 PMPI_File_delete_f08 -#define MPI_File_get_amode PMPI_File_get_amode +#define MPI_File_delete PMPI_File_delete #define MPI_File_get_amode_f08 PMPI_File_get_amode_f08 -#define MPI_File_get_atomicity PMPI_File_get_atomicity +#define MPI_File_get_amode PMPI_File_get_amode #define MPI_File_get_atomicity_f08 PMPI_File_get_atomicity_f08 -#define MPI_File_get_byte_offset PMPI_File_get_byte_offset +#define MPI_File_get_atomicity PMPI_File_get_atomicity #define MPI_File_get_byte_offset_f08 PMPI_File_get_byte_offset_f08 -#define MPI_File_get_group PMPI_File_get_group +#define MPI_File_get_byte_offset PMPI_File_get_byte_offset +#define MPI_File_get_errhandler_f08 PMPI_File_get_errhandler_f08 +#define MPI_File_get_errhandler PMPI_File_get_errhandler #define MPI_File_get_group_f08 PMPI_File_get_group_f08 -#define MPI_File_get_info PMPI_File_get_info +#define MPI_File_get_group PMPI_File_get_group #define MPI_File_get_info_f08 PMPI_File_get_info_f08 -#define MPI_File_get_position PMPI_File_get_position +#define MPI_File_get_info PMPI_File_get_info #define MPI_File_get_position_f08 PMPI_File_get_position_f08 -#define MPI_File_get_position_shared PMPI_File_get_position_shared +#define MPI_File_get_position PMPI_File_get_position #define MPI_File_get_position_shared_f08 PMPI_File_get_position_shared_f08 -#define MPI_File_get_size PMPI_File_get_size +#define MPI_File_get_position_shared PMPI_File_get_position_shared #define MPI_File_get_size_f08 PMPI_File_get_size_f08 -#define MPI_File_get_type_extent PMPI_File_get_type_extent +#define MPI_File_get_size PMPI_File_get_size #define MPI_File_get_type_extent_f08 PMPI_File_get_type_extent_f08 -#define MPI_File_get_view PMPI_File_get_view +#define MPI_File_get_type_extent PMPI_File_get_type_extent #define MPI_File_get_view_f08 PMPI_File_get_view_f08 -#define MPI_File_iread PMPI_File_iread -#define MPI_File_iread_f08 PMPI_File_iread_f08 -#define MPI_File_iread_at PMPI_File_iread_at -#define MPI_File_iread_at_f08 PMPI_File_iread_at_f08 -#define MPI_File_iread_all PMPI_File_iread_all +#define MPI_File_get_view PMPI_File_get_view #define MPI_File_iread_all_f08 PMPI_File_iread_all_f08 -#define MPI_File_iread_at_all PMPI_File_iread_at_all +#define MPI_File_iread_all PMPI_File_iread_all #define MPI_File_iread_at_all_f08 PMPI_File_iread_at_all_f08 -#define MPI_File_iread_shared PMPI_File_iread_shared +#define MPI_File_iread_at_all PMPI_File_iread_at_all +#define MPI_File_iread_at_f08 PMPI_File_iread_at_f08 +#define MPI_File_iread_at PMPI_File_iread_at +#define MPI_File_iread_f08 PMPI_File_iread_f08 +#define MPI_File_iread PMPI_File_iread #define MPI_File_iread_shared_f08 PMPI_File_iread_shared_f08 -#define MPI_File_iwrite PMPI_File_iwrite -#define MPI_File_iwrite_f08 PMPI_File_iwrite_f08 -#define MPI_File_iwrite_at PMPI_File_iwrite_at -#define MPI_File_iwrite_at_f08 PMPI_File_iwrite_at_f08 -#define MPI_File_iwrite_all PMPI_File_iwrite_all +#define MPI_File_iread_shared PMPI_File_iread_shared #define MPI_File_iwrite_all_f08 PMPI_File_iwrite_all_f08 -#define MPI_File_iwrite_at_all PMPI_File_iwrite_at_all +#define MPI_File_iwrite_all PMPI_File_iwrite_all #define MPI_File_iwrite_at_all_f08 PMPI_File_iwrite_at_all_f08 -#define MPI_File_iwrite_shared PMPI_File_iwrite_shared -#define MPI_File_iwrite_shared_f08 PMPI_File_iwrite_shared_f08 -#define MPI_File_open PMPI_File_open -#define MPI_File_open_f08 PMPI_File_open_f08 -#define MPI_File_preallocate PMPI_File_preallocate +#define MPI_File_iwrite_at_all PMPI_File_iwrite_at_all +#define MPI_File_iwrite_at_f08 PMPI_File_iwrite_at_f08 +#define MPI_File_iwrite_at PMPI_File_iwrite_at +#define MPI_File_iwrite_f08 PMPI_File_iwrite_f08 +#define MPI_File_iwrite PMPI_File_iwrite +#define MPI_File_iwrite_shared_f08 PMPI_File_iwrite_shared_f08 +#define MPI_File_iwrite_shared PMPI_File_iwrite_shared +#define MPI_File_open_f08 PMPI_File_open_f08 +#define MPI_File_open PMPI_File_open #define MPI_File_preallocate_f08 PMPI_File_preallocate_f08 -#define MPI_File_read PMPI_File_read -#define MPI_File_read_f08 PMPI_File_read_f08 -#define MPI_File_read_all PMPI_File_read_all -#define MPI_File_read_all_f08 PMPI_File_read_all_f08 -#define MPI_File_read_all_begin PMPI_File_read_all_begin +#define MPI_File_preallocate PMPI_File_preallocate #define MPI_File_read_all_begin_f08 PMPI_File_read_all_begin_f08 -#define MPI_File_read_all_end PMPI_File_read_all_end +#define MPI_File_read_all_begin PMPI_File_read_all_begin #define MPI_File_read_all_end_f08 PMPI_File_read_all_end_f08 -#define MPI_File_read_at PMPI_File_read_at -#define MPI_File_read_at_f08 PMPI_File_read_at_f08 -#define MPI_File_read_at_all PMPI_File_read_at_all -#define MPI_File_read_at_all_f08 PMPI_File_read_at_all_f08 -#define MPI_File_read_at_all_begin PMPI_File_read_at_all_begin +#define MPI_File_read_all_end PMPI_File_read_all_end +#define MPI_File_read_all_f08 PMPI_File_read_all_f08 +#define MPI_File_read_all PMPI_File_read_all #define MPI_File_read_at_all_begin_f08 PMPI_File_read_at_all_begin_f08 -#define MPI_File_read_at_all_end PMPI_File_read_at_all_end +#define MPI_File_read_at_all_begin PMPI_File_read_at_all_begin #define MPI_File_read_at_all_end_f08 PMPI_File_read_at_all_end_f08 -#define MPI_File_read_ordered PMPI_File_read_ordered -#define MPI_File_read_ordered_f08 PMPI_File_read_ordered_f08 -#define MPI_File_read_ordered_begin PMPI_File_read_ordered_begin +#define MPI_File_read_at_all_end PMPI_File_read_at_all_end +#define MPI_File_read_at_all_f08 PMPI_File_read_at_all_f08 +#define MPI_File_read_at_all PMPI_File_read_at_all +#define MPI_File_read_at_f08 PMPI_File_read_at_f08 +#define MPI_File_read_at PMPI_File_read_at +#define MPI_File_read_f08 PMPI_File_read_f08 #define MPI_File_read_ordered_begin_f08 PMPI_File_read_ordered_begin_f08 -#define MPI_File_read_ordered_end PMPI_File_read_ordered_end +#define MPI_File_read_ordered_begin PMPI_File_read_ordered_begin #define MPI_File_read_ordered_end_f08 PMPI_File_read_ordered_end_f08 -#define MPI_File_read_shared PMPI_File_read_shared +#define MPI_File_read_ordered_end PMPI_File_read_ordered_end +#define MPI_File_read_ordered_f08 PMPI_File_read_ordered_f08 +#define MPI_File_read_ordered PMPI_File_read_ordered +#define MPI_File_read PMPI_File_read #define MPI_File_read_shared_f08 PMPI_File_read_shared_f08 -#define MPI_File_seek PMPI_File_seek +#define MPI_File_read_shared PMPI_File_read_shared #define MPI_File_seek_f08 PMPI_File_seek_f08 -#define MPI_File_seek_shared PMPI_File_seek_shared +#define MPI_File_seek PMPI_File_seek #define MPI_File_seek_shared_f08 PMPI_File_seek_shared_f08 -#define MPI_File_set_atomicity PMPI_File_set_atomicity +#define MPI_File_seek_shared PMPI_File_seek_shared #define MPI_File_set_atomicity_f08 PMPI_File_set_atomicity_f08 -#define MPI_File_set_info PMPI_File_set_info +#define MPI_File_set_atomicity PMPI_File_set_atomicity +#define MPI_File_set_errhandler_f08 PMPI_File_set_errhandler_f08 +#define MPI_File_set_errhandler PMPI_File_set_errhandler #define MPI_File_set_info_f08 PMPI_File_set_info_f08 -#define MPI_File_set_size PMPI_File_set_size +#define MPI_File_set_info PMPI_File_set_info #define MPI_File_set_size_f08 PMPI_File_set_size_f08 -#define MPI_File_set_view PMPI_File_set_view +#define MPI_File_set_size PMPI_File_set_size #define MPI_File_set_view_f08 PMPI_File_set_view_f08 -#define MPI_File_sync PMPI_File_sync +#define MPI_File_set_view PMPI_File_set_view #define MPI_File_sync_f08 PMPI_File_sync_f08 -#define MPI_File_write PMPI_File_write -#define MPI_File_write_f08 PMPI_File_write_f08 -#define MPI_File_write_all PMPI_File_write_all -#define MPI_File_write_all_f08 PMPI_File_write_all_f08 -#define MPI_File_write_all_begin PMPI_File_write_all_begin +#define MPI_File_sync PMPI_File_sync #define MPI_File_write_all_begin_f08 PMPI_File_write_all_begin_f08 -#define MPI_File_write_all_end PMPI_File_write_all_end +#define MPI_File_write_all_begin PMPI_File_write_all_begin #define MPI_File_write_all_end_f08 PMPI_File_write_all_end_f08 -#define MPI_File_write_at PMPI_File_write_at -#define MPI_File_write_at_f08 PMPI_File_write_at_f08 -#define MPI_File_write_at_all PMPI_File_write_at_all -#define MPI_File_write_at_all_f08 PMPI_File_write_at_all_f08 -#define MPI_File_write_at_all_begin PMPI_File_write_at_all_begin +#define MPI_File_write_all_end PMPI_File_write_all_end +#define MPI_File_write_all_f08 PMPI_File_write_all_f08 +#define MPI_File_write_all PMPI_File_write_all #define MPI_File_write_at_all_begin_f08 PMPI_File_write_at_all_begin_f08 -#define MPI_File_write_at_all_end PMPI_File_write_at_all_end +#define MPI_File_write_at_all_begin PMPI_File_write_at_all_begin #define MPI_File_write_at_all_end_f08 PMPI_File_write_at_all_end_f08 -#define MPI_File_write_ordered PMPI_File_write_ordered -#define MPI_File_write_ordered_f08 PMPI_File_write_ordered_f08 -#define MPI_File_write_ordered_begin PMPI_File_write_ordered_begin +#define MPI_File_write_at_all_end PMPI_File_write_at_all_end +#define MPI_File_write_at_all_f08 PMPI_File_write_at_all_f08 +#define MPI_File_write_at_all PMPI_File_write_at_all +#define MPI_File_write_at_f08 PMPI_File_write_at_f08 +#define MPI_File_write_at PMPI_File_write_at +#define MPI_File_write_f08 PMPI_File_write_f08 #define MPI_File_write_ordered_begin_f08 PMPI_File_write_ordered_begin_f08 -#define MPI_File_write_ordered_end PMPI_File_write_ordered_end +#define MPI_File_write_ordered_begin PMPI_File_write_ordered_begin #define MPI_File_write_ordered_end_f08 PMPI_File_write_ordered_end_f08 -#define MPI_File_write_shared PMPI_File_write_shared +#define MPI_File_write_ordered_end PMPI_File_write_ordered_end +#define MPI_File_write_ordered_f08 PMPI_File_write_ordered_f08 +#define MPI_File_write_ordered PMPI_File_write_ordered +#define MPI_File_write PMPI_File_write #define MPI_File_write_shared_f08 PMPI_File_write_shared_f08 -#define MPI_Register_datarep PMPI_Register_datarep -#define MPI_Register_datarep_f08 PMPI_Register_datarep_f08 -#define MPI_Type_create_f90_complex PMPI_Type_create_f90_complex -#define MPI_Type_create_f90_complex_f08 PMPI_Type_create_f90_complex_f08 -#define MPI_Type_create_f90_integer PMPI_Type_create_f90_integer -#define MPI_Type_create_f90_integer_f08 PMPI_Type_create_f90_integer_f08 -#define MPI_Type_create_f90_real PMPI_Type_create_f90_real -#define MPI_Type_create_f90_real_f08 PMPI_Type_create_f90_real_f08 -#define MPI_Type_match_size PMPI_Type_match_size -#define MPI_Type_match_size_f08 PMPI_Type_match_size_f08 -#define MPI_Pcontrol PMPI_Pcontrol -#define MPI_Pcontrol_f08 PMPI_Pcontrol_f08 -#define MPI_Comm_split_type PMPI_Comm_split_type -#define MPI_Comm_split_type_f08 PMPI_Comm_split_type_f08 -#define MPI_F_sync_reg PMPI_F_sync_reg +#define MPI_File_write_shared PMPI_File_write_shared +#define MPI_Finalized_f08 PMPI_Finalized_f08 +#define MPI_Finalized PMPI_Finalized +#define MPI_Finalize_f08 PMPI_Finalize_f08 +#define MPI_Finalize PMPI_Finalize +#define MPI_Free_mem_f08 PMPI_Free_mem_f08 +#define MPI_Free_mem PMPI_Free_mem #define MPI_F_sync_reg_f08 PMPI_F_sync_reg_f08 -#define MPI_Get_library_version PMPI_Get_library_version +#define MPI_F_sync_reg PMPI_F_sync_reg +#define MPI_Gather_f08 PMPI_Gather_f08 +#define MPI_Gather_init_f08 PMPI_Gather_init_f08 +#define MPI_Gather_init PMPI_Gather_init +#define MPI_Gather PMPI_Gather +#define MPI_Gatherv_f08 PMPI_Gatherv_f08 +#define MPI_Gatherv_init_f08 PMPI_Gatherv_init_f08 +#define MPI_Gatherv_init PMPI_Gatherv_init +#define MPI_Gatherv PMPI_Gatherv +#define MPI_Get_accumulate_f08 PMPI_Get_accumulate_f08 +#define MPI_Get_accumulate PMPI_Get_accumulate +#define MPI_Get_address_f08 PMPI_Get_address_f08 +#define MPI_Get_address PMPI_Get_address +#define MPI_Get_count_f08 PMPI_Get_count_f08 +#define MPI_Get_count PMPI_Get_count +#define MPI_Get_elements_f08 PMPI_Get_elements_f08 +#define MPI_Get_elements PMPI_Get_elements +#define MPI_Get_elements_x_f08 PMPI_Get_elements_x_f08 +#define MPI_Get_elements_x PMPI_Get_elements_x +#define MPI_Get_f08 PMPI_Get_f08 #define MPI_Get_library_version_f08 PMPI_Get_library_version_f08 -#define MPI_Mprobe PMPI_Mprobe -#define MPI_Mprobe_f08 PMPI_Mprobe_f08 -#define MPI_Improbe PMPI_Improbe +#define MPI_Get_library_version PMPI_Get_library_version +#define MPI_Get PMPI_Get +#define MPI_Get_processor_name_f08 PMPI_Get_processor_name_f08 +#define MPI_Get_processor_name PMPI_Get_processor_name +#define MPI_Get_version_f08 PMPI_Get_version_f08 +#define MPI_Get_version PMPI_Get_version +#define MPI_Graph_create_f08 PMPI_Graph_create_f08 +#define MPI_Graph_create PMPI_Graph_create +#define MPI_Graphdims_get_f08 PMPI_Graphdims_get_f08 +#define MPI_Graphdims_get PMPI_Graphdims_get +#define MPI_Graph_get_f08 PMPI_Graph_get_f08 +#define MPI_Graph_get PMPI_Graph_get +#define MPI_Graph_map_f08 PMPI_Graph_map_f08 +#define MPI_Graph_map PMPI_Graph_map +#define MPI_Graph_neighbors_count_f08 PMPI_Graph_neighbors_count_f08 +#define MPI_Graph_neighbors_count PMPI_Graph_neighbors_count +#define MPI_Graph_neighbors_f08 PMPI_Graph_neighbors_f08 +#define MPI_Graph_neighbors PMPI_Graph_neighbors +#define MPI_Grequest_complete_f08 PMPI_Grequest_complete_f08 +#define MPI_Grequest_complete PMPI_Grequest_complete +#define MPI_Grequest_start_f08 PMPI_Grequest_start_f08 +#define MPI_Grequest_start PMPI_Grequest_start +#define MPI_Group_compare_f08 PMPI_Group_compare_f08 +#define MPI_Group_compare PMPI_Group_compare +#define MPI_Group_difference_f08 PMPI_Group_difference_f08 +#define MPI_Group_difference PMPI_Group_difference +#define MPI_Group_excl_f08 PMPI_Group_excl_f08 +#define MPI_Group_excl PMPI_Group_excl +#define MPI_Group_free_f08 PMPI_Group_free_f08 +#define MPI_Group_free PMPI_Group_free +#define MPI_Group_from_session_pset_f08 PMPI_Group_from_session_pset_f08 +#define MPI_Group_from_session_pset PMPI_Group_from_session_pset +#define MPI_Group_incl_f08 PMPI_Group_incl_f08 +#define MPI_Group_incl PMPI_Group_incl +#define MPI_Group_intersection_f08 PMPI_Group_intersection_f08 +#define MPI_Group_intersection PMPI_Group_intersection +#define MPI_Group_range_excl_f08 PMPI_Group_range_excl_f08 +#define MPI_Group_range_excl PMPI_Group_range_excl +#define MPI_Group_range_incl_f08 PMPI_Group_range_incl_f08 +#define MPI_Group_range_incl PMPI_Group_range_incl +#define MPI_Group_rank_f08 PMPI_Group_rank_f08 +#define MPI_Group_rank PMPI_Group_rank +#define MPI_Group_size_f08 PMPI_Group_size_f08 +#define MPI_Group_size PMPI_Group_size +#define MPI_Group_translate_ranks_f08 PMPI_Group_translate_ranks_f08 +#define MPI_Group_translate_ranks PMPI_Group_translate_ranks +#define MPI_Group_union_f08 PMPI_Group_union_f08 +#define MPI_Group_union PMPI_Group_union +#define MPI_Iallgather_f08 PMPI_Iallgather_f08 +#define MPI_Iallgather PMPI_Iallgather +#define MPI_Iallgatherv_f08 PMPI_Iallgatherv_f08 +#define MPI_Iallgatherv PMPI_Iallgatherv +#define MPI_Iallreduce_f08 PMPI_Iallreduce_f08 +#define MPI_Iallreduce PMPI_Iallreduce +#define MPI_Ialltoall_f08 PMPI_Ialltoall_f08 +#define MPI_Ialltoall PMPI_Ialltoall +#define MPI_Ialltoallv_f08 PMPI_Ialltoallv_f08 +#define MPI_Ialltoallv PMPI_Ialltoallv +#define MPI_Ialltoallw_f08 PMPI_Ialltoallw_f08 +#define MPI_Ialltoallw PMPI_Ialltoallw +#define MPI_Ibarrier_f08 PMPI_Ibarrier_f08 +#define MPI_Ibarrier PMPI_Ibarrier +#define MPI_Ibcast_f08 PMPI_Ibcast_f08 +#define MPI_Ibcast PMPI_Ibcast +#define MPI_Ibsend_f08 PMPI_Ibsend_f08 +#define MPI_Ibsend PMPI_Ibsend +#define MPI_Iexscan_f08 PMPI_Iexscan_f08 +#define MPI_Iexscan PMPI_Iexscan +#define MPI_Igather_f08 PMPI_Igather_f08 +#define MPI_Igather PMPI_Igather +#define MPI_Igatherv_f08 PMPI_Igatherv_f08 +#define MPI_Igatherv PMPI_Igatherv #define MPI_Improbe_f08 PMPI_Improbe_f08 -#define MPI_Imrecv PMPI_Imrecv +#define MPI_Improbe PMPI_Improbe #define MPI_Imrecv_f08 PMPI_Imrecv_f08 -#define MPI_Mrecv PMPI_Mrecv -#define MPI_Mrecv_f08 PMPI_Mrecv_f08 -#define MPI_Neighbor_allgather PMPI_Neighbor_allgather -#define MPI_Neighbor_allgather_f08 PMPI_Neighbor_allgather_f08 -#define MPI_Ineighbor_allgather PMPI_Ineighbor_allgather +#define MPI_Imrecv PMPI_Imrecv #define MPI_Ineighbor_allgather_f08 PMPI_Ineighbor_allgather_f08 -#define MPI_Neighbor_allgather_init PMPI_Neighbor_allgather_init -#define MPI_Neighbor_allgather_init_f08 PMPI_Neighbor_allgather_init_f08 -#define MPI_Neighbor_allgatherv PMPI_Neighbor_allgatherv -#define MPI_Neighbor_allgatherv_f08 PMPI_Neighbor_allgatherv_f08 -#define MPI_Ineighbor_allgatherv PMPI_Ineighbor_allgatherv +#define MPI_Ineighbor_allgather PMPI_Ineighbor_allgather #define MPI_Ineighbor_allgatherv_f08 PMPI_Ineighbor_allgatherv_f08 -#define MPI_Neighbor_allgatherv_init PMPI_Neighbor_allgatherv_init -#define MPI_Neighbor_allgatherv_init_f08 PMPI_Neighbor_allgatherv_init_f08 -#define MPI_Neighbor_alltoall PMPI_Neighbor_alltoall -#define MPI_Neighbor_alltoall_f08 PMPI_Neighbor_alltoall_f08 -#define MPI_Ineighbor_alltoall PMPI_Ineighbor_alltoall +#define MPI_Ineighbor_allgatherv PMPI_Ineighbor_allgatherv #define MPI_Ineighbor_alltoall_f08 PMPI_Ineighbor_alltoall_f08 -#define MPI_Neighbor_alltoall_init PMPI_Neighbor_alltoall_init -#define MPI_Neighbor_alltoall_init_f08 PMPI_Neighbor_alltoall_init_f08 -#define MPI_Neighbor_alltoallv PMPI_Neighbor_alltoallv -#define MPI_Neighbor_alltoallv_f08 PMPI_Neighbor_alltoallv_f08 -#define MPI_Ineighbor_alltoallv PMPI_Ineighbor_alltoallv +#define MPI_Ineighbor_alltoall PMPI_Ineighbor_alltoall #define MPI_Ineighbor_alltoallv_f08 PMPI_Ineighbor_alltoallv_init_f08 -#define MPI_Neighbor_alltoallv_init PMPI_Neighbor_alltoallv_init -#define MPI_Neighbor_alltoallv_init_f08 PMPI_Neighbor_alltoallv_init_f08 -#define MPI_Neighbor_alltoallw PMPI_Neighbor_alltoallw -#define MPI_Neighbor_alltoallw_f08 PMPI_Neighbor_alltoallw_f08 -#define MPI_Ineighbor_alltoallw PMPI_Ineighbor_alltoallw +#define MPI_Ineighbor_alltoallv PMPI_Ineighbor_alltoallv #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 +#define MPI_Ineighbor_alltoallw PMPI_Ineighbor_alltoallw +#define MPI_Info_create_env_f08 PMPI_Info_create_env_f08 +#define MPI_Info_create_env PMPI_Info_create_env +#define MPI_Info_create_f08 PMPI_Info_create_f08 +#define MPI_Info_create PMPI_Info_create +#define MPI_Info_delete_f08 PMPI_Info_delete_f08 +#define MPI_Info_delete PMPI_Info_delete +#define MPI_Info_dup_f08 PMPI_Info_dup_f08 +#define MPI_Info_dup PMPI_Info_dup +#define MPI_Info_free_f08 PMPI_Info_free_f08 +#define MPI_Info_free PMPI_Info_free +#define MPI_Info_get_f08 PMPI_Info_get_f08 +#define MPI_Info_get_nkeys_f08 PMPI_Info_get_nkeys_f08 +#define MPI_Info_get_nkeys PMPI_Info_get_nkeys +#define MPI_Info_get_nthkey_f08 PMPI_Info_get_nthkey_f08 +#define MPI_Info_get_nthkey PMPI_Info_get_nthkey +#define MPI_Info_get PMPI_Info_get +#define MPI_Info_get_string_f08 PMPI_Info_get_string_f08 +#define MPI_Info_get_string PMPI_Info_get_string +#define MPI_Info_get_valuelen_f08 PMPI_Info_get_valuelen_f08 +#define MPI_Info_get_valuelen PMPI_Info_get_valuelen +#define MPI_Info_set_f08 PMPI_Info_set_f08 +#define MPI_Info_set PMPI_Info_set +#define MPI_Init_f08 PMPI_Init_f08 +#define MPI_Initialized_f08 PMPI_Initialized_f08 +#define MPI_Initialized PMPI_Initialized +#define MPI_Init PMPI_Init +#define MPI_Init_thread_f08 PMPI_Init_thread_f08 +#define MPI_Init_thread PMPI_Init_thread +#define MPI_Intercomm_create_f08 PMPI_Intercomm_create_f08 +#define MPI_Intercomm_create_from_groups_f08 PMPI_Intercomm_create_from_groups_f08 +#define MPI_Intercomm_create_from_groups PMPI_Intercomm_create_from_groups +#define MPI_Intercomm_create PMPI_Intercomm_create +#define MPI_Intercomm_merge_f08 PMPI_Intercomm_merge_f08 +#define MPI_Intercomm_merge PMPI_Intercomm_merge +#define MPI_Iprobe_f08 PMPI_Iprobe_f08 +#define MPI_Iprobe PMPI_Iprobe +#define MPI_Irecv_f08 PMPI_Irecv_f08 +#define MPI_Irecv PMPI_Irecv +#define MPI_Ireduce_f08 PMPI_Ireduce_f08 +#define MPI_Ireduce PMPI_Ireduce +#define MPI_Ireduce_scatter_block_f08 PMPI_Ireduce_scatter_block_f08 +#define MPI_Ireduce_scatter_block PMPI_Ireduce_scatter_block +#define MPI_Ireduce_scatter_f08 PMPI_Ireduce_scatter_f08 +#define MPI_Ireduce_scatter PMPI_Ireduce_scatter +#define MPI_Irsend_f08 PMPI_Irsend_f08 +#define MPI_Irsend PMPI_Irsend +#define MPI_Iscan_f08 PMPI_Iscan_f08 +#define MPI_Iscan PMPI_Iscan +#define MPI_Iscatter_f08 PMPI_Iscatter_f08 +#define MPI_Iscatter PMPI_Iscatter +#define MPI_Iscatterv_f08 PMPI_Iscatterv_f08 +#define MPI_Iscatterv PMPI_Iscatterv +#define MPI_Isend_f08 PMPI_Isend_f08 +#define MPI_Isend PMPI_Isend +#define MPI_Isendrecv_f08 PMPI_Isendrecv_f08 +#define MPI_Isendrecv PMPI_Isendrecv +#define MPI_Isendrecv_replace_f08 PMPI_Isendrecv_replace_f08 +#define MPI_Isendrecv_replace PMPI_Isendrecv_replace +#define MPI_Issend_f08 PMPI_Issend_f08 +#define MPI_Issend PMPI_Issend +#define MPI_Is_thread_main_f08 PMPI_Is_thread_main_f08 +#define MPI_Is_thread_main PMPI_Is_thread_main +#define MPI_Lookup_name_f08 PMPI_Lookup_name_f08 +#define MPI_Lookup_name PMPI_Lookup_name +#define MPI_Mprobe_f08 PMPI_Mprobe_f08 +#define MPI_Mprobe PMPI_Mprobe +#define MPI_Mrecv_f08 PMPI_Mrecv_f08 +#define MPI_Mrecv PMPI_Mrecv +#define MPI_Neighbor_allgather_f08 PMPI_Neighbor_allgather_f08 +#define MPI_Neighbor_allgather_init_f08 PMPI_Neighbor_allgather_init_f08 +#define MPI_Neighbor_allgather_init PMPI_Neighbor_allgather_init +#define MPI_Neighbor_allgather PMPI_Neighbor_allgather +#define MPI_Neighbor_allgatherv_f08 PMPI_Neighbor_allgatherv_f08 +#define MPI_Neighbor_allgatherv_init_f08 PMPI_Neighbor_allgatherv_init_f08 +#define MPI_Neighbor_allgatherv_init PMPI_Neighbor_allgatherv_init +#define MPI_Neighbor_allgatherv PMPI_Neighbor_allgatherv +#define MPI_Neighbor_alltoall_f08 PMPI_Neighbor_alltoall_f08 +#define MPI_Neighbor_alltoall_init_f08 PMPI_Neighbor_alltoall_init_f08 +#define MPI_Neighbor_alltoall_init PMPI_Neighbor_alltoall_init +#define MPI_Neighbor_alltoall PMPI_Neighbor_alltoall +#define MPI_Neighbor_alltoallv_f08 PMPI_Neighbor_alltoallv_f08 +#define MPI_Neighbor_alltoallv_init_f08 PMPI_Neighbor_alltoallv_init_f08 +#define MPI_Neighbor_alltoallv_init PMPI_Neighbor_alltoallv_init +#define MPI_Neighbor_alltoallv PMPI_Neighbor_alltoallv +#define MPI_Neighbor_alltoallw_f08 PMPI_Neighbor_alltoallw_f08 +#define MPI_Neighbor_alltoallw_init_f08 PMPI_Neighbor_alltoallw_init_f08 +#define MPI_Neighbor_alltoallw_init PMPI_Neighbor_alltoallw_init +#define MPI_Neighbor_alltoallw PMPI_Neighbor_alltoallw +#define MPI_Op_commutative_f08 PMPI_Op_commutative_f08 +#define MPI_Op_commutative PMPI_Op_commutative +#define MPI_Op_create_f08 PMPI_Op_create_f08 +#define MPI_Op_create PMPI_Op_create +#define MPI_Open_port_f08 PMPI_Open_port_f08 +#define MPI_Open_port PMPI_Open_port +#define MPI_Op_free_f08 PMPI_Op_free_f08 +#define MPI_Op_free PMPI_Op_free +#define MPI_Pack_external_f08 PMPI_Pack_external_f08 +#define MPI_Pack_external PMPI_Pack_external +#define MPI_Pack_external_size_f08 PMPI_Pack_external_size_f08 +#define MPI_Pack_external_size PMPI_Pack_external_size +#define MPI_Pack_f08 PMPI_Pack_f08 +#define MPI_Pack PMPI_Pack +#define MPI_Pack_size_f08 PMPI_Pack_size_f08 +#define MPI_Pack_size PMPI_Pack_size +#define MPI_Parrived_f08 PMPI_Parrived_f08 +#define MPI_Parrived PMPI_Parrived +#define MPI_Pcontrol_f08 PMPI_Pcontrol_f08 +#define MPI_Pcontrol PMPI_Pcontrol +#define MPI_Pready_f08 PMPI_Pready_f08 +#define MPI_Pready_list_f08 PMPI_Pready_list_f08 +#define MPI_Pready_list PMPI_Pready_list +#define MPI_Pready PMPI_Pready +#define MPI_Pready_range_f08 PMPI_Pready_range_f08 +#define MPI_Pready_range PMPI_Pready_range +#define MPI_Precv_init_f08 PMPI_Precv_init_f08 +#define MPI_Precv_init PMPI_Precv_init +#define MPI_Probe_f08 PMPI_Probe_f08 +#define MPI_Probe PMPI_Probe +#define MPI_Psend_init_f08 PMPI_Psend_init_f08 +#define MPI_Psend_init PMPI_Psend_init +#define MPI_Publish_name_f08 PMPI_Publish_name_f08 +#define MPI_Publish_name PMPI_Publish_name +#define MPI_Put_f08 PMPI_Put_f08 +#define MPI_Put PMPI_Put +#define MPI_Query_thread_f08 PMPI_Query_thread_f08 +#define MPI_Query_thread PMPI_Query_thread +#define MPI_Raccumulate_f08 PMPI_Raccumulate_f08 +#define MPI_Raccumulate PMPI_Raccumulate +#define MPI_Recv_f08_c PMPI_Recv_f08_c +#define MPI_Recv_f08 PMPI_Recv_f08 +#define MPI_Recv_init_f08 PMPI_Recv_init_f08 +#define MPI_Recv_init PMPI_Recv_init +#define MPI_Recv PMPI_Recv +#define MPI_Reduce_f08 PMPI_Reduce_f08 +#define MPI_Reduce_init_f08 PMPI_Reduce_init_f08 +#define MPI_Reduce_init PMPI_Reduce_init +#define MPI_Reduce_local_f08 PMPI_Reduce_local_f08 +#define MPI_Reduce_local PMPI_Reduce_local +#define MPI_Reduce PMPI_Reduce +#define MPI_Reduce_scatter_block_f08 PMPI_Reduce_scatter_block_f08 +#define MPI_Reduce_scatter_block_init_f08 PMPI_Reduce_scatter_block_init_f08 +#define MPI_Reduce_scatter_block_init PMPI_Reduce_scatter_block_init +#define MPI_Reduce_scatter_block PMPI_Reduce_scatter_block +#define MPI_Reduce_scatter_f08 PMPI_Reduce_scatter_f08 +#define MPI_Reduce_scatter_init_f08 PMPI_Reduce_scatter_init_f08 +#define MPI_Reduce_scatter_init PMPI_Reduce_scatter_init +#define MPI_Reduce_scatter PMPI_Reduce_scatter +#define MPI_Register_datarep_f08 PMPI_Register_datarep_f08 +#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 +#define MPI_Rget PMPI_Rget +#define MPI_Rput_f08 PMPI_Rput_f08 +#define MPI_Rput PMPI_Rput +#define MPI_Rsend_f08 PMPI_Rsend_f08 +#define MPI_Rsend_init_f08 PMPI_Rsend_init_f08 +#define MPI_Rsend_init PMPI_Rsend_init +#define MPI_Rsend PMPI_Rsend +#define MPI_Scan_f08 PMPI_Scan_f08 +#define MPI_Scan_init_f08 PMPI_Scan_init_f08 +#define MPI_Scan_init PMPI_Scan_init +#define MPI_Scan PMPI_Scan +#define MPI_Scatter_f08 PMPI_Scatter_f08 +#define MPI_Scatter_init_f08 PMPI_Scatter_init_f08 +#define MPI_Scatter_init PMPI_Scatter_init +#define MPI_Scatter PMPI_Scatter +#define MPI_Scatterv_f08 PMPI_Scatterv_f08 +#define MPI_Scatterv_init_f08 PMPI_Scatterv_init_f08 +#define MPI_Scatterv_init PMPI_Scatterv_init +#define MPI_Scatterv PMPI_Scatterv +#define MPI_Send_f08_c PMPI_Send_f08_c +#define MPI_Send_f08 PMPI_Send_f08 +#define MPI_Send_init_f08 PMPI_Send_init_f08 +#define MPI_Send_init PMPI_Send_init +#define MPI_Send PMPI_Send +#define MPI_Sendrecv_f08 PMPI_Sendrecv_f08 +#define MPI_Sendrecv PMPI_Sendrecv +#define MPI_Sendrecv_replace_f08 PMPI_Sendrecv_replace_f08 +#define MPI_Sendrecv_replace PMPI_Sendrecv_replace +#define MPI_Session_call_errhandler_f08 PMPI_Session_call_errhandler_f08 +#define MPI_Session_call_errhandler PMPI_Session_call_errhandler +#define MPI_Session_create_errhandler_f08 PMPI_Session_create_errhandler_f08 +#define MPI_Session_create_errhandler PMPI_Session_create_errhandler +#define MPI_Session_finalize_f08 PMPI_Session_finalize_f08 +#define MPI_Session_finalize PMPI_Session_finalize +#define MPI_Session_get_errhandler_f08 PMPI_Session_get_errhandler_f08 +#define MPI_Session_get_errhandler PMPI_Session_get_errhandler +#define MPI_Session_get_info_f08 PMPI_Session_get_info_f08 +#define MPI_Session_get_info PMPI_Session_get_info +#define MPI_Session_get_info PMPI_Session_get_info +#define MPI_Session_get_nth_pset_f08 PMPI_Session_get_nth_pset_f08 +#define MPI_Session_get_nth_psetlen_f08 PMPI_Session_get_nth_psetlen_f08 +#define MPI_Session_get_nth_psetlen PMPI_Session_get_nth_psetlen +#define MPI_Session_get_nth_pset PMPI_Session_get_nth_pset +#define MPI_Session_get_num_psets_f08 PMPI_Session_get_num_psets_f08 +#define MPI_Session_get_num_psets PMPI_Session_get_num_psets +#define MPI_Session_get_pset_info_f08 PMPI_Session_get_pset_info_f08 +#define MPI_Session_get_pset_info PMPI_Session_get_pset_info +#define MPI_Session_init_f08 PMPI_Session_init_f08 +#define MPI_Session_init PMPI_Session_init +#define MPI_Session_set_errhandler_f08 PMPI_Session_set_errhandler_f08 +#define MPI_Session_set_errhandler PMPI_Session_set_errhandler +#define MPI_Ssend_f08 PMPI_Ssend_f08 +#define MPI_Ssend_init_f08 PMPI_Ssend_init_f08 +#define MPI_Ssend_init PMPI_Ssend_init +#define MPI_Ssend PMPI_Ssend +#define MPI_Startall_f08 PMPI_Startall_f08 +#define MPI_Startall PMPI_Startall +#define MPI_Start_f08 PMPI_Start_f08 +#define MPI_Start PMPI_Start +#define MPI_Status_f082f_f08 PMPI_Status_f082f_f08 +#define MPI_Status_f082f PMPI_Status_f082f +#define MPI_Status_f2f08_f08 PMPI_Status_f2f08_f08 +#define MPI_Status_f2f08 PMPI_Status_f2f08 +#define MPI_Status_set_cancelled_f08 PMPI_Status_set_cancelled_f08 +#define MPI_Status_set_cancelled PMPI_Status_set_cancelled +#define MPI_Status_set_elements_f08 PMPI_Status_set_elements_f08 +#define MPI_Status_set_elements PMPI_Status_set_elements +#define MPI_Status_set_elements_x_f08 PMPI_Status_set_elements_x_f08 +#define MPI_Status_set_elements_x PMPI_Status_set_elements_x +#define MPI_Testall_f08 PMPI_Testall_f08 +#define MPI_Testall PMPI_Testall +#define MPI_Testany_f08 PMPI_Testany_f08 +#define MPI_Testany PMPI_Testany +#define MPI_Test_cancelled_f08 PMPI_Test_cancelled_f08 +#define MPI_Test_cancelled PMPI_Test_cancelled +#define MPI_Test_f08 PMPI_Test_f08 +#define MPI_Test PMPI_Test +#define MPI_Testsome_f08 PMPI_Testsome_f08 +#define MPI_Testsome PMPI_Testsome +#define MPI_Topo_test_f08 PMPI_Topo_test_f08 +#define MPI_Topo_test PMPI_Topo_test +#define MPI_Type_commit_f08 PMPI_Type_commit_f08 +#define MPI_Type_commit PMPI_Type_commit +#define MPI_Type_contiguous_f08 PMPI_Type_contiguous_f08 +#define MPI_Type_contiguous PMPI_Type_contiguous +#define MPI_Type_create_darray_f08 PMPI_Type_create_darray_f08 +#define MPI_Type_create_darray PMPI_Type_create_darray +#define MPI_Type_create_f90_complex_f08 PMPI_Type_create_f90_complex_f08 +#define MPI_Type_create_f90_complex PMPI_Type_create_f90_complex +#define MPI_Type_create_f90_integer_f08 PMPI_Type_create_f90_integer_f08 +#define MPI_Type_create_f90_integer PMPI_Type_create_f90_integer +#define MPI_Type_create_f90_real_f08 PMPI_Type_create_f90_real_f08 +#define MPI_Type_create_f90_real PMPI_Type_create_f90_real +#define MPI_Type_create_hindexed_block_f08 PMPI_Type_create_hindexed_block_f08 +#define MPI_Type_create_hindexed_block PMPI_Type_create_hindexed_block +#define MPI_Type_create_hindexed_f08 PMPI_Type_create_hindexed_f08 +#define MPI_Type_create_hindexed PMPI_Type_create_hindexed +#define MPI_Type_create_hvector_f08 PMPI_Type_create_hvector_f08 +#define MPI_Type_create_hvector PMPI_Type_create_hvector +#define MPI_Type_create_indexed_block_f08 PMPI_Type_create_indexed_block_f08 +#define MPI_Type_create_indexed_block PMPI_Type_create_indexed_block +#define MPI_Type_create_keyval_f08 PMPI_Type_create_keyval_f08 +#define MPI_Type_create_keyval PMPI_Type_create_keyval +#define MPI_Type_create_resized_f08 PMPI_Type_create_resized_f08 +#define MPI_Type_create_resized PMPI_Type_create_resized +#define MPI_Type_create_struct_f08 PMPI_Type_create_struct_f08 +#define MPI_Type_create_struct PMPI_Type_create_struct +#define MPI_Type_create_subarray_f08 PMPI_Type_create_subarray_f08 +#define MPI_Type_create_subarray PMPI_Type_create_subarray +#define MPI_Type_delete_attr_f08 PMPI_Type_delete_attr_f08 +#define MPI_Type_delete_attr PMPI_Type_delete_attr +#define MPI_Type_dup_f08 PMPI_Type_dup_f08 +#define MPI_Type_dup PMPI_Type_dup +#define MPI_Type_free_f08 PMPI_Type_free_f08 +#define MPI_Type_free_keyval_f08 PMPI_Type_free_keyval_f08 +#define MPI_Type_free_keyval PMPI_Type_free_keyval +#define MPI_Type_free PMPI_Type_free +#define MPI_Type_get_attr_f08 PMPI_Type_get_attr_f08 +#define MPI_Type_get_attr PMPI_Type_get_attr +#define MPI_Type_get_contents_f08_c PMPI_Type_get_contents_f08_c +#define MPI_Type_get_contents_f08 PMPI_Type_get_contents_f08 +#define MPI_Type_get_contents PMPI_Type_get_contents +#define MPI_Type_get_envelope_f08_c PMPI_Type_get_envelope_f08_c +#define MPI_Type_get_envelope_f08 PMPI_Type_get_envelope_f08 +#define MPI_Type_get_envelope PMPI_Type_get_envelope +#define MPI_Type_get_extent_f08 PMPI_Type_get_extent_f08 +#define MPI_Type_get_extent PMPI_Type_get_extent +#define MPI_Type_get_extent_x_f08 PMPI_Type_get_extent_x_f08 +#define MPI_Type_get_extent_x PMPI_Type_get_extent_x +#define MPI_Type_get_name_f08 PMPI_Type_get_name_f08 +#define MPI_Type_get_name PMPI_Type_get_name +#define MPI_Type_get_true_extent_f08 PMPI_Type_get_true_extent_f08 +#define MPI_Type_get_true_extent PMPI_Type_get_true_extent +#define MPI_Type_get_true_extent_x_f08 PMPI_Type_get_true_extent_x_f08 +#define MPI_Type_get_true_extent_x PMPI_Type_get_true_extent_x +#define MPI_Type_indexed_f08 PMPI_Type_indexed_f08 +#define MPI_Type_indexed PMPI_Type_indexed +#define MPI_Type_match_size_f08 PMPI_Type_match_size_f08 +#define MPI_Type_match_size PMPI_Type_match_size +#define MPI_Type_set_attr_f08 PMPI_Type_set_attr_f08 +#define MPI_Type_set_attr PMPI_Type_set_attr +#define MPI_Type_set_name_f08 PMPI_Type_set_name_f08 +#define MPI_Type_set_name PMPI_Type_set_name +#define MPI_Type_size_f08 PMPI_Type_size_f08 +#define MPI_Type_size PMPI_Type_size +#define MPI_Type_size_x_f08 PMPI_Type_size_x_f08 +#define MPI_Type_size_x PMPI_Type_size_x +#define MPI_Type_vector_f08 PMPI_Type_vector_f08 +#define MPI_Type_vector PMPI_Type_vector +#define MPI_Unpack_external_f08 PMPI_Unpack_external_f08 +#define MPI_Unpack_external PMPI_Unpack_external +#define MPI_Unpack_f08 PMPI_Unpack_f08 +#define MPI_Unpack PMPI_Unpack +#define MPI_Unpublish_name_f08 PMPI_Unpublish_name_f08 +#define MPI_Unpublish_name PMPI_Unpublish_name +#define MPI_Waitall_f08 PMPI_Waitall_f08 +#define MPI_Waitall PMPI_Waitall +#define MPI_Waitany_f08 PMPI_Waitany_f08 +#define MPI_Waitany PMPI_Waitany +#define MPI_Wait_f08 PMPI_Wait_f08 +#define MPI_Wait PMPI_Wait +#define MPI_Waitsome_f08 PMPI_Waitsome_f08 +#define MPI_Waitsome PMPI_Waitsome +#define MPI_Win_allocate_f08 PMPI_Win_allocate_f08 +#define MPI_Win_allocate PMPI_Win_allocate +#define MPI_Win_allocate_shared_f08 PMPI_Win_allocate_shared_f08 +#define MPI_Win_allocate_shared PMPI_Win_allocate_shared +#define MPI_Win_attach_f08 PMPI_Win_attach_f08 +#define MPI_Win_attach PMPI_Win_attach +#define MPI_Win_call_errhandler_f08 PMPI_Win_call_errhandler_f08 +#define MPI_Win_call_errhandler PMPI_Win_call_errhandler +#define MPI_Win_complete_f08 PMPI_Win_complete_f08 +#define MPI_Win_complete PMPI_Win_complete +#define MPI_Win_create_dynamic_f08 PMPI_Win_create_dynamic_f08 +#define MPI_Win_create_dynamic PMPI_Win_create_dynamic +#define MPI_Win_create_errhandler_f08 PMPI_Win_create_errhandler_f08 +#define MPI_Win_create_errhandler PMPI_Win_create_errhandler +#define MPI_Win_create_f08 PMPI_Win_create_f08 +#define MPI_Win_create_keyval_f08 PMPI_Win_create_keyval_f08 +#define MPI_Win_create_keyval PMPI_Win_create_keyval +#define MPI_Win_create PMPI_Win_create +#define MPI_Win_delete_attr_f08 PMPI_Win_delete_attr_f08 +#define MPI_Win_delete_attr PMPI_Win_delete_attr +#define MPI_Win_detach_f08 PMPI_Win_detach_f08 +#define MPI_Win_detach PMPI_Win_detach +#define MPI_Win_fence_f08 PMPI_Win_fence_f08 +#define MPI_Win_fence PMPI_Win_fence +#define MPI_Win_flush_all_f08 PMPI_Win_flush_all_f08 +#define MPI_Win_flush_all PMPI_Win_flush_all +#define MPI_Win_flush_f08 PMPI_Win_flush_f08 +#define MPI_Win_flush_local_all_f08 PMPI_Win_flush_local_all_f08 +#define MPI_Win_flush_local_all PMPI_Win_flush_local_all +#define MPI_Win_flush_local_f08 PMPI_Win_flush_local_f08 +#define MPI_Win_flush_local PMPI_Win_flush_local +#define MPI_Win_flush PMPI_Win_flush +#define MPI_Win_free_f08 PMPI_Win_free_f08 +#define MPI_Win_free_keyval_f08 PMPI_Win_free_keyval_f08 +#define MPI_Win_free_keyval PMPI_Win_free_keyval +#define MPI_Win_free PMPI_Win_free +#define MPI_Win_get_attr_f08 PMPI_Win_get_attr_f08 +#define MPI_Win_get_attr PMPI_Win_get_attr +#define MPI_Win_get_errhandler_f08 PMPI_Win_get_errhandler_f08 +#define MPI_Win_get_errhandler PMPI_Win_get_errhandler +#define MPI_Win_get_group_f08 PMPI_Win_get_group_f08 +#define MPI_Win_get_group PMPI_Win_get_group +#define MPI_Win_get_info_f08 PMPI_Win_get_info_f08 +#define MPI_Win_get_info PMPI_Win_get_info +#define MPI_Win_get_name_f08 PMPI_Win_get_name_f08 +#define MPI_Win_get_name PMPI_Win_get_name +#define MPI_Win_lock_all_f08 PMPI_Win_lock_all_f08 +#define MPI_Win_lock_all PMPI_Win_lock_all +#define MPI_Win_lock_f08 PMPI_Win_lock_f08 +#define MPI_Win_lock PMPI_Win_lock +#define MPI_Win_post_f08 PMPI_Win_post_f08 +#define MPI_Win_post PMPI_Win_post +#define MPI_Win_set_attr_f08 PMPI_Win_set_attr_f08 +#define MPI_Win_set_attr PMPI_Win_set_attr +#define MPI_Win_set_errhandler_f08 PMPI_Win_set_errhandler_f08 +#define MPI_Win_set_errhandler PMPI_Win_set_errhandler +#define MPI_Win_set_info_f08 PMPI_Win_set_info_f08 +#define MPI_Win_set_info PMPI_Win_set_info +#define MPI_Win_set_name_f08 PMPI_Win_set_name_f08 +#define MPI_Win_set_name PMPI_Win_set_name +#define MPI_Win_shared_query_f08 PMPI_Win_shared_query_f08 +#define MPI_Win_shared_query PMPI_Win_shared_query +#define MPI_Win_start_f08 PMPI_Win_start_f08 +#define MPI_Win_start PMPI_Win_start +#define MPI_Win_sync_f08 PMPI_Win_sync_f08 +#define MPI_Win_sync PMPI_Win_sync +#define MPI_Win_test_f08 PMPI_Win_test_f08 +#define MPI_Win_test PMPI_Win_test +#define MPI_Win_unlock_all_f08 PMPI_Win_unlock_all_f08 +#define MPI_Win_unlock_all PMPI_Win_unlock_all +#define MPI_Win_unlock_f08 PMPI_Win_unlock_f08 +#define MPI_Win_unlock PMPI_Win_unlock +#define MPI_Win_wait_f08 PMPI_Win_wait_f08 +#define MPI_Win_wait PMPI_Win_wait #endif diff --git a/ompi/mpi/fortran/use-mpi-f08/mrecv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/mrecv_f08.F90 deleted file mode 100644 index 3eb9651cb31..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/mrecv_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Mrecv_f08(buf,count,datatype,message,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Message, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_mrecv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Message), INTENT(INOUT) :: message - TYPE(MPI_Status) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_mrecv_f(buf,count,datatype%MPI_VAL,message%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Mrecv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in new file mode 100644 index 00000000000..eefce291914 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/mrecv_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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) 2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2012 Oracle and/or its affiliates. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID mrecv(BUFFER x, COUNT count, DATATYPE datatype, + MESSAGE_INOUT message, STATUS status) +{ + int c_ierr; + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_Message c_message = PMPI_Message_f2c(*message); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + + /* Call the C function */ + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, &c_message, + c_status); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) + /* message is an INOUT, and may be updated by the recv */ + *message = PMPI_Message_c2f(c_message); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_f08.F90 deleted file mode 100644 index 084ab11076b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_f08.F90 +++ /dev/null @@ -1,32 +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-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_allgather_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_neighbor_allgather_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_allgather_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_allgather_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_f08.F90 deleted file mode 100644 index 0137d7ef79b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_allgather_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_neighbor_allgather_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_allgather_init_f(sendbuf,sendcount,sendtype%MPI_VAL,& - recvbuf,recvcount,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_allgather_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_ts.c.in new file mode 100644 index 00000000000..652eac1b4c8 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_init_ts.c.in @@ -0,0 +1,82 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_allgather_init(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + MPI_Request c_request; + MPI_Info c_info; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_sendtype, + recvbuf, + c_recvcount, + c_recvtype, + c_comm, + c_info, + &c_request); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in new file mode 100644 index 00000000000..8c714580ac1 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgather_ts.c.in @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype __opal_attribute_unused__ c_senddatatype; + MPI_Datatype c_sendtype = PMPI_Type_f2c(*sendtype); + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + c_recvcount, + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_f08.F90 deleted file mode 100644 index 7335c3f8b39..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_f08.F90 +++ /dev/null @@ -1,34 +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-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_allgatherv_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_neighbor_allgatherv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_allgatherv_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_allgatherv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_f08.F90 deleted file mode 100644 index eebeaecfbae..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_allgatherv_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcounts,& - displs,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_neighbor_allgatherv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_allgatherv_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcounts,& - displs,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_allgatherv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_ts.c.in new file mode 100644 index 00000000000..1c74849f556 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_init_ts.c.in @@ -0,0 +1,92 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_allgatherv_init(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm, + INFO info, REQUEST_OUT request) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + MPI_Request c_request; + MPI_Info c_info; + int size, c_ierr, idx=0; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, + c_comm, + c_info, + &c_request); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(displs, tmp_displs, c_request, c_ierr, idx); + } else { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in new file mode 100644 index 00000000000..220c351dcb0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_allgatherv_ts.c.in @@ -0,0 +1,81 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_allgatherv(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, DISP_ARRAY displs, + DATATYPE recvtype, COMM comm) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype __opal_attribute_unused__ c_senddatatype; + MPI_Datatype c_sendtype = PMPI_Type_f2c(*sendtype); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype); + int size, c_ierr; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + c_sendcount, + c_senddatatype, + recvbuf, + tmp_recvcounts, + tmp_displs, + c_recvtype, c_comm); + + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_f08.F90 deleted file mode 100644 index 8bfb42dd83b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_f08.F90 +++ /dev/null @@ -1,33 +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-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoall_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoall_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoall_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_f08.F90 deleted file mode 100644 index a77283d4e78..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoall_init_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoall_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoall_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoall_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_ts.c.in new file mode 100644 index 00000000000..2120d1b5905 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_init_ts.c.in @@ -0,0 +1,73 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoall_init(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + MPI_Request c_request; + MPI_Info c_info; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + (@COUNT_TYPE@) *sendcount, + c_sendtype, + recvbuf, + (@COUNT_TYPE@) *recvcount, + c_recvtype, + c_comm, + c_info, + &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in new file mode 100644 index 00000000000..6af37a17826 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoall_ts.c.in @@ -0,0 +1,63 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoall(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, DATATYPE recvtype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + (@COUNT_TYPE@) *sendcount, + c_sendtype, + recvbuf, + (@COUNT_TYPE@) *recvcount, + c_recvtype, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_f08.F90 deleted file mode 100644 index 377ac5b6f1f..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_f08.F90 +++ /dev/null @@ -1,34 +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-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoallv_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoallv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoallv_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,& - comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoallv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_f08.F90 deleted file mode 100644 index 1ed7d8a502b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoallv_init_f08(sendbuf,sendcounts,sdispls,sendtype,recvbuf,& - recvcounts,rdispls,recvtype,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoallv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), sdispls(*), recvcounts(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoallv_init_f(sendbuf,sendcounts,sdispls,sendtype%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtype%MPI_VAL,& - comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoallv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_ts.c.in new file mode 100644 index 00000000000..c54f7cc9a70 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_init_ts.c.in @@ -0,0 +1,97 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoallv_init(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, + COMM comm, + INFO info, + REQUEST_OUT request) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + MPI_Info c_info; + MPI_Request c_request; + int size, c_ierr, idx = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, + c_comm, + c_info, + &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sendcounts, tmp_sendcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(rdispls, tmp_rdispls, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sdispls, tmp_sdispls, c_request, c_ierr, idx); + } else { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in new file mode 100644 index 00000000000..f33edb16b0d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallv_ts.c.in @@ -0,0 +1,80 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoallv(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls, + DATATYPE sendtype, BUFFER_OUT x2, COUNT_ARRAY recvcounts, + DISP_ARRAY rdispls, DATATYPE recvtype, + COMM comm) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_sendtype, c_recvtype; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_sdispls = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + @DISP_TYPE@ *tmp_rdispls = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_sendtype = PMPI_Type_f2c(*sendtype); + c_recvtype = PMPI_Type_f2c(*recvtype); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtype, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtype, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_f08.F90 deleted file mode 100644 index e0fd6a68b8e..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2013 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoallw_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoallw_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcounts(*), recvcounts(*) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: sdispls(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtypes(*) - TYPE(MPI_Datatype), INTENT(IN) :: recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoallw_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,& - comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoallw_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_f08.F90 deleted file mode 100644 index 6ab2219e1c8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2013 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Neighbor_alltoallw_init_f08(sendbuf,sendcounts,sdispls,sendtypes,& - recvbuf,recvcounts,rdispls,recvtypes,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_neighbor_alltoallw_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), recvcounts(*) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) OMPI_ASYNCHRONOUS :: sdispls(*), rdispls(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: sendtypes(*) - TYPE(MPI_Datatype), INTENT(IN) OMPI_ASYNCHRONOUS :: recvtypes(*) - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_neighbor_alltoallw_init_f(sendbuf,sendcounts,sdispls,sendtypes(1)%MPI_VAL,& - recvbuf,recvcounts,rdispls,recvtypes(1)%MPI_VAL,& - comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Neighbor_alltoallw_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_ts.c.in new file mode 100644 index 00000000000..be976f2015f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_init_ts.c.in @@ -0,0 +1,107 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * Copyright (c) 2004-2005 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-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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoallw_init(BUFFER x1, COUNT_ARRAY sendcounts, + AINT_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, + AINT_ARRAY rdispls, DATATYPE_ARRAY recvtypes, + COMM comm, + INFO info, + REQUEST_OUT request) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes, *c_recvtypes; + MPI_Request c_request; + MPI_Info c_info; + int size, c_ierr, idx = 0; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + MPI_Aint *tmp_sdispls = NULL, *tmp_rdispls; + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + PMPI_Comm_size(c_comm, &size); + + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size); + + /* Alltoallw does not support MPI_IN_PLACE */ + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + while (size > 0) { + c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]); + c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]); + --size; + } + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_sdispls, + c_sendtypes, + recvbuf, + tmp_recvcounts, + tmp_rdispls, + c_recvtypes, + c_comm, + c_info, + &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(recvcounts, tmp_recvcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sendcounts, tmp_sendcounts, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(rdispls, tmp_rdispls, c_request, c_ierr, idx); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP_NONBLOCKING(sdispls, tmp_sdispls, c_request, c_ierr, idx); + } else { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls); + } + + + free(c_sendtypes); + free(c_recvtypes); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in new file mode 100644 index 00000000000..e4dc0181dc7 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/neighbor_alltoallw_ts.c.in @@ -0,0 +1,84 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2013 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID neighbor_alltoallw(BUFFER x1, COUNT_ARRAY sendcounts, + AINT_ARRAY sdispls, DATATYPE_ARRAY sendtypes, + BUFFER_OUT x2, COUNT_ARRAY recvcounts, + AINT_ARRAY rdispls, DATATYPE_ARRAY recvtypes, + COMM comm) +{ + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype *c_sendtypes, *c_recvtypes; + int size, c_ierr; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @COUNT_TYPE@ *tmp_recvcounts = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + PMPI_Comm_size(c_comm, &size); + + c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype)); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + + while (size > 0) { + c_sendtypes[size - 1] = PMPI_Type_f2c(sendtypes[size - 1]); + c_recvtypes[size - 1] = PMPI_Type_f2c(recvtypes[size - 1]); + --size; + } + + /* Alltoallw does not support MPI_IN_PLACE */ + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + sdispls, + c_sendtypes, + recvbuf, + tmp_recvcounts, + rdispls, + c_recvtypes, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + free(c_sendtypes); + free(c_recvtypes); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90 deleted file mode 100644 index 9f4ae490051..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize, & - position,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_pack_external_f - implicit none - CHARACTER(LEN=*), INTENT(IN) :: datarep - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf - INTEGER, INTENT(IN) :: incount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize - INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_pack_external_f(datarep,inbuf,incount,datatype%MPI_VAL,outbuf, & - outsize,position,c_ierror,len(datarep)) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Pack_external_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_size.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_external_size.c.in new file mode 100644 index 00000000000..51126948951 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_external_size.c.in @@ -0,0 +1,34 @@ +/* + * 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) 2007-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID pack_external_size(CHAR_ARRAY datarep, COUNT incount, + DATATYPE datatype, AINT_COUNT_OUT size) +{ + int c_ierr; + MPI_Datatype type = PMPI_Type_f2c(*datatype); + + c_ierr = @INNER_CALL@(datarep, + OMPI_FINT_2_INT(*incount), + type, size); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_size_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_external_size_f08.F90 deleted file mode 100644 index 477487a617d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/pack_external_size_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Pack_external_size_f08(datarep,incount,datatype,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_pack_external_size_f - implicit none - CHARACTER(LEN=*), INTENT(IN) :: datarep - INTEGER, INTENT(IN) :: incount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_pack_external_size_f(datarep,incount,datatype%MPI_VAL,size,c_ierror,len(datarep)) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Pack_external_size_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in new file mode 100644 index 00000000000..fd8e77b47ac --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_external_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID pack_external(CHAR_ARRAY datarep, BUFFER x1, COUNT incount, + DATATYPE datatype, BUFFER x2, + COUNT outsize, AINT_COUNT_INOUT position) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *inbuf = OMPI_CFI_BASE_ADDR(x1); + char *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_incount = OMPI_FINT_2_INT(*incount); + + OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(datarep, OMPI_F2C_BOTTOM(inbuf), + c_incount, + c_datatype, outbuf, + *outsize, + position); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_f08.F90 deleted file mode 100644 index 5b0da89c213..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/pack_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_pack_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf - INTEGER, INTENT(IN) :: incount, outsize - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(INOUT) :: position - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_pack_f(inbuf,incount,datatype%MPI_VAL,outbuf,outsize, & - position,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Pack_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_size.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_size.c.in new file mode 100644 index 00000000000..3ae578502ae --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_size.c.in @@ -0,0 +1,43 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID pack_size(COUNT incount, DATATYPE datatype, + COMM comm, COUNT_OUT size) +{ + int c_ierr; + MPI_Comm c_comm; + MPI_Datatype c_type; + OMPI_SINGLE_NAME_DECL(size); + + c_comm = PMPI_Comm_f2c(*comm); + c_type = PMPI_Type_f2c(*datatype); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*incount), + c_type, c_comm, + OMPI_SINGLE_NAME_CONVERT(size)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(size); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_size_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_size_f08.F90 deleted file mode 100644 index 57c1f54dbbb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/pack_size_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Pack_size_f08(incount,datatype,comm,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_pack_size_f - implicit none - INTEGER, INTENT(IN) :: incount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_pack_size_f(incount,datatype%MPI_VAL,comm%MPI_VAL,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Pack_size_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in new file mode 100644 index 00000000000..885653f5eba --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/pack_ts.c.in @@ -0,0 +1,69 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID pack(BUFFER x1, COUNT incount, DATATYPE datatype, + BUFFER x2, COUNT outsize, COUNT_INOUT position, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + OMPI_SINGLE_NAME_DECL(position); + void *inbuf = OMPI_CFI_BASE_ADDR(x1); + char *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_incount = OMPI_FINT_2_INT(*incount); + int c_outsize = OMPI_FINT_2_INT(*outsize); + + OMPI_SINGLE_FINT_2_INT(position); + + OMPI_CFI_2_C(x1, c_incount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(inbuf), c_incount, + c_datatype, outbuf, + c_outsize, + OMPI_SINGLE_NAME_CONVERT(position), + c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(position); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/precv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/precv_init_f08.F90 deleted file mode 100644 index 94fae6fb892..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/precv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2020 Sandia National Laboratories. All rights reserved. -! Copyright (c) 2021 Bull S.A.S. All rights reserved. -! Copyright (c) 2023 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Precv_init_f08(buf,partitions,count,datatype,dest,tag,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request, MPI_COUNT_KIND - use :: ompi_mpifh_bindings, only : ompi_precv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: partitions, dest, tag - INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_precv_init_f(buf,partitions,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL, & - info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Precv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/precv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/precv_init_ts.c.in new file mode 100644 index 00000000000..53a5b30f526 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/precv_init_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2021 Bull S.A.S. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE void precv_init(BUFFER_OUT x, INT partitions, PARTITIONED_COUNT count, DATATYPE datatype, + RANK dest, TAG tag, COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Info c_info; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm; + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + c_info = PMPI_Info_f2c(*info); + c_comm = PMPI_Comm_f2c (*comm); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*partitions), + c_count, + c_type, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, c_info, &c_req); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am b/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am deleted file mode 100644 index 1002fdc70c4..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/Makefile.am +++ /dev/null @@ -1,481 +0,0 @@ - -# -*- makefile.am -*- -# -# Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana -# University Research and Technology -# Corporation. All rights reserved. -# Copyright (c) 2004-2013 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) 2009-2021 Cisco Systems, Inc. All rights reserved. -# Copyright (c) 2011 Sandia National Laboratories. All rights reserved. -# Copyright (c) 2012 Oak Ridge National Laboratory. All rights reserved. -# Copyright (c) 2012-2013 Inria. All rights reserved. -# Copyright (c) 2013 Los Alamos National Security, LLC. All rights -# reserved. -# Copyright (c) 2015-2021 Research Organization for Information Science -# and Technology (RIST). All rights reserved. -# Copyright (c) 2022 Triad National Security, LLC. All rights -# reserved. -# Copyright (c) 2024 Jeffrey M. Squyres. All rights reserved. -# $COPYRIGHT$ -# -# Additional copyrights may follow -# -# $HEADER$ -# - -include $(top_srcdir)/Makefile.ompi-rules - -# Note that Automake's Fortran-buidling rules uses CPPFLAGS and -# AM_CPPFLAGS. This can cause weirdness (e.g., -# https://github.com/open-mpi/ompi/issues/7253). Let's just zero -# those out and rely on AM_FCFLAGS. -CPPFLAGS = -AM_CPPFLAGS = - -# This Makefile is only relevant if we're building the "use mpi_f08" -# MPI bindings. -if OMPI_BUILD_FORTRAN_USEMPIF08_BINDINGS - -AM_FCFLAGS = -I$(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/mod \ - -I$(top_builddir)/ompi/include \ - -I$(top_srcdir)/ompi/include \ - $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/mpi/fortran/use-mpi \ - $(OMPI_FC_MODULE_FLAG)$(top_builddir)/ompi/mpi/fortran/use-mpi-ignore-tkr \ - $(OMPI_FC_MODULE_FLAG)../mod \ - $(OMPI_FC_MODULE_FLAG)../bindings \ - -I$(top_srcdir) -I$(top_builddir) $(FCFLAGS_f90) \ - -DOMPI_BUILD_MPI_PROFILING=1 - -CLEANFILES += *.i90 - -noinst_LTLIBRARIES = libmpi_usempif08_pmpi.la - -pmpi_api_files = \ - pabort_f08.F90 \ - paccumulate_f08.F90 \ - padd_error_class_f08.F90 \ - padd_error_code_f08.F90 \ - padd_error_string_f08.F90 \ - paint_add_f08.F90 \ - paint_diff_f08.F90 \ - pallgather_f08.F90 \ - pallgather_init_f08.F90 \ - pallgatherv_f08.F90 \ - pallgatherv_init_f08.F90 \ - palloc_mem_f08.F90 \ - pallreduce_f08.F90 \ - pallreduce_init_f08.F90 \ - palltoall_f08.F90 \ - palltoall_init_f08.F90 \ - palltoallv_f08.F90 \ - palltoallv_init_f08.F90 \ - palltoallw_f08.F90 \ - palltoallw_init_f08.F90 \ - pbarrier_f08.F90 \ - pbarrier_init_f08.F90 \ - pbcast_f08.F90 \ - pbcast_init_f08.F90 \ - pbsend_f08.F90 \ - pbsend_init_f08.F90 \ - pbuffer_attach_f08.F90 \ - pbuffer_detach_f08.F90 \ - pcancel_f08.F90 \ - pcart_coords_f08.F90 \ - pcart_create_f08.F90 \ - pcartdim_get_f08.F90 \ - pcart_get_f08.F90 \ - pcart_map_f08.F90 \ - pcart_rank_f08.F90 \ - pcart_shift_f08.F90 \ - pcart_sub_f08.F90 \ - pclose_port_f08.F90 \ - pcomm_accept_f08.F90 \ - pcomm_call_errhandler_f08.F90 \ - pcomm_compare_f08.F90 \ - pcomm_connect_f08.F90 \ - pcomm_create_from_group_f08.F90 \ - pcomm_create_errhandler_f08.F90 \ - pcomm_create_f08.F90 \ - pcomm_create_group_f08.F90 \ - pcomm_create_keyval_f08.F90 \ - pcomm_delete_attr_f08.F90 \ - pcomm_disconnect_f08.F90 \ - pcomm_dup_f08.F90 \ - pcomm_dup_with_info_f08.F90 \ - pcomm_idup_f08.F90 \ - pcomm_idup_with_info_f08.F90 \ - pcomm_free_f08.F90 \ - pcomm_free_keyval_f08.F90 \ - pcomm_get_attr_f08.F90 \ - pcomm_get_errhandler_f08.F90 \ - pcomm_get_info_f08.F90 \ - pcomm_get_name_f08.F90 \ - pcomm_get_parent_f08.F90 \ - pcomm_group_f08.F90 \ - pcomm_join_f08.F90 \ - pcomm_rank_f08.F90 \ - pcomm_remote_group_f08.F90 \ - pcomm_remote_size_f08.F90 \ - pcomm_set_attr_f08.F90 \ - pcomm_set_errhandler_f08.F90 \ - pcomm_set_info_f08.F90 \ - pcomm_set_name_f08.F90 \ - pcomm_size_f08.F90 \ - pcomm_spawn_f08.F90 \ - pcomm_spawn_multiple_f08.F90 \ - pcomm_split_f08.F90 \ - pcomm_split_type_f08.F90 \ - pcomm_test_inter_f08.F90 \ - pcompare_and_swap_f08.F90 \ - pdims_create_f08.F90 \ - pdist_graph_create_adjacent_f08.F90 \ - pdist_graph_create_f08.F90 \ - pdist_graph_neighbors_count_f08.F90 \ - pdist_graph_neighbors_f08.F90 \ - perrhandler_free_f08.F90 \ - perror_class_f08.F90 \ - perror_string_f08.F90 \ - pexscan_f08.F90 \ - pexscan_init_f08.F90 \ - pf_sync_reg_f08.F90 \ - pfetch_and_op_f08.F90 \ - pfile_call_errhandler_f08.F90 \ - pfile_close_f08.F90 \ - pfile_create_errhandler_f08.F90 \ - pfile_delete_f08.F90 \ - pfile_get_amode_f08.F90 \ - pfile_get_atomicity_f08.F90 \ - pfile_get_byte_offset_f08.F90 \ - pfile_get_errhandler_f08.F90 \ - pfile_get_group_f08.F90 \ - pfile_get_info_f08.F90 \ - pfile_get_position_f08.F90 \ - pfile_get_position_shared_f08.F90 \ - pfile_get_size_f08.F90 \ - pfile_get_type_extent_f08.F90 \ - pfile_get_view_f08.F90 \ - pfile_iread_at_f08.F90 \ - pfile_iread_f08.F90 \ - pfile_iread_at_all_f08.F90 \ - pfile_iread_all_f08.F90 \ - pfile_iread_shared_f08.F90 \ - pfile_iwrite_at_f08.F90 \ - pfile_iwrite_f08.F90 \ - pfile_iwrite_at_all_f08.F90 \ - pfile_iwrite_all_f08.F90 \ - pfile_iwrite_shared_f08.F90 \ - pfile_open_f08.F90 \ - pfile_preallocate_f08.F90 \ - pfile_read_all_begin_f08.F90 \ - pfile_read_all_end_f08.F90 \ - pfile_read_all_f08.F90 \ - pfile_read_at_all_begin_f08.F90 \ - pfile_read_at_all_end_f08.F90 \ - pfile_read_at_all_f08.F90 \ - pfile_read_at_f08.F90 \ - pfile_read_f08.F90 \ - pfile_read_ordered_begin_f08.F90 \ - pfile_read_ordered_end_f08.F90 \ - pfile_read_ordered_f08.F90 \ - pfile_read_shared_f08.F90 \ - pfile_seek_f08.F90 \ - pfile_seek_shared_f08.F90 \ - pfile_set_atomicity_f08.F90 \ - pfile_set_errhandler_f08.F90 \ - pfile_set_info_f08.F90 \ - pfile_set_size_f08.F90 \ - pfile_set_view_f08.F90 \ - pfile_sync_f08.F90 \ - pfile_write_all_begin_f08.F90 \ - pfile_write_all_end_f08.F90 \ - pfile_write_all_f08.F90 \ - pfile_write_at_all_begin_f08.F90 \ - pfile_write_at_all_end_f08.F90 \ - pfile_write_at_all_f08.F90 \ - pfile_write_at_f08.F90 \ - pfile_write_f08.F90 \ - pfile_write_ordered_begin_f08.F90 \ - pfile_write_ordered_end_f08.F90 \ - pfile_write_ordered_f08.F90 \ - pfile_write_shared_f08.F90 \ - pfinalized_f08.F90 \ - pfinalize_f08.F90 \ - pfree_mem_f08.F90 \ - pgather_f08.F90 \ - pgather_init_f08.F90 \ - pgatherv_f08.F90 \ - pgatherv_init_f08.F90 \ - pget_accumulate_f08.F90 \ - pget_address_f08.F90 \ - pget_count_f08.F90 \ - pget_elements_f08.F90 \ - pget_elements_x_f08.F90 \ - pget_f08.F90 \ - pget_library_version_f08.F90 \ - pget_processor_name_f08.F90 \ - pget_version_f08.F90 \ - pgraph_create_f08.F90 \ - pgraphdims_get_f08.F90 \ - pgraph_get_f08.F90 \ - pgraph_map_f08.F90 \ - pgraph_neighbors_count_f08.F90 \ - pgraph_neighbors_f08.F90 \ - pgrequest_complete_f08.F90 \ - pgrequest_start_f08.F90 \ - pgroup_compare_f08.F90 \ - pgroup_difference_f08.F90 \ - pgroup_excl_f08.F90 \ - pgroup_free_f08.F90 \ - pgroup_from_session_pset_f08.F90 \ - pgroup_incl_f08.F90 \ - pgroup_intersection_f08.F90 \ - pgroup_range_excl_f08.F90 \ - pgroup_range_incl_f08.F90 \ - pgroup_rank_f08.F90 \ - pgroup_size_f08.F90 \ - pgroup_translate_ranks_f08.F90 \ - pgroup_union_f08.F90 \ - piallgather_f08.F90 \ - piallgatherv_f08.F90 \ - piallreduce_f08.F90 \ - pialltoall_f08.F90 \ - pialltoallv_f08.F90 \ - pialltoallw_f08.F90 \ - pibarrier_f08.F90 \ - pibcast_f08.F90 \ - pibsend_f08.F90 \ - pigather_f08.F90 \ - pigatherv_f08.F90 \ - piexscan_f08.F90 \ - pimprobe_f08.F90 \ - pimrecv_f08.F90 \ - pineighbor_allgather_f08.F90 \ - pineighbor_allgatherv_f08.F90 \ - pineighbor_alltoall_f08.F90 \ - pineighbor_alltoallv_f08.F90 \ - pineighbor_alltoallw_f08.F90 \ - pinfo_create_f08.F90 \ - pinfo_create_env_f08.F90 \ - pinfo_delete_f08.F90 \ - pinfo_dup_f08.F90 \ - pinfo_free_f08.F90 \ - pinfo_get_f08.F90 \ - pinfo_get_nkeys_f08.F90 \ - pinfo_get_nthkey_f08.F90 \ - pinfo_get_string_f08.F90 \ - pinfo_get_valuelen_f08.F90 \ - pinfo_set_f08.F90 \ - pinit_f08.F90 \ - pinitialized_f08.F90 \ - pinit_thread_f08.F90 \ - pintercomm_create_f08.F90 \ - pintercomm_create_from_groups_f08.F90 \ - pintercomm_merge_f08.F90 \ - piprobe_f08.F90 \ - pirecv_f08.F90 \ - pireduce_f08.F90 \ - pireduce_scatter_f08.F90 \ - pireduce_scatter_block_f08.F90 \ - pirsend_f08.F90 \ - piscan_f08.F90 \ - piscatter_f08.F90 \ - piscatterv_f08.F90 \ - pisend_f08.F90 \ - pisendrecv_f08.F90 \ - pisendrecv_replace_f08.F90 \ - pissend_f08.F90 \ - pis_thread_main_f08.F90 \ - plookup_name_f08.F90 \ - pmprobe_f08.F90 \ - pmrecv_f08.F90 \ - pneighbor_allgather_f08.F90 \ - pneighbor_allgather_init_f08.F90 \ - pneighbor_allgatherv_f08.F90 \ - pneighbor_allgatherv_init_f08.F90 \ - pneighbor_alltoall_f08.F90 \ - pneighbor_alltoall_init_f08.F90 \ - pneighbor_alltoallv_f08.F90 \ - pneighbor_alltoallv_init_f08.F90 \ - pneighbor_alltoallw_f08.F90 \ - pneighbor_alltoallw_init_f08.F90 \ - pop_commutative_f08.F90 \ - pop_create_f08.F90 \ - popen_port_f08.F90 \ - pop_free_f08.F90 \ - ppack_external_f08.F90 \ - ppack_external_size_f08.F90 \ - ppack_f08.F90 \ - ppack_size_f08.F90 \ - pparrived_f08.F90 \ - ppcontrol_f08.F90 \ - ppready_f08.F90 \ - ppready_list_f08.F90 \ - ppready_range_f08.F90 \ - pprobe_f08.F90 \ - ppsend_init_f08.F90 \ - ppublish_name_f08.F90 \ - pput_f08.F90 \ - pquery_thread_f08.F90 \ - praccumulate_f08.F90 \ - precv_f08.F90 \ - precv_init_f08.F90 \ - preduce_f08.F90 \ - preduce_init_f08.F90 \ - preduce_local_f08.F90 \ - preduce_scatter_f08.F90 \ - preduce_scatter_init_f08.F90 \ - preduce_scatter_block_f08.F90 \ - preduce_scatter_block_init_f08.F90 \ - pregister_datarep_f08.F90 \ - prequest_free_f08.F90 \ - prequest_get_status_f08.F90 \ - prget_f08.F90 \ - prget_accumulate_f08.F90 \ - prput_f08.F90 \ - prsend_f08.F90 \ - prsend_init_f08.F90 \ - pscan_f08.F90 \ - pscan_init_f08.F90 \ - pscatter_f08.F90 \ - pscatter_init_f08.F90 \ - pscatterv_f08.F90 \ - pscatterv_init_f08.F90 \ - psend_f08.F90 \ - psend_init_f08.F90 \ - psendrecv_f08.F90 \ - psendrecv_replace_f08.F90 \ - psession_call_errhandler_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 \ - pstart_f08.F90 \ - pstatus_f082f_f08.F90 \ - pstatus_f2f08_f08.F90 \ - pstatus_set_cancelled_f08.F90 \ - pstatus_set_elements_f08.F90 \ - pstatus_set_elements_x_f08.F90 \ - ptestall_f08.F90 \ - ptestany_f08.F90 \ - ptest_cancelled_f08.F90 \ - ptest_f08.F90 \ - ptestsome_f08.F90 \ - ptopo_test_f08.F90 \ - ptype_commit_f08.F90 \ - ptype_contiguous_f08.F90 \ - ptype_create_darray_f08.F90 \ - ptype_create_f90_complex_f08.F90 \ - ptype_create_f90_integer_f08.F90 \ - ptype_create_f90_real_f08.F90 \ - ptype_create_hindexed_f08.F90 \ - ptype_create_hvector_f08.F90 \ - ptype_create_indexed_block_f08.F90 \ - ptype_create_hindexed_block_f08.F90 \ - ptype_create_keyval_f08.F90 \ - ptype_create_resized_f08.F90 \ - ptype_create_struct_f08.F90 \ - ptype_create_subarray_f08.F90 \ - ptype_delete_attr_f08.F90 \ - ptype_dup_f08.F90 \ - ptype_free_f08.F90 \ - ptype_free_keyval_f08.F90 \ - ptype_get_attr_f08.F90 \ - ptype_get_contents_f08.F90 \ - ptype_get_envelope_f08.F90 \ - ptype_get_extent_f08.F90 \ - ptype_get_extent_x_f08.F90 \ - ptype_get_name_f08.F90 \ - ptype_get_true_extent_f08.F90 \ - ptype_get_true_extent_x_f08.F90 \ - ptype_indexed_f08.F90 \ - ptype_match_size_f08.F90 \ - ptype_set_attr_f08.F90 \ - ptype_set_name_f08.F90 \ - ptype_size_f08.F90 \ - ptype_size_x_f08.F90 \ - ptype_vector_f08.F90 \ - punpack_external_f08.F90 \ - punpack_f08.F90 \ - punpublish_name_f08.F90 \ - pwaitall_f08.F90 \ - pwaitany_f08.F90 \ - pwait_f08.F90 \ - pwaitsome_f08.F90 \ - pwin_allocate_f08.F90 \ - pwin_allocate_shared_f08.F90 \ - pwin_attach_f08.F90 \ - pwin_call_errhandler_f08.F90 \ - pwin_complete_f08.F90 \ - pwin_create_dynamic_f08.F90 \ - pwin_create_errhandler_f08.F90 \ - pwin_create_f08.F90 \ - pwin_create_keyval_f08.F90 \ - pwin_delete_attr_f08.F90 \ - pwin_detach_f08.F90 \ - pwin_fence_f08.F90 \ - pwin_flush_f08.F90 \ - pwin_flush_all_f08.F90 \ - pwin_flush_local_f08.F90 \ - pwin_flush_local_all_f08.F90 \ - pwin_free_f08.F90 \ - pwin_free_keyval_f08.F90 \ - pwin_get_attr_f08.F90 \ - pwin_get_errhandler_f08.F90 \ - pwin_get_group_f08.F90 \ - pwin_get_info_f08.F90 \ - pwin_get_name_f08.F90 \ - pwin_lock_f08.F90 \ - pwin_lock_all_f08.F90 \ - pwin_post_f08.F90 \ - pwin_set_attr_f08.F90 \ - pwin_set_errhandler_f08.F90 \ - pwin_set_info_f08.F90 \ - pwin_set_name_f08.F90 \ - pwin_shared_query_f08.F90 \ - pwin_start_f08.F90 \ - pwin_sync_f08.F90 \ - pwin_test_f08.F90 \ - pwin_unlock_f08.F90 \ - pwin_unlock_all_f08.F90 \ - pwin_wait_f08.F90 - -# -# Automake doesn't do Fortran dependency analysis, so must list them -# manually here. Bummer! -# - -pmpi_api_lo_files = $(pmpi_api_files:.F90=.lo) - -$(pmpi_api_lo_files): ../bindings/libforce_usempif08_internal_bindings_to_be_built.la - -nodist_libmpi_usempif08_pmpi_la_SOURCES = \ - $(pmpi_api_files) - -# -# Sym link in the sources from the real MPI directory -# -$(nodist_libmpi_usempif08_pmpi_la_SOURCES): - $(OMPI_V_LN_S) if test ! -r $@ ; then \ - pname=`echo $@ | cut -b '2-'` ; \ - $(LN_S) $(top_srcdir)/ompi/mpi/fortran/use-mpi-f08/$$pname $@ ; \ - fi - -# These files were created by targets above - -MAINTAINERCLEANFILES = $(nodist_libmpi_usempif08_pmpi_la_SOURCES) - -endif diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 deleted file mode 100644 index 84098a44dc2..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pcomm_create_from_group_f08.F90 +++ /dev/null @@ -1,29 +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_Comm_create_from_group_f08(group, stringtag, info, errhandler, newcomm, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Group, MPI_Errhandler, MPI_Info, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_comm_create_from_group_f - implicit none - TYPE(MPI_Group), INTENT(IN) :: group - CHARACTER(LEN=*), INTENT(IN) :: stringtag - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Errhandler), INTENT(IN) :: errhandler - TYPE(MPI_Comm), INTENT(OUT) :: newcomm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_comm_create_from_group_f(group%MPI_VAL, stringtag, info%MPI_VAL, errhandler%MPI_VAL, & - newcomm%MPI_VAL, c_ierror, len(stringtag)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Comm_create_from_group_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 deleted file mode 100644 index a719b361302..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pgroup_from_session_pset_f08.F90 +++ /dev/null @@ -1,29 +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-2021 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" -#include "mpi-f08-rename.h" - -subroutine PMPI_Group_from_session_pset_f08(session, pset_name, newgroup, ierror) - use :: mpi_f08_types, only : MPI_Session, MPI_Group - use :: ompi_mpifh_bindings, only : ompi_group_from_session_pset_f - implicit none - TYPE(MPI_Session), INTENT(IN) :: session - CHARACTER(LEN=*), INTENT(IN) :: pset_name - TYPE(MPI_Group), INTENT(OUT) :: newgroup - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_group_from_session_pset_f(session%MPI_VAL, pset_name, newgroup%MPI_VAL, c_ierror, len(pset_name)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Group_from_session_pset_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 deleted file mode 100644 index 668188d1adb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/pintercomm_create_from_groups_f08.F90 +++ /dev/null @@ -1,35 +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_Intercomm_create_from_groups_f08(local_group, local_leader, remote_group, & - remote_leader, stringtag, info, errhandler, & - newintercomm, ierror) - use :: mpi_f08_types, only : MPI_Comm, MPI_Group, MPI_Errhandler, MPI_Info - use :: ompi_mpifh_bindings, only : ompi_intercomm_create_from_groups_f - implicit none - TYPE(MPI_Group), INTENT(IN) :: local_group, remote_group - INTEGER, INTENT(IN):: local_leader, remote_leader - CHARACTER(LEN=*), INTENT(IN) :: stringtag - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Errhandler), INTENT(IN) :: errhandler - TYPE(MPI_Comm), INTENT(OUT) :: newintercomm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_intercomm_create_from_groups_f(local_group%MPI_VAL, local_leader, & - remote_group%MPI_VAL, & - remote_leader, stringtag, info%MPI_VAL, & - errhandler%MPI_VAL, & - newintercomm%MPI_VAL, c_ierror, len(stringtag)) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Intercomm_create_from_groups_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 deleted file mode 100644 index 01316dd79ca..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/profile/psession_finalize_f08.F90 +++ /dev/null @@ -1,24 +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_finalize_f08(session,ierror) - use :: mpi_f08_types, only : MPI_Session - use :: ompi_mpifh_bindings, only : ompi_session_finalize_f - implicit none - TYPE(MPI_Session), INTENT(OUT) :: session - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_session_finalize_f(session%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine PMPI_Session_finalize_f08 - diff --git a/ompi/mpi/fortran/use-mpi-f08/psend_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/psend_init_f08.F90 deleted file mode 100644 index b0ce80ddd48..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/psend_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2020 Sandia National Laboratories. All rights reserved. -! Copyright (c) 2021 Bull S.A.S. All rights reserved. -! Copyright (c) 2023 Triad National Security, LLC. All rights -! reserved. -! $COPYRIGHT$ - -#include "mpi-f08-rename.h" -#include "ompi/mpi/fortran/configure-fortran-output.h" - -subroutine MPI_Psend_init_f08(buf,partitions,count,datatype,dest,tag,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request, MPI_COUNT_KIND - use :: ompi_mpifh_bindings, only : ompi_psend_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: partitions, dest, tag - INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_psend_init_f(buf,partitions,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL, & - info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Psend_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/psend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/psend_init_ts.c.in new file mode 100644 index 00000000000..9d7ad29b22c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/psend_init_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2020 Sandia National Laboratories. All rights reserved. + * Copyright (c) 2021 Bull S.A.S. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID psend_init(BUFFER_ASYNC x, INT partitions, PARTITIONED_COUNT count, DATATYPE datatype, + RANK dest, TAG tag, COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Info c_info; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm; + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + c_info = PMPI_Info_f2c(*info); + c_comm = PMPI_Comm_f2c (*comm); + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), + OMPI_FINT_2_INT(*partitions), + c_count, + c_type, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, c_info, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/put_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/put_f08.F90 deleted file mode 100644 index b58e4d88623..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/put_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Put_f08(origin_addr,origin_count,origin_datatype,target_rank,& - target_disp,target_count,target_datatype,win,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_put_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_put_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Put_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in new file mode 100644 index 00000000000..6643aaf3cee --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/put_ts.c.in @@ -0,0 +1,53 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID put(BUFFER x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@)*origin_count; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + (@COUNT_TYPE@) *target_count, + c_target_datatype, c_win); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/raccumulate_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/raccumulate_f08.F90 deleted file mode 100644 index 1935be341d4..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/raccumulate_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Raccumulate_f08(origin_addr,origin_count,origin_datatype,& - target_rank,target_disp,target_count, & - target_datatype,op,win,request, ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_raccumulate_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_raccumulate_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,& - op%MPI_VAL,win%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Raccumulate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in new file mode 100644 index 00000000000..d35c47f4225 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/raccumulate_ts.c.in @@ -0,0 +1,66 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID raccumulate(BUFFER x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, OP op, WIN win, + REQUEST_OUT request) +{ + int c_ierr; + + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + MPI_Request c_req; + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + (@COUNT_TYPE@) *target_count, + c_target_datatype, c_op, c_win, + &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 deleted file mode 100644 index 034fe0fdc19..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/recv_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Recv_f08(buf,count,datatype,source,tag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_recv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_recv_f(buf,count,datatype%MPI_VAL,source,tag,comm%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Recv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/recv_init_f08.F90 deleted file mode 100644 index 5207511c281..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/recv_init_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Recv_init_f08(buf,count,datatype,source,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_recv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: buf - INTEGER, INTENT(IN) :: count, source, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_recv_init_f(buf,count,datatype%MPI_VAL,source,tag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Recv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in new file mode 100644 index 00000000000..d5653252687 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/recv_init_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID recv_init(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, + RANK source, TAG tag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_INT_2_FINT(*tag), c_comm, + &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in new file mode 100644 index 00000000000..5cada770821 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/recv_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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) 2012 Oracle and/or its affiliates. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID recv(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK source, TAG tag, COMM comm, STATUS_OUT status) +{ + OMPI_FORTRAN_STATUS_DECLARATION(c_status,c_status2) + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + int c_ierr; + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_FORTRAN_STATUS_SET_POINTER(c_status,c_status2,status) + + /* Call the C function */ + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*tag), c_comm, + c_status); + + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_STATUS_RETURN(c_status,c_status2,status,c_ierr) +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 deleted file mode 100644 index 1f9baea4005..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_f08(sendbuf,recvbuf,count,datatype,op,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_reduce_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_init_f08.F90 deleted file mode 100644 index 00dbda4965f..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_init_f08(sendbuf,recvbuf,count,datatype,op,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_reduce_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count, root - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_init_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_init_ts.c.in new file mode 100644 index 00000000000..90a4c2b3077 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_init_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_init(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, + RANK root, COMM comm, + INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Request c_request; + MPI_Info c_info; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + OMPI_FINT_2_INT(*root), + c_comm, + c_info, + &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_local_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_local_f08.F90 deleted file mode 100644 index ad9c10106b0..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_local_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_local_f08(inbuf,inoutbuf,count,datatype,op,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op - use :: ompi_mpifh_bindings, only : ompi_reduce_local_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: inoutbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_local_f(inbuf,inoutbuf,count,datatype%MPI_VAL,op%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_local_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in new file mode 100644 index 00000000000..622c48182e3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_local_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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) 2009-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_local(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Op c_op; + char *inbuf = OMPI_CFI_BASE_ADDR(x1), *inoutbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + inbuf = (char *) OMPI_F2C_BOTTOM(inbuf); + inoutbuf = (char *) OMPI_F2C_BOTTOM(inoutbuf); + + c_ierr = @INNER_CALL@(inbuf, inoutbuf, + (@COUNT_TYPE@) *count, + c_type, c_op); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_f08.F90 deleted file mode 100644 index 6bd4b38bbce..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_scatter_block_f08(sendbuf,recvbuf,recvcount,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_reduce_scatter_block_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_scatter_block_f(sendbuf,recvbuf,recvcount,& - datatype%MPI_VAL,op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_scatter_block_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_f08.F90 deleted file mode 100644 index 460f2a158c2..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_scatter_block_init_f08(sendbuf,recvbuf,recvcount,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_reduce_scatter_block_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_scatter_block_init_f(sendbuf,recvbuf,recvcount,& - datatype%MPI_VAL,op%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_scatter_block_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_ts.c.in new file mode 100644 index 00000000000..bfcd4c82512 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_init_ts.c.in @@ -0,0 +1,70 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_scatter_block_init(BUFFER x1, BUFFER_OUT x2, + COUNT recvcount, DATATYPE datatype, + OP op, COMM comm, INFO info, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Info c_info; + MPI_Request c_request; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *recvcount, + c_type, c_op, c_comm, + c_info, &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in new file mode 100644 index 00000000000..443da88c593 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_block_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_scatter_block(BUFFER x1, BUFFER_OUT x2, + COUNT recvcount, DATATYPE datatype, + OP op, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *recvcount, + c_type, c_op, c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_f08.F90 deleted file mode 100644 index a8587ea033b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_scatter_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_reduce_scatter_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_scatter_f(sendbuf,recvbuf,recvcounts,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_scatter_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_f08.F90 deleted file mode 100644 index e7531662b47..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Reduce_scatter_init_f08(sendbuf,recvbuf,recvcounts,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_reduce_scatter_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: recvcounts(*) - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_reduce_scatter_init_f(sendbuf,recvbuf,recvcounts,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Reduce_scatter_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_ts.c.in new file mode 100644 index 00000000000..dd091ce89a9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_init_ts.c.in @@ -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) 2011-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_scatter_init(BUFFER x1, BUFFER_OUT x2, + COUNT_ARRAY recvcounts, DATATYPE datatype, + OP op, COMM comm, INFO info, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Request c_request; + MPI_Info c_info; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_recvcounts = NULL; + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, + recvbuf, + tmp_recvcounts, + c_type, + c_op, + c_comm, + c_info, + &c_request); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + if ((recvcounts != NULL) && (recvcounts != tmp_recvcounts)) { + ompi_coll_base_nbc_request_t* nb_request = (ompi_coll_base_nbc_request_t*)c_request; + nb_request->data.release_arrays[0] = tmp_recvcounts; + nb_request->data.release_arrays[1] = NULL; + } + } else { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in new file mode 100644 index 00000000000..3203c959999 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_scatter_ts.c.in @@ -0,0 +1,64 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce_scatter(BUFFER x1, BUFFER_OUT x2, + COUNT_ARRAY recvcounts, DATATYPE datatype, + OP op, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + int size; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ *tmp_recvcounts = NULL; + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + PMPI_Comm_size(c_comm, &size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + tmp_recvcounts, + c_type, c_op, c_comm); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in new file mode 100644 index 00000000000..85a6d614213 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/reduce_ts.c.in @@ -0,0 +1,60 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID reduce(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, + RANK root, COMM comm) +{ + int c_ierr; + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + OMPI_FINT_2_INT(*count), + c_type, c_op, + OMPI_FINT_2_INT(*root), + c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_f08.F90 deleted file mode 100644 index f442abf2358..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_f08.F90 +++ /dev/null @@ -1,40 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Rget_accumulate_f08(origin_addr,origin_count,origin_datatype,& - result_addr,result_count,result_datatype,& - target_rank,target_disp,target_count, & - target_datatype,op,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_rget_accumulate_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, result_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: result_addr - TYPE(MPI_Datatype), INTENT(IN) :: result_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_rget_accumulate_f(origin_addr,origin_count,origin_datatype%MPI_VAL,& - result_addr,result_count,result_datatype%MPI_VAL,& - target_rank,target_disp,target_count,target_datatype%MPI_VAL,& - op%MPI_VAL,win%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Rget_accumulate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in new file mode 100644 index 00000000000..3e257c2cbe3 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rget_accumulate_ts.c.in @@ -0,0 +1,83 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2015 FUJITSU LIMITED. All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID rget_accumulate(BUFFER_ASYNC x1, COUNT origin_count, + DATATYPE origin_datatype, BUFFER_ASYNC_OUT x2, + COUNT result_count, DATATYPE result_datatype, + RANK target_rank, AINT target_disp, + COUNT target_count, DATATYPE target_datatype, + OP op, WIN win, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_result_datatype, c_result_type = PMPI_Type_f2c(*result_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + MPI_Op c_op = PMPI_Op_f2c(*op); + char *origin_addr = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + char *result_addr = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_result_count = (@COUNT_TYPE@) *result_count; + MPI_Request c_req; + + OMPI_CFI_2_C(x1, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_2_C(x2, c_result_count, c_result_type, c_result_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_F2C_BOTTOM(result_addr), + c_result_count, + c_result_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + (@COUNT_TYPE@) *target_count, + c_target_datatype, c_op, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (c_result_datatype != c_result_type) { + ompi_datatype_destroy(&c_result_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/rget_f08.F90 deleted file mode 100644 index 5e419fa8bfb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/rget_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Rget_f08(origin_addr,origin_count,origin_datatype,target_rank,& - target_disp,target_count,target_datatype,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_Request, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_rget_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_rget_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,win%MPI_VAL,& - request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Rget_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in new file mode 100644 index 00000000000..b2c55cc298b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rget_ts.c.in @@ -0,0 +1,61 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. All rights + * reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID rget(BUFFER_ASYNC_OUT x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + MPI_Request c_req; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + (@COUNT_TYPE@) *target_count, + c_target_datatype, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rput_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/rput_f08.F90 deleted file mode 100644 index efbca357754..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/rput_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2010-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2014 Los Alamos National Security, LLC. -! All Rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Rput_f08(origin_addr,origin_count,origin_datatype,target_rank,& - target_disp,target_count,target_datatype,win,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_Request, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_rput_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: origin_addr - INTEGER, INTENT(IN) :: origin_count, target_rank, target_count - TYPE(MPI_Datatype), INTENT(IN) :: origin_datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: target_disp - TYPE(MPI_Datatype), INTENT(IN) :: target_datatype - TYPE(MPI_Win), INTENT(IN) :: win - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_rput_f(origin_addr,origin_count,origin_datatype%MPI_VAL,target_rank,& - target_disp,target_count,target_datatype%MPI_VAL,win%MPI_VAL,& - request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Rput_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in new file mode 100644 index 00000000000..bd3edbd2e33 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rput_ts.c.in @@ -0,0 +1,61 @@ +/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil -*- */ +/* + * 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) 2014-2016 Los Alamos National Security, LLC. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID rput(BUFFER_ASYNC x, COUNT origin_count, + DATATYPE origin_datatype, RANK target_rank, + AINT target_disp, COUNT target_count, + DATATYPE target_datatype, WIN win, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_origin_datatype, c_origin_type = PMPI_Type_f2c(*origin_datatype); + MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype); + MPI_Win c_win = PMPI_Win_f2c(*win); + char *origin_addr = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_origin_count = (@COUNT_TYPE@) *origin_count; + MPI_Request c_req; + + OMPI_CFI_2_C(x, c_origin_count, c_origin_type, c_origin_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(origin_addr), + c_origin_count, + c_origin_datatype, + OMPI_FINT_2_INT(*target_rank), + *target_disp, + (@COUNT_TYPE@) *target_count, + c_target_datatype, c_win, &c_req); + if (c_origin_datatype != c_origin_type) { + ompi_datatype_destroy(&c_origin_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/rsend_f08.F90 deleted file mode 100644 index e00ebee63e9..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/rsend_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Rsend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_rsend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_rsend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Rsend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/rsend_init_f08.F90 deleted file mode 100644 index 28a3e8a6d31..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/rsend_init_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Rsend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_rsend_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_rsend_init_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Rsend_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in new file mode 100644 index 00000000000..7c4948edac7 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rsend_init_ts.c.in @@ -0,0 +1,56 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID rsend_init(BUFFER_ASYNC x, COUNT count, + DATATYPE datatype, RANK dest, + TAG tag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in new file mode 100644 index 00000000000..b46fbd78715 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in @@ -0,0 +1,48 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID rsend(BUFFER x, COUNT count, DATATYPE datatype, + RANK dest, TAG tag, COMM comm) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scan_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scan_f08.F90 deleted file mode 100644 index 78a09fa6dad..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scan_f08.F90 +++ /dev/null @@ -1,31 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scan_f08(sendbuf,recvbuf,count,datatype,op,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_scan_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scan_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scan_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scan_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scan_init_f08.F90 deleted file mode 100644 index 0b7fe3b993d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scan_init_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scan_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_scan_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Op), INTENT(IN) :: op - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scan_init_f(sendbuf,recvbuf,count,datatype%MPI_VAL,& - op%MPI_VAL,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scan_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scan_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scan_init_ts.c.in new file mode 100644 index 00000000000..7ed6a8c07d8 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scan_init_ts.c.in @@ -0,0 +1,69 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scan_init(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm, + INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + MPI_Info c_info; + MPI_Request c_request; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + c_info = PMPI_Info_f2c(*info); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, + c_comm, + c_info, + &c_request); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in new file mode 100644 index 00000000000..c7fcba1411f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in @@ -0,0 +1,58 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scan(BUFFER x1, BUFFER_OUT x2, COUNT count, + DATATYPE datatype, OP op, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_type; + MPI_Op c_op; + char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + + c_type = PMPI_Type_f2c(*datatype); + c_op = PMPI_Op_f2c(*op); + + sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf); + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf, recvbuf, + (@COUNT_TYPE@) *count, + c_type, c_op, + c_comm); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatter_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scatter_f08.F90 deleted file mode 100644 index 26ee9507e6f..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scatter_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scatter_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_scatter_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scatter_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcount,& - recvtype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scatter_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scatter_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scatter_init_f08.F90 deleted file mode 100644 index e892d27dea8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scatter_init_f08.F90 +++ /dev/null @@ -1,35 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scatter_init_f08(sendbuf,sendcount,sendtype,recvbuf,& - recvcount,recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_scatter_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: sendcount, recvcount, root - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scatter_init_f(sendbuf,sendcount,sendtype%MPI_VAL,recvbuf,recvcount,& - recvtype%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scatter_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scatter_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatter_init_ts.c.in new file mode 100644 index 00000000000..94f94eb5c85 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatter_init_ts.c.in @@ -0,0 +1,101 @@ +/* + * 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-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scatter_init(BUFFER x1, COUNT sendcount, + DATATYPE sendtype, BUFFER_OUT x2, + COUNT recvcount, DATATYPE recvtype, + RANK root, COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Info c_info; + MPI_Request c_request; + @COUNT_TYPE@ c_sendcount = 0, c_recvcount = 0; + + c_info = PMPI_Info_f2c(*info); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf,c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm, c_info, &c_request); + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + } + + if ((c_recvdatatype != NULL ) && (c_recvdatatype != c_recvtype)){ + ompi_datatype_destroy(&c_recvdatatype); + } + + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in new file mode 100644 index 00000000000..7eb27a09fda --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in @@ -0,0 +1,92 @@ +/* + * 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-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scatter(BUFFER x1, COUNT sendcount, + DATATYPE sendtype, BUFFER_OUT x2, + COUNT recvcount, DATATYPE recvtype, + RANK root, COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_sendcount = 0, c_recvcount = 0; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + c_sendtype = PMPI_Type_f2c(*sendtype); + c_sendcount = (@COUNT_TYPE@) *sendcount; + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf); + recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf); + + c_ierr = @INNER_CALL@(sendbuf,c_sendcount, c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm); + + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatterv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scatterv_f08.F90 deleted file mode 100644 index 931d264748b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scatterv_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scatterv_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,& - recvcount,recvtype,root,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_scatterv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scatterv_f(sendbuf,sendcounts,displs,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,root,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scatterv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scatterv_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/scatterv_init_f08.F90 deleted file mode 100644 index bbf3c77cdd0..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/scatterv_init_f08.F90 +++ /dev/null @@ -1,36 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-2022 Cisco Systems, Inc. All rights reserved -! Copyright (c) 2009-2012 Los Alamos National Security, LLC. -! All rights reserved. -! Copyright (c) 2018-2021 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Scatterv_init_f08(sendbuf,sendcounts,displs,sendtype,recvbuf,& - recvcount,recvtype,root,comm,info,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_scatterv_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: recvbuf - INTEGER, INTENT(IN) :: recvcount, root - INTEGER, INTENT(IN) OMPI_ASYNCHRONOUS :: sendcounts(*), displs(*) - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_scatterv_init_f(sendbuf,sendcounts,displs,sendtype%MPI_VAL,recvbuf,& - recvcount,recvtype%MPI_VAL,root,comm%MPI_VAL,info%MPI_VAL,request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Scatterv_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/scatterv_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatterv_init_ts.c.in new file mode 100644 index 00000000000..aa91f4e262c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatterv_init_ts.c.in @@ -0,0 +1,125 @@ +/* + * Copyright (c) 2004-2005 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-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-2021 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scatterv_init(BUFFER x1, COUNT_ARRAY sendcounts, + DISP_ARRAY displs, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, + DATATYPE recvtype, RANK root, + COMM comm, INFO info, REQUEST_OUT request) +{ + int c_ierr; + int idx = 0; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + MPI_Info c_info; + MPI_Request c_request; + @COUNT_TYPE@ c_recvcount = 0; + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + c_info = PMPI_Info_f2c(*info); + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_displs, + c_sendtype, + recvbuf, + c_recvcount, + c_recvdatatype, + c_root, + c_comm, + c_info, + &c_request); + if (NULL != ierr) { + *ierr = OMPI_INT_2_FINT(c_ierr); + } + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_request); + ompi_coll_base_nbc_request_t* nb_request = (ompi_coll_base_nbc_request_t*)c_request; + if (tmp_sendcounts != sendcounts) { + nb_request->data.release_arrays[idx++] = tmp_sendcounts; + } + if (tmp_displs != displs) { + nb_request->data.release_arrays[idx++] = tmp_displs; + } + nb_request->data.release_arrays[idx] = NULL; + } else { + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); + } + + if ((c_recvdatatype != NULL ) && (c_recvdatatype != c_recvtype)){ + ompi_datatype_destroy(&c_recvdatatype); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in new file mode 100644 index 00000000000..23fad728bfe --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in @@ -0,0 +1,102 @@ +/* + * 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-2013 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID scatterv(BUFFER x1, COUNT_ARRAY sendcounts, + DISP_ARRAY displs, DATATYPE sendtype, + BUFFER_OUT x2, COUNT recvcount, + DATATYPE recvtype, RANK root, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + int c_root = OMPI_FINT_2_INT(*root); + MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = 0; + @COUNT_TYPE@ *tmp_sendcounts = NULL; + @DISP_TYPE@ *tmp_displs = NULL; + + if (OMPI_COMM_IS_INTER(c_comm)) { + if (MPI_ROOT == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } else if (MPI_PROC_NULL != c_root) { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } else { + if (ompi_comm_rank(c_comm) == c_root) { + int size = ompi_comm_size(c_comm); + c_sendtype = PMPI_Type_f2c(*sendtype); + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size); + OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(displs, tmp_displs, size); + } + if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) { + recvbuf = MPI_IN_PLACE; + } else { + c_recvtype = PMPI_Type_f2c(*recvtype); + c_recvcount = (@COUNT_TYPE@) *recvcount; + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME) + return; + } + } + } + + c_ierr = @INNER_CALL@(sendbuf, + tmp_sendcounts, + tmp_displs, + c_sendtype, + recvbuf, c_recvcount, c_recvdatatype, + c_root, c_comm); + + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts); + OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(displs, tmp_displs); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 deleted file mode 100644 index 25fecbffb7a..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/send_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Send_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_send_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_send_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Send_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/send_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/send_init_f08.F90 deleted file mode 100644 index 769501bddb6..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/send_init_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Send_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_send_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_send_init_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL, & - request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Send_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in new file mode 100644 index 00000000000..edb96d73536 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in @@ -0,0 +1,55 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID send_init(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, + RANK dest, TAG tag, COMM comm, + REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in new file mode 100644 index 00000000000..b35715f5d55 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/send_ts.c.in @@ -0,0 +1,47 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID send(BUFFER x, COUNT count, DATATYPE datatype, RANK dest, + TAG tag, COMM comm) +{ + int c_ierr; + + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/sendrecv_f08.F90 deleted file mode 100644 index 9cbef5c81e8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/sendrecv_f08.F90 +++ /dev/null @@ -1,34 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Sendrecv_f08(sendbuf,sendcount,sendtype,dest,sendtag,recvbuf, & - recvcount,recvtype,source,recvtag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_sendrecv_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: sendbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: recvbuf - INTEGER, INTENT(IN) :: sendcount, dest, sendtag, recvcount, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: sendtype - TYPE(MPI_Datatype), INTENT(IN) :: recvtype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_sendrecv_f(sendbuf,sendcount,sendtype%MPI_VAL,dest,sendtag,recvbuf, & - recvcount,recvtype%MPI_VAL,source,recvtag,comm%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Sendrecv_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_f08.F90 deleted file mode 100644 index 4ed700efa61..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Sendrecv_replace_f08(buf,count,datatype,dest,sendtag,source, & - recvtag,comm,status,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_sendrecv_replace_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE :: buf - INTEGER, INTENT(IN) :: count, dest, sendtag, source, recvtag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Status), INTENT(OUT) :: status - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_sendrecv_replace_f(buf,count,datatype%MPI_VAL,dest,sendtag,source, & - recvtag,comm%MPI_VAL,status,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Sendrecv_replace_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in new file mode 100644 index 00000000000..84276dc33b6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/sendrecv_replace_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID sendrecv_replace(BUFFER_OUT x, COUNT count, DATATYPE datatype, + RANK dest, TAG sendtag, + RANK source, TAG recvtag, + COMM comm, STATUS_OUT status) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + MPI_Status c_status; + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ __opal_attribute_unused__ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), + (@COUNT_TYPE@) *count, + c_datatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_status); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr && + !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in new file mode 100644 index 00000000000..58619186a4c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/sendrecv_ts.c.in @@ -0,0 +1,77 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID sendrecv(BUFFER x1, COUNT sendcount, DATATYPE sendtype, + RANK dest, TAG sendtag, BUFFER_OUT x2, + COUNT recvcount, DATATYPE recvtype, + RANK source, TAG recvtag, COMM comm, + STATUS_OUT status) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + MPI_Datatype c_senddatatype, c_sendtype = PMPI_Type_f2c(*sendtype); + MPI_Datatype c_recvdatatype, c_recvtype = PMPI_Type_f2c(*recvtype); + MPI_Status c_status; + void *sendbuf = OMPI_CFI_BASE_ADDR(x1); + @COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount; + void *recvbuf = OMPI_CFI_BASE_ADDR(x2); + @COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount; + + OMPI_CFI_2_C(x1, c_sendcount, c_sendtype, c_senddatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(sendbuf), c_sendcount, + c_senddatatype, + OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*sendtag), + OMPI_F2C_BOTTOM(recvbuf), c_recvcount, + c_recvdatatype, OMPI_FINT_2_INT(*source), + OMPI_FINT_2_INT(*recvtag), + c_comm, &c_status); + if (c_senddatatype != c_sendtype) { + ompi_datatype_destroy(&c_senddatatype); + } + if (c_recvdatatype != c_recvtype) { + ompi_datatype_destroy(&c_recvdatatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr && + !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + PMPI_Status_c2f(&c_status, status); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ssend_f08.F90 deleted file mode 100644 index b4221f659bb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ssend_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ssend_f08(buf,count,datatype,dest,tag,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_ssend_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ssend_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ssend_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_init_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/ssend_init_f08.F90 deleted file mode 100644 index e40b75c6108..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/ssend_init_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Ssend_init_f08(buf,count,datatype,dest,tag,comm,request,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Request - use :: ompi_mpifh_bindings, only : ompi_ssend_init_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS, INTENT(IN) :: buf - INTEGER, INTENT(IN) :: count, dest, tag - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Request), INTENT(OUT) :: request - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_ssend_init_f(buf,count,datatype%MPI_VAL,dest,tag,comm%MPI_VAL, & - request%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Ssend_init_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in new file mode 100644 index 00000000000..e5a58d0f8f5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ssend_init_ts.c.in @@ -0,0 +1,54 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ssend_init(BUFFER_ASYNC x, COUNT count, DATATYPE datatype, + RANK dest, TAG tag, + COMM comm, REQUEST_OUT request) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Request c_req; + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), + c_comm, &c_req); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *request = PMPI_Request_c2f(c_req); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in new file mode 100644 index 00000000000..ea82a0f75c0 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/ssend_ts.c.in @@ -0,0 +1,49 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID ssend(BUFFER x, COUNT count, DATATYPE datatype, + RANK dest, TAG tag, + COMM comm) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + MPI_Comm c_comm = PMPI_Comm_f2c (*comm); + + void *buf = OMPI_CFI_BASE_ADDR(x); + @COUNT_TYPE@ c_count = (@COUNT_TYPE@) *count; + + OMPI_CFI_2_C(x, c_count, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(OMPI_F2C_BOTTOM(buf), c_count, + c_datatype, OMPI_FINT_2_INT(*dest), + OMPI_FINT_2_INT(*tag), c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/status_set_elements_c.in b/ompi/mpi/fortran/use-mpi-f08/status_set_elements_c.in new file mode 100644 index 00000000000..dcbc4fdb0c5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/status_set_elements_c.in @@ -0,0 +1,48 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID status_set_elements(STATUS status, DATATYPE datatype, + COUNT_OUT count) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*datatype); + MPI_Status c_status; + + /* This seems silly, but someone will do it */ + + if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) { + c_ierr = MPI_SUCCESS; + } else { + PMPI_Status_f2c( status, &c_status ); + + c_ierr = @INNER_CALL@(&c_status, c_type, + OMPI_FINT_2_INT(*count)); + + /* If datatype is really being set, then that needs to be + converted.... */ + if (MPI_SUCCESS == c_ierr) { + PMPI_Status_c2f(&c_status, status); + } + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/status_set_elements_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/status_set_elements_f08.F90 deleted file mode 100644 index 25f06ef3074..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/status_set_elements_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- 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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Status_set_elements_f08(status,datatype,count,ierror) - use :: mpi_f08_types, only : MPI_Status, MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_status_set_elements_f - implicit none - TYPE(MPI_Status), INTENT(INOUT) :: status - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(IN) :: count - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_status_set_elements_f(status,datatype%MPI_VAL,count,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Status_set_elements_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/testany.c.in b/ompi/mpi/fortran/use-mpi-f08/testany.c.in new file mode 100644 index 00000000000..49d8d998d69 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/testany.c.in @@ -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-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 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID testany(INT count, REQUEST_ARRAY array_of_requests:count, INT indx, + LOGICAL_OUT flag, STATUS_OUT status) +{ + 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))) { + *flag = OMPI_FORTRAN_VALUE_TRUE; + *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 (c_req == NULL) { + 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_Testany(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); + + OMPI_SINGLE_INT_2_LOGICAL(flag); + if (MPI_SUCCESS == c_ierr) { + + /* Increment index by one for fortran conventions. Note that + all Fortran compilers have FALSE==0; we just need to check + for any nonzero value (because TRUE is not always 1) */ + + OMPI_SINGLE_INT_2_FINT(indx); + if (*flag && + 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/type_contiguous.c.in b/ompi/mpi/fortran/use-mpi-f08/type_contiguous.c.in new file mode 100644 index 00000000000..2209ffb5773 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_contiguous.c.in @@ -0,0 +1,37 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_contiguous(COUNT count, DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_contiguous_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_contiguous_f08.F90 deleted file mode 100644 index cd00a5a0fd4..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_contiguous_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_contiguous_f08(count,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_type_contiguous_f - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_contiguous_f(count,oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_contiguous_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_darray.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_darray.c.in new file mode 100644 index 00000000000..0e489438ced --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_darray.c.in @@ -0,0 +1,61 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_darray(INT size, RANK rank, + INT ndims, COUNT_ARRAY gsize_array, + INT_ARRAY distrib_array, INT_ARRAY darg_array, + INT_ARRAY psize_array, INT order, + DATATYPE oldtype, DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + OMPI_ARRAY_NAME_DECL(gsize_array); + OMPI_ARRAY_NAME_DECL(distrib_array); + OMPI_ARRAY_NAME_DECL(darg_array); + OMPI_ARRAY_NAME_DECL(psize_array); + + OMPI_ARRAY_FINT_2_INT(gsize_array, *ndims); + OMPI_ARRAY_FINT_2_INT(distrib_array, *ndims); + OMPI_ARRAY_FINT_2_INT(darg_array, *ndims); + OMPI_ARRAY_FINT_2_INT(psize_array, *ndims); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*size), + OMPI_FINT_2_INT(*rank), + OMPI_FINT_2_INT(*ndims), + OMPI_ARRAY_NAME_CONVERT(gsize_array), + OMPI_ARRAY_NAME_CONVERT(distrib_array), + OMPI_ARRAY_NAME_CONVERT(darg_array), + OMPI_ARRAY_NAME_CONVERT(psize_array), + OMPI_FINT_2_INT(*order), c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(gsize_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(distrib_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(darg_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(psize_array); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_darray_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_darray_f08.F90 deleted file mode 100644 index 3f55f301c41..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_darray_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_darray_f08(size,rank,ndims,& - array_of_gsizes,array_of_distribs,array_of_dargs,array_of_psizes,& - order,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_type_create_darray_f - implicit none - INTEGER, INTENT(IN) :: size, rank, ndims, order - INTEGER, INTENT(IN) :: array_of_gsizes(*), array_of_distribs(*), array_of_dargs(*), array_of_psizes(*) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_darray_f(size,rank,ndims, & - array_of_gsizes,array_of_distribs,array_of_dargs,array_of_psizes, & - order,oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_darray_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed.c.in new file mode 100644 index 00000000000..9f076b219b5 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed.c.in @@ -0,0 +1,48 @@ +/* + * 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-2014 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_hindexed(COUNT count, + COUNT_ARRAY array_of_blocklengths, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + OMPI_ARRAY_NAME_DECL(array_of_blocklengths); + + OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths), + array_of_displacements, c_old, + &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } + + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block.c.in new file mode 100644 index 00000000000..3f58e681490 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block.c.in @@ -0,0 +1,34 @@ +/* + * Copyright (c) 2012 The University of Tennessee and The University + * of Tennessee Research Foundation. All rights + * reserved. + * Copyright (c) 2012 Inria. 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_hindexed_block(COUNT count, COUNT blocklength, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_FINT_2_INT(*blocklength), + array_of_displacements, + c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block_f08.F90 deleted file mode 100644 index f85fea57629..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_block_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2012 The University of Tennessee and The University -! of Tennessee Research Foundation. All rights -! reserved. -! Copyright (c) 2012 Inria. All rights reserved. -! Copyright (c) 2012 Cisco Systems, Inc. All rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_hindexed_block_f08(count,blocklength, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_create_hindexed_block_f - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_hindexed_block_f(count,blocklength,array_of_displacements, & - oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_hindexed_block_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_f08.F90 deleted file mode 100644 index 66443dd81cd..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_hindexed_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_hindexed_f08(count,array_of_blocklengths, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_create_hindexed_f - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_hindexed_f(count,array_of_blocklengths, & - array_of_displacements,oldtype%MPI_VAL, & - newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_hindexed_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hvector.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_hvector.c.in new file mode 100644 index 00000000000..5756ca9dbef --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_hvector.c.in @@ -0,0 +1,41 @@ +/* + * 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) 2007-2012 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_hvector(COUNT count, COUNT blocklength, + AINT_COUNT stride, DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_FINT_2_INT(*blocklength), + *stride, + c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_hvector_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_hvector_f08.F90 deleted file mode 100644 index 87b93a7e675..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_hvector_f08.F90 +++ /dev/null @@ -1,27 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_hvector_f08(count,blocklength,stride,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_create_hvector_f - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: stride - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_hvector_f(count,blocklength,stride, & - oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_hvector_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block.c.in new file mode 100644 index 00000000000..9c2eafca92d --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block.c.in @@ -0,0 +1,47 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_indexed_block(COUNT count, COUNT blocklength, + COUNT_ARRAY array_of_displacements, + DATATYPE oldtype, DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + OMPI_ARRAY_NAME_DECL(array_of_displacements); + + OMPI_ARRAY_FINT_2_INT(array_of_displacements, *count); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_FINT_2_INT(*blocklength), + OMPI_ARRAY_NAME_CONVERT(array_of_displacements), + c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } + + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_displacements); +} + diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block_f08.F90 deleted file mode 100644 index 956acbd0cc3..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_indexed_block_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_indexed_block_f08(count,blocklength, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_type_create_indexed_block_f - implicit none - INTEGER, INTENT(IN) :: count, blocklength - INTEGER, INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_indexed_block_f(count,blocklength,array_of_displacements, & - oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_indexed_block_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_struct.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_struct.c.in new file mode 100644 index 00000000000..a984f138bea --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_struct.c.in @@ -0,0 +1,61 @@ +/* + * 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 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_struct(COUNT count, + COUNT_ARRAY array_of_block_lengths, + AINT_COUNT_ARRAY array_of_displacements, + DATATYPE_ARRAY array_of_types, + DATATYPE_OUT newtype) +{ + MPI_Datatype c_new; + MPI_Datatype *c_type_old_array; + int i, c_ierr; + OMPI_ARRAY_NAME_DECL(array_of_block_lengths); + + c_type_old_array = (MPI_Datatype *) malloc(*count * sizeof(MPI_Datatype)); + if (NULL == c_type_old_array) { + 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 < *count; i++) { + c_type_old_array[i] = PMPI_Type_f2c(array_of_types[i]); + } + + OMPI_ARRAY_FINT_2_INT(array_of_block_lengths, *count); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_ARRAY_NAME_CONVERT(array_of_block_lengths), + array_of_displacements, c_type_old_array, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_block_lengths); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } + + free(c_type_old_array); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_struct_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_struct_f08.F90 deleted file mode 100644 index 92a1de45dbe..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_struct_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_struct_f08(count,array_of_blocklengths,array_of_displacements, & - array_of_types,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_create_struct_f - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count) - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: array_of_types(count) - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_struct_f(count,array_of_blocklengths,array_of_displacements, & - array_of_types(:)%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_struct_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_subarray.c.in b/ompi/mpi/fortran/use-mpi-f08/type_create_subarray.c.in new file mode 100644 index 00000000000..bf8fb450944 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_create_subarray.c.in @@ -0,0 +1,56 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_create_subarray(INT ndims, COUNT_ARRAY size_array, + COUNT_ARRAY subsize_array, + COUNT_ARRAY start_array, INT order, + DATATYPE oldtype, DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old; + MPI_Datatype c_new; + OMPI_ARRAY_NAME_DECL(size_array); + OMPI_ARRAY_NAME_DECL(subsize_array); + OMPI_ARRAY_NAME_DECL(start_array); + + c_old = PMPI_Type_f2c(*oldtype); + + OMPI_ARRAY_FINT_2_INT(size_array, *ndims); + OMPI_ARRAY_FINT_2_INT(subsize_array, *ndims); + OMPI_ARRAY_FINT_2_INT(start_array, *ndims); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*ndims), + OMPI_ARRAY_NAME_CONVERT(size_array), + OMPI_ARRAY_NAME_CONVERT(subsize_array), + OMPI_ARRAY_NAME_CONVERT(start_array), + *order, c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } + + OMPI_ARRAY_FINT_2_INT_CLEANUP(size_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(subsize_array); + OMPI_ARRAY_FINT_2_INT_CLEANUP(start_array); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_create_subarray_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_create_subarray_f08.F90 deleted file mode 100644 index a870231b922..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_create_subarray_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_create_subarray_f08(ndims,array_of_sizes,array_of_subsizes, & - array_of_starts,order,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_type_create_subarray_f - implicit none - INTEGER, INTENT(IN) :: ndims, order - INTEGER, INTENT(IN) :: array_of_sizes(*), array_of_subsizes(*), array_of_starts(*) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_create_subarray_f(ndims,array_of_sizes, & - array_of_subsizes,array_of_starts, & - order,oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_create_subarray_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_get_contents_f08_c.F90 b/ompi/mpi/fortran/use-mpi-f08/type_get_contents_f08_c.F90 new file mode 100644 index 00000000000..5b089fb9ca9 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_get_contents_f08_c.F90 @@ -0,0 +1,33 @@ +! -*- f90 -*- +! +! Copyright (c) 2009-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$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Type_get_contents_f08_c(datatype, max_integers, max_addresses, max_large_counts, & + max_datatypes, array_of_integers, array_of_addresses, & + array_of_large_counts, array_of_datatypes, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND + use :: ompi_mpifh_bindings, only : ompi_type_get_contents_f_c + implicit none + TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(KIND=MPI_COUNT_KIND), INTENT(IN) :: max_integers, max_addresses, & + max_large_counts, max_datatypes + INTEGER, INTENT(OUT) :: array_of_integers(max_integers) + INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: array_of_addresses(max_addresses) + INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: array_of_large_counts(max_large_counts) + TYPE(MPI_Datatype), INTENT(OUT) :: array_of_datatypes(max_datatypes) + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_type_get_contents_f_c(datatype%MPI_VAL,max_integers,max_addresses, & + max_large_counts, max_datatypes,array_of_integers,array_of_addresses, & + array_of_large_counts, array_of_datatypes(:)%MPI_VAL,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Type_get_contents_f08_c diff --git a/ompi/mpi/fortran/use-mpi-f08/type_get_envelope_f08_c.F90 b/ompi/mpi/fortran/use-mpi-f08/type_get_envelope_f08_c.F90 new file mode 100644 index 00000000000..cefa541ba8b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_get_envelope_f08_c.F90 @@ -0,0 +1,28 @@ +! -*- f90 -*- +! +! Copyright (c) 2009-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$ + +#include "mpi-f08-rename.h" + +subroutine MPI_Type_get_envelope_f08_c(datatype,num_integers,num_addresses, & + num_large_counts, num_datatypes,combiner,ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND, MPI_COUNT_KIND + use :: ompi_mpifh_bindings, only : ompi_type_get_envelope_f_c + implicit none + TYPE(MPI_Datatype), INTENT(IN) :: datatype + INTEGER(KIND=MPI_COUNT_KIND), INTENT(OUT) :: num_integers, num_addresses, num_large_counts, & + num_datatypes, combiner + INTEGER, OPTIONAL, INTENT(OUT) :: ierror + integer :: c_ierror + + call ompi_type_get_envelope_f_c(datatype%MPI_VAL,num_integers,num_addresses, & + num_large_counts, num_datatypes,combiner,c_ierror) + if (present(ierror)) ierror = c_ierror + +end subroutine MPI_Type_get_envelope_f08_c + diff --git a/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent.c.in b/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent.c.in new file mode 100644 index 00000000000..32188707e20 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent.c.in @@ -0,0 +1,31 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_get_true_extent(DATATYPE datatype, AINT_OUT true_lb, AINT_OUT true_extent) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*datatype); + + c_ierr = @INNER_CALL@(c_type, true_lb, true_extent); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent_f08.F90 deleted file mode 100644 index de477a00bbe..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_get_true_extent_f08.F90 +++ /dev/null @@ -1,24 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_get_true_extent_f08(datatype,true_lb,true_extent,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_get_true_extent_f - implicit none - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER(MPI_ADDRESS_KIND), INTENT(OUT) :: true_lb, true_extent - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_get_true_extent_f(datatype%MPI_VAL,true_lb,true_extent,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_get_true_extent_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_indexed.c.in b/ompi/mpi/fortran/use-mpi-f08/type_indexed.c.in new file mode 100644 index 00000000000..164f5ed73dd --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_indexed.c.in @@ -0,0 +1,49 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_indexed(COUNT count, COUNT_ARRAY array_of_blocklengths, + COUNT_ARRAY array_of_displacements, DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old = PMPI_Type_f2c(*oldtype); + MPI_Datatype c_new; + OMPI_ARRAY_NAME_DECL(array_of_blocklengths); + OMPI_ARRAY_NAME_DECL(array_of_displacements); + + OMPI_ARRAY_FINT_2_INT(array_of_blocklengths, *count); + OMPI_ARRAY_FINT_2_INT(array_of_displacements, *count); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_ARRAY_NAME_CONVERT(array_of_blocklengths), + OMPI_ARRAY_NAME_CONVERT(array_of_displacements), + c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_blocklengths); + OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_displacements); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_indexed_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_indexed_f08.F90 deleted file mode 100644 index 813665ce6c1..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_indexed_f08.F90 +++ /dev/null @@ -1,28 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_indexed_f08(count,array_of_blocklengths, & - array_of_displacements,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_indexed_f - implicit none - INTEGER, INTENT(IN) :: count - INTEGER, INTENT(IN) :: array_of_blocklengths(count), array_of_displacements(count) - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_indexed_f(count,array_of_blocklengths,array_of_displacements, & - oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_indexed_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_size.c.in b/ompi/mpi/fortran/use-mpi-f08/type_size.c.in new file mode 100644 index 00000000000..d8d50bcb069 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_size.c.in @@ -0,0 +1,36 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_size(DATATYPE type, COUNT size) +{ + int c_ierr; + MPI_Datatype c_type = PMPI_Type_f2c(*type); + OMPI_SINGLE_NAME_DECL(size); + + c_ierr = @INNER_CALL@(c_type, OMPI_SINGLE_NAME_CONVERT(size)); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(size); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_size_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_size_f08.F90 deleted file mode 100644 index 244a6e2378b..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_size_f08.F90 +++ /dev/null @@ -1,24 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_size_f08(datatype,size,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_type_size_f - implicit none - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, INTENT(OUT) :: size - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_size_f(datatype%MPI_VAL,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_size_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/type_vector.c.in b/ompi/mpi/fortran/use-mpi-f08/type_vector.c.in new file mode 100644 index 00000000000..5273387d080 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/type_vector.c.in @@ -0,0 +1,43 @@ +/* + * 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) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID type_vector(COUNT count, COUNT blocklength, + COUNT stride, DATATYPE oldtype, + DATATYPE_OUT newtype) +{ + int c_ierr; + MPI_Datatype c_old; + MPI_Datatype c_new; + + c_old = PMPI_Type_f2c(*oldtype); + + c_ierr = @INNER_CALL@(OMPI_FINT_2_INT(*count), + OMPI_FINT_2_INT(*blocklength), + OMPI_FINT_2_INT(*stride), + c_old, &c_new); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *newtype = PMPI_Type_c2f(c_new); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/type_vector_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/type_vector_f08.F90 deleted file mode 100644 index 66791440104..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/type_vector_f08.F90 +++ /dev/null @@ -1,26 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Type_vector_f08(count,blocklength,stride,oldtype,newtype,ierror) - use :: mpi_f08_types, only : MPI_Datatype - use :: ompi_mpifh_bindings, only : ompi_type_vector_f - implicit none - INTEGER, INTENT(IN) :: count, blocklength, stride - TYPE(MPI_Datatype), INTENT(IN) :: oldtype - TYPE(MPI_Datatype), INTENT(OUT) :: newtype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_type_vector_f(count,blocklength,stride, & - oldtype%MPI_VAL,newtype%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Type_vector_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_external_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/unpack_external_f08.F90 deleted file mode 100644 index 8cf2e637fe8..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/unpack_external_f08.F90 +++ /dev/null @@ -1,33 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount,datatype,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_unpack_external_f - implicit none - CHARACTER(LEN=*), INTENT(IN) :: datarep - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize - INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position - INTEGER, INTENT(IN) :: outcount - TYPE(MPI_Datatype), INTENT(IN) :: datatype - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_unpack_external_f(datarep,inbuf,insize,position,outbuf,& - outcount,datatype%MPI_VAL,c_ierror,len(datarep)) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Unpack_external_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in new file mode 100644 index 00000000000..adbf2e9e04c --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/unpack_external_ts.c.in @@ -0,0 +1,61 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID unpack_external(CHAR_ARRAY datarep, BUFFER x1, COUNT insize, + AINT_COUNT_INOUT position, BUFFER x2, + COUNT_OUT outcount, DATATYPE datatype) +{ + int c_ierr; + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + char *inbuf = OMPI_CFI_BASE_ADDR(x1); + void *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_outcount = OMPI_FINT_2_INT(*outcount); + + c_type = PMPI_Type_f2c(*datatype); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_2_C(x2, c_outcount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, c_ierr, FUNC_NAME); + return; + } + + c_ierr = @INNER_CALL@(datarep, inbuf, + *insize, + position, + OMPI_F2C_BOTTOM(outbuf), + c_outcount, + c_datatype); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/unpack_f08.F90 deleted file mode 100644 index 0f91d7859bc..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/unpack_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Unpack_f08(inbuf,insize,position,outbuf,outcount,datatype,comm,ierror) - use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm - use :: ompi_mpifh_bindings, only : ompi_unpack_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf - OMPI_FORTRAN_IGNORE_TKR_TYPE :: outbuf - INTEGER, INTENT(IN) :: insize, outcount - INTEGER, INTENT(INOUT) :: position - TYPE(MPI_Datatype), INTENT(IN) :: datatype - TYPE(MPI_Comm), INTENT(IN) :: comm - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_unpack_f(inbuf,insize,position,outbuf,outcount, & - datatype%MPI_VAL,comm%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Unpack_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in new file mode 100644 index 00000000000..ba8e2138a6b --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/unpack_ts.c.in @@ -0,0 +1,64 @@ +/* + * 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-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID unpack(BUFFER x1, COUNT insize, COUNT_INOUT position, + BUFFER_OUT x2, COUNT_OUT outcount, DATATYPE datatype, + COMM comm) +{ + int c_ierr; + MPI_Comm c_comm = PMPI_Comm_f2c(*comm); + MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype); + OMPI_SINGLE_NAME_DECL(position); + char *inbuf = OMPI_CFI_BASE_ADDR(x1); + void *outbuf = OMPI_CFI_BASE_ADDR(x2); + int c_outcount = OMPI_FINT_2_INT(*outcount); + + OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_CFI_2_C(x2, c_outcount, c_type, c_datatype, c_ierr); + if (MPI_SUCCESS != c_ierr) { + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + return; + } + + OMPI_SINGLE_FINT_2_INT(position); + + c_ierr = @INNER_CALL@(inbuf, OMPI_FINT_2_INT(*insize), + OMPI_SINGLE_NAME_CONVERT(position), + OMPI_F2C_BOTTOM(outbuf), c_outcount, + c_datatype, c_comm); + if (c_datatype != c_type) { + ompi_datatype_destroy(&c_datatype); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + OMPI_SINGLE_INT_2_FINT(position); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/waitall.c.in b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in new file mode 100644 index 00000000000..38cd9389722 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/waitall.c.in @@ -0,0 +1,66 @@ +/* + * 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 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID waitall(INT count, REQUEST_ARRAY array_of_requests:count, + STATUS_ARRAY array_of_statuses) +{ + MPI_Request *c_req; + MPI_Status *c_status; + int i, c_ierr; + + /* 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 = PMPI_Waitall(OMPI_FINT_2_INT(*count), c_req, c_status); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + 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/waitall_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/waitall_f08.F90 deleted file mode 100644 index f07551d4c45..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/waitall_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2009-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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Waitall_f08(count,array_of_requests,array_of_statuses,ierror) - use :: mpi_f08_types, only : MPI_Request, MPI_Status - use :: ompi_mpifh_bindings, only : ompi_waitall_f - implicit none - INTEGER, INTENT(IN) :: count - TYPE(MPI_Request), INTENT(INOUT) :: array_of_requests(count) - TYPE(MPI_Status), INTENT(OUT) :: array_of_statuses(*) - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_waitall_f(count,array_of_requests(:)%MPI_VAL,array_of_statuses,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Waitall_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_allocate.c.in b/ompi/mpi/fortran/use-mpi-f08/win_allocate.c.in new file mode 100644 index 00000000000..ea639f4bb68 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_allocate.c.in @@ -0,0 +1,41 @@ +/* + * 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-2014 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-2014 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_allocate(AINT size, DISP disp_unit, + INFO info, COMM comm, C_PTR_OUT baseptr, + WIN_OUT win) +{ + int c_ierr; + MPI_Info c_info; + MPI_Comm c_comm; + MPI_Win c_win; + + c_info = PMPI_Info_f2c(*info); + c_comm = PMPI_Comm_f2c(*comm); + + c_ierr = @INNER_CALL@(*size, OMPI_FINT_2_INT(*disp_unit), + c_info, c_comm, + baseptr, &c_win); + *win = PMPI_Win_c2f(c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_allocate_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_allocate_f08.F90 deleted file mode 100644 index a0f4f06562d..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_allocate_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- 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) 2004-2014 High Performance Computing Center Stuttgart, -! University of Stuttgart. All rights reserved. -! Copyright (c) 2018-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! $COPYRIGHT$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, & - baseptr, win, ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_allocate_f - implicit none - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(C_PTR), INTENT(OUT) :: baseptr - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_allocate_f(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_allocate_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared.c.in b/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared.c.in new file mode 100644 index 00000000000..4e5e1d5c4e6 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared.c.in @@ -0,0 +1,41 @@ +/* + * 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-2014 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-2014 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$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_allocate_shared(AINT size, DISP disp_unit, + INFO info, COMM comm, C_PTR_OUT baseptr, + WIN win) +{ + int c_ierr; + MPI_Info c_info; + MPI_Comm c_comm; + MPI_Win c_win; + + c_info = PMPI_Info_f2c(*info); + c_comm = PMPI_Comm_f2c(*comm); + + c_ierr = @INNER_CALL@(*size, OMPI_FINT_2_INT(*disp_unit), + c_info, c_comm, + baseptr, &c_win); + *win = PMPI_Win_c2f(c_win); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared_f08.F90 deleted file mode 100644 index ec692f900fb..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_allocate_shared_f08.F90 +++ /dev/null @@ -1,30 +0,0 @@ -! -*- 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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, & - baseptr, win, ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_allocate_shared_f - implicit none - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(C_PTR), INTENT(OUT) :: baseptr - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_allocate_shared_f(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_allocate_shared_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 deleted file mode 100644 index fb78b337158..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_attach_f08.F90 +++ /dev/null @@ -1,25 +0,0 @@ -! -*- f90 -*- -! -! Copyright (c) 2015-2020 Research Organization for Information Science -! and Technology (RIST). All rights reserved. -! Copyright (c) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_attach_f08(win,base,size,ierror) - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_attach_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS :: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_attach_f(win%MPI_VAL,base,size,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_attach_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in new file mode 100644 index 00000000000..bfb4b3accb2 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_attach_ts.c.in @@ -0,0 +1,26 @@ +/* + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_attach(WIN win, BUFFER x, AINT size) +{ + int c_ierr; + MPI_Win c_win; + + c_win = PMPI_Win_f2c(*win); + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = PMPI_Win_attach(c_win, OMPI_CFI_BASE_ADDR(x), *size); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_create_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_create_f08.F90 deleted file mode 100644 index 2376f399ce5..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_create_f08.F90 +++ /dev/null @@ -1,32 +0,0 @@ -! -*- 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) 2018 FUJITSU LIMITED. All rights reserved. -! $COPYRIGHT$ - -#include "ompi/mpi/fortran/configure-fortran-output.h" - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_create_f08(base,size,disp_unit,info,comm,win,ierror) - use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_create_f - implicit none - OMPI_FORTRAN_IGNORE_TKR_TYPE OMPI_ASYNCHRONOUS:: base - INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: size - INTEGER, INTENT(IN) :: disp_unit - TYPE(MPI_Info), INTENT(IN) :: info - TYPE(MPI_Comm), INTENT(IN) :: comm - TYPE(MPI_Win), INTENT(OUT) :: win - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_create_f(base,size,disp_unit,info%MPI_VAL,& - comm%MPI_VAL,win%MPI_VAL,c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_create_f08 diff --git a/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in new file mode 100644 index 00000000000..c46f59f8bf4 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_create_ts.c.in @@ -0,0 +1,48 @@ +/* + * 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) 2007-2012 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_create(BUFFER x, AINT size, DISP disp_unit, + INFO info, COMM comm, WIN_OUT win) +{ + int c_ierr; + MPI_Win c_win; + MPI_Info c_info; + MPI_Comm c_comm; + + c_comm = PMPI_Comm_f2c(*comm); + c_info = PMPI_Info_f2c(*info); + + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = @INNER_CALL@(OMPI_CFI_BASE_ADDR(x), *size, + OMPI_FINT_2_INT(*disp_unit), + c_info, c_comm, &c_win); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + + if (MPI_SUCCESS == c_ierr) { + *win = PMPI_Win_c2f(c_win); + } +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in b/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in new file mode 100644 index 00000000000..e89f9f4396f --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_detach_ts.c.in @@ -0,0 +1,26 @@ +/* + * Copyright (c) 2015-2019 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_detach(WIN win, BUFFER x) +{ + int c_ierr; + MPI_Win c_win; + + c_win = PMPI_Win_f2c(*win); + if (OMPI_CFI_IS_CONTIGUOUS(x)) { + c_ierr = @INNER_CALL@(c_win, OMPI_CFI_BASE_ADDR(x)); + } else { + c_ierr = MPI_ERR_BUFFER; + OMPI_ERRHANDLER_INVOKE(c_win, c_ierr, FUNC_NAME); + } + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_shared_query.c.in b/ompi/mpi/fortran/use-mpi-f08/win_shared_query.c.in new file mode 100644 index 00000000000..073e80e0fc7 --- /dev/null +++ b/ompi/mpi/fortran/use-mpi-f08/win_shared_query.c.in @@ -0,0 +1,37 @@ +/* + * 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-2014 Cisco Systems, Inc. All rights reserved. + * Copyright (c) 2015-2017 Research Organization for Information Science + * and Technology (RIST). All rights reserved. + * Copyright (c) 2024 Triad National Security, LLC. All rights + * reserved. + * $COPYRIGHT$ + * + * Additional copyrights may follow + * + * $HEADER$ + */ + +PROTOTYPE VOID win_shared_query(WIN win, INT rank, AINT_OUT size, + DISP_OUT disp_unit, C_PTR_OUT baseptr) +{ + int c_ierr; + MPI_Win c_win; + OMPI_SINGLE_NAME_DECL(disp_unit); + + c_win = PMPI_Win_f2c(*win); + + c_ierr = @INNER_CALL@(c_win, OMPI_FINT_2_INT(*rank), size, + OMPI_SINGLE_NAME_CONVERT(disp_unit), baseptr); + if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr); + +} diff --git a/ompi/mpi/fortran/use-mpi-f08/win_shared_query_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/win_shared_query_f08.F90 deleted file mode 100644 index e69f3028212..00000000000 --- a/ompi/mpi/fortran/use-mpi-f08/win_shared_query_f08.F90 +++ /dev/null @@ -1,29 +0,0 @@ -! -*- 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$ - -#include "mpi-f08-rename.h" - -subroutine MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr,& - ierror) - USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR - use :: mpi_f08_types, only : MPI_Win, MPI_ADDRESS_KIND - use :: ompi_mpifh_bindings, only : ompi_win_shared_query_f - implicit none - TYPE(MPI_Win), INTENT(IN) :: win - INTEGER, INTENT(IN) :: rank - INTEGER(KIND=MPI_ADDRESS_KIND), INTENT(OUT) :: size - INTEGER, INTENT(OUT) :: disp_unit - TYPE(C_PTR), INTENT(OUT) :: baseptr - INTEGER, OPTIONAL, INTENT(OUT) :: ierror - integer :: c_ierror - - call ompi_win_shared_query_f(win%MPI_VAL, rank, size, disp_unit, baseptr, c_ierror) - if (present(ierror)) ierror = c_ierror - -end subroutine MPI_Win_shared_query_f08 diff --git a/ompi/util/count_disp_array.h b/ompi/util/count_disp_array.h index b95137db23a..f95d65dc858 100644 --- a/ompi/util/count_disp_array.h +++ b/ompi/util/count_disp_array.h @@ -37,7 +37,8 @@ static inline void ompi_count_array_init_c(ompi_count_array_t *array, const size int *: ompi_count_array_init, \ const int *: ompi_count_array_init, \ size_t *: ompi_count_array_init_c, \ - const size_t *: ompi_count_array_init_c)(array, data) + const size_t *: ompi_count_array_init_c, \ + const MPI_Count *: ompi_count_array_init_c)(array, (const void *) data) #else #define OMPI_COUNT_ARRAY_INIT(array, data) \ do { \