diff --git a/src/mpi/c/op_c2f.c b/src/mpi/c/op_c2f.c index 6891581e7c..a29fb769a9 100644 --- a/src/mpi/c/op_c2f.c +++ b/src/mpi/c/op_c2f.c @@ -6,6 +6,9 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "op/op.h" +#include "errhandler/errhandler.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Op_c2f = PMPI_Op_c2f @@ -15,6 +18,19 @@ #include "mpi/c/profile/defines.h" #endif -MPI_Fint MPI_Op_c2f(MPI_Op op) { - return (MPI_Fint)0; +MPI_Fint MPI_Op_c2f(MPI_Op op) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (NULL == op || + MPI_OP_NULL == op) { + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, + "MPI_Op_c2f"); + } + } + + /* All done */ + + return (MPI_Fint) op->o_f_to_c_index; } diff --git a/src/mpi/c/op_create.c b/src/mpi/c/op_create.c index 15cc71f003..6b2fbf1745 100644 --- a/src/mpi/c/op_create.c +++ b/src/mpi/c/op_create.c @@ -6,6 +6,9 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "op/op.h" +#include "errhandler/errhandler.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Op_create = PMPI_Op_create @@ -16,6 +19,27 @@ #endif int MPI_Op_create(MPI_User_function *function, int commute, - MPI_Op *op) { - return MPI_SUCCESS; + MPI_Op *op) +{ + int err = MPI_SUCCESS; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (NULL == function || + NULL == op) { + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, + "MPI_Comm_create_op"); + } + } + + /* Create and cache the op. Sets a refcount of 1. */ + + *op = lam_op_create((bool) commute, (lam_op_fortran_handler_fn_t*) function); + if (NULL == *op) { + err = MPI_ERR_INTERN; + } + + LAM_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, MPI_ERR_INTERN, + "MPI_Comm_create_op"); } diff --git a/src/mpi/c/op_f2c.c b/src/mpi/c/op_f2c.c index 4be902f2aa..907c8ae1ad 100644 --- a/src/mpi/c/op_f2c.c +++ b/src/mpi/c/op_f2c.c @@ -6,6 +6,9 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "op/op.h" +#include "errhandler/errhandler.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Op_f2c = PMPI_Op_f2c @@ -15,6 +18,20 @@ #include "mpi/c/profile/defines.h" #endif -MPI_Op MPI_Op_f2c(MPI_Fint op) { - return (MPI_Op)0; +MPI_Op MPI_Op_f2c(MPI_Fint op_f) +{ + size_t o_index = (size_t) op_f; + + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (0 > o_index || + o_index >= lam_pointer_array_get_size(lam_op_f_to_c_table)) { + return MPI_OP_NULL; + } + } + + /* All done */ + + return lam_op_f_to_c_table->addr[o_index]; } diff --git a/src/mpi/c/op_free.c b/src/mpi/c/op_free.c index 64afdc914e..33db608f7e 100644 --- a/src/mpi/c/op_free.c +++ b/src/mpi/c/op_free.c @@ -6,6 +6,9 @@ #include "mpi.h" #include "mpi/c/bindings.h" +#include "op/op.h" +#include "errhandler/errhandler.h" +#include "communicator/communicator.h" #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES #pragma weak MPI_Op_free = PMPI_Op_free @@ -15,6 +18,24 @@ #include "mpi/c/profile/defines.h" #endif -int MPI_Op_free(MPI_Op *op) { - return MPI_SUCCESS; +int MPI_Op_free(MPI_Op *op) +{ + /* Error checking */ + + if (MPI_PARAM_CHECK) { + if (NULL == op || + lam_op_is_intrinsic(*op)) { + return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, + "MPI_Op_free"); + } + } + + /* We have a valid op, release it */ + + OBJ_RELEASE(*op); + *op = MPI_OP_NULL; + + /* All done */ + + return MPI_SUCCESS; } diff --git a/src/mpi/checklist.txt b/src/mpi/checklist.txt index 5fafcf5b85..70c3844e36 100644 --- a/src/mpi/checklist.txt +++ b/src/mpi/checklist.txt @@ -204,11 +204,11 @@ MPI_Is_thread_main MPI_Keyval_create MPI_Keyval_free MPI_Lookup_name -MPI_Op_c2f -MPI_Op_create +MPI_Op_c2f DONE +MPI_Op_create DONE MPI_Open_port -MPI_Op_f2c -MPI_Op_free +MPI_Op_f2c DONE +MPI_Op_free DONE MPI_Pack_external George MPI_Pack_external_size George MPI_Pack George