buildiface

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

#pragma weak mpi_${lcname}__ = pmpi_${lcname}__\
#elif !defined(F77_NAME_LOWER_USCORE)\n";
        &print_weak_decl( $OUTFD, "mpi_$lcname", $args, $lcname );
	print $OUTFD "\
#pragma weak mpi_$lcname = pmpi_$lcname\
#else\n";
        &print_weak_decl( $OUTFD, "mpi_${lcname}_", $args, $lcname );
	print $OUTFD "\
#pragma weak mpi_${lcname}_ = pmpi_${lcname}_\
#endif\
\
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)\
#if defined(F77_NAME_UPPER)\
#pragma _HP_SECONDARY_DEF PMPI_$ucname  MPI_$ucname\
#elif defined(F77_NAME_LOWER_2USCORE)\
#pragma _HP_SECONDARY_DEF pmpi_${lcname}__  mpi_${lcname}__\
#elif !defined(F77_NAME_LOWER_USCORE)\
#pragma _HP_SECONDARY_DEF pmpi_$lcname  mpi_$lcname\
#else\
#pragma _HP_SECONDARY_DEF pmpi_${lcname}_  mpi_${lcname}_\
#endif\
\
#elif defined(HAVE_PRAGMA_CRI_DUP)\
#if defined(F77_NAME_UPPER)\
#pragma _CRI duplicate MPI_$ucname as PMPI_$ucname\
#elif defined(F77_NAME_LOWER_2USCORE)\
#pragma _CRI duplicate mpi_${lcname}__ as pmpi_${lcname}__\
#elif !defined(F77_NAME_LOWER_USCORE)\
#pragma _CRI duplicate mpi_${lcname} as pmpi_${lcname}\
#else\
#pragma _CRI duplicate mpi_${lcname}_ as pmpi_${lcname}_\
#endif\
#endif /* HAVE_PRAGMA_WEAK */\
#endif /* USE_WEAK_SYMBOLS */\
/* End MPI profiling block */\n\n";

    &AddFwrapWeakName( $lcname, $ucname );
    }
}

#
# Print the code that modifies the name
# The function prototypes must be loaded *after* the name block so that the
# name used in the function prototypes will match the one that is declared
# in this file.
sub print_name_map_block {
    my $routine_name = $_[0];
    my $lcname = $_[1];
    my $ucname = uc($lcname);
    
    # This include the code to map names for the profiling interface,
    # using the same macro as for the rest of the MPI code
    $uc_out_prefix = uc($out_prefix);
    if ($do_profiling) {
	# Remove the leading MPI_ if the name has it.
	if ($routine_name =~ /^MPI_/) {
	    $routine_name =~ s/^MPI_//;
	}
	print $OUTFD "
/* Map the name to the correct form */
#ifndef MPICH_MPI_FROM_PMPI
#ifdef F77_NAME_UPPER
#define ${out_prefix}${lcname}_ PMPI_${ucname}
#elif defined(F77_NAME_LOWER_2USCORE)
#define ${out_prefix}${lcname}_ pmpi_${lcname}__
#elif !defined(F77_NAME_LOWER_USCORE)
#define ${out_prefix}${lcname}_ pmpi_${lcname}
#else
#define ${out_prefix}${lcname}_ pmpi_${lcname}_
#endif
/* This defines the routine that we call, which must be the PMPI version
   since we're renameing the Fortran entry as the pmpi version */
#define MPI_${routine_name} PMPI_${routine_name} 

#else
";
    }
    print $OUTFD "
#ifdef F77_NAME_UPPER
#define ${out_prefix}${lcname}_ ${uc_out_prefix}${ucname}
#elif defined(F77_NAME_LOWER_2USCORE)
#define ${out_prefix}${lcname}_ ${out_prefix}${lcname}__
#elif !defined(F77_NAME_LOWER_USCORE)
#define ${out_prefix}${lcname}_ ${out_prefix}${lcname}
/* Else leave name alone */
#endif

";
    if ($do_profiling) {
	print $OUTFD "
#endif /* MPICH_MPI_FROM_PMPI */
";
    }
    if ($build_prototypes) {
	print $OUTFD "
/* Prototypes for the Fortran interfaces */
#include \"$prototype_header_file\"
";
    }
}

