Commit 9008c2f7 authored by Junchao Zhang's avatar Junchao Zhang
Browse files

Revise impl of MPI_IN_PLACE and MPI_BOTTOM

Since Fortran forbids passing a disassociated (e.g., NULL) pointer to a non-pointer dummy argument
(e.g., an assumed-type, assumed-rank argument), we can not use the same MPI_BOTTOM value in C from Fortran.
So we use another approach.

See implementation details at the EuroMPI-2014 paper "Implementing the MPI-3.0 Fortran 2008 Binding"

No review since F08 binding is experimental now.
parent 1c2b3d35
......@@ -72,8 +72,7 @@ type(c_ptr), protected, bind(C, name="MPIR_C_MPI_WEIGHTS_EMPTY") :: MPIR_C_MPI_W
! MPI_IN_PLACE
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
integer, bind(C, name="MPIR_F08_MPI_IN_PLACE_OBJ"), target :: MPI_IN_PLACE
type(c_ptr), bind(C, name="MPIR_F08_MPI_IN_PLACE") :: MPIR_F08_MPI_IN_PLACE ! Point to MPI_IN_PLACE
integer(c_int), bind(C, name="MPIR_F08_MPI_IN_PLACE"), target :: MPI_IN_PLACE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
......@@ -82,6 +81,6 @@ type(c_ptr), bind(C, name="MPIR_F08_MPI_IN_PLACE") :: MPIR_F08_MPI_IN_PLACE ! Po
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Buffer Address Constants
! A.1.1 p. 663
integer, pointer :: MPI_BOTTOM => NULL()
integer(c_int), bind(C, name="MPIR_F08_MPI_BOTTOM"), target :: MPI_BOTTOM
end module mpi_f08_link_constants
......@@ -329,6 +329,7 @@ while (<FD>) {
#include "cdesc.h"
EOT
my @choice_buf_indices;
print CFILE "\n$retarg $cdesc_routine(";
print CDESCH "extern $retarg $cdesc_routine(";
......@@ -358,9 +359,10 @@ EOT
}
}
# replace void * with CFI_cdesc_t*
# replace void * with CFI_cdesc_t*, and record choice buffer arg indices.
if ($arglist[$x] =~ /.*void\s*\*/) {
$arglist[$x] = "CFI_cdesc_t*";
push(@choice_buf_indices, $x);
}
@argbits = split(/ /, $arglist[$x]);
......@@ -392,38 +394,48 @@ EOT
print CFILE "#ifdef MPI_MODE_RDONLY\n"
}
#================================================
#
# Print body of the C wrapper function
#
#================================================
print CFILE "${tab}int err = MPI_SUCCESS;\n";
print CFILE "${tab}int is_contig = 1;\n\n";
for ($x = 0; $x <= $#arglist; $x++) {
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE " /* When MPI_BOTTOM is passed in, base_addr is NULL and it is illegal to call CFI_is_contiguous. */\n";
print CFILE "${tab}if (x$x->base_addr != NULL) {\n";
print CFILE "${tab}${tab}if (!CFI_is_contiguous(x$x)) { is_contig = 0; }\n";
print CFILE "${tab}}\n"
}
print CFILE "${tab}int is_contig = 1;\n";
for my $i (@choice_buf_indices) {
print CFILE " void *addr$i = x$i->base_addr;\n"
}
print CFILE "\n";
print CFILE "${tab}if (is_contig) {\n";
# Handle MPI_BOTTOM
for my $i (@choice_buf_indices) {
print CFILE " if (addr$i == &MPIR_F08_MPI_BOTTOM) {\n";
print CFILE " addr$i = MPI_BOTTOM;\n";
print CFILE " }\n\n";
}
# Hanlde MPI_IN_PLACE
if (defined($inplace{$routine})) {
print CFILE "${tab}${tab}void *addr = x$inplace{$routine}->base_addr;\n";
print CFILE "${tab}${tab}if (addr == MPIR_F08_MPI_IN_PLACE)\n";
print CFILE "${tab}${tab}${tab}addr = MPI_IN_PLACE;\n\n";
my $i = $inplace{$routine};
print CFILE " if (addr$i == &MPIR_F08_MPI_IN_PLACE) {\n";
print CFILE " addr$i = MPI_IN_PLACE;\n";
print CFILE " }\n\n";
}
print CFILE "${tab}${tab}err = $routine(";
for ($x = 0; $x <= $#arglist; $x++) {
if ($x) {
# Test if all choice buffers are contiguous
for my $i (@choice_buf_indices) {
print CFILE " if (!CFI_is_contiguous(x$i)) is_contig = 0;\n\n";
}
print CFILE " if (is_contig) {\n";
print CFILE " err = $routine(";
for (my $i = 0; $i <= $#arglist; $i++) {
if ($i) {
print CFILE ", ";
}
if (defined($inplace{$routine}) && $x eq $inplace{$routine}) {
print CFILE "addr";
}
else {
print CFILE "x$x";
if ($arglist[$x] =~ /CFI_cdesc_t\*/) {
print CFILE "->base_addr";
}
if ($arglist[$i] =~ /CFI_cdesc_t\*/) {
print CFILE "addr$i";
} else {
print CFILE "x$i";
}
}
print CFILE ");\n";
......
......@@ -740,8 +740,8 @@ extern MPIU_DLL_SPEC MPI_Fint * MPI_F_STATUSES_IGNORE;
The field order should match that in mpi_f08_types.f90, and mpi_c_interface_types.f90.
*/
typedef struct {
int count_lo;
int count_hi_and_cancelled;
MPI_Fint count_lo;
MPI_Fint count_hi_and_cancelled;
MPI_Fint MPI_SOURCE;
MPI_Fint MPI_TAG;
MPI_Fint MPI_ERROR;
......@@ -749,12 +749,12 @@ typedef struct {
extern MPI_F08_Status MPIR_F08_MPI_STATUS_IGNORE_OBJ;
extern MPI_F08_Status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1];
extern MPI_Fint MPIR_F08_MPI_IN_PLACE_OBJ;
extern int MPIR_F08_MPI_IN_PLACE;
extern int MPIR_F08_MPI_BOTTOM;
/* Pointers to above objects */
extern MPI_F08_Status *MPI_F08_STATUS_IGNORE;
extern MPI_F08_Status *MPI_F08_STATUSES_IGNORE;
extern void *MPIR_F08_MPI_IN_PLACE;
/* For supported thread levels */
#define MPI_THREAD_SINGLE 0
......
......@@ -296,13 +296,12 @@ int *MPIR_C_MPI_ERRCODES_IGNORE;
MPI_F08_Status MPIR_F08_MPI_STATUS_IGNORE_OBJ;
MPI_F08_Status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1];
MPI_Fint MPIR_F08_MPI_IN_PLACE_OBJ;
int MPIR_F08_MPI_IN_PLACE;
int MPIR_F08_MPI_BOTTOM;
/* Althought the two STATUS pointers are required but the MPI3.0, they are not used in MPICH F08 binding */
MPI_F08_Status *MPI_F08_STATUS_IGNORE = &MPIR_F08_MPI_STATUS_IGNORE_OBJ;
MPI_F08_Status *MPI_F08_STATUSES_IGNORE = &MPIR_F08_MPI_STATUSES_IGNORE_OBJ[0];
void *MPIR_F08_MPI_IN_PLACE = &MPIR_F08_MPI_IN_PLACE_OBJ;
#endif
#undef FUNCNAME
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment