buildiface

刚才是说明 现在是安装程序在 LINUX环境下进行编程的MPICH安装文件

    &print_mpif_int( "MPI_BYTE" );
    &print_mpif_int( "MPI_UB" );
    &print_mpif_int( "MPI_LB" );
    &print_mpif_int( "MPI_PACKED" );

    # Optional types
    foreach $key (INTEGER1, INTEGER2, INTEGER4, INTEGER8, INTEGER16,
		  REAL4, REAL8, REAL16, COMPLEX8, COMPLEX16, COMPLEX32) {
	print MPIFFD "       INTEGER MPI_$key\n";
	print MPIFFD "       PARAMETER (MPI_$key=\@F77_$key\@)\n";
    }
    #
    # Fortran 90 types
    print MPIFFD "       INTEGER MPI_ADDRESS_KIND, MPI_OFFSET_KIND\n";
    print MPIFFD "       PARAMETER (MPI_ADDRESS_KIND=\@ADDRESS_KIND\@)\n";
    print MPIFFD "       PARAMETER (MPI_OFFSET_KIND=\@OFFSET_KIND\@)\n";
    # 
    # Finally, the special symbols
    print MPIFFD "       INTEGER MPI_BOTTOM\n";

    # And the external names
    print MPIFFD "       EXTERNAL MPI_DUP_FN, MPI_NULL_DELETE_FN, MPI_NULL_COPY_FN\n";
    # the time/tick functions
    print MPIFFD "       DOUBLE PRECISION MPI_WTIME, MPI_WTICK\n";
    print MPIFFD "       DOUBLE PRECISION PMPI_WTIME, PMPI_WTICK\n";
    # We avoid adding the external declarations because some Fortran
    # compilers then insist on linking with the routines, even if 
    # they are not used.  Combined with systems that do not have weak
    # symbols, and you can get some strange link failures.

    close( MPIFFD );
} # if write_mpif

#
# 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 $debug;
    $args = $newargs;
}

# print_type_decl( $FD, $lcname )

sub print_routine_type_decl {
    my $OUTFD = $_[0];
    my $lcname = $_[1];
    if ($do_subdecls) {
	print $OUTFD "FORTRAN_API void FORT_CALL ";
    }
    else {
	print $OUTFD "void ";
    }
    print $OUTFD "mpi_${lcname}_ ";
}