# Print the arguments for the routine DEFINITION.
sub print_args { 
    my @parms = split(/\s*,\s*/, $_[1] );
    my $OUTFD = $_[0];
    my $count = 1;
    my $last_args = "";
    my $prototype_only = $_[2];
    my $routine = $_[3];

    # Clear the @arg_addresses and $arg_qualifiers array.
    $#arg_addresses = -1;
    $#arg_qualifiers = -1;

    # Special case: if the only parm is "void", remove it from the list
    print STDERR "Nparms = $#parms, parms = " . join(',',@parms) . "\n" if $debug;
    if ($#parms == 0 && $parms[0] eq "void") {
	$#parms = -1;
    }
    # argsep is used to add a comma before every argument, except for the 
    # first
    $argsep = "";
    print $OUTFD "( ";
    foreach $parm (@parms) {
	# Match type to replacement
	print "parm = :$parm:\n" if $debug;
	# Remove qualifiers from the parm
	$arg_qualifiers[$count] = "";
	if ($parm =~ /^const\s+/) {
	    $parm =~ s/^const\s+//;
	    $arg_qualifiers[$count] .= "const ";
	}
	if ($parm =~ /^restrict\s+/) {
	    $parm =~ s/restrict\s+//;
	    $arg_qualifiers[$count] .= "restrict ";
	}
	# Remove arg names from array types
	if ($parm =~ /(\w+)\s+(\w+)\s*\[\]/) {
	    # Assume that this is <type> <name>[]; convert to
	    # <type>[]
	    print "    Removing argname $2 from parm array $parm\n" if $debug;
	    $parm = "$1" . "[]";
	}
	# Remove arg names from pointer types
	elsif ($parm =~ /(.*\*)\s+(\w+)/) {
	    print "    Removing argname $2 from parm pointer\n" if $debug;
	    $parm = $1;
	}
	# Remove blanks from the parm
	$parm =~ s/\s+//;
	$arg_addresses[$count] = 0;

	# This handles routines that have special declaration requirements
	# for particular arguments
	if (defined($declarg{"$routine-$count"})) {
	    print "    Using declarg{$routine} for this parm\n" if $debug;
	    $parm = $declarg{"$routine-$count"};
	    if ($prototype_only) {
		print $OUTFD "$argsep$parm";
	    }
	    else {
		print $OUTFD "$argsep$parm v$count";
	    }
	}
	elsif ($parm =~ /char\s*\*/) {
	    # char's go out at char *v FORT_MIXED_LEN(d) 
	    # and FORT_END_LEN(d) at the end
	    # (even if an array, because at the Fortran level, it
	    # is still a pointer to a character variable; the length
	    # of each entry in the array is the "d" value).
	    # FORT_END_LEN and FORT_MIXED_LEN contain the necessary comman
	    # if they are prsent at all.
	    print "    parm is a character string\n" if $debug;
	    if ($prototype_only) {
		print $OUTFD "${argsep}char * FORT_MIXED_LEN_DECL";
		$last_args .= "FORT_END_LEN_DECL ";
	    }
	    else {
		print $OUTFD "${argsep}char *v$count FORT_MIXED_LEN(d$count)";
		$last_args .= "FORT_END_LEN(d$count) ";
	    }
	}
	elsif ($parm =~/\[/) {
	    # Argument type is array, so we need to 
	    #  a) mark as containing a star
	    #  b) place parameter correctly
	    $star_count = 1;
	    $arg_addresses[$count] = $star_count;
	    # Split into raw type and []
            # Use \S* instead of the equivalent [^\s]*.
            # (\S is not-a-space)
            # perl 5.8 is known to mishandle the latter, leading to
	    # an empty basetype
	    if ($parm =~ /\s*(\S*)\s*(\[\s*\])/) {
		$basetype = $1;
	    }
	    else {
		print STDERR "Internal error.  Could not find basetype\n";
		print STDERR "This may be a bug in perl in the handling of certain expressions\n";
	    }
	    print "\tparm $parm is array of >$basetype<\n" if $debug;
	    #$foundbrack = $2;
	    if (defined($tof77{$parm})) {
		# This is a special case; the full type is defined.
		# This is used, for example, for int [][3] in the
		# routines that specify a range.
		print "Matched to full type $parm with replacement $tof77{$parm}\n" if $debug;
		# We use the replacement type
		$basetype = $tof77{$parm};
		$star_count = 0;
		$arg_addresses[$count] = $star_count;
	    }
	    elsif ($basetype eq "int") {
		# Do nothing because the [] added to the arg below
		# is all that is necessary.
		$star_count = 0;
		$arg_addresses[$count] = $star_count;
	    }
	    elsif (defined($tof77{"$basetype\[\]"})) {
		# Use the code for handling array parameters if
		# mapping code is provided.
		print "Match to array type $basetype\[\]\n" if $debug;
		$star_count = 0;
		$arg_addresses[$count] = $star_count;
		$basetype = $tof77{"$basetype\[\]"};
	    }
	    elsif (defined($tof77{$basetype})) {
		# FIXME: This code (now commented out) is not correct
		print STDERR "Using fall through for $basetype in $routine\n" if $debug;
# 		if ($useOldCode eq "yes") {
# 		$nstar_before = ($basetype =~ /\*/);
# 		$basetype = $tof77{$basetype};
# 		# The following fixes the case where the underlying type 
# 		# is a simple int.
# 		if ($basetype eq "int") {
# 		    $arg_addresses[$count] = 0;
# 		}
# 		print "\tparm has defined type of $basetype\n" if $debug;
# 		$nstar_after = ($basetype =~ /\*/);
# 		if ($nstar_before != $nstar_after) {
# 		    $star_count++;
# 		}
		# If we have an array, and a type mapping to fortran
		# We want to simply pretend that all is well (like int
		# above)
		$star_count = 0;
		$arg_addresses[$count] = $star_count;
	    }
	    if ($prototype_only) {
		print $OUTFD "$argsep$basetype \[\]";
	    }
	    else {
		print $OUTFD "$argsep$basetype v$count\[\]";
	    }
	}
	else {
	    $nstar_before = ($parm =~ /\*/);
	    $nstar_after = $nstar_before;
	    print "Nstar = $nstar_after\n" if $debug;
	    if (defined($tof77{$parm})) {
		$parm = $tof77{$parm};
		$nstar_after = ($parm =~ /\*/);
	    }
	    $leadspace = "";
	    if ($parm =~ /\w$/) {
		$leadspace = " ";
	    }
	    if ($prototype_only) {
		print $OUTFD "${argsep}${parm}";
	    }
	    else {
		print $OUTFD "${argsep}${parm}${leadspace}v$count";
	    }
	    $star_count = 0;
	    if ($nstar_before != $nstar_after) {
		$star_count = 1;
	    }
	    $arg_addresses[$count] = $star_count;
	}
	$count++;
	$argsep = ", ";
    }
    # Add the new error return code if necessary
    $tmpargs= $errparm;
    $tmpargs =~ s/\s*//g;
    if ($tmpargs ne "") {
	if ($prototype_only) {
	    print $OUTFD "$argsep$errparmtype";
	}
	else {
	    print $OUTFD "$argsep$errparm";
	}
    }
    print $OUTFD " $last_args";
    print $OUTFD ")";
}

# Print the arguments for the routine CALL.  
# Handle the special arguments
sub print_call_args {
    my @parms = split(/\s*,\s*/, $_[0] );
    my $count = 1;
    my $first = 1;
    print $OUTFD "( ";
    # Special case: if the only parm is "void", remove it from the list
    if ($#parms == 0 && $parms[0] eq "void") {
	$#parms = -1;
    }

    foreach $parm (@parms) {
	$parm =~ s/^const\s//;  # Remove const if present
	# Remove variable name if present in an array arg
	if ($parm =~ /(.*)\s+(\w+)\[\]/) {
	    $parm = "$1 \[\]";
	}
	# Compress multiple spaces
	$parm =~ s/\s\s/ /g;
	if (!$first) { print $OUTFD ", "; } else { $first = 0; }

	if (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.  
	    #print "TMP: parm = $arg_qualifiers[$count]$parm\n";
	    $fullparm="$arg_qualifiers[$count]$parm";
	    if (defined($argsneedcast{$fullparm})) {
		$argval = "v$count";
		if ($arg_addresses[$count] > 0) {
		    $argval = "*$argval";
		}
		$callparm = $argsneedcast{$fullparm};
		$callparm =~ s/ARG/$argval/;
		print $OUTFD "$callparm";
	    }
	    else {
		# Since MPICH objects are ints, we don't need to do 
		# anything unless MPI_Fint and int are different.
# print STDERR "XXX $count $#arg_addresses XXX\n";
		if ($arg_addresses[$count] > 0) {
		    print $OUTFD "*";
		}
		print $OUTFD "v$count";
	    }
	}
	$count++;
    }
    print $OUTFD " );\n";
}

# Print the option function attribute; this supports GCC, particularly 
# the __atribute__ ((weak)) option.  Unfortunately, the name must be
# made into a string and inserted into the attribute list.
sub print_attr {
    my $OUTFD = $_[0];
    my $name  = $_[1];
    if ($do_weak) {
	print $OUTFD " FUNC_ATTRIBUTES($name)";
    }
}

#
# We allow a routine to specify an alternate weak decl by name
sub set_weak_decl {
    my $name = $_[0];
    my $decl = $_[1];
    my $rtype = $_[2];
    $name = lc($name);
    $altweak{$name}      = $decl;
    $altweakrtype{$name} = $rtype;
}
sub print_weak_decl {
    my $OUTFD = $_[0];
    my $name  = $_[1];
    my $args  = $_[2];
    my $lcname = $_[3];

    my $basename = lc($name);
    $basename =~ s/_*$//;
    if (defined($altweak{$basename})) {
	print $OUTFD "extern FORT_DLL_SPEC $altweakrtype{$basename} FORT_CALL $name($altweak{$basename});\n";
    }
    else {
	print $OUTFD "extern FORT_DLL_SPEC $returnType FORT_CALL $name";
	&print_args( $OUTFD, $args, 1, $lcname );
	print $OUTFD ";\n";