Skip to content

Commit 717d5f9

Browse files
hppritchahppritcha
committed
F08: refactor templates
This PR refactors some of the f08 template files introduced in PR open-mpi#12621. Many of them had been using, incorrectly, macros from fint_2_int.h. The code in the use-mpi-f08 folder now makes use of generated code in the wrapper around the internal c code to avoid many of the problems that these older macros were trying to solve by providing 'c' interfaces directly to the fortran compiler. Also, generalized macros for handling translation of arrays of MPI_Fint's to c int's (and other types) are used in these templates. Related to open-mpi#13168 and associated issue raised by a user on the mail list. Signed-off-by: Howard Pritchard <howardp@lanl.gov>
1 parent 2c9dd0a commit 717d5f9

File tree

73 files changed

+395
-425
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

73 files changed

+395
-425
lines changed

‎ompi/mpi/bindings/ompi_bindings/fortran.py‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -179,10 +179,11 @@ def print_c_source(self):
179179
c_func = self.c_func_name
180180
self.dump(f'void {c_func}({parameters});')
181181
self.dump(f'void {c_func}({parameters})')
182-
count_type, disp_type = ('MPI_Count', 'MPI_Aint') if self.bigcount else ('int', 'int')
182+
count_type, disp_type, count_fint_type = ('MPI_Count', 'MPI_Aint', 'MPI_Count') if self.bigcount else ('int', 'int', 'MPI_Fint')
183183
self.template.print_body(c_func, out=self.out,
184184
replacements={'INNER_CALL': self.inner_call,
185185
'COUNT_TYPE': count_type,
186+
'COUNT_FINT_TYPE': count_fint_type,
186187
'DISP_TYPE': disp_type})
187188

188189
def print_interface(self):

‎ompi/mpi/fortran/use-mpi-f08/allgather_init_ts.c.in‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
1313
* Copyright (c) 2015-2021 Research Organization for Information Science
1414
* and Technology (RIST). All rights reserved.
15-
* Copyright (c) 2024 Triad National Security, LLC. All rights
15+
* Copyright (c) 2024-2025 Triad National Security, LLC. All rights
1616
* reserved.
1717
* $COPYRIGHT$
1818
*
@@ -33,6 +33,7 @@ PROTOTYPE VOID allgather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtyp
3333
MPI_Info c_info;
3434
void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
3535
@COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@) *sendcount;
36+
@COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@) *recvcount;
3637

3738
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
3839
if (MPI_SUCCESS != c_ierr) {
@@ -66,7 +67,7 @@ PROTOTYPE VOID allgather_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtyp
6667
c_sendcount,
6768
c_senddatatype,
6869
recvbuf,
69-
(@COUNT_TYPE@) *recvcount,
70+
c_recvcount,
7071
c_recvtype, c_comm, c_info, &c_req);
7172

7273
if (c_senddatatype != c_sendtype) {

‎ompi/mpi/fortran/use-mpi-f08/allgather_ts.c.in‎

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
1313
* Copyright (c) 2015-2019 Research Organization for Information Science
1414
* and Technology (RIST). All rights reserved.
15-
* Copyright (c) 2024 Triad National Security, LLC. All rights
15+
* Copyright (c) 2024-2025 Triad National Security, LLC. All rights
1616
* reserved.
1717
* $COPYRIGHT$
1818
*
@@ -28,7 +28,8 @@ PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
2828
{
2929
int c_ierr;
3030
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
31-
int c_sendcount = 0;
31+
@COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)*sendcount;
32+
@COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@)*recvcount;
3233
MPI_Datatype c_sendtype = NULL, c_senddatatype = NULL;
3334
MPI_Datatype c_recvtype = PMPI_Type_f2c(*recvtype);
3435
void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
@@ -60,7 +61,7 @@ PROTOTYPE VOID allgather(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
6061
c_sendcount,
6162
c_senddatatype,
6263
recvbuf,
63-
OMPI_FINT_2_INT(*recvcount),
64+
c_recvcount,
6465
c_recvtype, c_comm);
6566

6667
if (c_senddatatype != c_sendtype) {

‎ompi/mpi/fortran/use-mpi-f08/alltoall_init_ts.c.in‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,8 @@ PROTOTYPE VOID alltoall_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype
3232
MPI_Datatype c_sendtype, c_recvtype;
3333
MPI_Info c_info;
3434
void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
35+
@COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)*sendcount;
36+
@COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@)*recvcount;
3537

3638
c_comm = PMPI_Comm_f2c(*comm);
3739
c_sendtype = PMPI_Type_f2c(*sendtype);
@@ -61,10 +63,10 @@ PROTOTYPE VOID alltoall_init(BUFFER_ASYNC x1, COUNT sendcount, DATATYPE sendtype
6163
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
6264

6365
c_ierr = @INNER_CALL@(sendbuf,
64-
(@COUNT_TYPE@) *sendcount,
66+
c_sendcount,
6567
c_sendtype,
6668
recvbuf,
67-
(@COUNT_TYPE@) *recvcount,
69+
c_recvcount,
6870
c_recvtype, c_comm, c_info, &c_req);
6971
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
7072

‎ompi/mpi/fortran/use-mpi-f08/alltoall_ts.c.in‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
1313
* Copyright (c) 2015-2019 Research Organization for Information Science
1414
* and Technology (RIST). All rights reserved.
15-
* Copyright (c) 2024 Triad National Security, LLC. All rights
15+
* Copyright (c) 2024-2025 Triad National Security, LLC. All rights
1616
* reserved.
1717
* $COPYRIGHT$
1818
*
@@ -30,11 +30,11 @@ PROTOTYPE VOID alltoall(BUFFER x1, COUNT sendcount, DATATYPE sendtype,
3030
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
3131
MPI_Datatype c_sendtype = NULL, c_recvtype = PMPI_Type_f2c(*recvtype);
3232
void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
33-
int c_sendcount = 0, c_recvcount = OMPI_FINT_2_INT(*recvcount);
33+
@COUNT_TYPE@ c_sendcount = (@COUNT_TYPE@)(*sendcount);
34+
@COUNT_TYPE@ c_recvcount = (@COUNT_TYPE@)(*recvcount);
3435

3536
if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
3637
c_sendtype = PMPI_Type_f2c(*sendtype);
37-
c_sendcount = OMPI_FINT_2_INT(*sendcount);
3838
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
3939
if (MPI_SUCCESS != c_ierr) {
4040
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

‎ompi/mpi/fortran/use-mpi-f08/alltoallv_init_ts.c.in‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -62,8 +62,6 @@ PROTOTYPE VOID alltoallv_init(BUFFER_ASYNC x1, COUNT_ARRAY sendcounts, DISP_ARRA
6262
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
6363
return;
6464
}
65-
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
66-
OMPI_ARRAY_FINT_2_INT(sdispls, size);
6765
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size);
6866
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size);
6967

‎ompi/mpi/fortran/use-mpi-f08/alltoallv_ts.c.in‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
1313
* Copyright (c) 2015-2019 Research Organization for Information Science
1414
* and Technology (RIST). All rights reserved.
15-
* Copyright (c) 2024 Triad National Security, LLC. All rights
15+
* Copyright (c) 2024-2025 Triad National Security, LLC. All rights
1616
* reserved.
1717
* $COPYRIGHT$
1818
*
@@ -72,10 +72,9 @@ PROTOTYPE VOID alltoallv(BUFFER x1, COUNT_ARRAY sendcounts, DISP_ARRAY sdispls,
7272
c_recvtype, c_comm);
7373

7474
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
75-
if (MPI_IN_PLACE == sendbuf) {
76-
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
77-
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
78-
}
75+
76+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
77+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
7978
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts);
8079
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls);
8180
}

‎ompi/mpi/fortran/use-mpi-f08/alltoallw_ts.c.in‎

