fortran/use-mpi-f08: add CFI support for pack subroutines

open-mpi · Jul 30, 2024 · 5bf3286 · 5bf3286
1 parent 43096fb
commit 5bf3286
Show file tree

Hide file tree

Showing 9 changed files with 317 additions and 975 deletions.
diff --git a/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in b/ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-rename.h.in
diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_external_f08.F90
@@ -18,8 +18,8 @@ subroutine MPI_Pack_external_f08(datarep,inbuf,incount,datatype,outbuf,outsize,
    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
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: outsize

diff --git a/ompi/mpi/fortran/use-mpi-f08/pack_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/pack_f08.F90
@@ -16,8 +16,8 @@ subroutine MPI_Pack_f08(inbuf,incount,datatype,outbuf,outsize,position,comm,ierr
    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
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: incount, outsize
    TYPE(MPI_Datatype), INTENT(IN) :: datatype
    INTEGER, INTENT(INOUT) :: position

diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/pack_external_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/pack_external_ts.c
@@ -0,0 +1,82 @@
+/*
+ * 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$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/constants.h"
+#include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/mpi/fortran/base/fortran_base_strings.h"
+
+static const char FUNC_NAME[] = "MPI_Pack_external";
+
+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)
+{
+    int ret, c_ierr;
+    char *c_datarep;
+    MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
+    void *inbuf = x1->base_addr;
+    char *outbuf = x2->base_addr;
+    int c_incount = OMPI_FINT_2_INT(*incount);
+
+    /* Convert the fortran string */
+
+    if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
+                                                       &c_datarep))) {
+        c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME);
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        return;
+    }
+
+    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 = PMPI_Pack_external(c_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);
+
+    free(c_datarep);
+}
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/pack_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/pack_ts.c
@@ -0,0 +1,76 @@
+/*
+ * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-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$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/errhandler/errhandler.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+
+static const char FUNC_NAME[] = "MPI_Pack";
+
+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)
+{
+    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 = x1->base_addr;
+    char *outbuf = x2->base_addr;
+    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 = PMPI_Pack(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/ts/unpack_external_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/unpack_external_ts.c
@@ -0,0 +1,81 @@
+/*
+ * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
+ *                         University Research and Technology
+ *                         Corporation.  All rights reserved.
+ * Copyright (c) 2004-2005 The University of Tennessee and The University
+ *                         of Tennessee Research Foundation.  All rights
+ *                         reserved.
+ * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
+ *                         University of Stuttgart.  All rights reserved.
+ * Copyright (c) 2004-2005 The Regents of the University of California.
+ *                         All rights reserved.
+ * Copyright (c) 2011-2012 Cisco Systems, Inc.  All rights reserved.
+ * Copyright (c) 2015-2019 Research Organization for Information Science
+ *                         and Technology (RIST).  All rights reserved.
+ * $COPYRIGHT$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/constants.h"
+#include "ompi/mpi/fortran/base/constants.h"
+#include "ompi/mpi/fortran/base/fortran_base_strings.h"
+
+static const char FUNC_NAME[] = "MPI_Unpack_external";
+
+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)
+{
+    int ret, c_ierr;
+    char *c_datarep;
+    MPI_Datatype c_datatype, c_type = PMPI_Type_f2c(*datatype);
+    char *inbuf = x1->base_addr;
+    void *outbuf = x2->base_addr;
+    int c_outcount = OMPI_FINT_2_INT(*outcount);
+
+    c_type = PMPI_Type_f2c(*datatype);
+
+    /* Convert the fortran string */
+
+    if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(datarep, datarep_len,
+                                                       &c_datarep))) {
+        c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_SELF, ret, FUNC_NAME);
+        if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
+        return;
+    }
+
+    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 = PMPI_Unpack_external(c_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);
+
+    free(c_datarep);
+}
diff --git a/ompi/mpi/fortran/use-mpi-f08/ts/unpack_ts.c b/ompi/mpi/fortran/use-mpi-f08/ts/unpack_ts.c
@@ -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$
+ *
+ * Additional copyrights may follow
+ *
+ * $HEADER$
+ */
+
+#include "ompi_config.h"
+
+#include "ompi/communicator/communicator.h"
+#include "ompi/mpi/fortran/use-mpi-f08/ts/bindings.h"
+#include "ompi/mpi/fortran/base/constants.h"
+
+static const char FUNC_NAME[] = "MPI_Unpack";
+
+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)
+{
+    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 = x1->base_addr;
+    void *outbuf = x2->base_addr;
+    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 = PMPI_Unpack(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/unpack_external_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/unpack_external_f08.F90
@@ -17,8 +17,8 @@ subroutine MPI_Unpack_external_f08(datarep,inbuf,insize,position,outbuf,outcount
    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
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER(MPI_ADDRESS_KIND), INTENT(IN) :: insize
    INTEGER(MPI_ADDRESS_KIND), INTENT(INOUT) :: position
    INTEGER, INTENT(IN) :: outcount

diff --git a/ompi/mpi/fortran/use-mpi-f08/unpack_f08.F90 b/ompi/mpi/fortran/use-mpi-f08/unpack_f08.F90
@@ -16,8 +16,8 @@ subroutine MPI_Unpack_f08(inbuf,insize,position,outbuf,outcount,datatype,comm,ie
    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
+   OMPI_F08_IGNORE_TKR_TYPE, INTENT(IN) :: inbuf
+   OMPI_F08_IGNORE_TKR_TYPE :: outbuf
    INTEGER, INTENT(IN) :: insize, outcount
    INTEGER, INTENT(INOUT) :: position
    TYPE(MPI_Datatype), INTENT(IN) :: datatype