#! /usr/bin/env perl # # (C) 2014 by Argonne National Laboratory. # See COPYRIGHT in top-level directory. # use warnings; use strict; use File::Basename; my $debug = 0; my $cur_dir = "src/binding/fortran/use_mpi_f08"; my $wrappers_f_dir = "wrappers_f"; my $pmpi_dir = "wrappers_f/profiling"; # Stage 1: Translate mpi_f08.f90 into pmpi_f08.f90 # ===================================================================== my $mpi_f08_file = "mpi_f08.f90"; my $pmpi_f08_file = "pmpi_f08.f90"; my $mpi_f08_fh; my $pmpi_f08_fh; open($mpi_f08_fh, "<", $mpi_f08_file) || die "Error: Could not open $mpi_f08_file, $!"; open($pmpi_f08_fh, ">", $pmpi_f08_file) || die "Error: Could not open $pmpi_f08_file, $!"; while (<$mpi_f08_fh>) { if (/pmpi_f08/) { next; # Skip the "use :: pmpi_f08" line } # MPI_ part elsif (/module\s+mpi_f08/) { $_ =~ s/module\s+mpi_f08/module pmpi_f08/; } elsif (/interface\s+MPI_/) { $_ =~ s/interface\s+MPI_/interface PMPI_/; } elsif (/subroutine\s+MPI_/) { $_ =~ s/subroutine\s+MPI_/subroutine PMPIR_/; } elsif (/function\s+MPI_/) { $_ =~ s/function\s+MPI_/function PMPIR_/; } # MPIX_ part elsif (/interface\s+MPIX_/) { $_ =~ s/interface\s+MPIX_/interface PMPIX_/; } elsif (/subroutine\s+MPIX_/) { $_ =~ s/subroutine\s+MPIX_/subroutine PMPIXR_/; } elsif (/function\s+MPIX_/) { $_ =~ s/function\s+MPIX_/function PMPIXR_/; } print $pmpi_f08_fh $_; } close($mpi_f08_fh); close($pmpi_f08_fh); # Stage 2: Translate Fortran MPI wrapper files into PMPI wrapper files # ===================================================================== mkdir $pmpi_dir unless -d $pmpi_dir; foreach my $mpi_file (glob("$wrappers_f_dir/*.f90")) { my $basename = basename($mpi_file); my $pmpi_file = "$pmpi_dir/p$basename"; my $mpi_fh; my $pmpi_fh; open($mpi_fh, "<", $mpi_file) or die "Error: Could not open $mpi_file, $!"; open($pmpi_fh, ">", $pmpi_file) or die "Error: Could not open $pmpi_file, $!"; while (<$mpi_fh>) { if (/subroutine\s+MPI_/) { $_ =~ s/subroutine\s+MPI_/subroutine PMPIR_/ } elsif (/function\s+MPI_/) { $_ =~ s/function\s+MPI_/function PMPIR_/ } elsif (/subroutine\s+MPIX_/) { $_ =~ s/subroutine\s+MPIX_/subroutine PMPIXR_/ } elsif (/function\s+MPIX_/) { $_ =~ s/function\s+MPIX_/function PMPIXR_/ } print $pmpi_fh $_; } close($mpi_fh); close($pmpi_fh); } # Stage 3: Generate Makefile.mk under use_mpi_f08 # ===================================================================== my $makefile = "Makefile.mk"; my $makefile_fh; my @files; open($makefile_fh, ">", $makefile) || die "Error: Could not open $makefile, $!"; print $makefile_fh < "mpi_c_interface_cdesc", "mpi_c_interface_cdesc" => "mpi_c_interface_nobuf", "mpi_c_interface_nobuf" => "mpi_c_interface_glue", "mpi_c_interface_glue" => "mpi_f08", "mpi_f08" => "pmpi_f08", "pmpi_f08" => "mpi_f08_link_constants", "mpi_f08_link_constants" => "mpi_f08_callbacks", "mpi_f08_callbacks" => "mpi_f08_compile_constants", "mpi_f08_compile_constants" => "mpi_f08_types", "mpi_f08_types" => "mpi_c_interface_types", "mpi_c_interface_types" => "", ); print $makefile_fh </dev/null; then \\ \t rm -f src/binding/fortran/use_mpi_f08/$x.stamp; \\ \t \$(MAKE) \$(AM_MAKEFLAGS) src/binding/fortran/use_mpi_f08/$x.stamp; \\ \t rmdir src/binding/fortran/use_mpi_f08/$x-lock; \\ \t else \\ \t while test -d src/binding/fortran/use_mpi_f08/$x-lock; do sleep 1; done; \\ \t test -f src/binding/fortran/use_mpi_f08/$x.stamp; exit \$\$?; \\ \t fi; \\ \tfi CLEANFILES += src/binding/fortran/use_mpi_f08/$DOLLARX.\$(MOD) \\ src/binding/fortran/use_mpi_f08/$x.lo \\ src/binding/fortran/use_mpi_f08/$x.stamp \\ src/binding/fortran/use_mpi_f08/$x.tmp EOT } print $makefile_fh "\n\n"; print $makefile_fh "BUILT_SOURCES += \$(f08_module_files)\n"; print $makefile_fh "CLEANFILES += \$(f08_module_files)\n\n"; print $makefile_fh "include \$(top_srcdir)/src/binding/fortran/use_mpi_f08/wrappers_c/Makefile.mk\n\n"; print $makefile_fh "endif BUILD_F08_BINDING\n"; close($makefile_fh); # Stage 4: Generate mpi_f08_compile_constants.f90.in # ===================================================================== # Some of the following variables and subroutines are adapted from F77 # buildiface. They are used to parse files like mpi.h.in and mpio.h.in, # store MPI definitions and print them in Fortran soure code. # The main driver part follows the subroutines. my %mpidef; # Map MPI constant names to values my %mpidefFile; my $build_io = 1; my %skipBlocks; my $constants_file = "mpi_f08_compile_constants.f90.in.new"; my $constants_fh; # File handle of $constants_file # Skip ifndef'ed blocks sub SkipCPPIfdef { my $FD = $_[0]; my $depth = 1; while (<$FD>) { if (/^#\s*endif/) { $depth--; #print "Depth is now $depth\n"; } elsif (/^#\s*if/) { $depth++; #print "Depth is now $depth\n"; } #print "Skipping $_"; if ($depth <= 0) { last; } } return 0; } # Parse an interface file sub ReadInterfaceForDefinitions { my $prototype_file = $_[0]; my $linecount = 0; my $prototype_fh; open ($prototype_fh, "<$prototype_file" ) || die "Could not open $prototype_file\n"; # # First, find the values that we need while (<$prototype_fh>) { $linecount++; # Remove any comments; check for problems my $origline = $_; while (/(.*)\/\*(.*?)\*\/(.*)/) { my $removed = $2; $_ = $1.$3; if ($2 =~ /\/\*/) { print STDERR "Error in processing comment within interface file $prototype_file in line $origline"; } } # We should also skip #ifndef xxx, for some xxx. if (/^#\s*ifndef\s+(\w*)/) { my $ndefname = $1; if (defined($skipBlocks{$ndefname})) { &SkipCPPIfdef($prototype_fh); } } # Use \S instead of [^\s]. See the comment above if (/^\s*#\s*define\s+(MPI[X]*_[A-Za-z_0-9]*)\s+(\S+)(.*)/) { my $name = $1; my $val = $2; my $remainder = $3; print "Found definition of $name as $val\n" if $debug; # If the name has some lower case letters in it, we # need to skip it (e.g., for a define MPI_Comm_c2f...) if ($name =~ /[a-z]/) { next; } if (defined($mpidef{$name})) { # We want to catch the case ((cast) value). In # The above definition, the space will break the # value into the cast (actually, "((cast)"). my $fullval = "$val $remainder"; if ($fullval =~ /\(\(([^\(\)]*)\)\s*([^\(\)]*)\s*\)/) { $val = "(($1)$2)"; } if ($mpidef{$name} ne $val) { my $found = ""; if (defined($mpidefFile{$name})) { my $location = $mpidefFile{$name}; $found = " found in $location"; } print STDERR "Attempting to redefine $name with a new value $val found in \ $prototype_file:$linecount,\nusing original value of $mpidef{$name}$found\n"; } } else { $mpidef{$name} = $val; $mpidefFile{$name} = "$prototype_file:$linecount"; } } elsif (/typedef\s+enum\s+[A-Za-z0-9_]*\s*{\s*(.*)/) { # Allow a named type # Eat until we find the closing right brace my $enum_line = $1; while (! ($enum_line =~ /}/)) { my $newline = <$prototype_fh>; $newline =~ s/\r*\n//; $enum_line .= $newline; $linecount++; } print "Handling enum $enum_line...\n" if $debug; # Now process for names and values while (($enum_line =~ /\s*(MPI[X]*_[A-Z_0-9]*)\s*=\s*([a-fx0-9]*)(.*)/)) { $mpidef{$1} = $2; $mpidefFile{$1} = "$prototype_file:$linecount"; $enum_line = $3; print "Defining $1 as $2\n" if $debug; } } elsif (/enum\s+([A-Za-z0-9_]*)\s*{\s*(.*)/) { # Allow a named type # Eat until we find the closing right brace my $enum_name = $1; my $enum_line = $2; while (! ($enum_line =~ /}/)) { print "reading for $enum_name...\n" if $debug; my $newline = <$prototype_fh>; $newline =~ s/\r*\n//; $enum_line .= $newline; $linecount++; } # Now process for names and values while (($enum_line =~ /\s*(MPI[X]*_[A-Z_0-9]*)\s*=\s*([a-fx0-9]*)(.*)/)) { my $name = $1; my $val = $2; my $remainder = $3; $mpidef{$name} = $val; $mpidefFile{$name} = "$prototype_file:$linecount"; $enum_line = $remainder; print "Defining $name as $val\n" if $debug; } } } # ~while (<$prototype_fh>) close ($prototype_fh); } # Print a Fortran parameter sub print_param { my $type = $_[0]; # type can be integer or other MPI_F08 types like MPI_Op my $key = $_[1]; # MPI constants, like MPI_COMM_WORLD my $value = $mpidef{$key}; my $hexvalue = ""; if (!defined($value) || $value eq "") { print STDERR "No value found for \"$key\"\n"; return 0; } # Remove any casts print "Input value for $key = $value\n" if $debug; # Add a special case to for MPIX_* if ($value =~ /\(MPIX/) { $value =~ s/\(MPIX_[A-Za-z0-9]*\s*\)//; print "cast removal: $value\n" if $debug; # Remove any surrounding (MPI_REQUEST_NULL) if ($value =~ /\(\s*[A-Z_]*\)/) { $value =~ s/\(\s*([A-Z_]*)\s*\)/$1/; print "paren removal: $value\n" if $debug; } } if ($value =~ /\(MPI/) { $value =~ s/\(MPI_[A-Za-z0-9]*\s*\)//; print "cast removal: $value\n" if $debug; } # Remove any surrounding () around nubmers or placeholders like @MPI_COMPLEX@ if ($value =~ /\(\s*[-a-fx0-9\w@]*\)/) { $value =~ s/\(\s*([-a-fx0-9\w@]*)\s*\)/$1/; print "paren removal: $value\n" if $debug; } # Convert hex to decimal if ($value =~ /^0x[a-f\d]*/) { $hexvalue = $value; # remember hex value for better output $value = hex $value; print "hex conversion: $value\n" if $debug; } if ($type =~ /integer/) { printf $constants_fh ("$type, parameter :: %-32s = %s", $key, $value); } else { # Fortran derived data types my $typestr = $type; my $valuestr = $value; $typestr = "type($type)"; $valuestr = "$type($value)"; printf $constants_fh ("%-31s :: %-19s = %s", "$typestr, parameter", $key, $valuestr); } # Print the old hex value (if it was) as comments for readability if ($hexvalue) { printf $constants_fh " ! $hexvalue"; } printf $constants_fh "\n"; } # Replace old file with new file only if new file is different # Otherwise, remove new filename sub ReplaceIfDifferent { my ($oldfilename,$newfilename) = @_; my $rc = 1; if (-s $oldfilename) { $rc = system "cmp -s $newfilename $oldfilename"; $rc >>= 8; # Shift right to get exit status } if ($rc != 0) { # The files differ. Replace the old file # with the new one if (-s $oldfilename) { print STDERR "Replacing $oldfilename\n"; unlink $oldfilename; } else { print STDERR "Creating $oldfilename\n"; } rename $newfilename, $oldfilename || die "Could not replace $oldfilename"; } else { unlink $newfilename; } } # Main driver to generate mpi_f08_compile_constants.f90.in &ReadInterfaceForDefinitions("../../../include/mpi.h.in"); if ( -s "../../../mpi/romio/include/mpio.h.in" && $build_io) { %skipBlocks = ('HAVE_MPI_DARRAY_SUBARRAY' => 1, 'HAVE_MPI_INFO' => 1, 'MPICH' => 1); &ReadInterfaceForDefinitions( "../../../mpi/romio/include/mpio.h.in" ); %skipBlocks = (); } else { $build_io = 0; } open($constants_fh, ">", $constants_file) || die "Error: Could not open $constants_file, $!"; print $constants_fh < $errors{$b} } keys %errors) { &print_param("integer", $key); } # Predefined error handlers print $constants_fh "\n! Predefined error handlers\n"; foreach $key (qw(ERRORS_ARE_FATAL ERRORS_RETURN)) { &print_param("MPI_Errhandler", "MPI_$key"); } # Compare operations print $constants_fh "\n! Compare operations\n"; foreach $key (qw(IDENT CONGRUENT SIMILAR UNEQUAL)) { &print_param("integer","MPI_$key"); } # Window flavor and model print $constants_fh "\n! Window flavors and models\n"; foreach $key (qw(FLAVOR_CREATE FLAVOR_ALLOCATE FLAVOR_DYNAMIC FLAVOR_SHARED SEPARATE UNIFIED)) { &print_param("integer","MPI_WIN_$key"); } # Collective operations print $constants_fh "\n! Collective operations\n"; foreach $key (qw(MAX MIN SUM PROD LAND BAND LOR BOR LXOR BXOR MINLOC MAXLOC REPLACE NO_OP)) { &print_param("MPI_Op","MPI_$key"); } # Objects print $constants_fh "\n! Predefined comms and null handles\n"; &print_param("MPI_Comm", "MPI_COMM_WORLD"); &print_param("MPI_Comm", "MPI_COMM_SELF"); &print_param("MPI_Comm", "MPI_COMM_NULL"); &print_param("MPI_Group", "MPI_GROUP_EMPTY"); &print_param("MPI_Group", "MPI_GROUP_NULL"); &print_param("MPI_Win", "MPI_WIN_NULL"); &print_param("MPI_File", "MPI_FILE_NULL"); &print_param("MPI_Op", "MPI_OP_NULL"); &print_param("MPI_Datatype", "MPI_DATATYPE_NULL"); &print_param("MPI_Request", "MPI_REQUEST_NULL"); &print_param("MPI_Errhandler", "MPI_ERRHANDLER_NULL"); &print_param("MPI_Info", "MPI_INFO_NULL"); &print_param("MPI_Info", "MPI_INFO_ENV"); &print_param("MPI_Message", "MPI_MESSAGE_NULL"); &print_param("MPI_Message", "MPI_MESSAGE_NO_PROC"); # Attributes print $constants_fh "\n! Attributes\n"; foreach $key (qw(TAG_UB HOST IO WTIME_IS_GLOBAL UNIVERSE_SIZE LASTUSEDCODE APPNUM WIN_BASE WIN_SIZE WIN_DISP_UNIT WIN_CREATE_FLAVOR WIN_MODEL)) { # Special cast: The Fortran versions of these attributes have # value 1 greater than the C versions my $attrval = $mpidef{"MPI_$key"}; print "$key is $attrval\n" if $debug; if ($attrval =~ /^0x/) { $attrval = hex $attrval; } $attrval++; $attrval = "0x" . sprintf "%x", $attrval; print "$key is now $attrval\n" if $debug; $mpidef{"MPI_$key"} = $attrval; &print_param("integer", "MPI_$key"); } # String sizes print $constants_fh "\n! String sizes\n"; foreach $key (qw(MAX_ERROR_STRING MAX_PORT_NAME MAX_OBJECT_NAME MAX_INFO_KEY MAX_INFO_VAL MAX_PROCESSOR_NAME MAX_DATAREP_STRING MAX_LIBRARY_VERSION_STRING)) { # See MPI-2 2.6.2 and 4.12.9; the constants for string lengths are # defined as one less than the C/C++ version &print_param("integer", "MPI_$key", -1); } # Predefined constants print $constants_fh "\n! Predefined constants\n"; foreach $key (qw(UNDEFINED KEYVAL_INVALID BSEND_OVERHEAD PROC_NULL ANY_SOURCE ANY_TAG ROOT)) { &print_param("integer", "MPI_$key"); } # Topology types print $constants_fh "\n! Topology types\n"; foreach $key (qw(GRAPH CART DIST_GRAPH)) { &print_param("integer", "MPI_$key"); } # Special RMA values print $constants_fh "\n! RMA lock types\n"; &print_param("integer", "MPI_LOCK_EXCLUSIVE"); &print_param("integer", "MPI_LOCK_SHARED"); # Fortran 90 types # MPI_INTEGER_KIND added in MPI 2.2 $mpidef{MPI_ADDRESS_KIND} = "c_Aint"; $mpidef{MPI_OFFSET_KIND} = "c_Offset"; $mpidef{MPI_COUNT_KIND} = "c_Count"; $mpidef{MPI_INTEGER_KIND} = "c_int"; # F08 specific constants print $constants_fh "\n! F08 specific constants\n"; print $constants_fh "logical, parameter :: MPI_SUBARRAYS_SUPPORTED = .true.\n"; print $constants_fh "logical, parameter :: MPI_ASYNC_PROTECTS_NONBLOCKING = .true.\n"; print $constants_fh "\n"; foreach $key (qw(ADDRESS_KIND OFFSET_KIND COUNT_KIND INTEGER_KIND)) { &print_param("integer", "MPI_$key"); } # Datatypes print $constants_fh "\n! Datatypes\n"; foreach $key (qw(COMPLEX DOUBLE_COMPLEX LOGICAL REAL DOUBLE_PRECISION INTEGER 2INTEGER 2DOUBLE_PRECISION 2REAL CHARACTER)) { &print_param("MPI_Datatype", "MPI_$key"); } print $constants_fh "\n"; foreach $key (qw(BYTE UB LB PACKED INTEGER1 INTEGER2 INTEGER4 INTEGER8 INTEGER16 REAL4 REAL8 REAL16 COMPLEX8 COMPLEX16 COMPLEX32 CHAR SIGNED_CHAR UNSIGNED_CHAR WCHAR SHORT UNSIGNED_SHORT INT UNSIGNED LONG UNSIGNED_LONG FLOAT DOUBLE LONG_DOUBLE LONG_LONG_INT UNSIGNED_LONG_LONG LONG_LONG FLOAT_INT DOUBLE_INT LONG_INT SHORT_INT 2INT LONG_DOUBLE_INT INT8_T INT16_T INT32_T INT64_T UINT8_T UINT16_T UINT32_T UINT64_T C_BOOL C_FLOAT_COMPLEX C_COMPLEX C_DOUBLE_COMPLEX C_LONG_DOUBLE_COMPLEX AINT OFFSET COUNT CXX_BOOL CXX_FLOAT_COMPLEX CXX_DOUBLE_COMPLEX CXX_LONG_DOUBLE_COMPLEX)) { $mpidef{"MPI_$key"} = "\@F08_$key\@"; &print_param("MPI_Datatype", "MPI_$key"); } # Datatype combiners print $constants_fh "\n! Datatype combiners\n"; foreach $key (qw(NAMED DUP CONTIGUOUS VECTOR HVECTOR_INTEGER HVECTOR INDEXED HINDEXED_INTEGER HINDEXED INDEXED_BLOCK STRUCT_INTEGER STRUCT SUBARRAY DARRAY F90_REAL F90_COMPLEX F90_INTEGER RESIZED HINDEXED_BLOCK)) { &print_param("integer", "MPI_COMBINER_$key"); } # Typeclasses print $constants_fh "\n"; foreach $key (qw(REAL INTEGER COMPLEX)) { &print_param("integer", "MPI_TYPECLASS_$key"); } # RMA Asserts print $constants_fh "\n"; foreach $key (qw(NOCHECK NOSTORE NOPUT NOPRECEDE NOSUCCEED)) { &print_param("integer", "MPI_MODE_$key"); } # comm_split_types print $constants_fh "\n"; &print_param("integer", "MPI_COMM_TYPE_SHARED"); # Thread levels print $constants_fh "\n"; foreach $key (qw(SINGLE FUNNELED SERIALIZED MULTIPLE)) { &print_param("integer", "MPI_THREAD_$key"); } # MPI-2 types: Files if ($build_io) { # Modes print $constants_fh "\n"; foreach $key(qw(RDONLY RDWR WRONLY DELETE_ON_CLOSE UNIQUE_OPEN CREATE EXCL APPEND SEQUENTIAL)) { &print_param("integer", "MPI_MODE_$key"); } # Seek print $constants_fh "\n"; foreach $key (qw(SET CUR END)) { &print_param("integer", "MPI_SEEK_$key"); } # Order print $constants_fh "\n"; foreach $key (qw(C FORTRAN)) { &print_param("integer", "MPI_ORDER_$key"); } # direction print $constants_fh "\n"; foreach $key (qw(BLOCK CYCLIC NONE DFLT_DARG)) { &print_param("integer", "MPI_DISTRIBUTE_$key"); } print $constants_fh "\n"; &print_param("integer(kind=MPI_OFFSET_KIND)", "MPI_DISPLACEMENT_CURRENT"); } print $constants_fh "end module mpi_f08_compile_constants\n"; close($constants_fh); &ReplaceIfDifferent("mpi_f08_compile_constants.f90.in", "mpi_f08_compile_constants.f90.in.new"); # Stage 5: Generate mpi_c_interface_types.f90.in # ===================================================================== my $ctypes_file = "mpi_c_interface_types.f90.in.new"; my $ctypes_fh; open($ctypes_fh, ">", $ctypes_file) || die "Error: Could not open $ctypes_file, $!"; print $ctypes_fh <