buildiface

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

		    $lctype = $mytopclass{$lctype};
		}
		print $OUTFD "&(v$count->the_real_$lctype)";
	    }
	    else {
		print $OUTFD "&v$count";
	    }
	}
	elsif ($count == $class_pos) {
	    # Skip this arg in the definition 
	    if ($parm =~ /\*/) {
		print $OUTFD "($parm) &the_real_$lctopclass";
	    }
	    else {
		print $OUTFD "($parm) the_real_$lctopclass";
	    }
	}
	elsif (defined($special_args{"${routine_name}-$count"})) {
	    # We must handle this argument specially
	    &print_special_call_arg( $routine_name, $count );
	}
	else {
	    # Convert to/from object type as required.  
	    if (defined($argsneedcast{$parm})) {
		$argval = "v$count";
		$callparm = $argsneedcast{$parm};
		$callparm =~ s/ARG/$argval/;
		
		print $OUTFD &HandleObjectParm( $parm, $argval );
	    }
	    else {
		print $OUTFD &HandleObjectParm( $parm, "v$count" );
	    }
	}
	$count++;
    }
    print $OUTFD " )";
}

# Print the option function attribute; this supports GCC, particularly 
# the __atribute__ weak option.
sub print_attr {
    if ($do_weak) {
	print $OUTFD "FUNC_ATTRIBUTES\n";
    }
}

#
# Special processing

# 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);
	    $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 );
	    }
	}
    }
}


#
# 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;
}

#
# Build the special routines
sub build_specials {
    # The init routine contains some configure-time values.
    open( $OUTFD, ">initcxx.cpp" ) || die "Cannot open initcxx.cpp\n";
    @files[$#files+1] = "initcxx.cpp";
    &print_header;
    print $OUTFD "#include \"mpi.h\"\n";
    print $OUTFD "#include \"mpicxx.h\"\n";

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

    # Initialize the datatypes
    foreach $dtype (@dtypes) {
	print $OUTFD "Datatype MPI::$dtype(MPI_$dtype);\n";
    }
    # special case
    print $OUTFD "Datatype MPI::TWOINT(MPI_2INT);\n";

    # Initialize the operations
    foreach $op (@ops) {
	print $OUTFD "const Op MPI::$op(MPI_$op);\n";
    }

    # Predefined communicators and groups
    print $OUTFD "Intracomm MPI::COMM_WORLD(MPI_COMM_WORLD);\n";
    print $OUTFD "Intracomm MPI::COMM_SELF(MPI_COMM_SELF);\n";
    print $OUTFD "const Comm MPI::COMM_NULL;\n";
    print $OUTFD "const Group MPI::GROUP_EMPTY(MPI_GROUP_EMPTY);\n";

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

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

    print $OUTFD "} // namespace MPI\n";
    close ($OUTFD);
}

# Given an integer location of an argument, return the corresponding
# type, from the arg list
sub Convert_pos_to_type {
    my @parm = split( ',', $_[0] );
    my $loc = $_[1];

    return $parm[$loc-1];
}
sub Convert_type_to_pos {
    my @parm = split( ',', $_[0] );
    my $type = $_[1];
    my $loc = 1;
    
    for $parm (@parm) {
	if ($parm =~ /$type/) { return $loc; }
	$loc ++;
    }
    return 0;
}

# Print the class header 
# PrintClassHead( $OUTFD, class, mpitype, friends )
# E.g., PrintClassHead( $OUTFD, "Datatype", "MPI_Datatype", "Comm,Status" )
sub PrintClassHead {
    my $OUTFD = $_[0];
    my $class = $_[1];
    my $mpi_type = $_[2];
    my $friends  = $_[3];
    my $mpi_null_type = uc("${mpi_type}_NULL" );

    my $lcclass = lc($class);
    my $lctopclass = $lcclass;
    # For derived classes, we sometimes need to know the name of the
    # top-most class, particularly for the "the_real_xxx" name.
    if (defined($mytopclass{$lcclass})) {
	$lctopclass = $mytopclass{$lcclass};
    }
    my $parent = "";

    if (defined($derived_class{$shortclass})) {
	$parent = ": public $derived_class{$shortclass}";
    }
    
    print $OUTFD "class $class $parent {\n";
    if ($friends ne "") {
	foreach $name (split(/,/,$friends)) {
	    print $OUTFD "    friend class $name;\n";
	}
    }
    if ($lcclass eq $lctopclass) {
	print $OUTFD "\		
  protected:
    $mpi_type the_real_$lcclass;\n"
    }
  print $OUTFD "\
  public:
    // new/delete
    inline $class($mpi_type obj) { the_real_$lctopclass = obj; }\n";
    if (defined($class_has_no_default{$class})) {
	print $OUTFD "    inline $class(void) {}\n";
    }
    else {
	print $OUTFD "    inline $class(void) {the_real_$lctopclass = $mpi_null_type;}\n";
    }
    print $OUTFD "\
    virtual ~$class() {}
    // copy/assignment
    $class :: $class(const $class &obj) {
      the_real_$lctopclass = obj.the_real_$lctopclass; }
    $class& ${class}::operator=(const $class &obj) {
      the_real_$lctopclass = obj.the_real_$lctopclass; return *this; }";

    if (!defined($class_has_no_compare{$class})) {
	# Some classes (e.g., Status) do not have compare operations
	print $OUTFD "
    // logical
    bool operator== (const $class &obj) {
      return (the_real_$lctopclass == obj.the_real_$lctopclass); }
    bool operator!= (const $class &obj) {
      return (the_real_$lctopclass != obj.the_real_$lctopclass); }";
    }

    print $OUTFD "
    // C/C++ cast and assignment
    inline operator $mpi_type*() { return &the_real_$lctopclass; }
    inline operator $mpi_type() { return the_real_$lctopclass; }
    $class& ${class}::operator=(const $mpi_type& obj) {
      the_real_$lctopclass = obj; return *this; }
";
}

sub PrintClassTail { 
    my $OUTFD = $_[0];
    print $OUTFD "};\n";
}

# -----------------------------------------------------------------------------
# Here will go routines for handling return values.  These need to move them
# from pointer arguments in the parameter list into a local declaration 
# (possibly using new)
#
# We process a binding *first* and set the global variables
#    return_type (type of return value)
#    return_parm_pos (number of location of arg in parm list; 0 if none)
# return_info is either a number or a type.  If a type, it does NOT include
# the * (e.g., int instead of int *), but the * must be in the parameter
# FindReturnInfo( return_info, args )
sub FindReturnInfo {
    my @parms = split(/,/,$_[1] );
    my $return_info = $_[0];

    if ($return_info eq "0") {
	$return_type = "void";
	$return_parm_pos = 0;
    }
    elsif ($return_info =~ /^[0-9]/) {
	# We have the position but we need to find the type
	my $count = 1;
	for $parm (@parms) {
	    if ($count == $return_info) { 
		$return_type     = $parm;
		$return_type     =~ s/\s*\*$//;   # Remove *
		$return_parm_pos = $count;
	    }
	    $count ++;
	}
    }
    else {
	# Return info is a type. Find the matching location
	my $count = 1;
	for $parm (@parms) {
	    if ($parm =~ /$return_info\s*\*/) {
		$return_parm_pos = $count;
		$return_type     = $return_info;
		last;
	    }
	    $count ++;
	}
    }
}
# -----------------------------------------------------------------------------
# Convert other arguments from C to C++ versions.  E.g., change the
# MPI_Datatype arg in Comm::Send from MPI_Datatype to Datatype.  Use
# (MPI_Datatype)datatype.the_real_datatype (always).
#
# HandleObjectParms( parmtype, parm )
# e.g., HandleObjectParms( MPI_Datatype, v7 )
# returns appropriate string.  If parmtype unknown, just return parm 
sub HandleObjectParm {
    my $parmtype = $_[0];
    my $parm     = $_[1];
    my $need_address = 0;
    my $newparm;

    if ($parmtype =~ /MPI_/) {
	$ctype = $parmtype;
	if ($ctype =~ /\*/) {
	    $need_address = 1;
	    $ctype =~ s/\*//;
	}
	$ctype =~ s/MPI_//;
	$lctype = lc( $ctype );
	# For derived classes, we sometimes need to know the name of the
	# top-most class, particularly for the "the_real_xxx" name.
	if (defined($mytopclass{$lctype})) {
	    $lctype = $mytopclass{$lctype};
	}

	if ($need_address) {
	    $newparm = "($parmtype)&($parm.the_real_$lctype)";
	}
	else {
	    $newparm = "($parmtype)($parm.the_real_$lctype)";
	}
	return $newparm;
    }
    return $parm;
}
# ----------------------------------------------------------------------------
#
# MUST DO BEFORE USABLE
# The initialization of the objects:
#   const Datatype MPI::<name>(MPI_<name>);
#   Intracomm MPI::COMM_WORLD(MPI_COMM_WORLD), SELF
#   const COMM MPI::COMM_NULL;
#   const Group MPI::GROUP_EMPTY(MPI_GROUP_EMPTY);
#   const Op MPI::<op>(MPI_<op>)
#   const int MPI::IDENT,CONGRUENT,SIMILAR,UNEQUAL
#
# static functions that are in no class  (init already done)
# Get_error_class, Wtime, Wtick, Finalize, Is_initialized
#
# Namespace wrapper
#
# Insert use of const.  Can we do this automatically, with some
# exceptions?  E.g., all Datatype, void *, Comm, Group etc.
# Only recv of void *, output of collective aren't const (?)
#
# Returned objects that are not simple types must be created with new, not
# just declared and returned.  In addition, make sure that the correct
# value is passed into the C version.  E.g.,
#   Request *v7 = new Request;
#   .... MPI_Isend( ..., &(v7->the_real_request) )
#   return *v7;
#
# ----------------------------------------------------------------------------
#
# ReadInterface( filename )
sub ReadInterface {
    my $filename =$_[0];
    open( FD, "<$filename" ) || die "Cannot open $filename\n";

    # Skip to prototypes
    while (<FD>) {
	if ( /\/\*\s*Begin Prototypes/ ) { last; }
    }

    # Read each one
    # Save as
    #$mpi_routine{name} = args;
    while (<FD>) {
	if (/\/\*\s*End Prototypes/ ) { last; }
	if (/^int\s+MPI_([A-Z][a-z0-9_]*)\s*\((.*)/) {
	    $routine_name = $1;
	    $args = $2;
	    while (! ($args =~ /;/)) {
		$args .= <FD>;
	    }
	    $args =~ s/\)\s*;//g;
	    $args =~ s/[\r\n]*//g;
	    # Special substitutions
	    $args =~ s/MPIO_Request/MPI_Request/g;
	    $lcname = lc($routine_name);
	    if (defined($special_routines{$routine_name})) {
		print "Skipping $routine_name\n" if $debug;
	    }
	    else {
		# Clear variables
		$clean_up = "";
		&clean_args;
		$mpi_routine{$routine_name} = $args;
		print "Saving $routine_name ( $args )\n" if $debug;
	    }			
	}
    }
    close( FD );
}

#
# ISSUES NOT YET HANDLED
# ----------------------------------------------------------------------------
# This tool becomes particularly interesting if it allows custom generation
# of a mpicxx.h header file that contains references to only the
# requested routines (and even classes; e.g., no Groups if no-one is using
# them).
#
# Pack_size, Pack, and Unpack cannot be defined within the Datatype
# class definition because they also need Comm, and Comm needs datatype.
# We need to replace this with
#   Just provide the Pack_size, Pack, Unpack prototypes in the Datatype
#   class definition
#   Add these to the end
#
# Routines with arrays of aggregate types (e.g., arrays of Datatypes) 
# really require special processing.  We need to either do something like
# is done for the Fortran routines (for any routine with special needs, 
# enumerate which args require special handling and name the routine) 
# or simply provide hand-written code for the internals of those operations.