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
"$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])
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
if test "$MPI_FINT" = "int" ; then
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
# Make this fatal because we do not want to build a broken fortran
# interface
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.])
# interface (was error)
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
#
......
This diff is collapsed.
......@@ -5,17 +5,24 @@
*/
#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
#define FORT_MIXED_LEN_DECL , MPI_Fint
#define FORT_MIXED_LEN_DECL , int
#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)
#else
#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_END_LEN(a) , MPI_Fint a
#define FORT_END_LEN(a) , int a
#endif
/* ------------------------------------------------------------------------- */
......
......@@ -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_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) );
#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_release(MPID_Group *group_ptr);
......
......@@ -144,6 +144,9 @@ int MPIR_Allreduce_intra (
MPIU_THREADPRIV_DECL;
#ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif
MPIU_CHKLMEM_DECL(3);
......@@ -284,8 +287,12 @@ int MPIR_Allreduce_intra (
#endif
if ((op_ptr->language == MPID_LANG_C))
uop = (MPI_User_function *) op_ptr->function.c_function;
else
else {
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*/
......
......@@ -46,6 +46,20 @@ void MPIR_Op_set_cxx( MPI_Op op, void (*opcall)(void) )
MPI_Datatype, MPI_User_function *))opcall;
}
#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
#undef FUNCNAME
......
......@@ -53,6 +53,9 @@ static int MPIR_Reduce_binomial (
MPI_Comm comm;
#ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif
MPIU_CHKLMEM_DECL(2);
MPIU_THREADPRIV_DECL;
......@@ -93,8 +96,12 @@ static int MPIR_Reduce_binomial (
#endif
if ((op_ptr->language == MPID_LANG_C))
uop = (MPI_User_function *) op_ptr->function.c_function;
else
else {
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()
......@@ -185,19 +192,44 @@ static int MPIR_Reduce_binomial (
(*MPIR_Process.cxx_call_op_fn)( tmp_buf, recvbuf,
count, datatype, uop );
}
else
else {
#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);
#endif
}
}
else {
#ifdef HAVE_CXX_BINDING
if (is_cxx_uop) {
(*MPIR_Process.cxx_call_op_fn)( recvbuf, tmp_buf,
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
}
mpi_errno = MPIR_Localcopy(tmp_buf, count, datatype,
recvbuf, count, datatype);
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
MPI_User_function *uop;
#ifdef HAVE_CXX_BINDING
int is_cxx_uop = 0;
#endif
#if defined(HAVE_FORTRAN_BINDING) && !defined(HAVE_FINT_IS_INT)
int is_f77_uop = 0;
#endif
MPIU_THREADPRIV_DECL;
......@@ -59,10 +62,15 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
else
#endif
{
if ((op_ptr->language == MPID_LANG_C))
if ((op_ptr->language == MPID_LANG_C)) {
uop = (MPI_User_function *) op_ptr->function.c_function;
else
}
else {
uop = (MPI_User_function *) op_ptr->function.f77_function;
#ifndef HAVE_FINT_IS_INT
is_f77_uop = 1;
#endif
}
}
}
......@@ -74,8 +82,19 @@ int MPIR_Reduce_local_impl(void *inbuf, void *inoutbuf, int count, MPI_Datatype
else
#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);
#endif
}
/* --BEGIN ERROR HANDLING-- */
if (MPIU_THREADPRIV_FIELD(op_errno))
......
......@@ -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
we are supporting message-queue debugging. We make this
conditional on having debugger support since the
operation is not constant-time */
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 {
/* If the user attribute free function returns an error,
......
......@@ -139,8 +139,15 @@ int MPI_Comm_call_errhandler(MPI_Comm comm, int errorcode)
#ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90:
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)(
(MPI_Fint *)&comm_ptr->handle, &errorcode );
&commhandle, &ferr );
}
break;
#endif
}
......
......@@ -138,6 +138,16 @@ void MPIR_Errhandler_set_cxx( MPI_Errhandler errhand, void (*errcall)(void) )
}
#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
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[],
#ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90:
case MPID_LANG_FORTRAN:
/* FIXME: If an MPI_Fint isn't an int, this code is wrong */
(*comm_ptr->errhandler->errfn.F77_Handler_function)(
(MPI_Fint *)&comm_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 commhandle=comm_ptr->handle;
(*comm_ptr->errhandler->errfn.F77_Handler_function)( &commhandle,
&ferr );
}
break;
#endif /* FORTRAN_BINDING */
}
......@@ -326,8 +342,15 @@ int MPIR_Err_return_win( MPID_Win *win_ptr, const char fcname[], int errcode )
#ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90:
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=errcode;
MPI_Fint winhandle=win_ptr->handle;
(*win_ptr->errhandler->errfn.F77_Handler_function)(
(MPI_Fint *)&win_ptr->handle, &errcode );
&winhandle, &ferr );
}
break;
#endif /* FORTRAN_BINDING */
}
......
......@@ -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
with const), this preserves the intent */
{ 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;
#endif
......
......@@ -134,8 +134,14 @@ int MPI_Win_call_errhandler(MPI_Win win, int errorcode)
#ifdef HAVE_FORTRAN_BINDING
case MPID_LANG_FORTRAN90:
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;
#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