Changing the MPI_Info and lam_info functions to incorporate both error handlers and the fortran to C translation table

This commit was SVN r1057.

src/info/info.c

@@ -24,14 +24,40 @@ lam_class_t lam_info_entry_t_class = {
     (lam_destruct_t)lam_info_entry_destruct
 };
 
+/**
+ * The global fortran <-> C translation table
+ */
+lam_pointer_array_t *lam_info_f_to_c_table;
+
 /*
  * lam_info_t interface functions
+ * @param info lam_info_t pointer
+ *
+ * This function is invoked when OBJ_NEW() is called. Here, we add this
+ * info pointer to the table and then store its index as the handle
  */
 void lam_info_construct(lam_info_t *info) {
-    info->i_fhandle = -1;
+    info->i_fhandle = lam_pointer_array_add(lam_info_f_to_c_table, info);
+    return;
 }
 
+/**
+ * lam_info_t interface function
+ * @param info lam_info_t pointer
+ *
+ * This function is called during OBJ_DESTRUCT of "info". When this 
+ * done, we need to remove the entry from the lam fortran to C 
+ * translation table
+ */ 
 void lam_info_destruct(lam_info_t *info) {
+    /* 
+     * reset the lam_info_f_to_c_table entry - make sure that the
+     * entry is in the table 
+     */
+    if (NULL != lam_pointer_array_get_item(lam_info_f_to_c_table, info->i_fhandle)){
+        lam_pointer_array_set_item(lam_info_f_to_c_table, info->i_fhandle, NULL);
+    }
+    return;
 }
 
 /*
@@ -147,10 +173,7 @@ int lam_info_free (lam_info_t **info) {
           trailer_iterator = (lam_info_entry_t *)lam_list_get_prev(iterator);
           OBJ_RELEASE(trailer_iterator);
      }
-     /*
+
-      * Anju:
-      * Add things to remove the fortran handle from the mapping table
-      */
      OBJ_RELEASE(*info);
      *info = MPI_INFO_NULL;
      return MPI_SUCCESS;
@@ -266,3 +289,29 @@ int lam_info_get_valuelen (lam_info_t *info, char *key, int *valuelen,
     return MPI_SUCCESS;
 }
 
+/**
+ * function: lam_info_init
+ *
+ * This function is called during lam_init and initializes the fortran to C
+ * translation table
+ */ 
+int lam_info_init(void) {
+    /* initialize table */
+    lam_info_f_to_c_table = OBJ_NEW(lam_pointer_array_t);
+    if (NULL == lam_info_f_to_c_table) {
+        return LAM_ERROR;
+    }
+    return LAM_SUCCESS;
+}
+
+/**
+ * function: lam_info_finalize
+ *
+ * This functions is called during MPI Finalize
+ */
+int lam_info_finalize(void) {
+    /* finalize */
+    OBJ_RELEASE(lam_info_f_to_c_table);
+    return LAM_SUCCESS;
+}
+

src/info/info.h

@@ -10,6 +10,7 @@
 #include "mpi.h"
 #include "util/strncpy.h"
 #include "lfc/lam_list.h"
+#include "lfc/lam_pointer_array.h"
 #include "include/lam.h"
 
 
@@ -37,6 +38,11 @@ struct lam_info_entry_t {
 };
 typedef struct lam_info_entry_t lam_info_entry_t;
 
+/**
+ * Table for Fortran <-> C translation table
+ */ 
+extern lam_pointer_array_t *lam_info_f_to_c_table;
+
 /**
  * Some declarations needed to use OBJ_NEW and OBJ_DESTRUCT macros
  */
@@ -46,6 +52,8 @@ extern lam_class_t lam_info_entry_t_class;
 #if defined(c_plusplus) || defined(__cplusplus)
 extern "C" {
 #endif
+int lam_info_init(void);
+int lam_info_finalize(void);
 void lam_info_construct(lam_info_t *info);
 void lam_info_destruct(lam_info_t *info);
 

src/mpi/c/info_c2f.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_c2f = PMPI_Info_c2f
@@ -27,5 +29,14 @@
  * fortran handle to the same MPI_INFO object.
  */
 MPI_Fint MPI_Info_c2f(MPI_Info info) {
-    return (MPI_Fint)0;
+
+    /* check the arguments */
+    if (MPI_PARAM_CHECK) {
+        if (NULL == info) {
+            return (MPI_Fint) LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, 
+                    "MPI_Info_c2f");
+        }
+    }
+    /* return the index */
+    return (MPI_Fint)(info->i_fhandle);
 }

src/mpi/c/info_create.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_create = PMPI_Info_create
@@ -36,21 +38,24 @@ int MPI_Info_create(MPI_Info *info) {
      * NOTE:
      * Yet to add stuff for fortran handles
      */
+    if (MPI_PARAM_CHECK) {
         if (NULL == info) {
-        printf ("Info handle passed is invalid\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-        return MPI_ERR_ARG;
+                                         "MPI_Info_create");
+        }
     }
 
     /*
      * Call the object create function. This function not only
      * allocates the space for MPI_Info, but also calls all the
-     * relevant init functions.
+     * relevant init functions. Should I check if the fortran 
+     * handle is valid
      */
     (*info) = OBJ_NEW(lam_info_t);
     
     if (NULL == (*info)) {
-        printf ("Malloc failed. Ran out of resources\n");
+        return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_SYSRESOURCE,
-        return MPI_ERR_SYSRESOURCE;
+                                     "MPI_Info_create");
     }
 
     return MPI_SUCCESS;

