Commit 34b955a3 authored by Darius Buntinas's avatar Darius Buntinas
Browse files

[svn-r8154] reversed r8153, since there were other files that should not have been committed

parent 2c887617
...@@ -4120,13 +4120,18 @@ if test "$enable_f77" = yes ; then ...@@ -4120,13 +4120,18 @@ if test "$enable_f77" = yes ; then
"$ac_cv_sizeof_void_p" -gt "$pac_cv_f77_sizeof_integer" ; then "$ac_cv_sizeof_void_p" -gt "$pac_cv_f77_sizeof_integer" ; then
AC_DEFINE(HAVE_AINT_LARGER_THAN_FINT,1,[Define if addresses are larger than Fortran integers]) AC_DEFINE(HAVE_AINT_LARGER_THAN_FINT,1,[Define if addresses are larger than Fortran integers])
fi fi
if test "$ac_cv_sizeof_void_p" != 0 -a \
"$ac_cv_sizeof_void_p" != "$pac_cv_f77_sizeof_integer" ; then
AC_DEFINE(HAVE_AINT_DIFFERENT_THAN_FINT,1,[Define if addresses are a different size than Fortran integers])
fi
# Include a defined value for Fint is int # Include a defined value for Fint is int
if test "$MPI_FINT" = "int" ; then if test "$MPI_FINT" = "int" ; then
AC_DEFINE(HAVE_FINT_IS_INT,1,[Define if Fortran integer are the same size as C ints]) AC_DEFINE(HAVE_FINT_IS_INT,1,[Define if Fortran integer are the same size as C ints])
elif test "$SIZEOF_F77_INTEGER" != "$ac_cv_sizeof_int" ; then elif test "$SIZEOF_F77_INTEGER" != "$ac_cv_sizeof_int" ; then
# Make this fatal because we do not want to build a broken fortran # Make this fatal because we do not want to build a broken fortran
# interface # interface (was error)
AC_MSG_ERROR([Fortran integers and C ints are not the same size. The current Fortran binding does not support this case. Either force the Fortran compiler to use integers of $ac_cv_sizeof_int bytes, or use --disable-f77 on the configure line for MPICH2.]) AC_MSG_WARN([Fortran integers and C ints are not the same size. The current Fortran binding does not support this case. Either force the Fortran compiler to use integers of $ac_cv_sizeof_int bytes, or use --disable-f77 on the configure line for MPICH2.])
fi fi
# #
......
This diff is collapsed.
...@@ -5,17 +5,24 @@ ...@@ -5,17 +5,24 @@
*/ */
#include "mpichconf.h" #include "mpichconf.h"
/* Handle different mechanisms for passing Fortran CHARACTER to routines */ /* Handle different mechanisms for passing Fortran CHARACTER to routines.
*
* In the case where MPI_Fint is a different size from int, it appears that
* compilers use an int, rather than an MPI_Fint, for the length. However,
* there is no standard for this, so some compiler may choose to use
* an MPI_Fint instead of an int. In that case, we will need an additional
* case.
*/
#ifdef USE_FORT_MIXED_STR_LEN #ifdef USE_FORT_MIXED_STR_LEN
#define FORT_MIXED_LEN_DECL , MPI_Fint #define FORT_MIXED_LEN_DECL , int
#define FORT_END_LEN_DECL #define FORT_END_LEN_DECL
#define FORT_MIXED_LEN(a) , MPI_Fint a #define FORT_MIXED_LEN(a) , int a
#define FORT_END_LEN(a) #define FORT_END_LEN(a)
#else #else
#define FORT_MIXED_LEN_DECL #define FORT_MIXED_LEN_DECL
#define FORT_END_LEN_DECL , MPI_Fint #define FORT_END_LEN_DECL , int
#define FORT_MIXED_LEN(a) #define FORT_MIXED_LEN(a)
#define FORT_END_LEN(a) , MPI_Fint a #define FORT_END_LEN(a) , int a
#endif #endif
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
......
...@@ -2129,6 +2129,9 @@ extern void MPIR_Keyval_set_cxx( int, void (*)(void), void (*)(void) ); ...@@ -2129,6 +2129,9 @@ extern void MPIR_Keyval_set_cxx( int, void (*)(void), void (*)(void) );
extern void MPIR_Op_set_cxx( MPI_Op, void (*)(void) ); extern void MPIR_Op_set_cxx( MPI_Op, void (*)(void) );
extern void MPIR_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) ); extern void MPIR_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) );
#endif #endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
void MPIR_Op_set_fc( MPI_Op );
#endif
int MPIR_Group_create( int, MPID_Group ** ); int MPIR_Group_create( int, MPID_Group ** );
int MPIR_Group_release(MPID_Group *group_ptr); int MPIR_Group_release(MPID_Group *group_ptr);
......
...@@ -144,6 +144,9 @@ int MPIR_Allreduce_intra ( ...@@ -144,6 +144,9 @@ int MPIR_Allreduce_intra (
MPIU_THREADPRIV_DECL; MPIU_THREADPRIV_DECL;
#ifdef HAVE_CXX_BINDING #ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0; int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif #endif
MPIU_CHKLMEM_DECL(3); MPIU_CHKLMEM_DECL(3);
...@@ -284,8 +287,12 @@ int MPIR_Allreduce_intra ( ...@@ -284,8 +287,12 @@ int MPIR_Allreduce_intra (
#endif #endif
if ((op_ptr->language == MPID_LANG_C)) if ((op_ptr->language == MPID_LANG_C))
uop = (MPI_User_function *) op_ptr->function.c_function; uop = (MPI_User_function *) op_ptr->function.c_function;
else else {
uop = (MPI_User_function *) op_ptr->function.f77_function; uop = (MPI_User_function *) op_ptr->function.f77_function;
#ifndef HAVE_FINT_IS_INT
is_f77_uop = 1;
#endif
}
} }
/* need to allocate temporary buffer to store incoming data*/ /* need to allocate temporary buffer to store incoming data*/
......
...@@ -46,6 +46,20 @@ void MPIR_Op_set_cxx( MPI_Op op, void (*opcall)(void) ) ...@@ -46,6 +46,20 @@ void MPIR_Op_set_cxx( MPI_Op op, void (*opcall)(void) )
MPI_Datatype, MPI_User_function *))opcall; MPI_Datatype, MPI_User_function *))opcall;
} }
#endif #endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
/* Normally, the C and Fortran versions are the same, by design in the
MPI Standard. However, if MPI_Fint and int are not the same size (e.g.,
MPI_Fint was made 8 bytes but int is 4 bytes), then the C and Fortran
versions must be distinquished. */
void MPIR_Op_set_fc( MPI_Op op )
{
MPID_Op *op_ptr;
MPID_Op_get_ptr( op, op_ptr );
op_ptr->language = MPID_LANG_FORTRAN;
}
#endif
#endif #endif
#undef FUNCNAME #undef FUNCNAME
......
...@@ -53,6 +53,9 @@ static int MPIR_Reduce_binomial ( ...@@ -53,6 +53,9 @@ static int MPIR_Reduce_binomial (
MPI_Comm comm; MPI_Comm comm;
#ifdef HAVE_CXX_BINDING #ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0; int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif #endif
MPIU_CHKLMEM_DECL(2); MPIU_CHKLMEM_DECL(2);
MPIU_THREADPRIV_DECL; MPIU_THREADPRIV_DECL;
...@@ -93,8 +96,12 @@ static int MPIR_Reduce_binomial ( ...@@ -93,8 +96,12 @@ static int MPIR_Reduce_binomial (
#endif #endif
if ((op_ptr->language == MPID_LANG_C)) if ((op_ptr->language == MPID_LANG_C))
uop = (MPI_User_function *) op_ptr->function.c_function; uop = (MPI_User_function *) op_ptr->function.c_function;
else else {
uop = (MPI_User_function *) op_ptr->function.f77_function; uop = (MPI_User_function *) op_ptr->function.f77_function;
#ifndef HAVE_FINT_IS_INT
is_f77_uop = 1;
#endif
}
} }
/* I think this is the worse case, so we can avoid an assert() /* I think this is the worse case, so we can avoid an assert()
...@@ -185,9 +192,21 @@ static int MPIR_Reduce_binomial ( ...@@ -185,9 +192,21 @@ static int MPIR_Reduce_binomial (
(*MPIR_Process.cxx_call_op_fn)( tmp_buf, recvbuf, (*MPIR_Process.cxx_call_op_fn)( tmp_buf, recvbuf,
count, datatype, uop ); count, datatype, uop );
} }
else else {
#endif #endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
if (is_f77_uop) {
MPI_Fint lcount = (MPI_Fint)count;
MPI_Fint ldtype = (MPI_Fint)datatype;
(*uop)(tmp_buf, recvbuf, &lcount, &ldtype);
}
else {
(*uop)(tmp_buf, recvbuf, &count, &datatype);
}
#else
(*uop)(tmp_buf, recvbuf, &count, &datatype); (*uop)(tmp_buf, recvbuf, &count, &datatype);
#endif
}
} }
else { else {
#ifdef HAVE_CXX_BINDING #ifdef HAVE_CXX_BINDING
...@@ -195,9 +214,22 @@ static int MPIR_Reduce_binomial ( ...@@ -195,9 +214,22 @@ static int MPIR_Reduce_binomial (
(*MPIR_Process.cxx_call_op_fn)( recvbuf, tmp_buf, (*MPIR_Process.cxx_call_op_fn)( recvbuf, tmp_buf,
count, datatype, uop ); count, datatype, uop );
} }
else else {
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
if (is_f77_uop) {
/* In this case, the integer types do not match */
MPI_Fint lcount = (MPI_Fint)count;
MPI_Fint ldtype = (MPI_Fint)datatype;
(*uop)(recvbuf, tmp_buf, &lcount, &ldtype);
}
else {
(*uop)(recvbuf, tmp_buf, &count, &datatype);
}
#else
(*uop)(recvbuf, tmp_buf, &count, &datatype);
#endif #endif
(*uop)(recvbuf, tmp_buf, &count, &datatype); }
mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype, mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype,
recvbuf, count, datatype); recvbuf, count, datatype);
if (mpi_errno) { MPIU_ERR_POP(mpi_errno); } if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
......
...@@ -36,6 +36,9 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype ...@@ -36,6 +36,9 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
MPI_User_function *uop; MPI_User_function *uop;
#ifdef HAVE_CXX_BINDING #ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0; int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif #endif
MPIU_THREADPRIV_DECL; MPIU_THREADPRIV_DECL;
...@@ -59,10 +62,15 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype ...@@ -59,10 +62,15 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
else else
#endif #endif
{ {
if ((op_ptr->language == MPID_LANG_C)) if ((op_ptr->language == MPID_LANG_C)) {
uop = (MPI_User_function *) op_ptr->function.c_function; uop = (MPI_User_function *) op_ptr->function.c_function;
else }
else {
uop = (MPI_User_function *) op_ptr->function.f77_function; uop = (MPI_User_function *) op_ptr->function.f77_function;
#ifndef HAVE_FINT_IS_INT
is_f77_uop = 1;
#endif
}
} }
} }
...@@ -74,7 +82,18 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype ...@@ -74,7 +82,18 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
else else
#endif #endif
{ {
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
if (is_f77_uop) {
MPI_Fint lcount = (MPI_Fint)count;
MPI_Fint ldtype = (MPI_Fint)datatype;
(*uop)(inbuf, inoutbuf, &lcount, &ldtype);
}
else {
(*uop)(inbuf, inoutbuf, &count, &datatype);
}
#else
(*uop)(inbuf, inoutbuf, &count, &datatype); (*uop)(inbuf, inoutbuf, &count, &datatype);
#endif
} }
/* --BEGIN ERROR HANDLING-- */ /* --BEGIN ERROR HANDLING-- */
......
...@@ -1336,16 +1336,16 @@ int MPIR_Comm_delete_internal(MPID_Comm * comm_ptr, int isDisconnect) ...@@ -1336,16 +1336,16 @@ int MPIR_Comm_delete_internal(MPID_Comm * comm_ptr, int isDisconnect)
} }
} }
/* Check for predefined communicators - these should not
be freed */
if (! (HANDLE_GET_KIND(comm_ptr->handle) == HANDLE_KIND_BUILTIN) )
MPIU_Handle_obj_free( &MPID_Comm_mem, comm_ptr );
/* Remove from the list of active communicators if /* Remove from the list of active communicators if
we are supporting message-queue debugging. We make this we are supporting message-queue debugging. We make this
conditional on having debugger support since the conditional on having debugger support since the
operation is not constant-time */ operation is not constant-time */
MPIR_COMML_FORGET( comm_ptr ); MPIR_COMML_FORGET( comm_ptr );
/* Check for predefined communicators - these should not
be freed */
if (! (HANDLE_GET_KIND(comm_ptr->handle) == HANDLE_KIND_BUILTIN) )
MPIU_Handle_obj_free( &MPID_Comm_mem, comm_ptr );
} }
else { else {
/* If the user attribute free function returns an error, /* If the user attribute free function returns an error,
......
...@@ -139,8 +139,15 @@ int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode) ...@@ -139,8 +139,15 @@ int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
#ifdef HAVE_FORTRAN_BINDING #ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90: case MPID_LANG_FORTRAN90:
case MPID_LANG_FORTRAN: case MPID_LANG_FORTRAN:
{
/* If int and MPI_Fint aren't the same size, we need to
convert. As this is not performance critical, we
do this even if MPI_Fint and int are the same size. */
MPI_Fint ferr=errorcode;
MPI_Fint commhandle=comm_ptr->handle;
(*comm_ptr->errhandler->errfn.F77_Handler_function)( (*comm_ptr->errhandler->errfn.F77_Handler_function)(
(MPI_Fint *)&comm_ptr->handle, &errorcode ); &commhandle, &ferr );
}
break; break;
#endif #endif
} }
......
...@@ -138,6 +138,16 @@ void MPIR_Errhandler_set_cxx( MPI_Errhandler errhand, void (*errcall)(void) ) ...@@ -138,6 +138,16 @@ void MPIR_Errhandler_set_cxx( MPI_Errhandler errhand, void (*errcall)(void) )
} }
#endif /* HAVE_CXX_BINDING */ #endif /* HAVE_CXX_BINDING */
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
void MPIR_Errhandler_set_fc( MPI_Errhandler errhand )
{
MPID_Errhandler *errhand_ptr;
MPID_Errhandler_get_ptr( errhand, errhand_ptr );
errhand_ptr->language = MPID_LANG_FORTRAN;
}
#endif
/* ------------------------------------------------------------------------- */ /* ------------------------------------------------------------------------- */
/* These routines are called on error exit from most top-level MPI routines /* These routines are called on error exit from most top-level MPI routines
to invoke the appropriate error handler. Also included is the routine to invoke the appropriate error handler. Also included is the routine
...@@ -255,9 +265,15 @@ int MPIR_Err_return_comm( MPID_Comm *comm_ptr, const char fcname[], ...@@ -255,9 +265,15 @@ int MPIR_Err_return_comm( MPID_Comm *comm_ptr, const char fcname[],
#ifdef HAVE_FORTRAN_BINDING #ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90: case MPID_LANG_FORTRAN90:
case MPID_LANG_FORTRAN: case MPID_LANG_FORTRAN:
/* FIXME: If an MPI_Fint isn't an int, this code is wrong */ {
(*comm_ptr->errhandler->errfn.F77_Handler_function)( /* If int and MPI_Fint aren't the same size, we need to
(MPI_Fint *)&comm_ptr->handle, &errcode ); convert. As this is not performance critical, we
do this even if MPI_Fint and int are the same size. */
MPI_Fint ferr=errcode;
MPI_Fint commhandle=comm_ptr->handle;
(*comm_ptr->errhandler->errfn.F77_Handler_function)( &commhandle,
&ferr );
}
break; break;
#endif /* FORTRAN_BINDING */ #endif /* FORTRAN_BINDING */
} }
...@@ -326,8 +342,15 @@ int MPIR_Err_return_win( MPID_Win *win_ptr, const char fcname[], int errcode ) ...@@ -326,8 +342,15 @@ int MPIR_Err_return_win( MPID_Win *win_ptr, const char fcname[], int errcode )
#ifdef HAVE_FORTRAN_BINDING #ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90: case MPID_LANG_FORTRAN90:
case MPID_LANG_FORTRAN: case MPID_LANG_FORTRAN:
(*win_ptr->errhandler->errfn.F77_Handler_function)( {
(MPI_Fint *)&win_ptr->handle, &errcode ); /* If int and MPI_Fint aren't the same size, we need to
convert. As this is not performance critical, we
do this even if MPI_Fint and int are the same size. */
MPI_Fint ferr=errcode;
MPI_Fint winhandle=win_ptr->handle;
(*win_ptr->errhandler->errfn.F77_Handler_function)(
&winhandle, &ferr );
}
break; break;
#endif /* FORTRAN_BINDING */ #endif /* FORTRAN_BINDING */
} }
......
...@@ -113,7 +113,9 @@ int MPI_File_call_errhandler(MPI_File fh, int errorcode) ...@@ -113,7 +113,9 @@ int MPI_File_call_errhandler(MPI_File fh, int errorcode)
the value is really const (but MPI didn't define error handlers the value is really const (but MPI didn't define error handlers
with const), this preserves the intent */ with const), this preserves the intent */
{ void *fh1 = (void *)&fh; { void *fh1 = (void *)&fh;
(*e->errfn.F77_Handler_function)( fh1, &errorcode ); MPI_Fint ferr = errorcode; /* Needed if MPI_Fint and int aren't
the same size */
(*e->errfn.F77_Handler_function)( fh1, &ferr );
} }
break; break;
#endif #endif
......
...@@ -134,8 +134,14 @@ int MPI_Win_call_errhandler(MPI_Win win, int errorcode) ...@@ -134,8 +134,14 @@ int MPI_Win_call_errhandler(MPI_Win win, int errorcode)
#ifdef HAVE_FORTRAN_BINDING #ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90: case MPID_LANG_FORTRAN90:
case MPID_LANG_FORTRAN: case MPID_LANG_FORTRAN:
(*win_ptr->errhandler->errfn.F77_Handler_function)( {
(MPI_Fint *)&win_ptr->handle, &errorcode ); /* If int and MPI_Fint aren't the same size, we need to
convert. As this is not performance critical, we
do this even if MPI_Fint and int are the same size. */
MPI_Fint ferr=errorcode;
MPI_Fint winhandle=win_ptr->handle;
(*win_ptr->errhandler->errfn.F77_Handler_function)( &winhandle, &ferr );
}
break; break;
#endif #endif
} }
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment