From 9c7c07b6202e22b4d6a247e1a1b50c5b88d9703c Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Tue, 16 Nov 2021 23:50:59 -0600 Subject: [PATCH 1/7] python: extend linebreak for fortran declarations Extend linebreak for general line with comma separations. This is to allow using linebreaking for Fortran declarations. --- maint/local_python/binding_common.py | 24 ++++++++++++++---------- maint/local_python/binding_f08.py | 16 ++++++++-------- 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/maint/local_python/binding_common.py b/maint/local_python/binding_common.py index 5d52649df5a..f53603e5c05 100644 --- a/maint/local_python/binding_common.py +++ b/maint/local_python/binding_common.py @@ -55,14 +55,9 @@ def split_line_with_break(s, tail, N=100): if RE.match(r'(\s*)', s): n_lead = len(RE.m.group(1)) + 4 - if len(s) < N: - tlist.append(s) - n = len(s) - elif RE.match(r'(.*?\()(.*)', s): - # line with function pattern, match indent at opening parenthesis - s_lead, s_next = RE.m.group(1,2) - n_lead = len(s_lead) - + # ------------- + def break_s_next(s_lead, s_next): + nonlocal tlist, n for a in s_next.split(', '): if n == 0: # first line @@ -86,10 +81,19 @@ def split_line_with_break(s, tail, N=100): tlist = [' ' * n_lead, a] n = n_lead + len(a) # leave last segment with tail - else: - # only break long function declaration or call for now + + # ------------- + if len(s) < N: tlist.append(s) n = len(s) + elif RE.match(r'(.*?\()(.*)', s): + # line with function pattern, match indent at opening parenthesis + s_lead, s_next = RE.m.group(1,2) + n_lead = len(s_lead) + + break_s_next(s_lead, s_next) + else: + break_s_next('', s) # tail is mostly for "__attribute__ ((weak, alias(...))));", # which contains , that we do not desire to break diff --git a/maint/local_python/binding_f08.py b/maint/local_python/binding_f08.py index ee4fa7fab9b..d027edf779c 100644 --- a/maint/local_python/binding_f08.py +++ b/maint/local_python/binding_f08.py @@ -921,21 +921,21 @@ def dump_F_uses(uses): else: mpi_c_list_2.append(a) if iso_c_binding_list: - G.out.append("USE, intrinsic :: iso_c_binding, ONLY : %s" % ', '.join(iso_c_binding_list)) + dump_fortran_line("USE, intrinsic :: iso_c_binding, ONLY : %s" % ', '.join(iso_c_binding_list)) if mpi_f08_list_1: - G.out.append("USE :: mpi_f08_types, ONLY : %s" % ', '.join(mpi_f08_list_1)) + dump_fortran_line("USE :: mpi_f08_types, ONLY : %s" % ', '.join(mpi_f08_list_1)) if mpi_f08_list_2: - G.out.append("USE :: mpi_f08_compile_constants, ONLY : %s" % ', '.join(mpi_f08_list_2)) + dump_fortran_line("USE :: mpi_f08_compile_constants, ONLY : %s" % ', '.join(mpi_f08_list_2)) if mpi_f08_list_3: - G.out.append("USE :: mpi_f08_link_constants, ONLY : %s" % ', '.join(mpi_f08_list_3)) + dump_fortran_line("USE :: mpi_f08_link_constants, ONLY : %s" % ', '.join(mpi_f08_list_3)) if mpi_f08_list_4: - G.out.append("USE :: mpi_f08_callbacks, ONLY : %s" % ', '.join(mpi_f08_list_4)) + dump_fortran_line("USE :: mpi_f08_callbacks, ONLY : %s" % ', '.join(mpi_f08_list_4)) if mpi_c_list_1: - G.out.append("USE :: mpi_c_interface_types, ONLY : %s" % ', '.join(mpi_c_list_1)) + dump_fortran_line("USE :: mpi_c_interface_types, ONLY : %s" % ', '.join(mpi_c_list_1)) if mpi_c_list_2: - G.out.append("USE :: mpi_c_interface, ONLY : %s" % ', '.join(mpi_c_list_2)) + dump_fortran_line("USE :: mpi_c_interface, ONLY : %s" % ', '.join(mpi_c_list_2)) if mpi_c_list_3: - G.out.append("USE :: mpi_c_interface_glue, ONLY : %s" % ', '.join(mpi_c_list_3)) + dump_fortran_line("USE :: mpi_c_interface_glue, ONLY : %s" % ', '.join(mpi_c_list_3)) def dump_F_if_open(cond): G.out.append("IF (%s) THEN" % cond) From 6d8c5496a19405e75068e65181ece283b2579b26 Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Tue, 16 Nov 2021 23:08:41 -0600 Subject: [PATCH 2/7] f08: use wrapper c function for pointer constants The mechanism for external linkage of global variable from fortran dynamic library to C dynamic library is fragile despite the fortran specification. For example, currently this mechanism does not work on osx. Rather than adding more hacking and work arounds, avoid the mess by simply getting the symbol using a C function. The f08 interoperability using C functions is fairly robust. --- maint/local_python/binding_f08.py | 16 ++--- .../use_mpi_f08/mpi_f08_link_constants.f90 | 63 ++++++++++++++++--- .../fortran/use_mpi_f08/wrappers_c/cdesc.c | 6 -- .../fortran/use_mpi_f08/wrappers_c/cdesc.h | 14 +++-- .../fortran/use_mpi_f08/wrappers_c/utils.c | 35 +++++++++++ src/mpi/init/init_bindings.c | 13 ---- src/mpi/init/mpi_init.h | 1 - src/mpi/init/mpir_init.c | 1 - 8 files changed, 104 insertions(+), 45 deletions(-) diff --git a/maint/local_python/binding_f08.py b/maint/local_python/binding_f08.py index d027edf779c..dd7a9f2cdc0 100644 --- a/maint/local_python/binding_f08.py +++ b/maint/local_python/binding_f08.py @@ -350,7 +350,7 @@ def process_status(p): if p['length'] is not None: # always output parameter uses['MPI_STATUSES_IGNORE'] = 1 - uses['MPIR_C_MPI_STATUSES_IGNORE'] = 1 + uses['MPIR_F08_get_MPI_STATUSES_IGNORE_c'] = 1 need_check_status_ignore = p arg_1 = ":STATUS:" arg_2 = ":STATUS:" @@ -364,7 +364,7 @@ def process_status(p): if p['param_direction'] == 'out': need_check_status_ignore = p uses['MPI_STATUS_IGNORE'] = 1 - uses['MPIR_C_MPI_STATUS_IGNORE'] = 1 + uses['MPIR_F08_get_MPI_STATUS_IGNORE_c'] = 1 arg_1 = ":STATUS:" arg_2 = ":STATUS:" p['_status_convert'] = "status = status_c" @@ -440,18 +440,18 @@ def process_array_check(p): if check: uses['c_associated'] = 1 uses[check] = 1 - uses['MPIR_C_%s' % check] = 1 + uses['MPIR_F08_get_%s_c' % check] = 1 convert_list_pre.append("IF (c_associated(%s, c_loc(%s))) THEN" % (arg_1, check)) - convert_list_pre.append(" %s = MPIR_C_%s" % (arg_1, check)) + convert_list_pre.append(" %s = MPIR_F08_get_%s_c()" % (arg_1, check)) if check == "MPI_ERRCODES_IGNORE": convert_list_pre.append(" has_errcodes_ignore = .true.") elif check == "MPI_UNWEIGHTED": # also need check MPI_WEIGHTS_EMPTY check = "MPI_WEIGHTS_EMPTY" uses[check] = 1 - uses['MPIR_C_%s' % check] = 1 + uses['MPIR_F08_get_%s_c' % check] = 1 convert_list_pre.append("ELSE IF (c_associated(%s, c_loc(%s))) THEN" % (arg_1, check)) - convert_list_pre.append(" %s = MPIR_C_%s" % (arg_1, check)) + convert_list_pre.append(" %s = MPIR_F08_get_%s_c()" % (arg_1, check)) convert_list_pre.append("ELSE") convert_list_pre.append(" %s = c_loc(%s)" % (arg_1, p['name'])) convert_list_pre.append(" has_%s = .true." % p['name']) @@ -688,7 +688,7 @@ def dump_call(s, check_int_kind): else: ignore = 'MPI_STATUSES_IGNORE' dump_F_if_open("c_associated(c_loc(%s), c_loc(%s))" % (p['name'], ignore)) - s2 = re.sub(r':STATUS:', "MPIR_C_%s" % ignore, s) + s2 = re.sub(r':STATUS:', "MPIR_F08_get_%s_c()" % ignore, s) dump_fortran_line(s2) dump_F_else() if check_int_kind: @@ -908,7 +908,7 @@ def dump_F_uses(uses): mpi_c_list_3.append(a) elif re.match(r'MPI_\w+_(function|FN|FN_NULL)(_c)?$', a, re.IGNORECASE): mpi_f08_list_4.append(a) - elif re.search(r'(STATUS.*IGNORE|ARGV.*NULL|ERRCODES_IGNORE|_UNWEIGHTED|WEIGHTS_EMPTY|MPI_IN_PLACE|MPI_BOTTOM)$', a, re.IGNORECASE): + elif re.search(r'(STATUS.*IGNORE|ARGV.*NULL|ERRCODES_IGNORE|_UNWEIGHTED|WEIGHTS_EMPTY|MPI_IN_PLACE|MPI_BOTTOM)', a, re.IGNORECASE): mpi_f08_list_3.append(a) elif re.match(r'MPI_[A-Z_]+$', a): mpi_f08_list_2.append(a) diff --git a/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 b/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 index bcf6ca639de..5167a89c461 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 +++ b/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 @@ -24,9 +24,6 @@ module mpi_f08_link_constants type(MPI_Status), bind(C, name="MPIR_F08_MPI_STATUS_IGNORE_OBJ"), target :: MPI_STATUS_IGNORE type(MPI_Status), dimension(1), bind(C, name="MPIR_F08_MPI_STATUSES_IGNORE_OBJ"), target :: MPI_STATUSES_IGNORE -type(c_ptr), bind(C, name="MPIR_C_MPI_STATUS_IGNORE") :: MPIR_C_MPI_STATUS_IGNORE -type(c_ptr), bind(C, name="MPIR_C_MPI_STATUSES_IGNORE") :: MPIR_C_MPI_STATUSES_IGNORE - ! Though these two variables are required by MPI-3 Standard, they are not used in MPICH type(c_ptr), bind(C, name="MPI_F08_STATUS_IGNORE") :: MPI_F08_STATUS_IGNORE ! Point to MPI_STATUS_IGNORE type(c_ptr), bind(C, name="MPI_F08_STATUSES_IGNORE") :: MPI_F08_STATUSES_IGNORE ! Point to MPI_STATUSES_IGNORE @@ -41,9 +38,6 @@ module mpi_f08_link_constants character(len=1), dimension(1), target :: MPI_ARGV_NULL character(len=1), dimension(1,1), target :: MPI_ARGVS_NULL -type(c_ptr), bind(C, name="MPIR_C_MPI_ARGV_NULL") :: MPIR_C_MPI_ARGV_NULL -type(c_ptr), bind(C, name="MPIR_C_MPI_ARGVS_NULL") :: MPIR_C_MPI_ARGVS_NULL - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! @@ -51,7 +45,6 @@ module mpi_f08_link_constants ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! integer, dimension(1), target :: MPI_ERRCODES_IGNORE -type(c_ptr), bind(C, name="MPIR_C_MPI_ERRCODES_IGNORE") :: MPIR_C_MPI_ERRCODES_IGNORE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -64,9 +57,6 @@ module mpi_f08_link_constants integer, dimension(1), target :: MPI_UNWEIGHTED integer, dimension(1), target :: MPI_WEIGHTS_EMPTY -type(c_ptr), protected, bind(C, name="MPIR_C_MPI_UNWEIGHTED") :: MPIR_C_MPI_UNWEIGHTED -type(c_ptr), protected, bind(C, name="MPIR_C_MPI_WEIGHTS_EMPTY") :: MPIR_C_MPI_WEIGHTS_EMPTY - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! ! MPI_IN_PLACE @@ -83,4 +73,57 @@ module mpi_f08_link_constants ! A.1.1 p. 663 integer(c_int), bind(C, name="MPIR_F08_MPI_BOTTOM"), target :: MPI_BOTTOM +INTERFACE + +FUNCTION MPIR_F08_get_MPI_STATUS_IGNORE_c() & + bind (C, name="MPIR_F08_get_MPI_STATUS_IGNORE") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_STATUSES_IGNORE_c() & + bind (C, name="MPIR_F08_get_MPI_STATUSES_IGNORE") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_ARGV_NULL_c() & + bind (C, name="MPIR_F08_get_MPI_ARGV_NULL") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_ARGVS_NULL_c() & + bind (C, name="MPIR_F08_get_MPI_ARGVS_NULL") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_ERRCODES_IGNORE_c() & + bind (C, name="MPIR_F08_get_MPI_ERRCODES_IGNORE") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_UNWEIGHTED_c() & + bind (C, name="MPIR_F08_get_MPI_UNWEIGHTED") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +FUNCTION MPIR_F08_get_MPI_WEIGHTS_EMPTY_c() & + bind (C, name="MPIR_F08_get_MPI_WEIGHTS_EMPTY") result(p) + USE, intrinsic :: iso_c_binding, ONLY : c_ptr + IMPLICIT NONE + TYPE(c_ptr) :: p +END FUNCTION + +END INTERFACE + end module mpi_f08_link_constants diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c index d55247287fc..70226dc939a 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c @@ -6,12 +6,6 @@ #include "cdesc.h" #include -MPI_Status *MPIR_C_MPI_STATUS_IGNORE = MPI_STATUS_IGNORE; -MPI_Status *MPIR_C_MPI_STATUSES_IGNORE = MPI_STATUSES_IGNORE; -char **MPIR_C_MPI_ARGV_NULL = MPI_ARGV_NULL; -char ***MPIR_C_MPI_ARGVS_NULL = MPI_ARGVS_NULL; -int *MPIR_C_MPI_ERRCODES_IGNORE = MPI_ERRCODES_IGNORE; - /* Fortran 2008 specifies a maximum rank of 15 */ #define MAX_RANK (15) diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h index fe460c767d2..fcfccefff95 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h @@ -16,12 +16,6 @@ #define MPIO_Request MPI_Request #endif -extern MPI_Status *MPIR_C_MPI_STATUS_IGNORE; -extern MPI_Status *MPIR_C_MPI_STATUSES_IGNORE; -extern char **MPIR_C_MPI_ARGV_NULL; -extern char ***MPIR_C_MPI_ARGVS_NULL; -extern int *MPIR_C_MPI_ERRCODES_IGNORE; - extern int cdesc_create_datatype(CFI_cdesc_t * cdesc, MPI_Aint oldcount, MPI_Datatype oldtype, MPI_Datatype * newtype); extern int MPIR_Fortran_array_of_string_f2c(const char *strs_f, char ***strs_c, int str_len, @@ -36,4 +30,12 @@ extern int MPIR_Comm_spawn_multiple_c(int count, char *array_of_commands_f, char int argv_elem_len); extern int MPIR_F_sync_reg_cdesc(CFI_cdesc_t * buf); +void *MPIR_F08_get_MPI_STATUS_IGNORE(void); +void *MPIR_F08_get_MPI_STATUSES_IGNORE(void); +void *MPIR_F08_get_MPI_ARGV_NULL(void); +void *MPIR_F08_get_MPI_ARGVS_NULL(void); +void *MPIR_F08_get_MPI_ERRCODES_IGNORE(void); +void *MPIR_F08_get_MPI_UNWEIGHTED(void); +void *MPIR_F08_get_MPI_WEIGHTS_EMPTY(void); + #endif /* CDESC_H_INCLUDED */ diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c index 241c7455334..665232da057 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c @@ -93,3 +93,38 @@ extern int MPIR_Fortran_array_of_string_f2c(const char *strs_f, char ***strs_c, fn_fail: goto fn_exit; } + +void *MPIR_F08_get_MPI_STATUS_IGNORE(void) +{ + return (void *) MPI_STATUS_IGNORE; +} + +void *MPIR_F08_get_MPI_STATUSES_IGNORE(void) +{ + return (void *) MPI_STATUSES_IGNORE; +} + +void *MPIR_F08_get_MPI_ARGV_NULL(void) +{ + return (void *) MPI_ARGV_NULL; +} + +void *MPIR_F08_get_MPI_ARGVS_NULL(void) +{ + return (void *) MPI_ARGVS_NULL; +} + +void *MPIR_F08_get_MPI_ERRCODES_IGNORE(void) +{ + return (void *) MPI_ERRCODES_IGNORE; +} + +void *MPIR_F08_get_MPI_UNWEIGHTED(void) +{ + return (void *) MPI_UNWEIGHTED; +} + +void *MPIR_F08_get_MPI_WEIGHTS_EMPTY(void) +{ + return (void *) MPI_WEIGHTS_EMPTY; +} diff --git a/src/mpi/init/init_bindings.c b/src/mpi/init/init_bindings.c index 2f5da0a3eec..85fb67d2388 100644 --- a/src/mpi/init/init_bindings.c +++ b/src/mpi/init/init_bindings.c @@ -23,9 +23,6 @@ void MPII_init_binding_cxx(void) /* ** F08 binding **************/ #ifdef HAVE_F08_BINDING -int *MPIR_C_MPI_UNWEIGHTED MPICH_API_PUBLIC; -int *MPIR_C_MPI_WEIGHTS_EMPTY MPICH_API_PUBLIC; - MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ; MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1]; int MPIR_F08_MPI_IN_PLACE; @@ -35,14 +32,4 @@ int MPIR_F08_MPI_BOTTOM; 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 MPII_init_binding_f08(void) -{ - MPIR_C_MPI_UNWEIGHTED = MPI_UNWEIGHTED; - MPIR_C_MPI_WEIGHTS_EMPTY = MPI_WEIGHTS_EMPTY; -} - -#else -void MPII_init_binding_f08(void) -{ -} #endif diff --git a/src/mpi/init/mpi_init.h b/src/mpi/init/mpi_init.h index f5558c08995..6c95c193867 100644 --- a/src/mpi/init/mpi_init.h +++ b/src/mpi/init/mpi_init.h @@ -54,7 +54,6 @@ int MPII_init_tag_ub(void); void MPII_init_windows(void); void MPII_init_binding_cxx(void); -void MPII_init_binding_f08(void); void MPII_pre_init_dbg_logging(int *argc, char ***argv); void MPII_init_dbg_logging(void); diff --git a/src/mpi/init/mpir_init.c b/src/mpi/init/mpir_init.c index 16c302afa56..54699093988 100644 --- a/src/mpi/init/mpir_init.c +++ b/src/mpi/init/mpir_init.c @@ -159,7 +159,6 @@ int MPII_Init_thread(int *argc, char ***argv, int user_required, int *provided, MPII_nettopo_init(); MPII_init_windows(); MPII_init_binding_cxx(); - MPII_init_binding_f08(); mpi_errno = MPII_init_local_proc_attrs(&required); MPIR_ERR_CHECK(mpi_errno); From fe5751b65012c51bc07c2db26aac75ace1952e40 Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Wed, 17 Nov 2021 00:00:22 -0600 Subject: [PATCH 3/7] xfail: remove osx f08 xfails These are due to link constants issues, addressed in this PR. --- test/mpi/maint/jenkins/xfail.conf | 1 - 1 file changed, 1 deletion(-) diff --git a/test/mpi/maint/jenkins/xfail.conf b/test/mpi/maint/jenkins/xfail.conf index 356f7b95af0..ac33f85c122 100644 --- a/test/mpi/maint/jenkins/xfail.conf +++ b/test/mpi/maint/jenkins/xfail.conf @@ -44,7 +44,6 @@ * * * * osx /^fileerrretx/ xfail=ticket0 errors/cxx/io/testlist * * * * osx /^throwtestfilex/ xfail=ticket0 errors/cxx/io/testlist * gnu debug ch3:tcp osx /^namepubx/ xfail=issue3506 cxx/spawn/testlist -* * * * osx /^dgraph_unwgtf90/ xfail=issue4374 f08/topo/testlist ################################################################################ # xfail large count tests on 32 bit architectures (cannot allocate such large memory) * * * * freebsd32 /^getfence1 [0-9]* arg=-type=.* arg=-count=16000000/ xfail=ticket0 rma/testlist.dtp From 6cddfcad46a5379d8dc4585946efa216004cc7ce Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Tue, 30 Nov 2021 12:21:09 -0600 Subject: [PATCH 4/7] f08: move MPIR_F08_MPI_IN_PLACE and MPIR_F08_MPI_BOTTOM Both symbols are not used by the C binding and can be contained in the Fortran binding. This avoids the issue of resolving common symbols depending on the behavior of dynamic linker. --- src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h | 3 +++ src/binding/fortran/use_mpi_f08/wrappers_c/utils.c | 3 +++ src/include/mpi.h.in | 2 -- src/mpi/init/init_bindings.c | 2 -- 4 files changed, 6 insertions(+), 4 deletions(-) diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h index fcfccefff95..372b04bb344 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h @@ -16,6 +16,9 @@ #define MPIO_Request MPI_Request #endif +extern int MPIR_F08_MPI_IN_PLACE; +extern int MPIR_F08_MPI_BOTTOM; + extern int cdesc_create_datatype(CFI_cdesc_t * cdesc, MPI_Aint oldcount, MPI_Datatype oldtype, MPI_Datatype * newtype); extern int MPIR_Fortran_array_of_string_f2c(const char *strs_f, char ***strs_c, int str_len, diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c index 665232da057..28a3cc1e57a 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c @@ -6,6 +6,9 @@ #include "cdesc.h" #include +int MPIR_F08_MPI_IN_PLACE MPICH_API_PUBLIC; +int MPIR_F08_MPI_BOTTOM MPICH_API_PUBLIC; + /* Convert an array of strings in Fortran Format to an array of strings in C format (i.e., char* a[]). diff --git a/src/include/mpi.h.in b/src/include/mpi.h.in index d82c5dd6734..23fb3b36fcd 100644 --- a/src/include/mpi.h.in +++ b/src/include/mpi.h.in @@ -794,8 +794,6 @@ typedef struct { extern MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ MPICH_API_PUBLIC; extern MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1] MPICH_API_PUBLIC; -extern int MPIR_F08_MPI_IN_PLACE MPICH_API_PUBLIC; -extern int MPIR_F08_MPI_BOTTOM MPICH_API_PUBLIC; /* Pointers to above objects */ extern MPI_F08_status *MPI_F08_STATUS_IGNORE MPICH_API_PUBLIC; diff --git a/src/mpi/init/init_bindings.c b/src/mpi/init/init_bindings.c index 85fb67d2388..d1e8236748e 100644 --- a/src/mpi/init/init_bindings.c +++ b/src/mpi/init/init_bindings.c @@ -25,8 +25,6 @@ void MPII_init_binding_cxx(void) #ifdef HAVE_F08_BINDING MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ; MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1]; -int MPIR_F08_MPI_IN_PLACE; -int MPIR_F08_MPI_BOTTOM; /* Although 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; From 9791151547013f7fe6ae6861b3ce895180151345 Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Tue, 30 Nov 2021 21:20:42 -0600 Subject: [PATCH 5/7] f08: move MPI_F08_STATUS[ES]_IGNORE into fortran bindings Both MPI_F08_STATUS_IGNORE and MPI_F08_STATUSES_IGNORE don't need live in the C Binding since application is not suppose to use them unless the fortran binding is linked. Move them to the fortran binding avoids the linkage dependency on dynamic linker, which appears very fragile and currently does not work on osx. Both symbols are C symbols, thus there is no need to declare them in mpi_f08_link_constants.f90. The original comment -- "Although ..., they are not used in ..." is misleading. The two symbols are for application use, regardless whether implementation use it or not. Define the symbols in mpi.h as external is safe. User is not supposed to use it unless they link with fortran binding, i.e. libmpifort.so, which will resolve the symbol. --- .../fortran/use_mpi_f08/mpi_f08_link_constants.f90 | 4 ---- src/binding/fortran/use_mpi_f08/wrappers_c/utils.c | 9 +++++++++ src/include/mpi.h.in | 9 +++------ src/mpi/init/init_bindings.c | 11 ----------- 4 files changed, 12 insertions(+), 21 deletions(-) diff --git a/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 b/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 index 5167a89c461..a753ee4a5c7 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 +++ b/src/binding/fortran/use_mpi_f08/mpi_f08_link_constants.f90 @@ -24,10 +24,6 @@ module mpi_f08_link_constants type(MPI_Status), bind(C, name="MPIR_F08_MPI_STATUS_IGNORE_OBJ"), target :: MPI_STATUS_IGNORE type(MPI_Status), dimension(1), bind(C, name="MPIR_F08_MPI_STATUSES_IGNORE_OBJ"), target :: MPI_STATUSES_IGNORE -! Though these two variables are required by MPI-3 Standard, they are not used in MPICH -type(c_ptr), bind(C, name="MPI_F08_STATUS_IGNORE") :: MPI_F08_STATUS_IGNORE ! Point to MPI_STATUS_IGNORE -type(c_ptr), bind(C, name="MPI_F08_STATUSES_IGNORE") :: MPI_F08_STATUSES_IGNORE ! Point to MPI_STATUSES_IGNORE - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c index 28a3cc1e57a..029a7064907 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/utils.c @@ -9,6 +9,15 @@ int MPIR_F08_MPI_IN_PLACE MPICH_API_PUBLIC; int MPIR_F08_MPI_BOTTOM MPICH_API_PUBLIC; +/* MPI_F08_STATUS_IGNORE and MPI_F08_STATUSES_IGNORE are required by MPI-3.0. + * the obj variables are linked in mpi_f08_link_constants module via bind(c). + */ +MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ MPICH_API_PUBLIC; +MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1] MPICH_API_PUBLIC; + +MPI_F08_status *MPI_F08_STATUS_IGNORE MPICH_API_PUBLIC = &MPIR_F08_MPI_STATUS_IGNORE_OBJ; +MPI_F08_status *MPI_F08_STATUSES_IGNORE MPICH_API_PUBLIC = &MPIR_F08_MPI_STATUSES_IGNORE_OBJ[0]; + /* Convert an array of strings in Fortran Format to an array of strings in C format (i.e., char* a[]). diff --git a/src/include/mpi.h.in b/src/include/mpi.h.in index 23fb3b36fcd..1c15032a0a2 100644 --- a/src/include/mpi.h.in +++ b/src/include/mpi.h.in @@ -792,12 +792,9 @@ typedef struct { #define MPI_F_TAG 3 #define MPI_F_ERROR 4 -extern MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ MPICH_API_PUBLIC; -extern MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1] MPICH_API_PUBLIC; - -/* Pointers to above objects */ -extern MPI_F08_status *MPI_F08_STATUS_IGNORE MPICH_API_PUBLIC; -extern MPI_F08_status *MPI_F08_STATUSES_IGNORE MPICH_API_PUBLIC; +/* Provided in libmpifort.so */ +extern MPI_F08_status *MPI_F08_STATUS_IGNORE; +extern MPI_F08_status *MPI_F08_STATUSES_IGNORE; /* For supported thread levels */ #define MPI_THREAD_SINGLE 0 diff --git a/src/mpi/init/init_bindings.c b/src/mpi/init/init_bindings.c index d1e8236748e..4fdb6a3928c 100644 --- a/src/mpi/init/init_bindings.c +++ b/src/mpi/init/init_bindings.c @@ -20,14 +20,3 @@ void MPII_init_binding_cxx(void) MPIR_Process.cxx_call_op_fn = 0; #endif } - -/* ** F08 binding **************/ -#ifdef HAVE_F08_BINDING -MPI_F08_status MPIR_F08_MPI_STATUS_IGNORE_OBJ; -MPI_F08_status MPIR_F08_MPI_STATUSES_IGNORE_OBJ[1]; - -/* Although 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]; - -#endif From 11d681f0928d533af96b392a3b614606821d19d9 Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Wed, 1 Dec 2021 10:08:50 -0600 Subject: [PATCH 6/7] f08: include mpichconf.h in cdesc.h This is needed for `HAVE_VISIBILITY` option. It is also necessary to honor the configure for any potential system features. --- src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h | 1 + 1 file changed, 1 insertion(+) diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h index 372b04bb344..1ea7b00147e 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h @@ -6,6 +6,7 @@ #ifndef CDESC_H_INCLUDED #define CDESC_H_INCLUDED +#include "mpichconf.h" #include #include #include From 3cbd706ec26164e12dc156d1664c2c7ebe154f10 Mon Sep 17 00:00:00 2001 From: Hui Zhou Date: Wed, 1 Dec 2021 10:12:08 -0600 Subject: [PATCH 7/7] f08: avoid using MPIR_Assert Use assert to avoid including the whole mpich internal header stack. --- src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c index 70226dc939a..9d8d9120297 100644 --- a/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c +++ b/src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c @@ -5,6 +5,7 @@ #include "cdesc.h" #include +#include /* Fortran 2008 specifies a maximum rank of 15 */ #define MAX_RANK (15) @@ -24,12 +25,12 @@ int cdesc_create_datatype(CFI_cdesc_t * cdesc, MPI_Aint oldcount, MPI_Datatype o #ifdef HAVE_ERROR_CHECKING { int size; - MPIR_Assert(cdesc->rank <= MAX_RANK); + assert(cdesc->rank <= MAX_RANK); PMPI_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. */ - MPIR_Assert(cdesc->elem_len == size); + assert(cdesc->elem_len == size); } #endif