src/mpi/c/info_delete.c

@@ -10,6 +10,8 @@
 #include "info/info.h"
 #include <stdlib.h>
 #include <string.h>
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_delete = PMPI_Info_delete
@@ -36,22 +38,24 @@ int MPI_Info_delete(MPI_Info info, char *key) {
     /**
      * This function merely deletes the (key,val) pair in info
      */
-    if (NULL == info){
+    if (MPI_PARAM_CHECK) {
-        printf ("Invalid MPI_Info handle passed\n");
+        if (NULL == info || NULL == key){
-        return MPI_ERR_ARG;
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                         "MPI_Info_delete");
+        }
     }
 
     key_length = (key) ? strlen (key) : 0;
     if ( (0 == key_length) || (MPI_MAX_INFO_KEY <= key_length)) {
-        printf ("The key passed to MPI_INFO_SET is too long\n");
+        return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
-        return MPI_ERR_INFO_KEY;
+                                     "MPI_Info_delete");
     }
 
     err = lam_info_delete (info, key);
 
     if (MPI_ERR_INFO_NOKEY == err) {
-        printf ("Invalid Key given\n");
+        return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_NOKEY,
-        return err;
+                                     "MPI_Info_delete");
     }
     return err;
 }

src/mpi/c/info_dup.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_dup = PMPI_Info_dup
@@ -44,24 +46,25 @@ int MPI_Info_dup(MPI_Info info, MPI_Info *newinfo) {
      * and copy them to newinfo one by one
      */
 
+    if (MPI_PARAM_CHECK) {
         if (NULL == info){
-        printf ("Invalid MPI_Info handle passed\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-        return MPI_ERR_ARG;
+                                         "MPI_Info_dup");
+        }
     }
 
     err = MPI_Info_create(newinfo);
     if (MPI_SUCCESS != err) {
-        printf ("Creation of newinfo falied\n");
+        return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, err,
-        return err;
+                                     "MPI_Info_dup");
     }
     /*
      * Now to actually duplicate all the values
      */
     err = lam_info_dup (info, newinfo);
-
     if (err == MPI_ERR_SYSRESOURCE) {
-        printf ("Resources are not sufficient to finish dup'ing\n");
+        return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, err,
-        return err;
+                                     "MPI_Info_dup");
     }  
         
     return MPI_SUCCESS;

src/mpi/c/info_f2c.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_f2c = PMPI_Info_f2c
@@ -24,5 +26,12 @@
  * @retval C handle corresponding to MPI_INFOO object
  */
 MPI_Info MPI_Info_f2c(MPI_Fint info) {
-    return (MPI_Info)0;
+    /* check the arguments */
+    if (MPI_PARAM_CHECK) {
+        if (0 > info || info >= lam_pointer_array_get_size(lam_info_f_to_c_table)) {
+            return MPI_INFO_NULL;
+        }
+    }
+    /* return the index */ 
+    return lam_info_f_to_c_table->addr[info];
 }

