diff --git a/api/Makefile.am b/api/Makefile.am index 5cb108203..7dc9c32ba 100644 --- a/api/Makefile.am +++ b/api/Makefile.am @@ -1,7 +1,7 @@ AM_CPPFLAGS = -I $(top_srcdir) AM_CFLAGS = $(STACK_ALIGN_CFLAGS) -EXTRA_DIST = f03api.sh genf03.pl fftw3.f03.in +EXTRA_DIST = f03api.sh genf03.pl genf08.pl fftw3.f03.in include_HEADERS = fftw3.h fftw3.f fftw3l.f03 fftw3q.f03 nodist_include_HEADERS = fftw3.f03 diff --git a/api/genf08.pl b/api/genf08.pl new file mode 100644 index 000000000..10ae9d84e --- /dev/null +++ b/api/genf08.pl @@ -0,0 +1,210 @@ +#!/usr/bin/perl -w +# Generate Fortran 2008 module interfaces (with mpi_f08 type-safe wrappers) +# from a sequence of C function declarations of the form (one per line): +# extern (...args...) +# extern (...args...) +# ... +# with no line breaks within a given function. (It's too much work to +# write a general parser, since we just have to handle FFTW's header files.) + +sub canonicalize_type { + my($type); + ($type) = @_; + $type =~ s/ +/ /g; + $type =~ s/^ //; + $type =~ s/ $//; + $type =~ s/([^\* ])\*/$1 \*/g; + return $type; +} + +# C->Fortran map of supported return types +%return_types = ( + "int" => "integer(C_INT)", + "ptrdiff_t" => "integer(C_INTPTR_T)", + "size_t" => "integer(C_SIZE_T)", + "double" => "real(C_DOUBLE)", + "float" => "real(C_FLOAT)", + "long double" => "real(C_LONG_DOUBLE)", + "__float128" => "real(16)", + "fftw_plan" => "type(C_PTR)", + "fftwf_plan" => "type(C_PTR)", + "fftwl_plan" => "type(C_PTR)", + "fftwq_plan" => "type(C_PTR)", + "void *" => "type(C_PTR)", + "char *" => "type(C_PTR)", + "double *" => "type(C_PTR)", + "float *" => "type(C_PTR)", + "long double *" => "type(C_PTR)", + "__float128 *" => "type(C_PTR)", + "fftw_complex *" => "type(C_PTR)", + "fftwf_complex *" => "type(C_PTR)", + "fftwl_complex *" => "type(C_PTR)", + "fftwq_complex *" => "type(C_PTR)", + ); + +# C->Fortran map of supported argument types +%arg_types = ( + "int" => "integer(C_INT), value", + "unsigned" => "integer(C_INT), value", + "size_t" => "integer(C_SIZE_T), value", + "ptrdiff_t" => "integer(C_INTPTR_T), value", + + "fftw_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwf_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwl_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + "fftwq_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", + + "double" => "real(C_DOUBLE), value", + "float" => "real(C_FLOAT), value", + "long double" => "real(C_LONG_DOUBLE), value", + "__float128" => "real(16), value", + + "fftw_complex" => "complex(C_DOUBLE_COMPLEX), value", + "fftwf_complex" => "complex(C_DOUBLE_COMPLEX), value", + "fftwl_complex" => "complex(C_LONG_DOUBLE), value", + "fftwq_complex" => "complex(16), value", + + "fftw_plan" => "type(C_PTR), value", + "fftwf_plan" => "type(C_PTR), value", + "fftwl_plan" => "type(C_PTR), value", + "fftwq_plan" => "type(C_PTR), value", + "const fftw_plan" => "type(C_PTR), value", + "const fftwf_plan" => "type(C_PTR), value", + "const fftwl_plan" => "type(C_PTR), value", + "const fftwq_plan" => "type(C_PTR), value", + + "const int *" => "integer(C_INT), dimension(*), intent(in)", + "ptrdiff_t *" => "integer(C_INTPTR_T), intent(out)", + "const ptrdiff_t *" => "integer(C_INTPTR_T), dimension(*), intent(in)", + + "const fftw_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwf_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwl_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + "const fftwq_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", + + "double *" => "real(C_DOUBLE), dimension(*), intent(out)", + "float *" => "real(C_FLOAT), dimension(*), intent(out)", + "long double *" => "real(C_LONG_DOUBLE), dimension(*), intent(out)", + "__float128 *" => "real(16), dimension(*), intent(out)", + + "fftw_complex *" => "complex(C_DOUBLE_COMPLEX), dimension(*), intent(out)", + "fftwf_complex *" => "complex(C_FLOAT_COMPLEX), dimension(*), intent(out)", + "fftwl_complex *" => "complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out)", + "fftwq_complex *" => "complex(16), dimension(*), intent(out)", + + "const fftw_iodim *" => "type(fftw_iodim), dimension(*), intent(in)", + "const fftwf_iodim *" => "type(fftwf_iodim), dimension(*), intent(in)", + "const fftwl_iodim *" => "type(fftwl_iodim), dimension(*), intent(in)", + "const fftwq_iodim *" => "type(fftwq_iodim), dimension(*), intent(in)", + + "const fftw_iodim64 *" => "type(fftw_iodim64), dimension(*), intent(in)", + "const fftwf_iodim64 *" => "type(fftwf_iodim64), dimension(*), intent(in)", + "const fftwl_iodim64 *" => "type(fftwl_iodim64), dimension(*), intent(in)", + "const fftwq_iodim64 *" => "type(fftwq_iodim64), dimension(*), intent(in)", + + "void *" => "type(C_PTR), value", + "FILE *" => "type(C_PTR), value", + + "const char *" => "character(C_CHAR), dimension(*), intent(in)", + + "fftw_write_char_func" => "type(C_FUNPTR), value", + "fftwf_write_char_func" => "type(C_FUNPTR), value", + "fftwl_write_char_func" => "type(C_FUNPTR), value", + "fftwq_write_char_func" => "type(C_FUNPTR), value", + "fftw_read_char_func" => "type(C_FUNPTR), value", + "fftwf_read_char_func" => "type(C_FUNPTR), value", + "fftwl_read_char_func" => "type(C_FUNPTR), value", + "fftwq_read_char_func" => "type(C_FUNPTR), value", + + # MPI_Comm is interoperable with plain integer via the mpi_f08 + # module, so we use TYPE(MPI_Comm) here for type safety. + "MPI_Comm" => "type(MPI_Comm), value" + ); + +while (<>) { + next if /^ *$/; + if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *\((.*)\) *$/) { + $ret = &canonicalize_type($1); + $name = $2; + + $args = $3; + $args =~ s/^ *void *$//; + + $bad = ($ret ne "void") && !exists($return_types{$ret}); + foreach $arg (split(/ *, */, $args)) { + $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; + $argtype = &canonicalize_type($1); + $bad = 1 if !exists($arg_types{$argtype}); + } + if ($bad) { + print "! Unable to generate Fortran interface for $name\n"; + next; + } + + # any function taking an MPI_Comm arg needs a C wrapper (grr). + if ($args =~ /MPI_Comm/) { + $cname = $name . "_f03"; + } + else { + $cname = $name; + } + + # Fortran has a 132-character line-length limit by default (grr) + $len = 0; + + print " "; $len = $len + length(" "); + if ($ret eq "void") { + $kind = "subroutine" + } + else { + print "$return_types{$ret} "; + $len = $len + length("$return_types{$ret} "); + $kind = "function" + } + print "$kind $name("; $len = $len + length("$kind $name("); + $len0 = $len; + + $argnames = $args; + $argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g; + $comma = ""; + foreach $argname (split(/ *, */, $argnames)) { + if ($len + length("$comma$argname") + 3 > 132) { + printf ", &\n%*s", $len0, ""; + $len = $len0; + $comma = ""; + } + print "$comma$argname"; + $len = $len + length("$comma$argname"); + $comma = ","; + } + print ") "; $len = $len + 2; + + if ($len + length("bind(C, name='$cname')") > 132) { + printf "&\n%*s", $len0 - length("$name("), ""; + } + print "bind(C, name='$cname')\n"; + + print " import\n"; + foreach $arg (split(/ *, */, $args)) { + $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; + $argtype = &canonicalize_type($1); + $argname = $2; + $ftype = $arg_types{$argtype}; + + # Various special cases for argument types: + if ($name =~ /_flops$/ && $argtype eq "double *") { + $ftype = "real(C_DOUBLE), intent(out)" + } + if ($name =~ /_execute/ && ($argname eq "ri" || + $argname eq "ii" || + $argname eq "in")) { + $ftype =~ s/intent\(out\)/intent(inout)/; + } + + print " $ftype :: $argname\n" + } + + print " end $kind $name\n"; + print " \n"; + } +} diff --git a/mpi/Makefile.am b/mpi/Makefile.am index 8e43fac5b..9025e30ba 100644 --- a/mpi/Makefile.am +++ b/mpi/Makefile.am @@ -6,15 +6,15 @@ AM_CPPFLAGS = -I $(top_srcdir) -I $(top_srcdir)/api if MPI lib_LTLIBRARIES = libfftw3@PREC_SUFFIX@_mpi.la include_HEADERS = fftw3-mpi.h -nodist_include_HEADERS = fftw3-mpi.f03 fftw3l-mpi.f03 +nodist_include_HEADERS = fftw3-mpi.f03 fftw3l-mpi.f03 fftw3-mpi.f08 fftw3l-mpi.f08 noinst_PROGRAMS = mpi-bench endif CC=@MPICC@ -EXTRA_DIST = testsched.c f03api.sh f03-wrap.sh genf03-wrap.pl fftw3-mpi.f03.in fftw3l-mpi.f03.in -BUILT_SOURCES = fftw3-mpi.f03.in fftw3-mpi.f03 fftw3l-mpi.f03.in fftw3l-mpi.f03 f03-wrap.c -CLEANFILES = fftw3-mpi.f03 fftw3l-mpi.f03 +EXTRA_DIST = testsched.c f03api.sh f03-wrap.sh genf03-wrap.pl fftw3-mpi.f03.in fftw3l-mpi.f03.in f08api.sh fftw3-mpi.f08.in fftw3l-mpi.f08.in +BUILT_SOURCES = fftw3-mpi.f03.in fftw3-mpi.f03 fftw3l-mpi.f03.in fftw3l-mpi.f03 fftw3-mpi.f08.in fftw3-mpi.f08 fftw3l-mpi.f08.in fftw3l-mpi.f08 f03-wrap.c +CLEANFILES = fftw3-mpi.f03 fftw3l-mpi.f03 fftw3-mpi.f08 fftw3l-mpi.f08 TRANSPOSE_SRC = transpose-alltoall.c transpose-pairwise.c transpose-recurse.c transpose-problem.c transpose-solve.c mpi-transpose.h DFT_SRC = dft-serial.c dft-rank-geq2.c dft-rank-geq2-transposed.c dft-rank1.c dft-rank1-bigvec.c dft-problem.c dft-solve.c mpi-dft.h @@ -87,6 +87,12 @@ fftw3-mpi.f03: fftw3-mpi.f03.in Makefile fftw3l-mpi.f03: fftw3l-mpi.f03.in Makefile sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3l-mpi.f03.in > $@ +fftw3-mpi.f08: fftw3-mpi.f08.in Makefile + sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3-mpi.f08.in > $@ + +fftw3l-mpi.f08: fftw3l-mpi.f08.in Makefile + sed 's/C_MPI_FINT/@C_MPI_FINT@/' $(srcdir)/fftw3l-mpi.f08.in > $@ + if MAINTAINER_MODE fftw3-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl @@ -95,6 +101,12 @@ fftw3-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl fftw3l-mpi.f03.in: fftw3-mpi.h f03api.sh $(top_srcdir)/api/genf03.pl sh $(srcdir)/f03api.sh l | grep -v parameter | sed 's/fftw3.f03/fftw3l.f03/' > $@ +fftw3-mpi.f08.in: fftw3-mpi.h f08api.sh $(top_srcdir)/api/genf08.pl + sh $(srcdir)/f08api.sh d f > $@ + +fftw3l-mpi.f08.in: fftw3-mpi.h f08api.sh $(top_srcdir)/api/genf08.pl + sh $(srcdir)/f08api.sh l | grep -v parameter | sed 's/include .fftw3.f03./include '"'"'fftw3l.f03'"'"'/; s/module fftw3_mpi/module fftw3l_mpi/' > $@ + f03-wrap.c: fftw3-mpi.h f03-wrap.sh genf03-wrap.pl sh $(srcdir)/f03-wrap.sh > $@ diff --git a/mpi/f08api.sh b/mpi/f08api.sh new file mode 100644 index 000000000..cece8a5fe --- /dev/null +++ b/mpi/f08api.sh @@ -0,0 +1,45 @@ +#! /bin/sh + +# Script to generate the fftw3_mpi Fortran 2008 module from the +# fftw3-mpi.h header file, using mpi_f08 type-safe MPI bindings. + +# This is designed so that the Fortran caller can do: +# use fftw3_mpi +# and then call the C FFTW MPI functions directly, with TYPE(MPI_Comm) +# instead of an integer communicator handle. + +echo "! Generated automatically. DO NOT EDIT!" +echo + +echo "module fftw3_mpi" +echo " use, intrinsic :: iso_c_binding" +echo " use mpi_f08, only: MPI_Comm" +echo " implicit none" +echo + +echo " include 'fftw3.f03'" +echo + +# Extract constants +perl -pe 's/#define +([A-Z0-9_]+) +\(([+-]?[0-9]+)U?\)/\n integer\(C_INTPTR_T\), parameter :: \1 = \2\n/g' < fftw3-mpi.h | grep 'integer(C_INTPTR_T)' +perl -pe 'if (/#define +([A-Z0-9_]+) +\(([0-9]+)U? *<< *([0-9]+)\)/) { print "\n integer\(C_INT\), parameter :: $1 = ",$2 << $3,"\n"; }' < fftw3-mpi.h | grep 'integer(C_INT)' + +# Extract function declarations +for p in $*; do + if test "$p" = "d"; then p=""; fi + + echo + cat <