buildiface

fortran并行计算包

#! /usr/bin/perl -w
# binding.sub provides the routines for reading the prototype file
# and extracting the function definitions.
require "binding.sub";

$arg_string = join( ' ', @ARGV );
$prototype_file = "../../include/mpi.h.in";
$gDebug = 0;
%mpi_routines = ();
%NeedConstants = ();   # constants needed for declaration, hased by routine

#
# ToDo: Fortran 90 allows some additional checks not possible in Fortran 77.
# For example, the size of an array may be queried.  This could be particularly
# useful for the ARGV argument in SPAWN, which in Fortran requires a blank
# line to terminate the ARGV.  Even without that, the Fortran 90 wrappers
# could check for the required blank entry, and report an error if it was
# missing.
#

#
# parmc2f translates the C/C++ names to the Fortran 90 name.  %name% will
# be replaced with the argument name in declarations.
#
# Some picky compilers want an interface description where Fortran 77
# was happy with a simple EXTERNAL.  To handle this, the EXTERNAL
# has a more elaborate form:
#  INTERFACE %nl%SUBROUTINE %name%(<args>)%nl%<type decls>%nl%END SUBROUTINE%nl%END INTERFACE
# where %nl% is newline/indent.  
#
%parmc2f = ( 'int' => 'INTEGER',
	     'int[]' => 'INTEGER %name%(*)',
	     'int[][3]' => 'INTEGER %name%(3,*)',
	     'int*' => 'INTEGER',      # assume output scalar (see array
	                               # replacement below)
	     'bool' => 'LOGICAL',
	     'bool[]' => 'LOGICAL %name%(*)',
	     'MPI_Handler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
	     'MPI_Win_errhandler_fn*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
	     'MPI_Comm_errhandler_fn*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
	     'MPI_File_errhandler_fn*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
	     # These other functions have <choice> (really void*) arguments
	     # and so an interface spec is very hard to do in Fortran 90.
	     'MPI_Comm_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Comm_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Type_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Type_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Win_copy_attr_function*' => 'EXTERNAL',
	     'MPI_Win_delete_attr_function*' => 'EXTERNAL',
	     'MPI_Copy_function*' => 'EXTERNAL',
	     'MPI_Delete_function*' => 'EXTERNAL',
	     'MPI_User_function*' => 'EXTERNAL',
	     'MPI_Grequest_query_function*' => 'EXTERNAL',
	     'MPI_Grequest_free_function*' => 'EXTERNAL',
	     'MPI_Grequest_cancel_function*' => 'EXTERNAL',
	     'MPI_Request' => 'INTEGER',
	     'MPI_Request*' => 'INTEGER',
	     'MPI_Request[]' => 'INTEGER %name%(*)',
	     'MPI_Datatype' => 'INTEGER',
	     'MPI_Datatype*' => 'INTEGER',
	     'MPI_Datatype[]' => 'INTEGER %name%(*)',
	     'MPI_Comm' => 'INTEGER',
	     'MPI_Comm*' => 'INTEGER', # Never an array of comm
	     'MPI_Group' => 'INTEGER',
	     'MPI_Group*' => 'INTEGER', # Never an array of groups
	     'MPI_Errhandler' => 'INTEGER',
	     'MPI_Errhandler*' => 'INTEGER', # Never an array of errhandlers
	     'MPI_Op' => 'INTEGER',
	     'MPI_Op*' => 'INTEGER', # Never an array of ops
	     'MPI_Status*' => 'INTEGER %name%(MPI_STATUS_SIZE)',
	     'MPI_Status[]' => 'INTEGER %name%(MPI_STATUS_SIZE,*)',
	     'MPI_Aint' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
	     'MPI_Aint*' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
	     'MPI_Aint[]' => 'INTEGER(KIND=MPI_ADDRESS_KIND) %name%(*)',
	     'MPI_Info' => 'INTEGER',
	     'MPI_Info*' => 'INTEGER', # Never an array of info
	     'MPI_Info[]' => 'INTEGER %name%(*)',
	     'char*' => 'CHARACTER (LEN=*)',
	     'char*[]' => 'CHARACTER (LEN=*) %name%(*)',
	     'char**[]' => 'CHARACTER (LEN=*) %name%(v0,*)',  #special case
				# from Comm_Spawn_multiple
	     'MPI_Win' => 'INTEGER',
	     'MPI_Win*' => 'INTEGER', # Never an array of win
	     'MPI_File' => 'INTEGER',
	     'MPI_File*' => 'INTEGER', # Never an array of files
	     );