Lines changed: 36 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@
1212
* Copyright (c) 2011-2012 Cisco Systems, Inc. All rights reserved.
1313
* Copyright (c) 2015-2019 Research Organization for Information Science
1414
* and Technology (RIST). All rights reserved.
15-
* Copyright (c) 2024 Triad National Security, LLC. All rights
15+
* Copyright (c) 2024-2025 Triad National Security, LLC. All rights
1616
* reserved.
1717
* $COPYRIGHT$
1818
*
@@ -27,42 +27,42 @@ PROTOTYPE VOID alltoallw(BUFFER x1, COUNT_ARRAY sendcounts,
2727
DISP_ARRAY rdispls, DATATYPE_ARRAY recvtypes,
2828
COMM comm)
2929
{
30-
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
31-
MPI_Datatype *c_sendtypes = NULL, *c_recvtypes;
3230
int size, c_ierr;
31+
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
3332
char *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
33+
MPI_Datatype *c_sendtypes = NULL, *c_recvtypes;
34+
@COUNT_TYPE@ *tmp_sendcounts = NULL;
35+
@DISP_TYPE@ *tmp_sdispls = NULL;
36+
@COUNT_TYPE@ *tmp_recvcounts = NULL;
37+
@DISP_TYPE@ *tmp_rdispls = NULL;
3438

35-
OMPI_ARRAY_NAME_DECL(sendcounts);
36-
OMPI_ARRAY_NAME_DECL(sdispls);
37-
OMPI_ARRAY_NAME_DECL(recvcounts);
38-
OMPI_ARRAY_NAME_DECL(rdispls);
39+
size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
3940

40-
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
41-
if (MPI_SUCCESS != c_ierr) {
42-
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
43-
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
44-
return;
41+
if (OMPI_COMM_IS_INTER(c_comm) || !OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
42+
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
43+
if (MPI_SUCCESS != c_ierr) {
44+
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
45+
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
46+
return;
47+
}
48+
c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
49+
for (int i=0; i<size; i++) {
50+
c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
51+
}
52+
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sendcounts, tmp_sendcounts, size);
53+
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(sdispls, tmp_sdispls, size);
54+
} else {
55+
sendbuf = MPI_IN_PLACE;
4556
}
57+
4658
OMPI_CFI_CHECK_CONTIGUOUS(x2, c_ierr);
4759
if (MPI_SUCCESS != c_ierr) {
4860
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
4961
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
5062
return;
5163
}
52-
size = OMPI_COMM_IS_INTER(c_comm)?ompi_comm_remote_size(c_comm):ompi_comm_size(c_comm);
53-
54-
if (!OMPI_IS_FORTRAN_IN_PLACE(sendbuf)) {
55-
c_sendtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
56-
OMPI_ARRAY_FINT_2_INT(sendcounts, size);
57-
OMPI_ARRAY_FINT_2_INT(sdispls, size);
58-
for (int i=0; i<size; i++) {
59-
c_sendtypes[i] = PMPI_Type_f2c(sendtypes[i]);
60-
}
61-
}
6264

6365
c_recvtypes = (MPI_Datatype *) malloc(size * sizeof(MPI_Datatype));
64-
OMPI_ARRAY_FINT_2_INT(recvcounts, size);
65-
OMPI_ARRAY_FINT_2_INT(rdispls, size);
6666
for (int i=0; i<size; i++) {
6767
c_recvtypes[i] = PMPI_Type_f2c(recvtypes[i]);
6868
}
@@ -71,20 +71,24 @@ PROTOTYPE VOID alltoallw(BUFFER x1, COUNT_ARRAY sendcounts,
7171
sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
7272
recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);
7373

74+
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(recvcounts, tmp_recvcounts, size);
75+
OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(rdispls, tmp_rdispls, size);
76+
7477
c_ierr = @INNER_CALL@(sendbuf,
75-
OMPI_ARRAY_NAME_CONVERT(sendcounts),
76-
OMPI_ARRAY_NAME_CONVERT(sdispls),
78+
tmp_sendcounts,
79+
tmp_sdispls,
7780
c_sendtypes,
7881
recvbuf,
79-
OMPI_ARRAY_NAME_CONVERT(recvcounts),
80-
OMPI_ARRAY_NAME_CONVERT(rdispls),
82+
tmp_recvcounts,
83+
tmp_rdispls,
8184
c_recvtypes, c_comm);
8285
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
8386

84-
OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
85-
OMPI_ARRAY_FINT_2_INT_CLEANUP(sdispls);
86-
OMPI_ARRAY_FINT_2_INT_CLEANUP(recvcounts);
87-
OMPI_ARRAY_FINT_2_INT_CLEANUP(rdispls);
87+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sendcounts, tmp_sendcounts);
88+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(sdispls, tmp_sdispls);
89+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(recvcounts, tmp_recvcounts);
90+
OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(rdispls, tmp_rdispls);
91+
8892
if (NULL != c_sendtypes) {
8993
free(c_sendtypes);
9094
}

‎ompi/mpi/fortran/use-mpi-f08/base/bigcount.h‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
#define OMPI_FORTRAN_BIGCOUNT_ARRAY_SET(array, tmp_array, n) \
1616
do { \
1717
if (sizeof(*(array)) == sizeof(*(tmp_array))) { \
18-
(tmp_array) = (array); \
18+
(tmp_array) = (void *)(array); \
1919
} else { \
2020
(tmp_array) = malloc(sizeof(*tmp_array) * n); \
2121
for (int bigcount_array_i = 0; bigcount_array_i < n; ++bigcount_array_i) { \
@@ -24,9 +24,19 @@
2424
} \
2525
} while (0)
2626

27-
#define OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(array, tmp_array) \
27+
#define OMPI_FORTRAN_BIGCOUNT_ARRAY_COPYOUT(array, tmp_array, n) \
2828
do { \
2929
if ((array) != (tmp_array) && NULL != (tmp_array)) { \
30+
for (int bigcount_array_i = 0; bigcount_array_i < n; ++bigcount_array_i) { \
31+
(array)[bigcount_array_i] = (tmp_array)[bigcount_array_i]; \
32+
} \
33+
} \
34+
} while (0)
35+
36+
37+
#define OMPI_FORTRAN_BIGCOUNT_ARRAY_CLEANUP(array, tmp_array) \
38+
do { \
39+
if ((void *)(array) != (void *)(tmp_array) && NULL != (tmp_array)) { \
3040
free(tmp_array); \
3141
tmp_array = NULL; \
3242
} \
@@ -36,7 +46,7 @@
3646
do { \
3747
if (MPI_SUCCESS == (c_ierr)) { \
3848
ompi_coll_base_nbc_request_t* nb_request = (ompi_coll_base_nbc_request_t*)c_request; \
39-
if ((array) != (tmp_array) && (tmp_array) != NULL) { \
49+
if ((void *)(array) != (void *)(tmp_array) && (tmp_array) != NULL) { \
4050
nb_request->data.release_arrays[(idx)++] = tmp_array; \
4151
} \
4252
nb_request->data.release_arrays[idx] = NULL; \

0 commit comments

Comments
 (0)