Some more errhandler stuff, including updated invocation macros in

errhandler/errhandler.h.

This commit was SVN r944.

src/errhandler/errhandler.c

@@ -1,4 +1,5 @@
-/*
+/* -*- Mode: C; c-basic-offset:4 ;
+ *
  * $HEADER$
  */
 
@@ -39,7 +40,7 @@ lam_errhandler_t lam_mpi_errhandler_null = {
 
     "MPI_ERRHANDLER_NULL",
     false,
-    LAM_ERRHANDLER_COMM,
+    LAM_ERRHANDLER_TYPE_COMM,
     { NULL }
 };
 
@@ -52,7 +53,7 @@ lam_errhandler_t lam_mpi_errors_are_fatal = {
 
     "MPI_ERRORS_ARE_FATAL",
     false,
-    LAM_ERRHANDLER_COMM,
+    LAM_ERRHANDLER_TYPE_COMM,
     { lam_mpi_errors_are_fatal_handler },
     -1
 };
@@ -66,43 +67,12 @@ lam_errhandler_t lam_mpi_errors_return = {
 
     "MPI_ERRORS_ARE_RETURN",
     false,
-    LAM_ERRHANDLER_COMM,
+    LAM_ERRHANDLER_TYPE_COMM,
     { lam_mpi_errors_return_handler },
     -1
 };
 
 
-/**
- * Errhandler constructor
- */
-static void lam_errhandler_construct(lam_errhandler_t *new_errhandler)
-{
-  int ret_val;
-
-  /* assign entry in fortran <-> c translation array */
-
-  ret_val = lam_pointer_array_add(lam_errhandler_f_to_c_table, 
-                                  new_errhandler);
-  new_errhandler->eh_f_to_c_index = ret_val;
-}
-
-
-/**
- * Errhandler destructor
- */
-static void lam_errhandler_destruct(lam_errhandler_t *errhandler)
-{
-  /* reset the lam_errhandler_f_to_c_table entry - make sure that the
-     entry is in the table */
-
-  if (NULL!= lam_pointer_array_get_item(lam_errhandler_f_to_c_table,
-                                        errhandler->eh_f_to_c_index)) {
-    lam_pointer_array_set_item(lam_errhandler_f_to_c_table,
-                               errhandler->eh_f_to_c_index, NULL);
-  }
-}
-
-
 /*
  * Initialize LAM errhandler infrastructure
  */
@@ -182,3 +152,76 @@ int lam_errhandler_finalize(void)
 
   return LAM_SUCCESS;
 };
+
+
+lam_errhandler_t *lam_errhandler_create(lam_errhandler_type_t object_type,
+                                        lam_errhandler_fortran_handler_fn_t *func)
+{
+  lam_errhandler_t *new_errhandler;
+
+  /* Create a new object and ensure that it's valid */
+
+  new_errhandler = OBJ_NEW(lam_errhandler_t);
+  if (NULL == new_errhandler) {
+    if (LAM_ERROR == new_errhandler->eh_f_to_c_index) {
+      OBJ_RELEASE(new_errhandler);
+      new_errhandler = NULL;
+    } else {
+
+      /* The new object is valid -- initialize it.  If this is being
+         created from fortran, the fortran MPI API wrapper function
+         will override the eh_fortran_field directly.  We cast the
+         function pointer type to the fortran type arbitrarily -- it
+         only has to be a function pointer in order to store properly,
+         it doesn't matter what type it is (we'll cast it to the Right
+         type when we *use* it). */
+
+      new_errhandler->eh_mpi_object_type = object_type;
+      new_errhandler->eh_fortran_function = false;
+      new_errhandler->eh_func.fort_fn = func;
+    }
+  }
+
+
+  /* All done */
+  return LAM_SUCCESS;
+}
+
+
+/**************************************************************************
+ *
+ * Static functions
+ *
+ **************************************************************************/
+
+/**
+ * Errhandler constructor
+ */
+static void lam_errhandler_construct(lam_errhandler_t *new_errhandler)
+{
+  int ret_val;
+
+  /* assign entry in fortran <-> c translation array */
+
+  ret_val = lam_pointer_array_add(lam_errhandler_f_to_c_table, 
+                                  new_errhandler);
+  new_errhandler->eh_f_to_c_index = ret_val;
+}
+
+
+/**
+ * Errhandler destructor
+ */
+static void lam_errhandler_destruct(lam_errhandler_t *errhandler)
+{
+  /* reset the lam_errhandler_f_to_c_table entry - make sure that the
+     entry is in the table */
+
+  if (NULL!= lam_pointer_array_get_item(lam_errhandler_f_to_c_table,
+                                        errhandler->eh_f_to_c_index)) {
+    lam_pointer_array_set_item(lam_errhandler_f_to_c_table,
+                               errhandler->eh_f_to_c_index, NULL);
+  }
+}
+
+

