mirror of
https://github.com/tildearrow/furnace.git
synced 2024-11-01 18:42:40 +00:00
78 lines
2.1 KiB
Perl
Executable file
78 lines
2.1 KiB
Perl
Executable file
#!/usr/bin/perl -w
|
|
# Generate Fortran 2003 wrappers (which translate MPI_Comm from f2c) from
|
|
# function declarations of the form (one per line):
|
|
# extern <type> fftw_mpi_<name>(...args...)
|
|
# extern <type> fftw_mpi_<name>(...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.)
|
|
# Each declaration has at least one MPI_Comm argument.
|
|
|
|
sub canonicalize_type {
|
|
my($type);
|
|
($type) = @_;
|
|
$type =~ s/ +/ /g;
|
|
$type =~ s/^ //;
|
|
$type =~ s/ $//;
|
|
$type =~ s/([^\* ])\*/$1 \*/g;
|
|
$type =~ s/double/R/;
|
|
$type =~ s/fftw_([A-Za-z0-9_]+)/X(\1)/;
|
|
return $type;
|
|
}
|
|
|
|
while (<>) {
|
|
next if /^ *$/;
|
|
if (/^ *extern +([a-zA-Z_0-9 ]+[ \*]) *fftw_mpi_([a-zA-Z_0-9]+) *\((.*)\) *$/) {
|
|
$ret = &canonicalize_type($1);
|
|
$name = $2;
|
|
|
|
$args = $3;
|
|
|
|
|
|
print "\n$ret XM(${name}_f03)(";
|
|
|
|
$comma = "";
|
|
foreach $arg (split(/ *, */, $args)) {
|
|
$arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
|
|
$argtype = &canonicalize_type($1);
|
|
$argname = $2;
|
|
print $comma;
|
|
if ($argtype eq "MPI_Comm") {
|
|
print "MPI_Fint f_$argname";
|
|
}
|
|
else {
|
|
print "$argtype $argname";
|
|
}
|
|
$comma = ", ";
|
|
}
|
|
print ")\n{\n";
|
|
|
|
print " MPI_Comm ";
|
|
$comma = "";
|
|
foreach $arg (split(/ *, */, $args)) {
|
|
$arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
|
|
$argtype = &canonicalize_type($1);
|
|
$argname = $2;
|
|
if ($argtype eq "MPI_Comm") {
|
|
print "$comma$argname";
|
|
$comma = ", ";
|
|
}
|
|
}
|
|
print ";\n\n";
|
|
|
|
foreach $arg (split(/ *, */, $args)) {
|
|
$arg =~ /^([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) *$/;
|
|
$argtype = &canonicalize_type($1);
|
|
$argname = $2;
|
|
if ($argtype eq "MPI_Comm") {
|
|
print " $argname = MPI_Comm_f2c(f_$argname);\n";
|
|
}
|
|
}
|
|
|
|
$argnames = $args;
|
|
$argnames =~ s/([a-zA-Z_0-9 ]+[ \*]) *([a-zA-Z_0-9]+) */$2/g;
|
|
print " ";
|
|
print "return " if ($ret ne "void");
|
|
print "XM($name)($argnames);\n}\n";
|
|
}
|
|
}
|