src/mpi/c/info_free.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_free = PMPI_Info_free
@@ -36,9 +38,11 @@ int MPI_Info_free(MPI_Info *info) {
      * Also, something needs to be done about the 
      * fortran handle.
      */
+    if (MPI_PARAM_CHECK) {
         if (NULL == info){
-        printf ("Invalid MPI_Info handle passed\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-        return MPI_ERR_ARG;
+                                         "MPI_Info_free");
+        }
     }
 
     /*

src/mpi/c/info_get.c

@@ -11,6 +11,8 @@
 #include "util/strncpy.h"
 #include <stdlib.h>
 #include <string.h>
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_get = PMPI_Info_get
@@ -48,15 +50,17 @@ int MPI_Info_get(MPI_Info info, char *key, int valuelen,
      * having the "key" associated with it and then populate the
      * necessary structures.
      */
-    if (NULL == info){
+    if (MPI_PARAM_CHECK) {
-        printf ("Invalid MPI_Info handle passed\n");
+        if (NULL == info || NULL == key || 0 > valuelen){
-        return MPI_ERR_ARG;
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                         "MPI_Info_get");
         }
 
         key_length = (key) ? strlen (key) : 0;
         if ( (0 == key_length) || (MPI_MAX_INFO_KEY <= key_length)) {
-        printf ("The key passed to MPI_INFO_SET is too long\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
-        return MPI_ERR_INFO_KEY;
+                                         "MPI_Info_get");
+        }
     }
 
     err = lam_info_get (info, key, valuelen, value, flag);

src/mpi/c/info_get_nkeys.c

@@ -8,6 +8,8 @@
 #include "mpi/c/bindings.h"
 #include "lfc/lam_list.h"
 #include "info/info.h"
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_get_nkeys = PMPI_Info_get_nkeys
@@ -33,9 +35,11 @@
 int MPI_Info_get_nkeys(MPI_Info info, int *nkeys) {
     int err;
 
+    if (MPI_PARAM_CHECK) {
         if (NULL == info){
-        printf ("Invalid MPI_Info handle passed\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
-        return MPI_ERR_ARG;
+                                         "MPI_Info_nkeys");
+        }
     }
     err = lam_info_get_nkeys(info, nkeys);
 

src/mpi/c/info_get_nthkey.c

@@ -9,6 +9,8 @@
 #include "lfc/lam_list.h"
 #include "info/info.h"
 #include <string.h>
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_get_nthkey = PMPI_Info_get_nthkey
@@ -37,16 +39,19 @@ int MPI_Info_get_nthkey(MPI_Info info, int n, char *key) {
      * 2. Check if there are atleast "n" elements
      * 3. If so, give the nth defined key
      */
-    if (NULL == info){
+    if (MPI_PARAM_CHECK) {
-        printf ("Invalid MPI_Info handle passed\n");
+        if (NULL == info || 0 > n){
-        return MPI_ERR_ARG;
+            return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_ARG,
+                                          "MPI_Info_get_nthkey");
+        }
     }
 
     MPI_Info_get_nkeys(info, &nkeys);
     
     if (nkeys < n) {
-        printf ("Requested key does not exist\n");
+        return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
-        return MPI_ERR_ARG;
+                                      "MPI_Info_get_nthkey");
+
     } else {
         /*
          * Everything seems alright. Call the back end key copy

src/mpi/c/info_get_valuelen.c

@@ -10,6 +10,8 @@
 #include "info/info.h"
 #include <stdlib.h>
 #include <string.h>
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_get_valuelen = PMPI_Info_get_valuelen
@@ -46,19 +48,19 @@ int MPI_Info_get_valuelen(MPI_Info info, char *key, int *valuelen,
      * Simple function. All we need to do is search for the value
      * having the "key" associated with it and return the length
      */
-    if (NULL == info){
+    if (MPI_PARAM_CHECK) {
-        printf ("Invalid MPI_Info handle passed\n");
+        if (NULL == info || NULL == key){
-        return MPI_ERR_ARG;
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG,
+                                         "MPI_Info_get_valuelen");
         }
-
         key_length = (key) ? strlen (key) : 0;
         if ( (0 == key_length) || (MPI_MAX_INFO_KEY <= key_length)) {
-        printf ("The key passed to MPI_INFO_SET is too long\n");
+            return LAM_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
-        return MPI_ERR_INFO_KEY;
+                                         "MPI_Info_get_valuelen");
+        }
     }
 
     err = lam_info_get_valuelen (info, key, valuelen, flag);
-
     /*
      * Once again, the error problem. lam_info_get_valuelen
      * does not have an obvious error return.

src/mpi/c/info_set.c

@@ -10,6 +10,8 @@
 #include "info/info.h"
 #include <stdlib.h>
 #include <string.h>
+#include "errhandler/errhandler.h"
+#include "communicator/communicator.h"
 
 #if LAM_HAVE_WEAK_SYMBOLS && LAM_PROFILING_DEFINES
 #pragma weak MPI_Info_set = PMPI_Info_set
@@ -57,21 +59,23 @@ int MPI_Info_set(MPI_Info info, char *key, char *value) {
      *          - value length exceeded MPI_MAX_KEY_VAL
      */
 
+    if (MPI_PARAM_CHECK) {
         if (NULL == info){
-        printf ("Invalid MPI_Info handle passed\n");
+            return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_ARG,
-        return MPI_ERR_ARG;
+                                          "MPI_Info_set");
         }
 
         key_length = (key) ? strlen (key) : 0;
         if ( (0 == key_length) || (MPI_MAX_INFO_KEY <= key_length)) {
-        printf ("The key passed to MPI_INFO_SET is too long\n");
+            return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_KEY,
-        return MPI_ERR_INFO_KEY;
+                                          "MPI_Info_set");
         }
 
         value_length = (value) ? strlen (value) : 0;
         if ( (0 == value_length) || (MPI_MAX_INFO_KEY <= value_length)) {
-        printf ("The value passed to MPI_INFO_SET is too long\n");
+            return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_INFO_VALUE,
-        return MPI_ERR_INFO_VALUE;
+                                          "MPI_Info_set");
+        }
     }
 
     /*
@@ -82,8 +86,8 @@ int MPI_Info_set(MPI_Info info, char *key, char *value) {
     err = lam_info_set (info, key, value);
 
     if (MPI_ERR_SYSRESOURCE == err) {
-        printf ("Unable to malloc memory for new (key, value) pair\n");
+        return LAM_ERRHANDLER_INVOKE (MPI_COMM_WORLD, MPI_ERR_SYSRESOURCE,
-        return err;
+                                      "MPI_Info_set");
     }
     
     return err;