#
# Build the special routines
sub build_specials {
    # The init routine contains some configure-time values.
    # We may not want to do this if we are supporting multiple
    # Fortran compilers with different values for Fortran .TRUE. and
    # .FALSE., but to get started, this is easiest.
    $OUTFD = "INITFFD";
    open( $OUTFD, ">initf.c" ) || die "Cannot open initf.c\n";
    $files[$#files+1] = "initf.c";
    &print_header( "MPI_Init", "init" );
    # This is temporary.  Eventually, these should move into
    # support file.
    # Note that the global variables have values.  This is to work around
    # a bug in some C environments (e.g., Mac OS/X) that don't load
    # external symbols that don't have a value assigned at compile time 
    # (so called common symbols)
    print $OUTFD "
#if !defined(F77_RUNTIME_VALUES) && defined(F77_TRUE_VALUE_SET)
const MPI_Fint MPIR_F_TRUE= F77_TRUE_VALUE, MPIR_F_FALSE= F77_FALSE_VALUE;
#else
MPI_Fint MPIR_F_TRUE = 1, MPIR_F_FALSE = 0;
#endif
";
    # This is also temporary.
    print $OUTFD "
#ifndef USE_POINTER_FOR_BOTTOM
void *MPIR_F_MPI_BOTTOM = 0;
void *MPIR_F_MPI_STATUS_IGNORE = 0;
void *MPIR_F_MPI_STATUSES_IGNORE = 0;
#endif
\n";

    &print_routine_type_decl( $OUTFD, "init" );
    $args = "";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{\n";
    print $OUTFD "#ifndef F77_RUNTIME_VALUES
    /* any compile/link time values go here */
#else
#   abort \"Fortran values must be determined at configure time\"
#endif
";
    print $OUTFD "    *ierr = MPI_Init( 0, 0 );\n";
    # Still to do:
    #   Initialize the Fortran versions of the predefined keyvals.
    #   Find the value of MPI_BOTTOM.  
    #     Call a Fortran routine that calls a C routine that is passed
    #     MPI_BOTTOM from the common block.  
    #     
    print $OUTFD "}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "init" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    # Functions used by the C init process, but that must be called 
    # from C
    $OUTFD = "FORTTOC";
    open( $OUTFD, ">setbot.c" ) || die "Cannot open setbot.c\n";
    $files[$#files+1] = "setbot.c";
    &print_copyright;
    print $OUTFD "
#ifdef F77_NAME_UPPER
#define mpirinitc_ MPIRINITC
#elif defined(F77_NAME_LOWER_2USCORE) || defined(F77_NAME_LOWER_USCORE)
/* leave name alone */
#else
#define mpirinitc_ mpirinitc
#endif
";

    print $OUTFD "
FORTRAN_API void FORT_CALL mpirinitc_( void *a, void *b, void *c )
{
    MPIR_F_MPI_BOTTOM = a;
    MPIR_F_MPI_STATUS_IGNORE = b;
    MPIR_F_MPI_STATUSES_IGNORE = c;
}
";
    close ($OUTFD);
    
    $OUTFD = "PCONTROLFFD";
    open( $OUTFD, ">pcontrolf.c" ) || die "Cannot open pcontrolf.c\n";
    $files[$#files+1] = "pcontrolf.c";
    &print_header( "MPI_Pcontrol", "pcontrol" );
    &print_routine_type_decl( $OUTFD, "pcontrol" );
    $args = "int";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{\n";
    print $OUTFD "    *ierr = MPI_Pcontrol( (int)*v1 );\n";
    print $OUTFD "}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "pcontrol" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    $OUTFD = "ADDRESSFFD";
    open ($OUTFD, ">addressf.c" ) || die "Cannot open addressf.c\n";
    $files[$#files+1] = "addressf.c";
    &print_header( "MPI_Address", "address" );
    &print_routine_type_decl( $OUTFD, "address" );
    $args = "void *, int *";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
    MPI_Aint a, b;
    *ierr = MPI_Address( v1, &a );
#ifdef USE_POINTER_FOR_BOTTOM
    b = a;
#else
    b = a - (MPI_Aint) MPIR_F_MPI_BOTTOM;
#endif
    *v2 = (MPI_Fint)( b );
#ifdef HAVE_AINT_LARGER_THAN_FINT
    /* Check for truncation */
    if (((MPI_Aint)*v2 - b != 0) {
        *ierr = MPIR_Err_create_code( MPI_ERR_ARG, \"inttosmall\", 0 );
	(void)MPIR_Err_return_comm( 0, \"MPI_Address\",  *ierr );
    }
#endif
}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "address" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    $OUTFD = "WTIMEFD";
    open( $OUTFD, ">wtimef.c" ) || die "Cannot open wtimef.c\n";
    $files[$#files+1] = "wtimef.c";
    &print_header( "MPI_Wtime", "wtime" );
    # mpiimpl.h is needed for the timer definitions
    print $OUTFD "#include \"mpiimpl.h\"\n";
    print $OUTFD "double mpi_wtime_( void ) ";
    &print_attr;
    print $OUTFD "{\n";
    print $OUTFD "    double d; MPID_Time_t t;\n
    MPID_Wtime( &t );
    MPID_Wtime_todouble( &t, &d );
    return d;\n";
    print $OUTFD "}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	print PROTOFD "double mpi_wtime_( void );\n";
    }

    $OUTFD = "WTICKFD";
    open( $OUTFD, ">wtickf.c" ) || die "Cannot open wtickf.c\n";
    $files[$#files+1] = "wtickf.c";
    &print_header( "MPI_Wtick", "wtick" );
    # mpiimpl.h is needed for the timer definitions
    print $OUTFD "#include \"mpiimpl.h\"\n";
    print $OUTFD "double mpi_wtick_( void ) ";
    &print_attr;
    print $OUTFD "{\n";
    print $OUTFD "    double d; 
    d = MPID_Wtick( );
    return d;\n";
    print $OUTFD "}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	print PROTOFD "double mpi_wtick_( void );\n";
    }

    $OUTFD = "KEYVALCREATEF";
    open ($OUTFD, ">keyval_createf.c" ) || die "Cannot open keyval_createf.c\n";
    $files[$#files+1] = "keyval_createf.c";
    &print_header( "MPI_Keyval_create", "keyval_create" );
    &print_routine_type_decl( $OUTFD, "keyval_create" );
    $args = "MPI_Copy_function , MPI_Delete_function , int *, void *";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
        *ierr = PMPI_Comm_create_keyval( v1, v2, v3, v4 );
        if (!*ierr) {
            MPIR_Keyval_set_fortran( *v3 );
        }
}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "keyval_create" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    $OUTFD = "DUPFN";
    open ($OUTFD, ">dup_fnf.c" ) || die "Cannot open dup_fnf.c\n";
    $files[$#files+1] = "dup_fnf.c";
    &print_header( "mpi_dup_fn", "dup_fn" );
    &print_routine_type_decl( $OUTFD, "dup_fn" );
    $args = "MPI_Fint, MPI_Fint *, void *, void **, void **, MPI_Fint *";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
        *v5 = *v4;
        *v6 = MPIR_TO_FLOG(1);
        *ierr = MPI_SUCCESS;
}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "dup_fn" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    $OUTFD = "NULLDELFN";
    open ($OUTFD, ">null_del_fnf.c" ) || die "Cannot open null_del_fnf.c\n";
    $files[$#files+1] = "null_del_fnf.c";
    &print_header( "mpi_null_delete_fn", "null_delete_fn" );
    &print_routine_type_decl( $OUTFD, "null_delete_fn" );
    $args = "MPI_Fint *, MPI_Fint *, void *, void *";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
        *ierr = MPI_SUCCESS;
}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "null_delete_fn" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

    $OUTFD = "NULLCOPYFN";
    open ($OUTFD, ">null_copy_fnf.c" ) || die "Cannot open null_copy_fnf.c\n";
    $files[$#files+1] = "null_copy_fnf.c";
    &print_header( "mpi_null_copy_fn", "null_copy_fn" );
    &print_routine_type_decl( $OUTFD, "null_copy_fn" );
    $args = "MPI_Fint *, MPI_Fint *, void *, void *, void *, int *";
    &print_args( $OUTFD, $args );
    &print_attr;
    print $OUTFD "{
        *ierr = MPI_SUCCESS;
        *v6 = MPIR_TO_FLOG(0);
}\n";
    close ($OUTFD);
    if ($build_prototypes) {
	&print_routine_type_decl( PROTOFD, "null_copy_fn" );
	&print_args( PROTOFD, $args );
	print PROTOFD ";\n";
    }

}

sub print_mpif_int {
    my $key = $_[0];
    my $value = $mpidef{$key};
    # Remove any casts
    print "Input value for $key = $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 ()
    if ($value =~ /\(\s*[-a-fx0-9]*\)/) {
	$value =~ s/\(\s*([-a-fx0-9]*)\s*\)/$1/;
	print "paren removal: $value\n" if $debug;
    }
    # Convert hex to decimal
    if ($value =~ /^0x[a-f\d]*/) {
	$value = hex $value;
	print "hex conversion: $value\n" if $debug;
    }
    print MPIFFD "       INTEGER $key\n";
    print MPIFFD "       PARAMETER ($key=$value)\n";
}

# ----------------------------------------------------------------------------
# Check for a working autoconf
#
# Try the following first
# in a new directory, create configure.in containing:
# AC_INIT(configure.in)
# AC_LANG_FORTRAN77
# AC_TRY_COMPILE(,[integer a],a=1,a=0)
# Then run autoconf
# Then grep endEOF configure.  If found (status 0), then autoconf is
# broken.
#
# CheckAutoconf - returns 0 if autoconf works, 1 if broken.
sub CheckAutoconf {
    if (! -d "tmp") {
        mkdir "tmp", 0777 || die "Cannot create temporary directory\n";
    }
    open (ACFD, ">tmp/configure.in" ) || die "Cannot create test configure.in\n";
    print ACFD "AC_INIT(configure.in)\nAC_LANG_FORTRAN77\n";
    print ACFD "AC_TRY_COMPILE(,[integer a],a=1,a=0)\n";
    close ACFD;

    chdir tmp;
    $rc = system "autoconf 2>&1 >/dev/null";
    $rc = system "grep endEOF configure 2>&1 >/dev/null";
    $rc = !$rc;
    chdir "..";

    system "rm -rf tmp";
    return $rc;
}
#
# ISSUES NOT YET HANDLED
# ----------------------------------------------------------------------------
# Fortran Integer conversion.
# If C ints and Fortran integers are not the same size, we have to do
# more.  In the case of arrays, we must make temporary copies.
# In MPICH1, there is also code for the case where the sizes of 
# the C and Fortran integers are not known.  Roughly, the code could look 
# like
# #ifdef HAVE_FINT_IS_INT
#   straight-forward code
# #else
# #ifdef HAVE_FINT_TYPE_UNKNOWN
# if (sizeof(int) == sizeof(MPI_Fint)) {
#  straight-forward code
# } else
# #endif
# {
#   code that converts arrays, calls routine, frees arrays
# }
# #endif
#
# There are several options for allocating the temporary arrays
# For some, like cartesian dimension arrays, it is reasonable to 
# use a predeclared array (and signal an error if too large)
# For the others, use a predeclared array with a special case
# for extra-large
#
# ----------------------------------------------------------------------------
# Character buffer handling for choice arguments
#  If Fortran passes character arrays as a pair of arguments (rather than
# putting the second argument at the end of the arg list), then all of the
# choice arg routines must check the *count* of the number of arguments, 
# and then, if there are too many args, assume that the choice buffer
# is a character.  Note that for Sendrecv, there is no unique
# solution unless you know more about the MPI datatypes.
#