ABI: Fortran binding on top of core C ABI

autogen.sh

@@ -323,6 +323,8 @@ fn_copy_confdb_etc() {
         confdb_dirs="${confdb_dirs} test/mpi/dtpools/confdb"
     fi
 
+    confdb_dirs="${confdb_dirs} src/binding/abi_fortran/confdb"
+
     # all the confdb directories, by various names
     for destdir in $confdb_dirs ; do
         sync_external confdb "$destdir"
@@ -334,6 +336,7 @@ fn_copy_confdb_etc() {
         cp -pPR maint/version.m4 src/mpi/romio/version.m4
         cp -pPR maint/version.m4 src/pmi/version.m4
         cp -pPR maint/version.m4 test/mpi/version.m4
+        cp -pPR maint/version.m4 src/binding/abi_fortran/version.m4
     fi
 
     # Now sanity check that some of the above sync was successful

maint/gen_abi.py

@@ -37,7 +37,7 @@ def dump_mpi_abi_internal_h(mpi_abi_internal_h):
     def gen_mpi_abi_internal_h(out):
         re_Handle = r'\bMPI_(Comm|Datatype|Errhandler|Group|Info|Message|Op|Request|Session|Win|KEYVAL_INVALID|TAG_UB|IO|HOST|WTIME_IS_GLOBAL|APPNUM|LASTUSEDCODE|UNIVERSE_SIZE|WIN_BASE|WIN_DISP_UNIT|WIN_SIZE|WIN_CREATE_FLAVOR|WIN_MODEL)\b'
         for line in G.abi_h_lines:
-            if RE.search(r'MPI_ABI_H_INCLUDED', line):
+            if RE.search(r'MPI_ABI_H_INCLUDED|MPI_H_ABI', line):
                 # skip the include guard, harmless
                 pass
             elif RE.match(r'\s*int MPI_(SOURCE|TAG|ERROR);', line):
@@ -100,6 +100,13 @@ def gen_mpi_abi_internal_h(out):
         print("#define MPI_ABI_INTERNAL_H_INCLUDED", file=Out)
         print("", file=Out)
 
+        # the internal code use MPI_Fint etc. Temporary until ABI proposal settles and MPICH implementation cleans up.
+        # TODO: skip src/mpi/misc/f2c_impl.c
+        print("typedef int MPI_Fint;", file=Out)
+        print("typedef struct {MPI_Fint MPI_SOURCE,MPI_TAG,MPI_ERROR,count_lo,count_hi_and_cancelled,dummy[3];} MPI_F08_status;", file=Out)
+        print("extern MPI_Fint *MPI_F_STATUS_IGNORE, *MPI_F_STATUSES_IGNORE;", file=Out);
+        print("extern MPI_F08_status *MPI_F08_STATUS_IGNORE, *MPI_F08_STATUSES_IGNORE;", file=Out);
+
         for k in define_constants:
             print("#define %s %s" % (k, define_constants[k]), file=Out)
         print("", file=Out)

maint/gen_binding_abi_fortran.py

@@ -0,0 +1,131 @@
+##
+## Copyright (C) by Argonne National Laboratory
+##     See COPYRIGHT in top-level directory
+##
+
+from local_python import MPI_API_Global as G
+from local_python.mpi_api import *
+from local_python.binding_common import *
+from local_python.binding_f77 import *
+from local_python.binding_f08 import *
+from local_python import RE
+import os
+
+def main():
+    # currently support -no-real128, -no-mpiio, -aint-is-int
+    G.parse_cmdline()
+
+    binding_dir = G.get_srcdir_path("src/binding")
+    f77_dir = "src/binding/abi_fortran/mpif_h"
+    f08_dir = "src/binding/abi_fortran/use_mpi_f08"
+
+    func_list = load_C_func_list(binding_dir, True, custom_dir=None) # suppress noise
+
+    # preprocess
+    for func in func_list:
+        check_func_directives_abi(func)
+    func_list = [f for f in func_list if '_skip_fortran' not in f]
+
+    # fortran_binding.c
+    def has_cptr(func):
+        for p in func['parameters']:
+            if p['kind'] == 'C_BUFFER':
+                return True
+        return False
+
+    G.out = []
+    G.profile_out = []
+    for func in func_list:
+        G.out.append("")
+        dump_f77_c_func(func, is_abi=True)
+        if has_cptr(func):
+            dump_f77_c_func(func, True, is_abi=True)
+
+    f = "%s/fortran_binding.c" % f77_dir
+    dump_f77_c_file(f, G.out)
+
+    f = "%s/fortran_profile.h" % f77_dir
+    dump_f77_c_file(f, G.profile_out)
+
+    # .in files has to be generated in the source tree
+    if G.is_autogen():
+        G.mpih_defines = {}
+        load_mpi_abi_h("src/binding/abi/mpi_abi.h")
+        load_mpi_abi_h("src/binding/abi_fortran/mpi_abi_fort.h")
+        del G.mpih_defines['MPI_ABI_Aint']
+        del G.mpih_defines['MPI_ABI_Offset']
+        del G.mpih_defines['MPI_ABI_Count']
+        del G.mpih_defines['MPI_ABI_Fint']
+        G.mpih_defines['MPI_LONG_LONG_INT'] = G.mpih_defines['MPI_LONG_LONG']
+        G.mpih_defines['MPI_C_COMPLEX'] = G.mpih_defines['MPI_C_FLOAT_COMPLEX']
+
+        G.mpih_defines['MPI_INTEGER_KIND'] = 4
+        G.mpih_defines['MPI_ADDRESS_KIND'] = 8
+        G.mpih_defines['MPI_COUNT_KIND'] = 8
+        G.mpih_defines['MPI_OFFSET_KIND'] = 8
+        for name in ['INTEGER_KIND', 'ADDRESS_KIND', 'COUNT_KIND', 'OFFSET_KIND']:
+            if name in os.environ:
+                G.mpih_defines['MPI_' + name] = os.environ[name]
+        autoconf_macros = {}
+        autoconf_macros['FORTRAN_MPI_OFFSET'] = 'INTEGER(KIND=MPI_OFFSET_KIND)'
+        autoconf_macros['DLLIMPORT'] = ''
+
+        f = "%s/mpif.h" % f77_dir
+        dump_mpif_h(f, autoconf_macros)
+
+        f = "%s/mpi_f08_compile_constants.f90" % f08_dir
+        dump_compile_constants_f90(f)
+
+def load_mpi_abi_h(f):
+    # load constants into G.mpih_defines
+    with open(f, "r") as In:
+        for line in In:
+            # trim trailing comments
+            line = re.sub(r'\s+\/\*.*', '', line)
+            if RE.match(r'#define\s+(MPI_\w+)\s+(.+)', line):
+                # direct macros
+                (name, val) = RE.m.group(1, 2)
+                if RE.match(r'\(+(MPI_\w+)\)\(?0x([0-9a-fA-F]+)', val):
+                    # handle constants
+                    val = "%s(%d)" % (RE.m.group(1), int(RE.m.group(2), 16))
+                elif RE.match(r'\(+MPI_Offset\)(-?\d+)', val):
+                    # MPI_DISPLACEMENT_CURRENT
+                    val = RE.m.group(1)
+                elif RE.match(r'0x([0-9a-fA-F]+)', val):
+                    # direct hex constants (KEYVAL constants)
+                    val = int(RE.m.group(1), 16)
+                    if RE.match(r'MPI_(TAG_UB|HOST|IO|WTIME_IS_GLOBAL|UNIVERSE_SIZE|LASTUSEDCODE|APPNUM|WIN_(BASE|SIZE|DISP_UNIT|CREATE_FLAVOR|MODEL))', name):
+                        # KEYVAL, Fortran value is C-value + 1
+                        val = val + 1
+                elif RE.match(r'MPI_MAX_', name):
+                    # Fortran string buffer limit need be 1-less
+                    if re.match(r'@\w+@', val):
+                        val += "-1"
+                    else:
+                        val = int(val) - 1
+                elif RE.match(r'\(([-\d]+)\)', val):
+                    # take off the extra parentheses
+                    val = RE.m.group(1)
+
+                G.mpih_defines[name] = val
+            elif RE.match(r'\s+(MPI_\w+)\s*=\s*(\d+)', line):
+                # enum values
+                (name, val) = RE.m.group(1, 2)
+                G.mpih_defines[name] = val
+
+def check_func_directives_abi(func):
+    if RE.match(r'mpi_t_', func['name'], re.IGNORECASE):
+        func['_skip_fortran'] = 1
+    elif RE.match(r'mpix_(grequest_|type_iov)', func['name'], re.IGNORECASE):
+        func['_skip_fortran'] = 1
+    elif RE.match(r'mpi_\w+_(f|f08|c)2(f|f08|c)$', func['name'], re.IGNORECASE):
+        # implemented in mpi_f08_types.f90
+        func['_skip_fortran'] = 1
+    elif RE.match(r'mpi_.*_function$', func['name'], re.IGNORECASE):
+        # defined in mpi_f08_callbacks.f90
+        func['_skip_fortran'] = 1
+
+# ---------------------------------------------------------
+if __name__ == "__main__":
+    main()
+

maint/gen_binding_c.py

@@ -123,6 +123,10 @@ def dump_func_abi(func):
         if 'replace' in func and 'body' not in func:
             continue
 
+        # skip Fortran inter op functions
+        if re.match(r'.*_(f2c|c2f|f2f08|f082f|f082c|c2f08)', func['name']):
+            continue
+
         if re.match(r'MPIX_', func['name']):
             if re.match(r'MPIX_(Grequest_|Type_iov)', func['name']):
                 # needed by ROMIO

maint/gen_binding_f77.py

@@ -59,6 +59,13 @@ def has_cptr(func):
         G.mpih_defines = {}
         load_mpi_h_in("src/include/mpi.h.in")
         load_mpi_h_in("src/mpi/romio/include/mpio.h.in")
+
+        for a in ['INTEGER', 'ADDRESS', 'COUNT', 'OFFSET']:
+            G.mpih_defines['MPI_%s_KIND' % a] = '@%s_KIND@' % a
+        G.mpih_defines['MPI_STATUS_SIZE'] = G.mpih_defines['MPI_F_STATUS_SIZE']
+        for a in ['SOURCE', 'TAG', 'ERROR']:
+            G.mpih_defines['MPI_%s' % a] = int(G.mpih_defines['MPI_F_%s' % a]) + 1
+
         f = "%s/mpif.h.in" % f77_dir
         dump_mpif_h(f)
 

maint/local_python/binding_f77.py

@@ -9,7 +9,7 @@
 
 import re
 
-def dump_f77_c_func(func, is_cptr=False):
+def dump_f77_c_func(func, is_cptr=False, is_abi=False):
     func_name = get_function_name(func)
     f_mapping = get_kind_map('F90')
     c_mapping = get_kind_map('C')
@@ -68,15 +68,23 @@ def dump_p(p):
                 raise Exception("Unhandled: %s - %s, length=%s" % (func['name'], p['name'], p['length']))
         else:
             c_param_list.append("MPI_Fint *" + p['name'])
-            c_arg_list_A.append("(%s) (*%s)" % (c_type, p['name']))
-            c_arg_list_B.append("(%s) (*%s)" % (c_type, p['name']))
+            if is_abi and c_type in G.handle_list:
+                arg = "%s_f2c(*%s)" % (c_type, p['name'])
+            else:
+                arg = "(%s) (*%s)" % (c_type, p['name'])
+            c_arg_list_A.append(arg)
+            c_arg_list_B.append(arg)
 
     def dump_scalar_out(v, f_type, c_type):
         c_param_list.append("%s *%s" % (f_type, v))
         c_arg_list_A.append("&%s_i" % v)
         c_arg_list_B.append("&%s_i" % v)
         code_list_common.append("%s %s_i;" % (c_type, v))
-        end_list_common.append("*%s = (%s) %s_i;" % (v, f_type, v))
+        if is_abi and c_type in G.handle_list:
+            val = "%s_c2f(%s_i)" % (c_type, v)
+        else:
+            val = "(%s) %s_i" % (f_type, v)
+        end_list_common.append("*%s = %s;" % (v, val))
 
     # void *
     def dump_buf(buf, check_in_place):
@@ -498,7 +506,7 @@ def dump_attr_out(v, c_type, flag):
         end_list_common.append("if (*ierr || !%s) {" % flag)
         end_list_common.append("    *%s = 0;" % v)
         end_list_common.append("} else {")
-        end_list_common.append("    *%s = (MPI_Aint) %s_i;" % (v, v))
+        end_list_common.append("    *%s = (%s) (intptr_t) (*(void **) %s_i);" % (v, c_type, v))
         end_list_common.append("}")
 
     def dump_handle_create(v, c_type):
@@ -845,19 +853,7 @@ def process_func_parameters():
     process_func_parameters()
 
     c_func_name = func_name
-    if need_ATTR_AINT:
-        if RE.match(r'MPI_Attr_(get|put)', func['name'], re.IGNORECASE):
-            if RE.m.group(1) == 'put':
-                c_func_name = "MPII_Comm_set_attr"
-            else:
-                c_func_name = "MPII_Comm_get_attr"
-            c_arg_list_A.append("MPIR_ATTR_INT")
-            c_arg_list_B.append("MPIR_ATTR_INT")
-        else:
-            c_func_name = re.sub(r'MPI_', 'MPII_', func['name'])
-            c_arg_list_A.append("MPIR_ATTR_AINT")
-            c_arg_list_B.append("MPIR_ATTR_AINT")
-    elif re.match(r'MPI_(Init|Init_thread|Info_create_env)$', func['name'], re.IGNORECASE):
+    if re.match(r'MPI_(Init|Init_thread|Info_create_env)$', func['name'], re.IGNORECASE):
         # argc, argv
         c_arg_list_A.insert(0, "0, 0")
         c_arg_list_B.insert(0, "0, 0")
@@ -952,21 +948,16 @@ def dump_f77_c_file(f, lines):
                     print("    " * indent, end='', file=Out)
                 print(l, file=Out)
 
-def dump_mpif_h(f):
+def dump_mpif_h(f, autoconf_macros={}):
     print("  --> [%s]" % f)
     # note: fixed-form Fortran line is ignored after column 72
     with open(f, "w") as Out:
         for l in G.copyright_f77:
             print(l, file=Out)
 
-        for a in ['INTEGER', 'ADDRESS', 'COUNT', 'OFFSET']:
-            G.mpih_defines['MPI_%s_KIND' % a] = '@%s_KIND@' % a
-        G.mpih_defines['MPI_STATUS_SIZE'] = G.mpih_defines['MPI_F_STATUS_SIZE']
-        for a in ['SOURCE', 'TAG', 'ERROR']:
-            G.mpih_defines['MPI_%s' % a] = int(G.mpih_defines['MPI_F_%s' % a]) + 1
-
         # -- all integer constants
         for name in G.mpih_defines:
+            val = G.mpih_defines[name]
             T = "INTEGER"
             if re.match(r'MPI_[TF]_', name):
                 continue
@@ -977,9 +968,15 @@ def dump_mpif_h(f):
             elif re.match(r'MPI_(UNWEIGHTED|WEIGHTS_EMPTY|BUFFER_AUTOMATIC|BOTTOM|IN_PLACE|STATUS_IGNORE|STATUSES_IGNORE|ERRCODES_IGNORE|ARGVS_NULL|ARGV_NULL)', name):
                 continue
             elif re.match(r'MPI_DISPLACEMENT_CURRENT', name):
-                T = '@FORTRAN_MPI_OFFSET@'
+                if 'FORTRAN_MPI_OFFSET' in autoconf_macros:
+                    T = autoconf_macros['FORTRAN_MPI_OFFSET']
+                else:
+                    T = '@FORTRAN_MPI_OFFSET@'
+            elif isinstance(val, str) and RE.match(r'(MPI_\w+)\((.+)\)', val):
+                # handles in F77 are just ITNEGERs
+                val = RE.m.group(2)
             print("       %s %s" % (T, name), file=Out)
-            print("       PARAMETER (%s=%s)" % (name, G.mpih_defines[name]), file=Out)
+            print("       PARAMETER (%s=%s)" % (name, val), file=Out)
 
         # -- Fortran08 capability
         for a in ['SUBARRAYS_SUPPORTED', 'ASYNC_PROTECTS_NONBLOCKING']:
@@ -1011,7 +1008,10 @@ def dump_mpif_h(f):
         print("       INTEGER MPI_ERRCODES_IGNORE(1)", file=Out)
         print("       CHARACTER*1 MPI_ARGVS_NULL(1,1)", file=Out)
         print("       CHARACTER*1 MPI_ARGV_NULL(1)", file=Out)
-        print("@DLLIMPORT@", file=Out)
+        if 'DLLIMPORT' in autoconf_macros:
+            print(autoconf_macros['DLLIMPORT'], file=Out)
+        else:
+            print("@DLLIMPORT@", file=Out)
         print("       COMMON /MPIFCMB5/ MPI_UNWEIGHTED", file=Out)
         print("       COMMON /MPIFCMB9/ MPI_WEIGHTS_EMPTY", file=Out)
         print("       COMMON /MPIFCMBa/ MPI_BUFFER_AUTOMATIC", file=Out)

maint/local_python/mpi_api.py

@@ -12,7 +12,7 @@
 import os
 import glob
 
-def load_C_func_list(binding_dir="src/binding", silent=False):
+def load_C_func_list(binding_dir="src/binding", silent=False, custom_dir="src/binding/c"):
     # -- Loading Standard APIs --
     if os.path.exists("%s/apis.json" % binding_dir):
         if not silent: print("Loading %s/apis.json ..." % binding_dir)
@@ -26,16 +26,16 @@ def load_C_func_list(binding_dir="src/binding", silent=False):
     if not silent: print("Loading %s/custom_mapping.txt ..." % binding_dir)
     load_mpi_mapping("%s/custom_mapping.txt" % binding_dir)
 
-    # -- Loading MPICH APIs --
-
-    api_files = glob.glob("%s/c/*_api.txt" % binding_dir)
-    for f in api_files:
-        if RE.match(r'.*\/(\w+)_api.txt', f):
-            # The name in eg pt2pt_api.txt indicates the output folder.
-            # Only the api functions with output folder will get generated.
-            # This allows simple control of what functions to generate.
-            if not silent: print("Loading %s ..." % f)
-            load_mpi_api(f, RE.m.group(1))
+    if custom_dir:
+        # -- Loading MPICH APIs --
+        api_files = glob.glob("%s/*_api.txt" % custom_dir)
+        for f in api_files:
+            if RE.match(r'.*\/(\w+)_api.txt', f):
+                # The name in eg pt2pt_api.txt indicates the output folder.
+                # Only the api functions with output folder will get generated.
+                # This allows simple control of what functions to generate.
+                if not silent: print("Loading %s ..." % f)
+                load_mpi_api(f, RE.m.group(1))
 
     # -- filter and sort func_list --
     func_list = []
@@ -45,11 +45,13 @@ def load_C_func_list(binding_dir="src/binding", silent=False):
         elif RE.match(r'\w+_(function|FN)$', f['name']):
             # skip various callback functions
             continue
-        elif not 'dir' in f:
+        elif custom_dir and not 'dir' in f:
             if not silent: print("    skip %s (not defined)" % f['name'])
         else:
             func_list.append(f)
-    func_list.sort(key = lambda f: f['dir'])
+
+    if custom_dir:
+        func_list.sort(key = lambda f: f['dir'])
 
     load_mpix_txt("%s/mpix.txt" % binding_dir)