This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, release/mpich-3.0.x has been updated via 9a19e6b6774e8b9a9fd2ffe86fe5cbe570c86559 (commit) via a9a1d54629a910b7bfa57d60bf665ddd1b83b066 (commit) from 45305a3a74fe8a4bb4667892ccebc9b2f15fbbc4 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/9a19e6b6774e8b9a9fd2ffe86fe5cbe570... commit 9a19e6b6774e8b9a9fd2ffe86fe5cbe570c86559 Author: William Gropp <[email protected]> Date: Thu May 2 12:49:26 2013 -0400 Fixes for #1804 and #1828, related to alignment issues with MPI_Status There are two alignment-related problems with MPI_STATUS arguments in Fortran. The first is that while MPI_STATUS is an INTEGER array in Fortran, in C there is an element of type MPI_Count. MPI_Count may be longer than an INTEGER and thus a C MPI_Status may have a stricter alignment requirement than a Fortran INTEGER array. The fixes to src/binding/f77/buildiface ensures that STATUS arguments that are provided to C by the Fortran wrappers are properly aligned, while avoiding copies when possible. The second fix deals with padding that the introduction of MPI_Count as the count type into the C structure for status will often introduce. diff --git a/.gitignore b/.gitignore index 1634a5a..ed5203c 100644 --- a/.gitignore +++ b/.gitignore @@ -159,6 +159,7 @@ Makefile.am-stamp /README.envvar /maint/extracterrmsgs /src/binding/f90/mpi_base.f90.in +/src/binding/f90/mpi_constants.f90.in /src/env/mpixxx_opts.conf /src/mpi/romio/include/mpio.h /src/mpi/romio/include/mpiof.h diff --git a/configure.ac b/configure.ac index 6b7237c..f3d3c2d 100644 --- a/configure.ac +++ b/configure.ac @@ -4079,9 +4079,10 @@ dnl len_doublecplx=$hexlen # PAC_PROG_FC_INT_KIND(INTEGER_KIND,$pac_cv_f77_sizeof_integer,$CROSS_F90_INTEGER_KIND) if test "$INTEGER_KIND" = "-1" ; then - # Wild guess; probably means that Fortran 90 is not available - AC_MSG_WARN([Unable to determine Fortran 90 KIND values for either address-sized integers or offset-sized integers. Using 4 in that case.]) - INTEGER_KIND=4 + # In our experience, this usually means that there is some + # problem building and/or running the f90 program. Fail + # in this case rather than attempt to continue + AC_MSG_ERROR([Unable to determine Fortran 90 KIND values for either address-sized integers or offset-sized integers.]) fi # # Some compilers won't allow a -1 kind (e.g., absoft). In this case, @@ -5792,6 +5793,8 @@ if test "$enable_f77" = yes -a -z "$MPI_STATUS_SIZE" ; then if test $MPI_SIZEOF_COUNT -gt $pac_cv_f77_sizeof_integer ; then # Alignment test looks at the low address bits, as long # as the sizeof(MPI_Count) is 2^j. + # If we can't tell, pick a value that forces the Fortran + # wrappers to use a local copy. MPIR_COUNT_ALIGNMENT=0 case $MPI_SIZEOF_COUNT in 4) MPIR_COUNT_ALIGNMENT="0x3";; @@ -5801,6 +5804,77 @@ if test "$enable_f77" = yes -a -z "$MPI_STATUS_SIZE" ; then esac AC_DEFINE_UNQUOTED([MPIR_COUNT_ALIGNMENT],[$MPIR_COUNT_ALIGNMENT],[Value that anded with an address will give 0 if the address is properly aligned for MPI_Count]) + + # Compare the size of MPI_Status to the sizes of the individual + # elements. If the sizeof(MPI_Status) > sum of the sizes, then + # determine if simple padding will work. + # FIXME: DETERMINED TO SEE IF THERE IS PROBLEM BUT NOT YET USED + AC_MSG_CHECKING([whether MPI_Status contains padding]) + sum_of_status_element_sizes=`expr 6 \* $ac_cv_sizeof_int + $MPI_SIZEOF_COUNT` + if test $sum_of_status_element_sizes -lt $pac_cv_sizeof_mpi_status ; then + AC_MSG_RESULT([yes]) + if test "$enable_fc" = "yes" ; then + # FIXME: We could compute the padding or delete the + # status definition from mpi_constants + AC_MSG_CHECKING([padding size before count field in MPI_Status]) + rm -f pac_mpi_status.h +dnl quote with [] since otherwise m4 strips the array declaration out of this +dnl structure +[ cat > pac_mpi_status.h <<_EOF +typedef struct { + int MPI_SOURCE; + int MPI_TAG; + int MPI_ERROR; + $MPI_COUNT count; + int cancelled; + int abi_slush_fund[2]; + $EXTRA_STATUS_DECL +} MPI_Status; +MPI_Status mya; +_EOF +] + AC_COMPUTE_INT(pac_cv_fc_pad1,[((char*)&mya.count-(((char*)&mya)+3*sizeof(int)))],[AC_INCLUDES_DEFAULT() +#include "pac_mpi_status.h"]) + AC_MSG_RESULT($pac_cv_fc_pad1) + AC_MSG_CHECKING([padding at end of MPI_Status]) + AC_COMPUTE_INT(pac_cv_fc_pad2,[((char*)(&mya + 1) - ((char *)(mya.abi_slush_fund+1) + sizeof(int)))],[AC_INCLUDES_DEFAULT() +#include "pac_mpi_status.h"]) + AC_MSG_RESULT($pac_cv_fc_pad2) + rm -f pac_mpi_status.h + pac_cv_pad1found=no + pac_cv_pad2found=no + FC_STATUS_PAD1="" + FC_STATUS_PAD2="" + AC_SUBST(FC_STATUS_PAD1) + AC_SUBST(FC_STATUS_PAD2) + if test $pac_cv_fc_pad1 -gt 0 ; then + if test $pac_cv_fc_pad1 -eq $ac_cv_sizeof_int ; then + pac_cv_pad1found=yes + FC_STATUS_PAD1="INTEGER :: PAD1" + fi + else + # No padding needed here, so successfully determined + # padding + pac_cv_pad1found=yes + fi + if test $pac_cv_fc_pad2 -gt 0 ; then + if test $pac_cv_fc_pad2 -eq $ac_cv_sizeof_int ; then + pac_cv_pad2found=yes + FC_STATUS_PAD2="INTEGER :: PAD2" + fi + else + # No padding needed here, so successfully determined + # padding + pac_cv_pad2found=yes + fi + if test $pac_cv_pad1found = "no" -o \ + $pac_cv_pad2found = "no" ; then + AC_MSG_ERROR([INTERNAL ERROR: definition of MPI_Status in C and Fortran 90 is incompatible due to padding in the C definition]) + fi + fi + else + AC_MSG_RESULT([no]) + fi fi fi AC_SUBST([MPI_STATUS_SIZE]) @@ -6063,6 +6137,7 @@ AC_OUTPUT(Makefile \ src/binding/f77/setbot.c \ src/binding/f90/mpi_sizeofs.f90 \ src/binding/f90/mpi_base.f90 \ + src/binding/f90/mpi_constants.f90 \ src/packaging/pkgconfig/mpich.pc \ src/packaging/envmods/mpich.module \ src/env/mpixxx_opts.conf \ diff --git a/src/binding/f77/buildiface b/src/binding/f77/buildiface index f6c6611..5f30c6d 100755 --- a/src/binding/f77/buildiface +++ b/src/binding/f77/buildiface @@ -2553,10 +2553,18 @@ sub status_out_ftoc { # casting to a pointer with greater alignment (and which the # specific runtime check is used to ensure the alignments are # ok). + # Horrible requirement: MPI Standard (see MPI-3, Section 3.2.5, + # page 30, lines 39-43) implies that the MPI_ERROR field needs + # to be *preserved*. Thus, if we have a temp status, we need to + # either copy it to the temp status (as here) or *not* copy over + # it when storing the result. This is simpler. print $OUTFD "\ - if (l$count != MPI_STATUS_IGNORE && - (((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0) - l$count = (MPI_Status*)(void *)v$count;\n"; + if (l$count != MPI_STATUS_IGNORE) { + if ((((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0) + l$count = (MPI_Status*)(void *)v$count; + else + l$count->MPI_ERROR = ((MPI_Status*)v$count)->MPI_ERROR; + }\n"; } } sub status_out_arg { @@ -2679,9 +2687,17 @@ sub status_array_out_fnulltoc { } sub status_array_out_ftoc { my $count = $_[0]; - + + # See discussion of status_out_ftoc - unfortunately, we need to + # copy *just* the MPI_ERROR field if ($within_fint) { - print $OUTFD " if (l$count != MPI_STATUSES_IGNORE) { l$count = (MPI_Status*)$malloc($Array_size * sizeof(MPI_Status)); }\n"; + print $OUTFD "\ + if (l$count != MPI_STATUSES_IGNORE) { + int li; + l$count = (MPI_Status*)$malloc($Array_size * sizeof(MPI_Status)); + for (li=0; li<$Array_size; li++) + l$count\[li].MPI_ERROR = ((MPI_Status*)v$count)[li].MPI_ERROR; + }\n"; } elsif ($fixStatusAlignment) { print $OUTFD "\ @@ -2689,8 +2705,11 @@ sub status_array_out_ftoc { if( (((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0) l$count = (MPI_Status*)(void *)v$count; else { + int li; lalloc$count = 1; l$count = (MPI_Status*)$malloc($Array_size * sizeof(MPI_Status)); + for (li=0; li<$Array_size; li++) + l$count\[li].MPI_ERROR = ((MPI_Status*)v$count)[li].MPI_ERROR; } }\n"; } @@ -2714,7 +2733,7 @@ sub status_array_ctof { " if ($testFlag$coutvar != MPI_STATUSES_IGNORE) { int li; for (li=0; li<$ActSize; li++) { - MPI_Status_c2f($coutvar+li,$outvar+li*5); + MPI_Status_c2f($coutvar+li,$outvar+li*MPIF_STATUS_SIZE); } }\n"; $clean_up .= " if ($coutvar != MPI_STATUSES_IGNORE) { $free($coutvar); }\n"; @@ -2732,7 +2751,7 @@ sub status_array_ctof { " if (${testFlag}lalloc$count) { int li; for (li=0; li<$ActSize; li++) { - MPI_Status_c2f($coutvar+li,$outvar+li*5); + MPI_Status_c2f($coutvar+li,$outvar+li*MPIF_STATUS_SIZE); } }\n"; $clean_up .= " if (lalloc$count) { $free($coutvar); }\n"; diff --git a/src/binding/f90/buildiface b/src/binding/f90/buildiface index c5eb901..d84ef1f 100755 --- a/src/binding/f90/buildiface +++ b/src/binding/f90/buildiface @@ -603,7 +603,7 @@ print MPIBASEFD " END MODULE ${ucoutfile_prefix}_BASE\n"; close MPIBASEFD; &ReplaceIfDifferent( "${outfile_prefix}_base.f90.in", "${outfile_prefix}_base.f90.in.new" ); -open ( MPIFD, ">${outfile_prefix}_constants.f90.new" ) || die "Cannot open ${outfile_prefix}_constants.f90.new\n"; +open ( MPIFD, ">${outfile_prefix}_constants.f90.in.new" ) || die "Cannot open ${outfile_prefix}_constants.f90.in.new\n"; print MPIFD "! -*- Mode: Fortran; -*- ! (C) 2008 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -642,13 +642,21 @@ $PRIVATEVAR = ""; # #$BINDACCESS = ", BIND(C)"; #$BINDDEF =""; +# Yet another problem. +# Because MPI_Count may be longer than a single (Fortran) INTEGER, +# alignment restrictions may introduce padding in the structure +# And one more problem: If a Fortran INTEGER is not the same as a C int, +# then these are also wrong (see the "fint" option in +# src/binding/f77/buildiface print MPIFD <<EOT; TYPE$BINDACCESS :: MPI_Status $BINDDEF INTEGER$PUBLICVAR :: MPI_SOURCE, MPI_TAG, MPI_ERROR + \@FC_STATUS_PAD1\@ INTEGER$PRIVATEVAR(KIND=MPI_COUNT_KIND) :: count INTEGER$PRIVATEVAR :: cancelled INTEGER$PRIVATEVAR(2) :: abi_slush_fund + \@FC_STATUS_PAD2\@ END TYPE MPI_Status EOT @@ -708,7 +716,7 @@ foreach $handle (keys(%handles)) { print MPIFD " END MODULE ${ucoutfile_prefix}_CONSTANTS\n"; close MPIFD; -&ReplaceIfDifferent( "${outfile_prefix}_constants.f90", "${outfile_prefix}_constants.f90.new" ); +&ReplaceIfDifferent( "${outfile_prefix}_constants.f90.in", "${outfile_prefix}_constants.f90.in.new" ); # # Generate the choice argument routines http://git.mpich.org/mpich.git/commitdiff/a9a1d54629a910b7bfa57d60bf665ddd1b... commit a9a1d54629a910b7bfa57d60bf665ddd1b83b066 Author: William Gropp <[email protected]> Date: Sun Apr 28 19:16:05 2013 -0500 Fix for #1804 - Alignment issues in Fortran with MPI_Status Changed the Fortran wrapper generator to test for proper alignment of MPI_Status - because of the new MPI_Count field, some systems may need MPI_Status to be aligned on a multiple of sizeof(MPI_Count). By default, new code enforces that, using a temporay status variable only when required. Cost is a few additional tests. diff --git a/configure.ac b/configure.ac index 35dc573..6b7237c 100644 --- a/configure.ac +++ b/configure.ac @@ -5783,6 +5783,25 @@ if test "$enable_f77" = yes -a -z "$MPI_STATUS_SIZE" ; then else AC_MSG_ERROR([MPI_STATUS_SIZE was not defined!]) fi + + # Because MPI_Status may contain C integers of different sizes + # and with different alignments, we determine the maximum element + # size and then tell Fortran to enforce maximal alignment. + # A more sophisticated test would determine the required alignment, + # rather than assuming alignment to maximum size + if test $MPI_SIZEOF_COUNT -gt $pac_cv_f77_sizeof_integer ; then + # Alignment test looks at the low address bits, as long + # as the sizeof(MPI_Count) is 2^j. + MPIR_COUNT_ALIGNMENT=0 + case $MPI_SIZEOF_COUNT in + 4) MPIR_COUNT_ALIGNMENT="0x3";; + 8) MPIR_COUNT_ALIGNMENT="0x7";; + 16) MPIR_COUNT_ALIGNMENT="0xF";; + *) MPIR_COUNT_ALIGNMENT=-1 ;; + esac + + AC_DEFINE_UNQUOTED([MPIR_COUNT_ALIGNMENT],[$MPIR_COUNT_ALIGNMENT],[Value that anded with an address will give 0 if the address is properly aligned for MPI_Count]) + fi fi AC_SUBST([MPI_STATUS_SIZE]) MPIF_STATUS_SIZE=$MPI_STATUS_SIZE diff --git a/src/binding/f77/buildiface b/src/binding/f77/buildiface index 66ad07e..f6c6611 100755 --- a/src/binding/f77/buildiface +++ b/src/binding/f77/buildiface @@ -46,6 +46,10 @@ $do_fint = 0; # Set to 1 to support C and Fortran integers of a # different size $within_fint = 0; # This is set to 1 while generating code for the # do_fint branch +$fixStatusAlignment = 1; # Set to 1 to generate code that + # handles different alignment rules between + # Fortran (INTEGER) and C (likely MPI_Count) + # Note set by feature value do_fixstatus . %fintToHandle = ( 'int' => 1, 'MPI_Request' => 1, 'MPI_Group' => 1, 'MPI_Win' => 1, 'MPI_Info' => 1, 'MPI_Errhandler' => 1, 'MPI_File' => 1, 'MPI_Op' => 1, 'MPI_Message' => 1 ); @@ -68,6 +72,7 @@ $do_logical = 1; $do_weak = 1; $do_subdecls = 1; $do_bufptr = 1; +$do_fixstatus = 1; $prototype_file = "../../include/mpi.h.in"; # Global hashes used for definitions and to record the locations of the @@ -107,8 +112,8 @@ $specialInitString = "\ # Process arguments # # Args -# -feature={logical,fint,subdecls,weak,bufptr}, separated by :, value given -# by =on or =off, eg +# -feature={logical,fint,subdecls,weak,bufptr,fixstatus}, +# separated by :, value given by =on or =off, eg # -feature=logical=on:fint=off # The feature names mean: # logical - Fortran logicals are converted to/from C @@ -117,6 +122,11 @@ $specialInitString = "\ # weak - Use weak symbols # bufptr - Check for MPI_BOTTOM as a special address. This is # not needed if a POINTER declaration is available. +# fixstatus - The alignment of a Fortran STATUS array may not always +# be what is required in C (particularly with MPI_Count in +# MPI_Status now). If set, generate code to handle this case. +# Systems without alignment restrictions can set this to off, +# which will remove some tests. foreach $_ (@ARGV) { if (/-noprototypes/) { $build_prototypes = 0; } elsif (/-infile=(.*)/) { @@ -161,6 +171,8 @@ foreach $_ (@ARGV) { print STDERR "Unrecognized argument $_\n"; } } +# For now, make these equal. +$fixStatusAlignment = $do_fixstatus; # Note that the code that looks up values strips blanks out of the type name # No blanks should be used in the key. @@ -647,18 +659,18 @@ foreach $_ (@ARGV) { 'Testsome-2' => 'inout:handle_array:*v1:MPI_Request', 'Testsome-3' => 'out:fint2int', 'Testsome-4' => 'out:index_array:*v1:*v3', - 'Testsome-5' => 'out:status_array:*v1:*v3:l3>0', + 'Testsome-5' => 'out:status_array:*v1:*v3:*v3>0', 'Get_count' => '1', 'Get_count-1' => 'in:status', 'Request_get_status' => '2:3', 'Request_get_status-2' => 'out:logical', 'Request_get_status-3' => 'out:status', 'Status_set_cancelled' => '1:2', - 'Status_set_cancelled-1' => 'in:status', + 'Status_set_cancelled-1' => 'inout:status', 'Status_set_cancelled-2' => 'in:logical', 'Status_set_elements' => '1', - 'Status_set_elements-1' => 'out:status', + 'Status_set_elements-1' => 'inout:status', 'Status_set_elements_x' => '1', - 'Status_set_elements_x-1' => 'out:status', + 'Status_set_elements_x-1' => 'inout:status', 'Type_contiguous' => '2:3', 'Type_contiguous-2' => 'in:handle::MPI_Datatype', 'Type_contiguous-3' => 'out:handle::MPI_Datatype', @@ -1744,6 +1756,7 @@ sub bufptr_in_arg { sub bufptr_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; } # -------------------------------------------------------------------------- # MPI_IN_PLACE buffer pointers @@ -1763,6 +1776,7 @@ sub inplace_in_arg { sub inplace_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; } # -------------------------------------------------------------------------- # MPI_UNWEIGHTED pointers. Note that unweighted is only used to indicate @@ -1839,6 +1853,7 @@ sub unweighted_out_arg { sub unweighted_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { # MPI_WEIGHTS_EMPTY should never be an output value from the MPI library @@ -1877,6 +1892,7 @@ sub logical_in_arg { sub logical_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($do_logical) { print $OUTFD " if ($errparmlval == MPI_SUCCESS) *$outvar = MPIR_TO_FLOG($coutvar);\n"; } @@ -1940,6 +1956,7 @@ sub logical_array_in_arg { sub logical_array_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; # Special case if MPI_Fint == int: we use the input variable # for space. my $ActSize = $Array_size; @@ -1984,6 +2001,7 @@ sub index_ftoc { sub index_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; print $OUTFD " *$outvar = (MPI_Fint)$coutvar;\n"; print $OUTFD " if ($coutvar >= 0) *$outvar = *$outvar + 1;\n"; } @@ -2010,6 +2028,7 @@ sub index_array_out_ftoc { sub index_array_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; my $ActSize = $Array_size; # In the case where the input and out sizes are not the same, # the output size is in the fourth argument. @@ -2082,6 +2101,7 @@ sub handle_inout_ftoc { sub handle_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { print $OUTFD " if ($errparmlval==MPI_SUCCESS) *$outvar = (MPI_Fint)$coutvar;\n"; } @@ -2204,7 +2224,8 @@ sub handle_array_out_ftoc { sub handle_array_inout_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; - &handle_array_ctof( $coutvar, $outvar ); + my $count = $_[2]; + &handle_array_ctof( $coutvar, $outvar, $count ); } # Make sure that there is no output processing (other than to free the @@ -2212,12 +2233,14 @@ sub handle_array_inout_ctof { sub handle_array_in_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; - #&handle_array_ctof( $coutvar, $outvar ); + my $count = $_[2]; + #&handle_array_ctof( $coutvar, $outvar, $count ); } sub handle_array_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { my $basetype = $nativeType; $basetype =~ s/MPI_//; @@ -2228,7 +2251,7 @@ sub handle_array_ctof { $asize = "_csize"; } print $OUTFD "\ - /* handle_array_ctof( $coutvar, $outvar ) */ + /* handle_array_ctof( $coutvar, $outvar, $count ) */ {int li; for (li=0; li<$asize; li++) { $outvar\[li\] = $convfunc( $coutvar\[li\] ); @@ -2336,6 +2359,7 @@ sub addrint_in_arg { sub attrint_ctof { my $fvar = $_[0]; my $cvar = $_[1]; + my $count = $_[2]; my $flagarg = 4; # get from option # The strange cast is due to the following: # The MPICH attribute code returns an int in the void *. In @@ -2392,6 +2416,7 @@ sub addraint_in_arg { sub attraint_ctof { my $fvar = $_[0]; my $cvar = $_[1]; + my $count = $_[2]; my $flagarg = 4; # get from option print $OUTFD " if ((int)*ierr || !l$flagarg) { @@ -2429,6 +2454,7 @@ sub bufaddr_out_arg { sub bufaddr_ctof { my $fvar = $_[0]; my $cvar = $_[1]; + my $count = $_[2]; } # -------------------------------------------------------------------------- # @@ -2449,6 +2475,10 @@ sub status_out_fnulltoc { if (v$count == MPI_F_STATUS_IGNORE) { l$count = MPI_STATUS_IGNORE; } else { l$count->MPI_ERROR = (int)(v$count\[2\]); }\n"; } + elsif ($fixStatusAlignment) { + print $OUTFD "\ + if (v$count == MPI_F_STATUS_IGNORE) { l$count = MPI_STATUS_IGNORE; }\n"; + } else { print $OUTFD "\ if (v$count == MPI_F_STATUS_IGNORE) { v$count = (MPI_Fint*)MPI_STATUS_IGNORE; }\n"; @@ -2460,11 +2490,26 @@ sub status_in_ftoc { if ($within_fint) { print $OUTFD " MPI_Status_f2c( v$count, l$count );\n"; } + elsif ($fixStatusAlignment) { + print $OUTFD "\ + if ( l$count != MPI_STATUS_IGNORE && + (((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0 ) + l$count = (MPI_Status *)(void*)v$count; + else { + MPI_Status_f2c( v$count, l$count ); + } +"; + } +} +sub status_inout_ftoc { + my $count = $_[0]; + status_in_ftoc( $count ); } sub status_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { my $testFlag = ""; if (defined($condition) && $condition ne "") { @@ -2473,24 +2518,50 @@ sub status_out_ctof { print $OUTFD " if ($testFlag$coutvar != MPI_STATUS_IGNORE && $errparmlval == MPI_SUCCESS) { MPI_Status_c2f($coutvar,$outvar); - }\n" + }\n"; + } + elsif ($fixStatusAlignment) { + # only copy if Fortran is not properly aligned + print $OUTFD "\ + if ($coutvar != MPI_STATUS_IGNORE && $errparmlval == MPI_SUCCESS && $outvar != (MPI_Fint*)$coutvar) { + MPI_Status_c2f($coutvar,$outvar); + }\n"; } } sub status_in_decl { my $count = $_[0]; - if ($within_fint) { + if ($within_fint || $fixStatusAlignment) { print $OUTFD " MPI_Status vtmp$count, *l$count = &vtmp$count;\n"; } } sub status_out_decl { my $count = $_[0]; - if ($within_fint) { + if ($within_fint || $fixStatusAlignment) { print $OUTFD " MPI_Status vtmp$count, *l$count = &vtmp$count;\n"; } } +sub status_inout_decl { + my $count = $_[0]; + if ($within_fint || $fixStatusAlignment) { + print $OUTFD " MPI_Status vtmp$count, *l$count = &vtmp$count;\n"; + } +} +sub status_out_ftoc { + my $count = $_[0]; + if ($fixStatusAlignment) { + # The first (void *) cast helps suppress compiler warnings about + # casting to a pointer with greater alignment (and which the + # specific runtime check is used to ensure the alignments are + # ok). + print $OUTFD "\ + if (l$count != MPI_STATUS_IGNORE && + (((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0) + l$count = (MPI_Status*)(void *)v$count;\n"; + } +} sub status_out_arg { my $count = $_[0]; - if ($within_fint) { + if ($within_fint|| $fixStatusAlignment) { print $OUTFD "l$count"; } else { @@ -2499,7 +2570,16 @@ sub status_out_arg { } sub status_in_arg { my $count = $_[0]; - if ($within_fint) { + if ($within_fint || $fixStatusAlignment) { + print $OUTFD "l$count"; + } + else { + print $OUTFD "(MPI_Status *)(v$count)"; + } +} +sub status_inout_arg { + my $count = $_[0]; + if ($within_fint || $fixStatusAlignment) { print $OUTFD "l$count"; } else { @@ -2549,6 +2629,7 @@ sub errcodesignore_out_ftoc { sub errcodesignore_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { $asize = $Array_size; @@ -2592,7 +2673,7 @@ sub status_array_out_fnulltoc { &specialInitStatement( $OUTFD ); my $varname = "v"; my $varcast = "(MPI_Fint *)"; - if ($within_fint) { $varname = "l"; $varcast = ""; } + if ($within_fint || $fixStatusAlignment) { $varname = "l"; $varcast = ""; } print $OUTFD "\ if (v$count == MPI_F_STATUSES_IGNORE) { $varname$count = ${varcast}MPI_STATUSES_IGNORE; }\n"; } @@ -2602,11 +2683,23 @@ sub status_array_out_ftoc { if ($within_fint) { print $OUTFD " if (l$count != MPI_STATUSES_IGNORE) { l$count = (MPI_Status*)$malloc($Array_size * sizeof(MPI_Status)); }\n"; } + elsif ($fixStatusAlignment) { + print $OUTFD "\ + if (l$count != MPI_STATUSES_IGNORE) { + if( (((MPI_Aint)v$count) & MPIR_COUNT_ALIGNMENT) == 0) + l$count = (MPI_Status*)(void *)v$count; + else { + lalloc$count = 1; + l$count = (MPI_Status*)$malloc($Array_size * sizeof(MPI_Status)); + } + }\n"; + } } sub status_array_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { my $ActSize = $Array_size; @@ -2626,17 +2719,38 @@ sub status_array_ctof { }\n"; $clean_up .= " if ($coutvar != MPI_STATUSES_IGNORE) { $free($coutvar); }\n"; } + elsif ($fixStatusAlignment) { + my $ActSize = $Array_size; + if (defined($nativeType) && $nativeType ne "") { + $ActSize = $nativeType; + } + my $testFlag = ""; + if (defined($condition) && $condition ne "") { + $testFlag = "$condition && " + } + print $OUTFD +" if (${testFlag}lalloc$count) { + int li; + for (li=0; li<$ActSize; li++) { + MPI_Status_c2f($coutvar+li,$outvar+li*5); + } + }\n"; + $clean_up .= " if (lalloc$count) { $free($coutvar); }\n"; + } } sub status_array_out_decl { my $count = $_[0]; if ($within_fint) { print $OUTFD " MPI_Status *l$count=0;\n"; + } + elsif ($fixStatusAlignment) { + print $OUTFD " MPI_Status *l$count=0;\n int lalloc$count=0;\n"; } } sub status_array_out_arg { my $count = $_[0]; - if ($within_fint) { + if ($within_fint || $fixStatusAlignment) { print $OUTFD "l$count"; } else { @@ -2648,6 +2762,7 @@ sub status_array_out_arg { sub aintToInt_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; print $OUTFD " if ($errparmlval == MPI_SUCCESS) *$outvar = (MPI_Fint)($coutvar);\n"; } sub aintToInt_out_decl { @@ -2685,6 +2800,7 @@ sub fint2int_ftoc { sub fint2int_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { print $OUTFD " if ($errparmlval == MPI_SUCCESS) *$outvar = (MPI_Fint)$coutvar;\n"; } @@ -2800,6 +2916,7 @@ sub fint2int_array_out_ftoc { sub fint2int_array_out_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; if ($within_fint) { my $asize = $Array_size; if ($Array_size =~ /_commsize/) { @@ -3033,16 +3150,16 @@ sub print_post_call { $processing_routine = "${method}_${direction}_ctof"; # Prefer a specific choice matching the direction if (defined(&$processing_routine)) { - &$processing_routine( "l$count", "v$count" ); + &$processing_routine( "l$count", "v$count", $count ); } elsif ($direction eq "inout" && defined(&$processing_out_routine)) { - &$processing_out_routine( "l$count", "v$count" ); + &$processing_out_routine( "l$count", "v$count", $count ); } else { $processing_routine = "${method}_ctof"; if (defined(&$processing_routine)) { - &$processing_routine( "l$count", "v$count" ); + &$processing_routine( "l$count", "v$count", $count ); } elsif ($direction ne "in") { print STDERR "Missing $processing_routine for $routine_name\n"; @@ -3090,6 +3207,7 @@ sub blankpad_out_ftoc { sub blankpad_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; # find the null character. Replace with blanks from there to the # end of the string. The declared lenght is given by a variable @@ -3132,6 +3250,7 @@ sub blankpadonflag_out_ftoc { sub blankpadonflag_ctof { my $coutvar = $_[0]; my $outvar = $_[1]; + my $count = $_[2]; # find the null character. Replace with blanks from there to the # end of the string. The declared lenght is given by a variable @@ -3455,6 +3574,7 @@ sub intToAintArr_in_arg { sub intToAintArr_in_ctof { my $lname = $_[0]; my $vname = $_[1]; + my $count = $_[2]; print $OUTFD " #ifdef HAVE_AINT_LARGER_THAN_FINT if ($lname) { $free($lname); } @@ -3500,6 +3620,7 @@ sub FileToFint_out_decl { sub FileToFint_ctof { my $lvar = $_[0]; my $gvar = $_[1]; + my $count = $_[2]; print $OUTFD " *$gvar = MPI_File_c2f($lvar);\n"; } sub FileToFint_out_arg { @@ -4515,6 +4636,7 @@ print $OUTFD "\ return MPIR_Err_return_comm( 0, \"MPI_Status_f2c\", mpi_errno ); }\n"; if ($do_fint) { + #FIXME: Invalid alignment assumptions on MPI_Count field. print $OUTFD "\ #ifdef HAVE_FINT_IS_INT *c_status = *(MPI_Status *) f_status; @@ -4553,7 +4675,11 @@ print $OUTFD "\ #include \"mpi_fortimpl.h\" /* mpierrs.h and mpierror.h for the error code creation */ #include \"mpierrs.h\" -#include <stdio.h> +#include <stdio.h>\n"; + if ($fixStatusAlignment) { + print $OUTFD "#include <string.h>\n"; + } + print $OUTFD "\ #include \"mpierror.h\" /* -- Begin Profiling Symbol Block for routine MPI_Status_c2f */ @@ -4589,6 +4715,8 @@ int MPI_Status_c2f( const MPI_Status *c_status, MPI_Fint *f_status ) return MPIR_Err_return_comm( 0, \"MPI_Status_c2f\", mpi_errno ); }\n"; if ($do_fint) { + #FIXME: Copy to f_status of MPI_Count data makes invalid alignment + # data. print $OUTFD "\ #ifdef HAVE_FINT_IS_INT *(MPI_Status *)f_status = *c_status; @@ -4601,14 +4729,24 @@ int MPI_Status_c2f( const MPI_Status *c_status, MPI_Fint *f_status ) #endif\n"; } else { - print $OUTFD " *(MPI_Status *)f_status = *c_status;\n"; + if ($fixStatusAlignment) { + # Within this routine, MPI_STATUS_IGNORE is invalid + print $OUTFD "\ + if ( (((MPI_Aint)f_status) & MPIR_COUNT_ALIGNMENT) == 0 ) + *(MPI_Status*)(void *)f_status = *c_status; + else + memcpy(f_status,c_status,sizeof(MPI_Status)); + \n"; + } + else { + print $OUTFD " *(MPI_Status *)f_status = *c_status;\n"; + } } print $OUTFD " return MPI_SUCCESS; }\n"; close ($OUTFD); &ReplaceIfDifferent( $filename, $filename . ".new" ); - } sub print_mpif_int { ----------------------------------------------------------------------- Summary of changes: .gitignore | 1 + configure.ac | 100 +++++++++++++++++++++- src/binding/f77/buildiface | 207 ++++++++++++++++++++++++++++++++++++++------ src/binding/f90/buildiface | 12 ++- 4 files changed, 290 insertions(+), 30 deletions(-) hooks/post-receive -- MPICH primary repository