Add top-level interface functions for the MPI_OP* calls

This commit was SVN r1066.

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;
 }

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");
 }

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];
 }

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;
 }

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