cannam@95: #!/usr/bin/perl -w
cannam@95: # Generate Fortran 2003 interfaces from a sequence of C function declarations
cannam@95: # of the form (one per line):
cannam@95: #     extern <type> <name>(...args...)
cannam@95: #     extern <type> <name>(...args...)
cannam@95: #     ...
cannam@95: # with no line breaks within a given function.  (It's too much work to
cannam@95: # write a general parser, since we just have to handle FFTW's header files.)
cannam@95: 
cannam@95: sub canonicalize_type {
cannam@95:     my($type);
cannam@95:     ($type) = @_;
cannam@95:     $type =~ s/ +/ /g;
cannam@95:     $type =~ s/^ //;
cannam@95:     $type =~ s/ $//;
cannam@95:     $type =~ s/([^\* ])\*/$1 \*/g;
cannam@95:     return $type;
cannam@95: }
cannam@95: 
cannam@95: # C->Fortran map of supported return types
cannam@95: %return_types = (
cannam@95:     "int" => "integer(C_INT)",
cannam@95:     "ptrdiff_t" => "integer(C_INTPTR_T)",
cannam@95:     "size_t" => "integer(C_SIZE_T)",
cannam@95:     "double" => "real(C_DOUBLE)",
cannam@95:     "float" => "real(C_FLOAT)",
cannam@95:     "long double" => "real(C_LONG_DOUBLE)",
cannam@95:     "float128__" => "real(16)",
cannam@95:     "fftw_plan" => "type(C_PTR)",
cannam@95:     "fftwf_plan" => "type(C_PTR)",
cannam@95:     "fftwl_plan" => "type(C_PTR)",
cannam@95:     "fftwq_plan" => "type(C_PTR)",
cannam@95:     "void *" => "type(C_PTR)",
cannam@95:     "char *" => "type(C_PTR)",
cannam@95:     "double *" => "type(C_PTR)",
cannam@95:     "float *" => "type(C_PTR)",
cannam@95:     "long double *" => "type(C_PTR)",
cannam@95:     "float128__ *" => "type(C_PTR)",
cannam@95:     "fftw_complex *" => "type(C_PTR)",
cannam@95:     "fftwf_complex *" => "type(C_PTR)",
cannam@95:     "fftwl_complex *" => "type(C_PTR)",
cannam@95:     "fftwq_complex *" => "type(C_PTR)",
cannam@95:     );
cannam@95: 
cannam@95: # C->Fortran map of supported argument types
cannam@95: %arg_types = (
cannam@95:     "int" => "integer(C_INT), value",
cannam@95:     "unsigned" => "integer(C_INT), value",
cannam@95:     "size_t" => "integer(C_SIZE_T), value",
cannam@95:     "ptrdiff_t" => "integer(C_INTPTR_T), value",
cannam@95: 
cannam@95:     "fftw_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
cannam@95:     "fftwf_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
cannam@95:     "fftwl_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
cannam@95:     "fftwq_r2r_kind" => "integer(C_FFTW_R2R_KIND), value",
cannam@95: 
cannam@95:     "double" => "real(C_DOUBLE), value",
cannam@95:     "float" => "real(C_FLOAT), value",
cannam@95:     "long double" => "real(C_LONG_DOUBLE), value",
cannam@95:     "__float128" => "real(16), value",
cannam@95: 
cannam@95:     "fftw_complex" => "complex(C_DOUBLE_COMPLEX), value",
cannam@95:     "fftwf_complex" => "complex(C_DOUBLE_COMPLEX), value",
cannam@95:     "fftwl_complex" => "complex(C_LONG_DOUBLE), value",
cannam@95:     "fftwq_complex" => "complex(16), value",
cannam@95: 
cannam@95:     "fftw_plan" => "type(C_PTR), value",
cannam@95:     "fftwf_plan" => "type(C_PTR), value",
cannam@95:     "fftwl_plan" => "type(C_PTR), value",
cannam@95:     "fftwq_plan" => "type(C_PTR), value",
cannam@95:     "const fftw_plan" => "type(C_PTR), value",
cannam@95:     "const fftwf_plan" => "type(C_PTR), value",
cannam@95:     "const fftwl_plan" => "type(C_PTR), value",
cannam@95:     "const fftwq_plan" => "type(C_PTR), value",
cannam@95: 
cannam@95:     "const int *" => "integer(C_INT), dimension(*), intent(in)",
cannam@95:     "ptrdiff_t *" => "integer(C_INTPTR_T), intent(out)",
cannam@95:     "const ptrdiff_t *" => "integer(C_INTPTR_T), dimension(*), intent(in)",
cannam@95: 
cannam@95:     "const fftw_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
cannam@95:     "const fftwf_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
cannam@95:     "const fftwl_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
cannam@95:     "const fftwq_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)",
cannam@95: 
cannam@95:     "double *" => "real(C_DOUBLE), dimension(*), intent(out)",
cannam@95:     "float *" => "real(C_FLOAT), dimension(*), intent(out)",
cannam@95:     "long double *" => "real(C_LONG_DOUBLE), dimension(*), intent(out)",
cannam@95:     "__float128 *" => "real(16), dimension(*), intent(out)",
cannam@95: 
cannam@95:     "fftw_complex *" => "complex(C_DOUBLE_COMPLEX), dimension(*), intent(out)",
cannam@95:     "fftwf_complex *" => "complex(C_FLOAT_COMPLEX), dimension(*), intent(out)",
cannam@95:     "fftwl_complex *" => "complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out)",
cannam@95:     "fftwq_complex *" => "complex(16), dimension(*), intent(out)",
cannam@95: 
cannam@95:     "const fftw_iodim *" => "type(fftw_iodim), dimension(*), intent(in)",
cannam@95:     "const fftwf_iodim *" => "type(fftwf_iodim), dimension(*), intent(in)",
cannam@95:     "const fftwl_iodim *" => "type(fftwl_iodim), dimension(*), intent(in)",
cannam@95:     "const fftwq_iodim *" => "type(fftwq_iodim), dimension(*), intent(in)",
cannam@95: 
cannam@95:     "const fftw_iodim64 *" => "type(fftw_iodim64), dimension(*), intent(in)",
cannam@95:     "const fftwf_iodim64 *" => "type(fftwf_iodim64), dimension(*), intent(in)",
cannam@95:     "const fftwl_iodim64 *" => "type(fftwl_iodim64), dimension(*), intent(in)",
cannam@95:     "const fftwq_iodim64 *" => "type(fftwq_iodim64), dimension(*), intent(in)",
cannam@95: 
cannam@95:     "void *" => "type(C_PTR), value",
cannam@95:     "FILE *" => "type(C_PTR), value",
cannam@95: 
cannam@95:     "const char *" => "character(C_CHAR), dimension(*), intent(in)",
cannam@95: 
cannam@95:     "fftw_write_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwf_write_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwl_write_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwq_write_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftw_read_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwf_read_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwl_read_char_func" => "type(C_FUNPTR), value",
cannam@95:     "fftwq_read_char_func" => "type(C_FUNPTR), value",
cannam@95: 
cannam@95:     # Although the MPI standard defines this type as simply "integer",
cannam@95:     # if we use integer without a 'C_' kind in a bind(C) interface then
cannam@95:     # gfortran complains.  Instead, since MPI also requires the C type
cannam@95:     # MPI_Fint to match Fortran integers, we use the size of this type
cannam@95:     # (extracted by configure and substituted by the Makefile).
cannam@95:     "MPI_Comm" => "integer(C_MPI_FINT), value"
cannam@95:     );
cannam@95: 
cannam@95: while (<>) {
cannam@95:     next if /^ *$/;
cannam@95:     if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *\((.*)\) *$/) {
cannam@95: 	$ret = &canonicalize_type($1);
cannam@95: 	$name = $2;
cannam@95: 
cannam@95: 	$args = $3;
cannam@95: 	$args =~ s/^ *void *$//;
cannam@95: 
cannam@95: 	$bad = ($ret ne "void") && !exists($return_types{$ret});	
cannam@95: 	foreach $arg (split(/ *, */, $args)) {
cannam@95: 	    $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
cannam@95: 	    $argtype = &canonicalize_type($1);
cannam@95: 	    $bad = 1 if !exists($arg_types{$argtype});
cannam@95: 	}
cannam@95: 	if ($bad) {
cannam@95: 	    print "! Unable to generate Fortran interface for $name\n";
cannam@95: 	    next;
cannam@95: 	}
cannam@95: 
cannam@95: 	# any function taking an MPI_Comm arg needs a C wrapper (grr).
cannam@95: 	if ($args =~ /MPI_Comm/) {
cannam@95: 	    $cname = $name . "_f03";
cannam@95: 	}
cannam@95: 	else {
cannam@95: 	    $cname = $name;
cannam@95: 	}
cannam@95: 
cannam@95: 	# Fortran has a 132-character line-length limit by default (grr)
cannam@95: 	$len = 0;
cannam@95: 
cannam@95: 	print "    "; $len = $len + length("    ");
cannam@95: 	if ($ret eq "void") {
cannam@95: 	    $kind = "subroutine"
cannam@95: 	}
cannam@95: 	else {
cannam@95: 	    print "$return_types{$ret} ";
cannam@95: 	    $len = $len + length("$return_types{$ret} ");
cannam@95: 	    $kind = "function"
cannam@95: 	}
cannam@95: 	print "$kind $name("; $len = $len + length("$kind $name(");
cannam@95: 	$len0 = $len;
cannam@95: 	
cannam@95: 	$argnames = $args;
cannam@95: 	$argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g;
cannam@95: 	$comma = "";
cannam@95: 	foreach $argname (split(/ *, */, $argnames)) {
cannam@95: 	    if ($len + length("$comma$argname") + 3 > 132) {
cannam@95: 		printf ", &\n%*s", $len0, "";
cannam@95: 		$len = $len0;
cannam@95: 		$comma = "";
cannam@95: 	    }
cannam@95: 	    print "$comma$argname";
cannam@95: 	    $len = $len + length("$comma$argname");
cannam@95: 	    $comma = ",";
cannam@95: 	}
cannam@95: 	print ") "; $len = $len + 2;
cannam@95: 
cannam@95: 	if ($len + length("bind(C, name='$cname')") > 132) {
cannam@95: 	    printf "&\n%*s", $len0 - length("$name("), "";
cannam@95: 	}
cannam@95: 	print "bind(C, name='$cname')\n";
cannam@95: 
cannam@95: 	print "      import\n";
cannam@95: 	foreach $arg (split(/ *, */, $args)) {
cannam@95: 	    $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
cannam@95: 	    $argtype = &canonicalize_type($1);
cannam@95: 	    $argname = $2;
cannam@95: 	    $ftype = $arg_types{$argtype};
cannam@95: 
cannam@95: 	    # Various special cases for argument types:
cannam@95: 	    if ($name =~ /_flops$/ && $argtype eq "double *") {
cannam@95: 		$ftype = "real(C_DOUBLE), intent(out)" 
cannam@95: 	    }
cannam@95: 	    if ($name =~ /_execute/ && ($argname eq "ri" ||
cannam@95: 					$argname eq "ii" || 
cannam@95: 					$argname eq "in")) {
cannam@95: 		$ftype =~ s/intent\(out\)/intent(inout)/;
cannam@95: 	    }
cannam@95: 
cannam@95: 	    print "      $ftype :: $argname\n"
cannam@95: 	}
cannam@95: 
cannam@95: 	print "    end $kind $name\n";
cannam@95: 	print "    \n";
cannam@95:     }
cannam@95: }