buildiface

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

     }
    }
";
}
sub logical_array_in_decl {
    my $count = $_[0];
    print $OUTFD "    int *l$count = (int *)MPIU_Malloc($Array_size * sizeof(int));\n";
    $clean_up .= "    MPIU_Free( l$count );\n";
}
sub logical_array_in_arg {
    my $count = $_[0];
    print $OUTFD "l$count";
}

sub logical_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "\
    {int li;
     for (li=0; li<$Array_size; li++) {
        $outvar\[li\] = MPIR_TO_FLOG($outvar\[li\]);
     }
    }
";
}
sub logical_array_out_decl {
}
sub logical_array_out_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
# 
# Index variables.
# Index variables are not optional, since the values of the variable
# are changed.
sub index_ftoc {
    my $count = $_[0];
}
sub index_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "    *$outvar = (MPI_Fint)$coutvar;\n";
    print $OUTFD "    if ($coutvar >= 0) *$outvar = *$outvar + 1;\n";
}
sub index_out_decl {
    my $count = $_[0];
    print $OUTFD "    int l$count;\n";
}
sub index_out_arg {
    my $count = $_[0];
    print $OUTFD " \&l$count";
}
#
# Index variables, but for an array.  
# Array args can use the global $Array_size and $Array_typedef if necessary
sub index_array_ftoc {
    my $count = $_[0];
}
sub index_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    print $OUTFD "\
    {int li;
     for (li=0; li<$Array_size; li++) {
        if ($outvar\[li\] >= 0) $outvar\[li\] += 1;
     }
    }
"
}
sub index_array_out_decl {
}
sub index_array_out_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}

#
# Address and attribute handling
#in:addrint
#out:attrint:4
sub addrint_ftoc {
    my $count = $_[0];
}
sub addrint_in_decl {
}
sub addrint_in_arg {
    my $count = $_[0];
    print $OUTFD "(void *)(MPI_Aint)((int)*(int *)v$count)";
}

sub attrint_ctof {
    my $fvar = $_[0];
    my $cvar = $_[1];
    my $flagarg = 4; # get from option
    print $OUTFD "
    if ((int)*ierr || !l$flagarg) {
        *(MPI_Fint*)$cvar = 0;
    }
    else {
        *(MPI_Fint*)$cvar = (MPI_Fint)attr$cvar;
    }\n";
}

sub attrint_out_decl {
    my $count = $_[0];
    print $OUTFD "    void *attrv$count;\n";
}

sub attrint_out_arg {
    my $count = $_[0];
    print $OUTFD "&attrv$count";
}

#
# Buffer Address output handling (Buffer_detach)
#out:bufaddr
sub bufaddr_ftoc {
}
sub bufaddr_out_decl {
    my $count =$_[0];
    print $OUTFD "    void *t$count = v$count;\n";
}
sub bufaddr_out_arg {
    my $count = $_[0];
    print $OUTFD "&t$count";
}

sub bufaddr_ctof {
    my $fvar = $_[0];
    my $cvar = $_[1];
}

# 
# Handle MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE
sub status_ftoc {
    my $count = $_[0];
    print $OUTFD "\
    if (v$count == MPIR_F_MPI_STATUS_IGNORE) { v$count = MPI_STATUS_IGNORE; }\n";
}
sub status_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
sub status_in_decl {
    my $count = $_[0];
}
sub status_in_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
#
# Index variables, but for an array.  
# Array args can use the global $Array_size and $Array_typedef if necessary
sub status_array_ftoc {
    my $count = $_[0];
    print $OUTFD "\
    if (v$count == MPIR_F_MPI_STATUSES_IGNORE) { v$count = MPI_STATUS_IGNORE; }\n";
}
sub status_array_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
}
sub status_array_in_decl {
}
sub status_array_in_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}

# ---------------------------------------------------------------------------
# This is the routine that handles the post-call processing
sub print_post_call {
    my $routine_name = $_[0];
    my $args = $_[1];
    if (!defined($special_args{$routine_name})) { return; }
    # Erg.  Special processing
    foreach $count (split(/:/,$special_args{$routine_name})) {
	$rule = $special_args{"${routine_name}-$count"};
	($direction,$method,$Array_size) = split(/:/,$rule);
	print STDERR "$routine_name: dir = $direction, method = $method\n" if $debug;
	if ($direction eq "out") {
	    $processing_routine = "${method}_ctof";
	    &$processing_routine( "l$count", "v$count" );
	}
	if ($clean_up ne "") {
	    print $OUTFD $clean_up;
	    $clean_up = "";
	}
    }
}

