buildiface

mpi并行计算的c++代码 可用vc或gcc编译通过 可以用来搭建并行计算试验环境

#
# Look through $args for parameter names (foo\s\s*name)
# and remove them
sub clean_args {
    my $newargs = "";
    my $comma = "";
    for $parm (split(',',$args)) {
	# Remove any leading or trailing spaces
	$parm =~ s/^\s*//;
	$parm =~ s/\s*$//;
	# Handle parameters with parameter names
	# First if handles "int foo", second handles "int *foo"
	if ( ($parm =~ /^([A-Za-z0-9_]+)\s+[A-Za-z0-9_]+$/) ) {
	    $parm = $1;
	}
	elsif ( ($parm =~ /^([A-Za-z0-9_]+\s*\*)\s*[A-Za-z0-9_]+$/) ) {
	    $parm = $1;
	}
	$newargs .= "$comma$parm";
	$comma = ",";
    }
    print STDERR "$newargs\n" if $gDebug;
    $args = $newargs;
}

# Print out the constants.
# PrintConstants( FD, giveValue )
# if GiveValue is true, defint the value, otherwise, make it external
sub PrintConstants {    
    my ($OUTFD, $giveValue) = @_;
    my $extern = "extern ";
    if ($giveValue) { $extern = ""; }

    # Initialize the datatypes.
    # We do not use MPI:: within the MPI namespace
    foreach $dtype (@dtypes) {
	print $OUTFD "${extern}Datatype $dtype";
	if ($giveValue) { print $OUTFD "(MPI_$dtype);\n"; }
	else            { print $OUTFD ";\n"; }
    }
    # special case
    if ($giveValue) {
	print $OUTFD "Datatype TWOINT(MPI_2INT);\n";
    }
    else {
	print $OUTFD "extern Datatype TWOINT;\n";
    }
    print $OUTFD "${extern}Datatype DATATYPE_NULL;\n";

    # Fortran types
    if ($giveValue) {
	print $OUTFD "
#ifdef HAVE_FORTRAN_BINDING
Datatype INTEGER(MPI_INTEGER);
Datatype REAL(MPI_REAL);
Datatype DOUBLE_PRECISION(MPI_DOUBLE_PRECISION);
Datatype F_COMPLEX(MPI_COMPLEX);
Datatype F_DOUBLE_COMPLEX(MPI_DOUBLE_COMPLEX);
Datatype LOGICAL(MPI_LOGICAL);
Datatype CHARACTER(MPI_CHARACTER);
Datatype TWOREAL(MPI_2REAL);
Datatype TWODOUBLE_PRECISION(MPI_2DOUBLE_PRECISION);
Datatype TWOINTEGER(MPI_2INTEGER);
#endif\n";
    }
    else {
	print $OUTFD "
#ifdef HAVE_FORTRAN_BINDING
extern Datatype INTEGER;
extern Datatype REAL;
extern Datatype DOUBLE_PRECISION;
extern Datatype F_COMPLEX;
extern Datatype F_DOUBLE_COMPLEX;
extern Datatype LOGICAL;
extern Datatype CHARACTER;
extern Datatype TWOREAL;
extern Datatype TWODOUBLE_PRECISION;
extern Datatype TWOINTEGER;
#endif\n";
    }
    # Still to do: Fortran optional types, integer1,2,4, real2,4,8,

    # Initialize the operations
    foreach $op (@ops) {
	print $OUTFD "${extern}const Op $op";
	if ($giveValue) { print $OUTFD "(MPI_$op);\n"; }
	else            { print $OUTFD ";\n"; }
    }
    print $OUTFD "${extern}const Op OP_NULL;\n";

    # Predefined communicators and groups
    if ($giveValue) {
	print $OUTFD "Intracomm COMM_WORLD(MPI_COMM_WORLD);\n";
	print $OUTFD "Intracomm COMM_SELF(MPI_COMM_SELF);\n";
	print $OUTFD "const Group GROUP_EMPTY(MPI_GROUP_EMPTY);\n";
    } 
    else {
	print $OUTFD "extern Intracomm COMM_WORLD;\n";
	print $OUTFD "extern Intracomm COMM_SELF;\n";
	print $OUTFD "extern const Group GROUP_EMPTY;\n";
    }
    # COMM_NULL can't be a Comm since Comm is an abstract base class.
    # Following the model of Intracomm etc., we make this a separate class,
    # and a peer to the other communicator classes.
    print $OUTFD "${extern}const Nullcomm COMM_NULL;\n";
    print $OUTFD "${extern}const Group GROUP_NULL;\n"; 

    # Predefined requests
    print $OUTFD "${extern}const Request REQUEST_NULL;\n";

    # Predefined errhandlers
    print $OUTFD "${extern}const Errhandler ERRHANDLER_NULL;\n";
    if ($giveValue) {
	print $OUTFD "const Errhandler ERRORS_RETURN(MPI_ERRORS_RETURN);\n";
	print $OUTFD "const Errhandler ERRORS_ARE_FATAL(MPI_ERRORS_ARE_FATAL);\n";
	# Errors_return is not quite right for errors-throw-exceptions,
	# but it is close.
	print $OUTFD "const Errhandler ERRORS_THROW_EXCEPTIONS(MPI_ERRORS_RETURN);\n";
    }
    else {
	print $OUTFD "extern const Errhandler ERRORS_RETURN;\n";
	print $OUTFD "extern const Errhandler ERRORS_ARE_FATAL;\n";
	print $OUTFD "extern const Errhandler ERRORS_THROW_EXCEPTIONS;\n";
    }

    # Predefined info
    print $OUTFD "${extern}const Info INFO_NULL;\n";

    # Predefined File and Win
    print $OUTFD "${extern}const Win WIN_NULL;\n";
    print $OUTFD "${extern}const File FILE_NULL;\n";

    # Predefined integers
    foreach $int (BSEND_OVERHEAD, KEYVAL_INVALID, CART, GRAPH,
		  IDENT, SIMILAR, CONGRUENT, UNEQUAL, PROC_NULL,
		  ANY_TAG, ANY_SOURCE, ROOT, TAG_UB, IO, HOST, WTIME_IS_GLOBAL,
                  UNIVERSE_SIZE, LASTUSEDCODE, APPNUM, 
		  MAX_PROCESSOR_NAME, MAX_ERROR_STRING,
		  MAX_NAME_STRING, MAX_PORT_NAME, MAX_OBJECT_NAME,
                  MAX_INFO_VAL, MAX_INFO_KEY, 
		  UNDEFINED, LOCK_EXCLUSIVE, LOCK_SHARED, 
		  WIN_BASE, WIN_DISP_UNIT, WIN_SIZE, 
		  @errclasses ) {
	print $OUTFD "${extern}const int $int";
	if ($giveValue) { print $OUTFD "= MPI_$int;\n"; }
    	else            { print $OUTFD ";\n"; }
    }
    # Handle seek as a special case
    print $OUTFD "#if defined(MPI_SEEK_SET) && !defined(MPICH_IGNORE_CXX_SEEK) && !defined(SEEK_SET)\n";
    foreach $int (SEEK_SET, SEEK_END, SEEK_CUR) {
	print $OUTFD "${extern}const int $int";
	if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }
    print $OUTFD "#endif\n";

    foreach $int (DISTRIBUTE_BLOCK, DISTRIBUTE_CYCLIC,
		  DISTRIBUTE_DFLT_DARG, DISTRIBUTE_NONE, ORDER_C, 
		  ORDER_FORTRAN) {
        print $OUTFD "${extern}const int $int";
	if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }

    print $OUTFD "// Include these only if MPI-IO is available\n";
    print $OUTFD "#ifdef MPI_MODE_RDONLY\n";

    # Other file constants
    foreach $int (DISPLACEMENT_CURRENT, MAX_DATAREP_STRING) {
        print $OUTFD "${extern}const int $int";
	if ($giveValue) { print $OUTFD " = MPI_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }

    # MPI Mode
    foreach $int (APPEND, CREATE, DELETE_ON_CLOSE, EXCL, 
		  RDONLY, RDWR, SEQUENTIAL, UNIQUE_OPEN, WRONLY) {
	print $OUTFD "${extern}const int MODE_$int";
	if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }
    print $OUTFD "#endif // IO\n";
    # Some modes are for RMA, not I/O
    foreach $int (NOCHECK,NOPRECEDE, NOPUT, NOSTORE, NOSUCCEED) {
	print $OUTFD "${extern}const int MODE_$int";
	if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }

    # MPI Combiners
    foreach $int (CONTIGUOUS, DARRAY, DUP, F90_COMPLEX, F90_INTEGER, 
		  F90_REAL, HINDEXED_INTEGER, HINDEXED, HVECTOR_INTEGER,
		  HVECTOR, INDEXED_BLOCK, INDEXED, NAMED, RESIZED, 
		  STRUCT_INTEGER, STRUCT, SUBARRAY, VECTOR) {
	print $OUTFD "${extern}const int COMBINER_$int";
	if ($giveValue) { print $OUTFD " = MPI_COMBINER_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }
    # MPI Thread levels
    foreach $int (FUNNELED, MULTIPLE, SERIALIZED, SINGLE) {
	print $OUTFD "${extern}const int THREAD_$int";
	if ($giveValue) { print $OUTFD " = MPI_THREAD_$int;\n"; }
	else            { print $OUTFD ";\n"; }
    }
    # MPI Empty argvs
    if ($giveValue) {
	print $OUTFD "const char ** const ARGV_NULL = 0;\n";
	print $OUTFD "const char *** const ARGVS_NULL = 0;\n";
    }
    else {
	print $OUTFD "extern const char ** const ARGV_NULL;\n";
	print $OUTFD "extern const char *** const ARGVS_NULL;\n";
    }

    # Predefined other
    if ($giveValue) {
	print $OUTFD "void * const BOTTOM = MPI_BOTTOM;\n";
	print $OUTFD "void * const IN_PLACE = MPI_IN_PLACE;\n";
    }
    else {
	print $OUTFD "extern void * const BOTTOM;\n";
	print $OUTFD "extern void * const IN_PLACE;\n";
    }
}

#
# Build the special routines
sub build_specials {
    # The init routine contains some configure-time values.
    my $filename = "initcxx.cxx";
    open( $OUTFD, ">${filename}.new" ) || die "Cannot open ${filename}.new\n";
    @files[$#files+1] = "initcxx.cxx";
    &print_header;
    print $OUTFD "#include \"mpi.h\"\n";
    print $OUTFD "#include <stdarg.h>\n";    # Required for pcontrol

    # The coverage header is included in mpicxx.h.in
    #&printCoverageHeader( $OUTFD, 0 );

    print $OUTFD "
// #define MPIX_TRACE_MEMORY
#ifdef MPIX_TRACE_MEMORY
int _mpi_lineno = __LINE__;
// We need stdlib.h for size_t.  But that can cause problems if the
// header isn't C++ clean.  Instead, we just include a definition
// for size_t.  If this is not the correct size, then edit this line
// (Note that this is needed only when memory tracing is enabled)
typedef unsigned int size_t;
extern \"C\" void *MPIU_trmalloc( unsigned int, int, const char [] );
extern \"C\" void MPIU_trfree( void *, int, const char [] );
extern \"C\" void MPIU_trdump( void *, int );
void *operator new(size_t size) {
    void *p = MPIU_trmalloc( (unsigned int) size, _mpi_lineno, __FILE__ );
    return p;}
void operator delete(void *p) {
    MPIU_trfree( p, _mpi_lineno, __FILE__ );}
void *operator new[]( size_t size) {
    void *p = MPIU_trmalloc( (unsigned int) size, _mpi_lineno, __FILE__ );
    return p;}
void operator delete[](void *p) {
    MPIU_trfree( p, _mpi_lineno, __FILE__ );}
#define MPIX_TRSummary() MPIU_trdump( 0, -1 )
#define MPIX_SetLineno _mpi_lineno = __LINE__ + 1
#else
#define MPIX_TRSummary()
#define MPIX_SetLineno
#endif\n";

    # Start the namespace
    print $OUTFD "namespace MPI {\n";

    &PrintConstants( $OUTFD, 1 );

    print $OUTFD "void Init";
    $args = "";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{\n";
    print $OUTFD "    MPI_Init( 0, 0 );\n";
    &printCoverageInitialize( $OUTFD );
    print $OUTFD "}\n";

    #
    # The following may not be quite right because they don't include
    # any attributes that we may include with the definitions.  However,
    # this is easier than forcing the print_args routine to handle these
    # simple cases.
    #
    print $OUTFD "void Init( int &argc, char **&argv )
{
    MPI_Init( &argc, &argv );\n";
    &printCoverageInitialize( $OUTFD );
    print $OUTFD "}\n";

    print $OUTFD "int Init_thread";
    $routine = "Init_thread"; # So we'll know for debugging
    # The two args are needed to tell print_args that one is the output
    $return_parm_pos = 2;
    #$args = "int,int";
    # Grr.  Under Cygwin, we needed two...
    $args = "int";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
    int provided;
    MPI_Init_thread( 0, 0, v1, &provided );\n";
    &printCoverageInitialize( $OUTFD );
    print $OUTFD "\
    return provided;
}\n";
    #
    # The following may not be quite right because they don't include
    # any attributes that we may include with the definitions.  However,
    # this is easier than forcing the print_args routine to handle these
    # simple cases.
    #
    print $OUTFD "int Init_thread( int &argc, char **&argv, int req )
{
    int provided;
    MPI_Init_thread( &argc, &argv, req, &provided );\n";

    &printCoverageInitialize( $OUTFD );
    print $OUTFD "    return provided;\n}\n";

    print $OUTFD "void Finalize"; 
    $args = "";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{\n";
    &printCoverageFinalize( $OUTFD );
    print $OUTFD "    MPIX_TRSummary();\n";
    print $OUTFD "    MPI_Finalize( );\n";
    print $OUTFD "}\n";

    print $OUTFD "bool Is_initialized(void)
    { 
	int flag;\n";
     &printCoverageStart( $OUTFD, "Initialized", 0 );
    print $OUTFD "\
	MPI_Initialized( &flag );\n";
     &printCoverageEnd( $OUTFD, "Initialized", 0 );
    # Microsoft C++ compiler complains about using an explicit cast to bool (!)
    print $OUTFD "\
	return (flag != 0);
    }\n";

    print $OUTFD "void Compute_dims( int nnodes, int ndims, int dims[] )
    {\n";
    &printCoverageStart( $OUTFD, "Dims_create", 3 );
    print $OUTFD "\
	MPIX_CALL( MPI_Dims_create( nnodes, ndims, dims ) );\n";
    &printCoverageEnd( $OUTFD, "Dims_create", 3 );
    print $OUTFD "\
    }\n";

    print $OUTFD "void Attach_buffer( void *buffer, int size )
    {\n";
    &printCoverageStart( $OUTFD, "Buffer_attach", 2 );
    print $OUTFD "\
	MPIX_CALL( MPI_Buffer_attach( buffer, size ) );\n";
    &printCoverageEnd( $OUTFD, "Buffer_attach", 2 );
    print $OUTFD "\
    }\n";

    print $OUTFD "int Detach_buffer( void *&buffer )
    {
	int size;\n";
    &printCoverageStart( $OUTFD, "Buffer_detach", 2 );
    print $OUTFD "\
	MPIX_CALL( MPI_Buffer_detach( &buffer, &size ) );\n";
    &printCoverageEnd( $OUTFD, "Buffer_detach", 2 );
    print $OUTFD "\
	return size;
    }\n";

    print $OUTFD "void Get_processor_name( char *name, int &resultlen ) 
    {\n";
    &printCoverageStart( $OUTFD, "Get_processor_name", 2 );
    print $OUTFD "\
    MPIX_CALL( MPI_Get_processor_name( name, &resultlen ) );\n";
    &printCoverageEnd( $OUTFD, "Get_processor_name", 2 );
    print $OUTFD "\
    }\n";

    # The MPI-2 specification specifies Pcontrol as taking const int,
    # not just int, and some C++ compilers will (correctly) require this
    print $OUTFD "void Pcontrol( const int v, ... )
    {
	va_list ap;
        va_start(ap,v);\n";
     &printCoverageStart( $OUTFD, "Pcontrol", -1 );
    print $OUTFD "\
	MPIX_CALL( MPI_Pco