1#!/usr/bin/perl -w 2# Generate Fortran 2003 interfaces from a sequence of C function declarations 3# of the form (one per line): 4# extern <type> <name>(...args...) 5# extern <type> <name>(...args...) 6# ... 7# with no line breaks within a given function. (It's too much work to 8# write a general parser, since we just have to handle FFTW's header files.) 9 10sub canonicalize_type { 11 my($type); 12 ($type) = @_; 13 $type =~ s/ +/ /g; 14 $type =~ s/^ //; 15 $type =~ s/ $//; 16 $type =~ s/([^\* ])\*/$1 \*/g; 17 return $type; 18} 19 20# C->Fortran map of supported return types 21%return_types = ( 22 "int" => "integer(C_INT)", 23 "ptrdiff_t" => "integer(C_INTPTR_T)", 24 "size_t" => "integer(C_SIZE_T)", 25 "double" => "real(C_DOUBLE)", 26 "float" => "real(C_FLOAT)", 27 "long double" => "real(C_LONG_DOUBLE)", 28 "__float128" => "real(16)", 29 "fftw_plan" => "type(C_PTR)", 30 "fftwf_plan" => "type(C_PTR)", 31 "fftwl_plan" => "type(C_PTR)", 32 "fftwq_plan" => "type(C_PTR)", 33 "void *" => "type(C_PTR)", 34 "char *" => "type(C_PTR)", 35 "double *" => "type(C_PTR)", 36 "float *" => "type(C_PTR)", 37 "long double *" => "type(C_PTR)", 38 "__float128 *" => "type(C_PTR)", 39 "fftw_complex *" => "type(C_PTR)", 40 "fftwf_complex *" => "type(C_PTR)", 41 "fftwl_complex *" => "type(C_PTR)", 42 "fftwq_complex *" => "type(C_PTR)", 43 ); 44 45# C->Fortran map of supported argument types 46%arg_types = ( 47 "int" => "integer(C_INT), value", 48 "unsigned" => "integer(C_INT), value", 49 "size_t" => "integer(C_SIZE_T), value", 50 "ptrdiff_t" => "integer(C_INTPTR_T), value", 51 52 "fftw_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", 53 "fftwf_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", 54 "fftwl_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", 55 "fftwq_r2r_kind" => "integer(C_FFTW_R2R_KIND), value", 56 57 "double" => "real(C_DOUBLE), value", 58 "float" => "real(C_FLOAT), value", 59 "long double" => "real(C_LONG_DOUBLE), value", 60 "__float128" => "real(16), value", 61 62 "fftw_complex" => "complex(C_DOUBLE_COMPLEX), value", 63 "fftwf_complex" => "complex(C_DOUBLE_COMPLEX), value", 64 "fftwl_complex" => "complex(C_LONG_DOUBLE), value", 65 "fftwq_complex" => "complex(16), value", 66 67 "fftw_plan" => "type(C_PTR), value", 68 "fftwf_plan" => "type(C_PTR), value", 69 "fftwl_plan" => "type(C_PTR), value", 70 "fftwq_plan" => "type(C_PTR), value", 71 "const fftw_plan" => "type(C_PTR), value", 72 "const fftwf_plan" => "type(C_PTR), value", 73 "const fftwl_plan" => "type(C_PTR), value", 74 "const fftwq_plan" => "type(C_PTR), value", 75 76 "const int *" => "integer(C_INT), dimension(*), intent(in)", 77 "ptrdiff_t *" => "integer(C_INTPTR_T), intent(out)", 78 "const ptrdiff_t *" => "integer(C_INTPTR_T), dimension(*), intent(in)", 79 80 "const fftw_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", 81 "const fftwf_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", 82 "const fftwl_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", 83 "const fftwq_r2r_kind *" => "integer(C_FFTW_R2R_KIND), dimension(*), intent(in)", 84 85 "double *" => "real(C_DOUBLE), dimension(*), intent(out)", 86 "float *" => "real(C_FLOAT), dimension(*), intent(out)", 87 "long double *" => "real(C_LONG_DOUBLE), dimension(*), intent(out)", 88 "__float128 *" => "real(16), dimension(*), intent(out)", 89 90 "fftw_complex *" => "complex(C_DOUBLE_COMPLEX), dimension(*), intent(out)", 91 "fftwf_complex *" => "complex(C_FLOAT_COMPLEX), dimension(*), intent(out)", 92 "fftwl_complex *" => "complex(C_LONG_DOUBLE_COMPLEX), dimension(*), intent(out)", 93 "fftwq_complex *" => "complex(16), dimension(*), intent(out)", 94 95 "const fftw_iodim *" => "type(fftw_iodim), dimension(*), intent(in)", 96 "const fftwf_iodim *" => "type(fftwf_iodim), dimension(*), intent(in)", 97 "const fftwl_iodim *" => "type(fftwl_iodim), dimension(*), intent(in)", 98 "const fftwq_iodim *" => "type(fftwq_iodim), dimension(*), intent(in)", 99 100 "const fftw_iodim64 *" => "type(fftw_iodim64), dimension(*), intent(in)", 101 "const fftwf_iodim64 *" => "type(fftwf_iodim64), dimension(*), intent(in)", 102 "const fftwl_iodim64 *" => "type(fftwl_iodim64), dimension(*), intent(in)", 103 "const fftwq_iodim64 *" => "type(fftwq_iodim64), dimension(*), intent(in)", 104 105 "void *" => "type(C_PTR), value", 106 "FILE *" => "type(C_PTR), value", 107 108 "const char *" => "character(C_CHAR), dimension(*), intent(in)", 109 110 "fftw_write_char_func" => "type(C_FUNPTR), value", 111 "fftwf_write_char_func" => "type(C_FUNPTR), value", 112 "fftwl_write_char_func" => "type(C_FUNPTR), value", 113 "fftwq_write_char_func" => "type(C_FUNPTR), value", 114 "fftw_read_char_func" => "type(C_FUNPTR), value", 115 "fftwf_read_char_func" => "type(C_FUNPTR), value", 116 "fftwl_read_char_func" => "type(C_FUNPTR), value", 117 "fftwq_read_char_func" => "type(C_FUNPTR), value", 118 119 # Although the MPI standard defines this type as simply "integer", 120 # if we use integer without a 'C_' kind in a bind(C) interface then 121 # gfortran complains. Instead, since MPI also requires the C type 122 # MPI_Fint to match Fortran integers, we use the size of this type 123 # (extracted by configure and substituted by the Makefile). 124 "MPI_Comm" => "integer(C_MPI_FINT), value" 125 ); 126 127while (<>) { 128 next if /^ *$/; 129 if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *\((.*)\) *$/) { 130 $ret = &canonicalize_type($1); 131 $name = $2; 132 133 $args = $3; 134 $args =~ s/^ *void *$//; 135 136 $bad = ($ret ne "void") && !exists($return_types{$ret}); 137 foreach $arg (split(/ *, */, $args)) { 138 $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; 139 $argtype = &canonicalize_type($1); 140 $bad = 1 if !exists($arg_types{$argtype}); 141 } 142 if ($bad) { 143 print "! Unable to generate Fortran interface for $name\n"; 144 next; 145 } 146 147 # any function taking an MPI_Comm arg needs a C wrapper (grr). 148 if ($args =~ /MPI_Comm/) { 149 $cname = $name . "_f03"; 150 } 151 else { 152 $cname = $name; 153 } 154 155 # Fortran has a 132-character line-length limit by default (grr) 156 $len = 0; 157 158 print " "; $len = $len + length(" "); 159 if ($ret eq "void") { 160 $kind = "subroutine" 161 } 162 else { 163 print "$return_types{$ret} "; 164 $len = $len + length("$return_types{$ret} "); 165 $kind = "function" 166 } 167 print "$kind $name("; $len = $len + length("$kind $name("); 168 $len0 = $len; 169 170 $argnames = $args; 171 $argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g; 172 $comma = ""; 173 foreach $argname (split(/ *, */, $argnames)) { 174 if ($len + length("$comma$argname") + 3 > 132) { 175 printf ", &\n%*s", $len0, ""; 176 $len = $len0; 177 $comma = ""; 178 } 179 print "$comma$argname"; 180 $len = $len + length("$comma$argname"); 181 $comma = ","; 182 } 183 print ") "; $len = $len + 2; 184 185 if ($len + length("bind(C, name='$cname')") > 132) { 186 printf "&\n%*s", $len0 - length("$name("), ""; 187 } 188 print "bind(C, name='$cname')\n"; 189 190 print " import\n"; 191 foreach $arg (split(/ *, */, $args)) { 192 $arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/; 193 $argtype = &canonicalize_type($1); 194 $argname = $2; 195 $ftype = $arg_types{$argtype}; 196 197 # Various special cases for argument types: 198 if ($name =~ /_flops$/ && $argtype eq "double *") { 199 $ftype = "real(C_DOUBLE), intent(out)" 200 } 201 if ($name =~ /_execute/ && ($argname eq "ri" || 202 $argname eq "ii" || 203 $argname eq "in")) { 204 $ftype =~ s/intent\(out\)/intent(inout)/; 205 } 206 207 print " $ftype :: $argname\n" 208 } 209 210 print " end $kind $name\n"; 211 print " \n"; 212 } 213} 214