src/errhandler/errhandler.h

@@ -30,9 +30,9 @@ typedef void (lam_errhandler_fortran_handler_fn_t)(int *, int *, ...);
  * Enum used to describe what kind MPI object an error handler is used for
  */
 enum lam_errhandler_type_t {
-    LAM_ERRHANDLER_COMM,
-    LAM_ERRHANDLER_WIN,
-    LAM_ERRHANDLER_FILE
+    LAM_ERRHANDLER_TYPE_COMM,
+    LAM_ERRHANDLER_TYPE_WIN,
+    LAM_ERRHANDLER_TYPE_FILE
 };
 typedef enum lam_errhandler_type_t lam_errhandler_type_t;
 
@@ -70,6 +70,23 @@ struct lam_errhandler_t {
 typedef struct lam_errhandler_t lam_errhandler_t;
 
 
+/**
+ * Global variable for MPI_ERRHANDLER_NULL
+ */
+extern lam_errhandler_t lam_mpi_errhandler_null;
+
+/**
+ * Global variable for MPI_ERRORS_ARE_FATAL
+ */
+extern lam_errhandler_t lam_mpi_errors_are_fatal;
+
+/**
+ * Global variable for MPI_ERRORS_RETURN
+ */
+extern lam_errhandler_t lam_mpi_errors_return;
+
+
+
 /**
  * This is the macro to invoke to directly invoke an MPI error
  * handler.
@@ -83,9 +100,9 @@ typedef struct lam_errhandler_t lam_errhandler_t;
  * This macro is used when you want to directly invoke the error
  * handler.  It is exactly equivalent to calling
  * lam_errhandler_invoke() directly, but is provided to have a
- * parallel invocation to LAM_ERRHDL_CHECK() and LAM_ERRHDL_RETURN().
+ * parallel invocation to LAM_ERRHANDLER_CHECK() and LAM_ERRHANDLER_RETURN().
  */
-#define LAM_ERRHDL_INVOKE(mpi_object, err_code, message) \
+#define LAM_ERRHANDLER_INVOKE(mpi_object, err_code, message) \
   lam_errhandler_invoke((mpi_object)->error_handler, (mpi_object), \
                         (err_code), (message));
 
@@ -103,10 +120,11 @@ typedef struct lam_errhandler_t lam_errhandler_t;
  * This macro will invoke the error handler if the return code is not
  * LAM_SUCCESS.
  */
-#define LAM_ERRHDL_CHECK(rc, mpi_object, err_code, message) \
+#define LAM_ERRHANDLER_CHECK(rc, mpi_object, err_code, message) \
   if (rc != LAM_SUCCESS) { \
-    lam_errhandler_invoke((errhandler), (mpi_object)->error_handler, \
-                          (mpi_object), (err_code), (message)); \
+    lam_errhandler_invoke((mpi_object)->error_handler, (mpi_object), \
+                          (err_code), (message)); \
+    return (err_code); \
   }
 
 /**
@@ -125,10 +143,11 @@ typedef struct lam_errhandler_t lam_errhandler_t;
  * LAM_SUCCESS.  If the return code is LAM_SUCCESS, then return
  * MPI_SUCCESS.
  */
-#define LAM_ERRHDL_RETURN(rc, mpi_object, err_code, message) \
+#define LAM_ERRHANDLER_RETURN(rc, mpi_object, err_code, message) \
   if (rc != LAM_SUCCESS) { \
-    lam_errhandler_invoke((errhandler), (mpi_object)->error_handler, \
-                          (mpi_object), (err_code), (message)); \
+    lam_errhandler_invoke((mpi_object)->error_handler, (mpi_object), \
+                          (err_code), (message)); \
+    return (err_code); \
   } else { \
     return MPI_SUCCESS; \
   }
@@ -159,8 +178,8 @@ extern "C" {
    * \internal
    *
    * This function should not be invoked directly; it should only be
-   * invoked by LAM_ERRHDL_INVOKE(), LAM_ERRHDL_CHECK(), or
-   * LAM_ERRHDL_RETURN().
+   * invoked by LAM_ERRHANDLER_INVOKE(), LAM_ERRHANDLER_CHECK(), or
+   * LAM_ERRHANDLER_RETURN().
    *
    * @param errhandler The MPI_Errhandler to invoke
    * @param mpi_object The MPI object to invoke the errhandler on (a
@@ -179,11 +198,18 @@ extern "C" {
 
 
   /**
+   * Create a lam_errhandler_t
+   *
+   * @param mpi_object The object that the errhandler should be cached on
+   * @param object_type Enum of the type of MPI object
+   * @param func Function pointer of the error handler
+   * @param errhandler Pointer to the lam_errorhandler_t that will be
+   *   created and returned
+   *
+   * This function will.... JMS continue here
    */
-  int lam_errhandler_create(void *mpi_object, 
-                            lam_errhandler_type_t object_type,
-                            lam_errhandler_fortran_handler_fn_t *func,
-                            lam_errhandler_t **errhandler);
+  lam_errhandler_t *lam_errhandler_create(lam_errhandler_type_t object_type,
+                                          lam_errhandler_fortran_handler_fn_t *func);
 #if defined(c_plusplus) || defined(__cplusplus)
 }
 #endif

src/errhandler/errhandler_invoke.c

@@ -22,7 +22,7 @@ int lam_errhandler_invoke(lam_errhandler_t *errhandler, void *mpi_object,
      fortran or C, and then invoke it */
 
   switch (errhandler->eh_mpi_object_type) {
-  case LAM_ERRHANDLER_COMM:
+  case LAM_ERRHANDLER_TYPE_COMM:
     comm = (lam_communicator_t *) mpi_object;
     if (errhandler->eh_fortran_function) {
       fortran_handle = comm->c_f_to_c_index;
@@ -32,7 +32,7 @@ int lam_errhandler_invoke(lam_errhandler_t *errhandler, void *mpi_object,
     }
     break;
 
-  case LAM_ERRHANDLER_WIN:
+  case LAM_ERRHANDLER_TYPE_WIN:
     win = (lam_win_t *) mpi_object;
     if (errhandler->eh_fortran_function) {
       fortran_handle = win->w_f_to_c_index;
@@ -42,7 +42,7 @@ int lam_errhandler_invoke(lam_errhandler_t *errhandler, void *mpi_object,
     }
     break;
 
-  case LAM_ERRHANDLER_FILE:
+  case LAM_ERRHANDLER_TYPE_FILE:
     file = (lam_file_t *) mpi_object;
     if (errhandler->eh_fortran_function) {
       fortran_handle = file->f_f_to_c_index;

src/mpi/c/comm_create_errhandler.c

@@ -17,19 +17,26 @@
 int MPI_Comm_create_errhandler(MPI_Comm_errhandler_fn *function,
                                MPI_Errhandler *errhandler) 
 {
+  int err = MPI_SUCCESS;
+
   /* Error checking */
 
   if (MPI_PARAM_CHECK) {
     if (NULL == function || 
         NULL == errhandler) {
-      return LAM_ERRHDL_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-                               "MPI_Errhandler_get");
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Comm_create_errhandler");
     }
   }
 
-  /* JMS Continue here */
+  /* Create and cache the errhandler */
 
-  /* All done */
+  *errhandler = 
+    lam_errhandler_create(LAM_ERRHANDLER_TYPE_COMM,
+                          (lam_errhandler_fortran_handler_fn_t*) function);
+  if (NULL == *errhandler)
+    err = MPI_ERR_INTERN;
 
-  return MPI_SUCCESS;
+  LAM_ERRHANDLER_RETURN(err, MPI_COMM_WORLD, MPI_ERR_INTERN,
+                        "MPI_Comm_create_errhandler");
 }

src/mpi/c/comm_get_errhandler.c

@@ -6,11 +6,34 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Comm_get_errhandler = PMPI_Comm_get_errhandler
 #endif
 
-int MPI_Comm_get_errhandler(MPI_Comm comm, MPI_Errhandler *erhandler) {
+
+int MPI_Comm_get_errhandler(MPI_Comm comm, MPI_Errhandler *errhandler)
+{
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == comm || 
+        MPI_COMM_NULL == comm) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Comm_set_errhandler");
+    } else if (NULL == errhandler) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Comm_create_errhandler");
+    }
+  }
+
+  /* Return the errhandler */
+
+  *errhandler = comm->error_handler;
+
+  /* All done */
+
   return MPI_SUCCESS;
 }

src/mpi/c/comm_set_errhandler.c

@@ -6,11 +6,34 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Comm_set_errhandler = PMPI_Comm_set_errhandler
 #endif
 
-int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler) {
+
+int MPI_Comm_set_errhandler(MPI_Comm comm, MPI_Errhandler errhandler) 
+{
+  /* Error checking */
+
+  if (MPI_PARAM_CHECK) {
+    if (NULL == comm || 
+        MPI_COMM_NULL == comm) {
+      return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                   "MPI_Comm_set_errhandler");
+    } else if (NULL == errhandler ||
+               MPI_ERRHANDLER_NULL == errhandler ||
+               LAM_ERRHANDLER_TYPE_COMM != errhandler->eh_mpi_object_type) {
+      return LAM_ERRHANDLER_INVOKE(comm, MPI_ERR_ARG,
+                               "MPI_Comm_set_errhandler");
+    }
+  }
+
+  /* We have a valid comm and errhandler */
+
+  comm->error_handler = errhandler;
+  
   return MPI_SUCCESS;
 }

src/mpi/c/errhandler_free.c

@@ -11,6 +11,8 @@
 #pragma weak MPI_Errhandler_free = PMPI_Errhandler_free
 #endif
 
-int MPI_Errhandler_free(MPI_Errhandler *errhandler) {
+
+int MPI_Errhandler_free(MPI_Errhandler *errhandler)
+{
   return MPI_SUCCESS;
 }

src/mpi/c/errhandler_get.c

@@ -6,8 +6,6 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
-#include "errhandler/errhandler.h"
-#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Errhandler_get = PMPI_Errhandler_get
@@ -16,23 +14,8 @@
 
 int MPI_Errhandler_get(MPI_Comm comm, MPI_Errhandler *errhandler) 
 {
-  /* Error checking */
+  /* This is a deprecated -- just turn around and call the real
+     function */
 
-  if (MPI_PARAM_CHECK) {
-    if (MPI_COMM_NULL == comm) {
-      return LAM_ERRHDL_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, 
-                               "MPI_Errhandler_get");
-    } else if (NULL == errhandler) {
-      return LAM_ERRHDL_INVOKE(comm, MPI_ERR_ARG, "MPI_Errhandler_get");
-    }
-  }
-
-  /* This is the backwards compatability function for communicator
-     errorhandlers */
-
-  *errhandler = comm->error_handler;
-
-  /* All done */
-
-  return MPI_SUCCESS;
+  return MPI_Comm_get_errhandler(comm, errhandler);
 }

src/mpi/c/errhandler_set.c

@@ -11,6 +11,11 @@
 #pragma weak MPI_Errhandler_set = PMPI_Errhandler_set
 #endif
 
-int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler errhandler) {
-    return MPI_SUCCESS;
+
+int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler errhandler)
+{
+  /* This is a deprecated -- just turn around and call the real
+     function */
+
+  return MPI_Comm_set_errhandler(comm, errhandler);
 }