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)