# special_args provides for handling of arguments that require special
# features.  The keys are of the form 'Routine-count', with count the 
# position of the argument, starting from one.
%special_args = ( 'Testany-2' => 'MPI_Request[]',
		  'Startall-2' => 'MPI_Request[]',
		  'Testall-2' => 'MPI_Request[]',
		  'Testall-4' => 'MPI_Status[]',
		  'Testsome-2' => 'MPI_Request[]',
		  'Testsome-4' => 'int[]',
		  'Testsome-5' => 'MPI_Status[]',
		  'Type_hindexed-2' => 'int[]',
		  'Type_hindexed-3' => 'int[]',
		  'Type_indexed-2' => 'int[]',
		  'Type_indexed-3' => 'int[]',
		  'Type_struct-2' => 'int[]',
		  'Type_struct-3' => 'int[]',
		  'Type_struct-4' => 'MPI_Datatype[]',
		  'Waitall-2' => 'MPI_Request[]',
		  'Waitall-3' => 'MPI_Status[]',
		  'Waitany-2' => 'MPI_Request[]',
		  'Waitsome-2' => 'MPI_Request[]',
		  'Waitsome-4' => 'int[]',
		  'Waitsome-5' => 'MPI_Status[]',
		  'Group_excl-3' => 'int[]',
		  'Group_incl-3' => 'int[]',
		  'Group_translate_ranks-3' => 'int[]',
		  'Group_translate_ranks-5' => 'int[]',
		  'Cart_coords-4' => 'int[]',
		  'Cart_create-3' => 'int[]',
		  'Cart_create-4' => 'bool[]',
		  'Cart_get-3' => 'int[]',
		  'Cart_get-5' => 'int[]',
		  'Cart_get-4' => 'bool[]',
		  'Cart_map-3' => 'int[]',
		  'Cart_map-4' => 'bool[]',
		  'Cart_rank-2' => 'int[]',
		  'Cart_sub-2' => 'bool[]',
		  'Dims_create-3' => 'int[]',
		  'Graph_create-3' => 'int[]',
		  'Graph_create-4' => 'int[]',
		  'Graph_create-5' => 'bool',
		  'Graph_get-4' => 'int[]',
		  'Graph_get-5' => 'int[]',
		  'Graph_map-3' => 'int[]',
		  'Graph_map-4' => 'int[]',
		  'Graph_neighbors-4' => 'int[]',
		  'Iprobe-4' => 'bool',
		  'Test-2' => 'bool',
		  'Testall-3' => 'bool',
		  'Testany-4' => 'bool',
		  'Test_cancelled-2' => 'bool',
		  'Op_create-2' => 'bool',
		  'Attr_get-4' => 'bool',
		  'Comm_test_inter-2' => 'bool',
		  'Intercomm_merge-2' => 'bool',
		  'Cart_create-5' => 'bool',
		  'Initialized-1' => 'bool',		
		  'Finalized-1' => 'bool',
		  'Group_range_excl-3' => 'int[][3]',
		  'Group_range_incl-3' => 'int[][3]',
		  'Info_get_valuelen-4' => 'bool',
		  'Is_thread_main-1' => 'bool',
		  'Type_create_subarray-2' => 'int[]',
		  'Type_create_subarray-3' => 'int[]',
		  'Type_create_subarray-4' => 'int[]',
		  'Request_get_status-2' => 'bool',
		  'Info_get-5' => 'bool',
		  'Type_create_indexed_block-3' => 'int[]',
		  'Type_create_darray-4' => 'int[]',
		  'Type_create_darray-5' => 'int[]',
		  'Type_create_darray-6' => 'int[]',
		  'Type_create_darray-7' => 'int[]',
		  'Type_create_struct-2' => 'int[]',
		  'Type_create_struct-3' => 'MPI_Aint[]',
		  'Win_test-2' => 'bool',
		  'Type_create_hindexed-2' => 'int[]',
		  'Type_create_hindexed-3' => 'MPI_Aint[]',
		);

# Some routines must be skipped (custom code is provided for them)
%skip_routines = ( 'Init' => 1, 'Init_thread' => 1, 'Status_c2f' => 1,
		   'Status_f2c' => 1, 'Pcontrol' => 1,
		   );

# Some routines *may* be skipped if we don't want to handle the possibility
# of a scalar or vector argument
# Still to do: Add the others (datatype creation, translate ranks, etc.)
# For each of these, we need to know which arguments are the "scalar/vector"
# The value of the hash gives us the answer, indexed from 1
# (these are not correct yet).
%scalarVectorRoutines = ( 'Startall' => '2-1', 'Testall' => '2-1:4-1', 
			  'Testany' => '2-1',
			  'Testsome' => '2-1:4-1:5-1', 
			  'Waitall' => '2-1:3-1', 'Waitany' => '2-1',
			  'Waitsome' => '2-1:4-1:5-1', 
			  'Dims_create' => '3-2', 
			  'Cart_rank' => '2', 'Cart_coords' => '4-3', 
			  'Cart_get' => '3-2:4-2:5-2', 
			  'Graph_neighbors' => '4-3', 
			  'Cart_sub' => '2',
			  'Cart_map' => '3-2:4-2',
			  'Cart_create' => '3-2:4-2',
			  'Graph_create' => '3:4',
			  'Group_translate_ranks' => '3-2:5-2',

    );

# And we skip them byy default
$buildScalarVector = 0;

# Process any options
foreach $_ (@ARGV) {
    if (/-prototype=(.*)/) {
	$prototype_file = $1;
    }
    elsif (/-sv/) {
	# This obscure argument enables the creation of an interface that
	# includes the routines that can accept a scalar or a vector
	# (e.g., a single request or an array of requests) on a single 
	# type (e.g., an integer).  By default, we leave these out.
	$buildScalarVector = 1;
    }
    else {
	print STDERR "Unrecognized argument $_\n";
	exit 2;
    }
}

#
# Read the interface file (e.g., mpi.h.in) and file in the various 
# data structures (they're in global variables)
&ReadInterface( $prototype_file, "MPI_", "[A-Z][a-z_0-9]*", "mpi_routines" );

#
# For some MPI routines, we need to distinguish between arguments that are 
# input arrays versus ones that are output scalars.  For those functions,
# convert input (or output) arrays to [] format.  

# ----------------------------------------------------------------------------
#
# Generate the module for the routines
# First pass.  Ignore the issue of choice routines
# Print header
open (MPIFD, ">mpi.f90.new" ) || die "Could not open mpi.f90.new\n";

# Was 
#       USE MPI_CONSTANTS,                                               &
#     &      BASE_MPI_WTIME => MPI_WTIME, BASE_MPI_WTICK => MPI_WTICK
# but this caused problems with the pg compiler.  Need to understand and fix
print MPIFD "       MODULE MPI
!      This module was created by the script buildiface
       USE MPI_CONSTANTS
       USE MPI_SIZEOFS
       USE MPI_BASE
       END MODULE MPI\n";
  
close (MPIFD);
&ReplaceIfDifferent( "mpi.f90", "mpi.f90.new" );

# ----------------------------------------------------------------------------
# This is the file for the routines that have no "choice" arguments.
# An example of a choice argument is a "void *buf" input argument to 
# MPI_Send, which allows any buffer address, both numeric and character.
open ( MPIBASEFD, ">mpi_base.f90.new" ) || die "Could not open mpi_base.f90.new\n";
print MPIBASEFD "       MODULE MPI_BASE
       IMPLICIT NONE
!      This module was created by the script buildiface
       INTERFACE\n";

foreach $routine (keys(%mpi_routines)) {
    $ucname = uc($routine);
    $args   = $mpi_routines{$routine};
    @parms  = split(/,/, $args );

    # Check for a routine to skip
    if (defined($skip_routines{$routine})) {
	next;
    }

    if (defined($scalarVectorRoutines{$routine})) {
	# These require special processing in any case
	next;
    }

    # Check for a void * argument (usually choice)
    # As noted above, we don't include the routines with choice arguments
    # in the base module.
    if ($args =~ /void/) {
	$mpi_choice_routines{$routine} = $args;
	print "Skipping $routine because of void argument\n" if $gDebug;
	next;
    }
    print MPIBASEFD "       SUBROUTINE MPI_$ucname(";
    for ($i=0; $i<=$#parms; $i++) {
	print MPIBASEFD "v$i,";
    }
    print MPIBASEFD "ierror)\n";
    &PrintArgDecls( $routine, 0, "" );
    print MPIBASEFD "       END SUBROUTINE MPI_$ucname\n\n";
}

# Add special routines (e.g., the ones with unusual arguments)

print MPIBASEFD "
        SUBROUTINE MPI_INIT(ierror)
        INTEGER ierror
        END SUBROUTINE MPI_INIT

        SUBROUTINE MPI_INIT_THREAD(v0,v1,ierror)
        INTEGER v0, v1, ierror
        END SUBROUTINE MPI_INIT_THREAD

        FUNCTION MPI_WTIME()
            DOUBLE PRECISION MPI_WTIME
        END FUNCTION MPI_WTIME
!
        FUNCTION MPI_WTICK()
            DOUBLE PRECISION MPI_WTICK
        END FUNCTION MPI_WTICK

        FUNCTION PMPI_WTIME()
            DOUBLE PRECISION PMPI_WTIME
        END FUNCTION PMPI_WTIME
!
        FUNCTION PMPI_WTICK()
            DOUBLE PRECISION PMPI_WTICK
        END FUNCTION PMPI_WTICK

        SUBROUTINE MPI_NULL_DELETE_FN(a,b,c,d,e)