# Blankpad strings
sub blankpad_out_decl {
}
sub blankpad_out_arg {
    my $count = $_[0];
    print $OUTFD "v$count";
}
sub blankpad_ctof {
    my $coutvar = $_[0];
    my $outvar  = $_[1];
    
    # find the null character.  Replace with blanks from there to the
    # end of the string.  The declared lenght is given by a variable
    # whose name is derived from outvar
    $strlen = $outvar;
    $strlen =~ s/^v/d/;
    print $OUTFD "\
    {char *p = $outvar;
        while (*p) p++;
        while ((p-$outvar) < $strlen) { *p++ = ' '; }
    }
";
}

# Add null to input strings
# We must make a copy 
sub addnull_in_decl {
    my $count = $_[0];
    print $OUTFD "    char *p$count;\n";
}
sub addnull_in_arg {
    my $count = $_[0];
    print $OUTFD "p$count";
}
sub addnull_ftoc {
    my $count = $_[0];
    
    # Working backwards from the length argument, find the first 
    # nonblank character
    # end of the string.  The declared lenght is given by a variable
    # whose name is derived from outvar
    $strlen = "v$count";
    $strlen =~ s/^v/d/;
    print $OUTFD "\
    {char *p = v$count + $strlen - 1;
     int  li;
        while (*p == ' ') p--;
        p$count = (char *)MPIU_Malloc( p-v$count + 1 );
        for (li=0; li<(p-v$count); li++) { p$count\[li\] = v$count\[li\]; }
        p$count\[li\] = 0; 
    }
";
    $clean_up .= "    MPIU_Free( p$count );\n";
}

# This routine handles the special arguments in the *call*
sub print_special_call_arg {
    my $routine_name = $_[0];
    my $count = $_[1];

    $rule = $special_args{"${routine_name}-$count"};
    ($direction,$method,$Array_size) = split(/:/,$rule);

    $processing_routine = "${method}_${direction}_arg";
    &$processing_routine( $count );
}

# This routine prints any declarations that are needed 
sub print_special_decls {
    my $routine_name = $_[0];

    if (defined($special_args{$routine_name})) {
	# First do the declarations
	foreach $count (split(/:/,$special_args{$routine_name})) {
	    $rule = $special_args{"${routine_name}-$count"};
	    ($direction,$method,$Array_size) = split(/:/,$rule);
	    # Sanity check: method and direction must be nonnull
	    if ($method eq "" || $direction eq "") {
		print STDERR "Error in special args for argument number $count of $routine_name\n";
		last;
	    }
	    $processing_routine = "${method}_${direction}_decl";
	    &$processing_routine( $count );
	}
	# Then do the precall steps
	foreach $count (split(/:/,$special_args{$routine_name})) {
	    $rule = $special_args{"${routine_name}-$count"};
	    ($direction,$method,$Array_size) = split(/:/,$rule);
	    if ($direction eq "in") {
		$processing_routine = "${method}_ftoc";
		&$processing_routine( $count );
	    }
	}
    }
}

#
# --------------------------------------------------------------------------
# Create mpif.h.in from mpi.h
#
# Need to put this into a routine similar to the ReadInterface routine
# in the c++ version.  This will allow us to read both mpi.h.in
# and mpio.h.in (or other files)
open ( MPIFD, "<$prototype_file" ) || die "Could not open $prototype_file\n";
#
# First, find the values that we need
while (<MPIFD>) {
    # Remove any comments
    s/\/\*.*\*\///g;
    if (/#\s*define\s+(MPI_[A-Z_0-9]*)\s*([^\s]*)/) {
	$mpidef{$1} = $2;
    }
    elsif (/typedef\s+enum\s*{\s*(.*)/) {
	# Eat until we find the closing right brace
	$enum_line = $1;
	while (! ($enum_line =~ /}/)) { $enum_line .= <MPIFD>; }
	# Now process for names and values
	while ( ($enum_line =~ /\s*(MPI_[A-Z_0-9]*)\s*=\s*([a-fx0-9]*)(.*)/ ) ){
	    $mpidef{$1} = $2;
	    $enum_line = $3;
	    print "Defining $1 as $2\n" if $debug;
	}
	
    } 
}
close (MPIFD);
#
if ($write_mpif) {

    $cchar = "C";
    open ( MPIFFD, ">mpif.h.in" ) || die "Could not open mpif.h.in\n";

    
    # Now, write out the file
    print MPIFFD "$cchar      DO NOT EDIT
$cchar       This file created by buildiface $arg_string\n";
    #
    # Status elements
    # FIXME: The offsets for the status elements are hardwired.  If they
    # change in mpi.h.in, they need to change here as well.
    print MPIFFD "       INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR\n";
    print MPIFFD "       PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5)\n";
    print MPIFFD "       INTEGER MPI_STATUS_SIZE\n";
    print MPIFFD "       PARAMETER (MPI_STATUS_SIZE=\@MPI_STATUS_SIZE\@)\n";
    # Temporary until configure handles these.  Define as arrays to keep
    # Fortran compilers from complaining excessively.
    print MPIFFD "       INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE)\n";
    print MPIFFD "       INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1)\n";

    #
    # Error Classes
    print MPIFFD "       INTEGER MPI_SUCCESS\n";
    print MPIFFD "       PARAMETER (MPI_SUCCESS=0)\n";
    foreach $key (keys(%mpidef)) {
	if ($key =~ /MPI_ERR_/) {
	    &print_mpif_int( $key );
	}
    }
    # Predefined error handlers
    foreach $key (ERRORS_ARE_FATAL, ERRORS_RETURN) {
	&print_mpif_int( "MPI_$key" );
    }
    # Compare operations
    foreach $key (IDENT,CONGRUENT,SIMILAR,UNEQUAL) {
	&print_mpif_int( "MPI_$key" );
    }
    # Collective operations
    foreach $key (MAX, MIN, SUM, PROD, LAND, BAND, LOR, BOR, LXOR, BXOR, MINLOC, MAXLOC, REPLACE ) {
	&print_mpif_int( "MPI_$key" );
    }
    # Objects
    foreach $key ('COMM_WORLD', 'COMM_SELF', 'GROUP_EMPTY', 'COMM_NULL', 'WIN_NULL', 'FILE_NULL', 'GROUP_NULL', 'OP_NULL', 'DATATYPE_NULL', 'REQUEST_NULL', 'ERRHANDLER_NULL') {
	&print_mpif_int( "MPI_$key" );
    }
    # Attributes
    foreach $key (TAG_UB, HOST, IO, WTIME_IS_GLOBAL, UNIVERSE, LASTUSEDCODE, APPNUM) {
	# Special cast:  The Fortran versions of these attributes have 
	# value 1 greater than the C versions
	$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_mpif_int( "MPI_$key" );
    } 
    # String sizes
    # Missing - max processor name!
    # Handle max processor name here.
    $mpidef{"MPI_MAX_PROCESSOR_NAME"} = "\@MPI_MAX_PROCESSOR_NAME\@";
    foreach $key (MAX_ERROR_STRING, MAX_NAME_STRING, MAX_PORT_NAME, 
		  MAX_OBJECT_NAME, MAX_INFO_KEY, MAX_INFO_VAL,
		  MAX_PROCESSOR_NAME ) {
	&print_mpif_int( "MPI_$key" );
    }
    
    # predefined constants
    print MPIFFD "       INTEGER MPI_UNDEFINED, MPI_UNDEFINED_RANK\n";
    print MPIFFD "       PARAMETER (MPI_UNDEFINED=$mpidef{'MPI_UNDEFINED'})\n";
    # mpi_undefined_rank is defined as mpi-undefined
    print MPIFFD "       PARAMETER (MPI_UNDEFINED_RANK=$mpidef{'MPI_UNDEFINED'})\n";
    &print_mpif_int( "MPI_KEYVAL_INVALID" );
    foreach $key ('BSEND_OVERHEAD', 'PROC_NULL', 'ANY_SOURCE', 'ANY_TAG', 'ROOT') {
	&print_mpif_int( "MPI_$key" );
    }
    #
    # Topology types
    foreach $key (GRAPH, CART) {
	&print_mpif_int( "MPI_$key" );
    }
    #
    # version
    &print_mpif_int( "MPI_VERSION" );
    &print_mpif_int( "MPI_SUBVERSION" );
    #
    # Datatypes
    # These are determined and set at configure time
    foreach $key (COMPLEX, DOUBLE_COMPLEX, LOGICAL, REAL, DOUBLE_PRECISION, INTEGER, '2INTEGER', '2COMPLEX', '2DOUBLE_PRECISION', '2REAL', '2DOUBLE_COMPLEX', CHARACTER) {
	print MPIFFD "       INTEGER MPI_$key\n";
	print MPIFFD "       PARAMETER (MPI_$key=\@MPI_$key\@)\n";
    }
    # HACK!
    # Value of MPI_BYTE from top level configure!
    $mpidef{"MPI_BYTE"} = hex "0x4c000111";