Enable proper f2c <--> c2f MPI_Request translation. Pick up f2c <-->

c2f MPI_Status translation along the way.  This should enable Fortran
MPI apps that use non-blocking communication to start working.

This commit was SVN r2996.

include/mpif.h.in

@@ -129,7 +129,7 @@
        parameter (MPI_GROUP_NULL=0)
        parameter (MPI_COMM_NULL=2)
        parameter (MPI_DATATYPE_NULL=0)
-       parameter (MPI_REQUEST_NULL=-1)
+       parameter (MPI_REQUEST_NULL=0)
        parameter (MPI_OP_NULL=0)
        parameter (MPI_ERRHANDLER_NULL=0)
        parameter (MPI_INFO_NULL=0)

src/mpi/c/request_c2f.c

@@ -23,21 +23,35 @@ static const char FUNC_NAME[] = "MPI_Request_f2c";
 
 MPI_Fint MPI_Request_c2f(MPI_Request request) 
 {
-    /* local variables */
-    ompi_request_t *request_c;
-
     /* error checking */
     if( MPI_PARAM_CHECK ) {
         OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
 
- 	    /* mapping an invalid handle to a null handle */
-	    /* not invoking an error handler */
-        if( (NULL == request) ) {
-			request = MPI_REQUEST_NULL;
+        /* mapping an invalid handle to a null handle */
+        /* not invoking an error handler */
+
+        if (NULL == request) {
+            request = MPI_REQUEST_NULL;
         }
     }
 
-    request_c=(ompi_request_t *)request;
+    /* We only put requests in the f2c table when this function is
+       invoked.  This is because putting requests in the table
+       involves locking and unlocking the table, which would incur a
+       performance penalty (in the critical performance path) for C
+       applications.  In this way, at least only Fortran applications
+       are penalized.  :-\
 
-    return (MPI_Fint) (request_c->req_f_to_c_index) ;
+       Modifying this one function neatly fixes up all the Fortran
+       bindings because they all call MPI_Request_c2f in order to
+       transmorgify the C MPI_Request that they got back into a
+       fortran integer.
+    */
+
+    if (-1 == request->req_f_to_c_index) {
+        request->req_f_to_c_index = 
+            ompi_pointer_array_add(&ompi_request_f_to_c_table, request);
+    }
+
+    return (MPI_Fint) (request->req_f_to_c_index) ;
 }

src/mpi/c/request_f2c.c

@@ -36,9 +36,10 @@ MPI_Request MPI_Request_f2c(MPI_Fint request)
     
     if (request_index < 0 || 
         request_index >= 
-        ompi_pointer_array_get_size(ompi_req_f_to_c_table)) {
+        ompi_pointer_array_get_size(&ompi_request_f_to_c_table)) {
         return MPI_REQUEST_NULL;
     }
 
-    return ompi_pointer_array_get_item(ompi_req_f_to_c_table, request_index);
+    return ompi_pointer_array_get_item(&ompi_request_f_to_c_table,
+                                       request_index);
 }

src/mpi/c/status_c2f.c

@@ -6,6 +6,7 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "mpi/f77/constants.h"
 #include "communicator/communicator.h"
 #include "errhandler/errhandler.h"
 
@@ -22,11 +23,26 @@ static const char FUNC_NAME[] = "MPI_Status_c2f";
 
 int MPI_Status_c2f(MPI_Status *c_status, MPI_Fint *f_status) 
 {
-  if (MPI_PARAM_CHECK) {
-    OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
-  }
+    if (MPI_PARAM_CHECK) {
+        OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
 
-  /* This function is not yet implemented */
+        /* MPI-2:4.12.5 says that if you pass in
+           MPI_STATUS[ES]_IGNORE, it's erroneous */
+        
+        if (NULL == c_status || MPI_STATUS_IGNORE == c_status || 
+            MPI_STATUSES_IGNORE == c_status || NULL == f_status) {
+            return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, 
+                                          MPI_ERR_IN_STATUS, FUNC_NAME);
+        }
+    }
 
-  return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME);
+    /* We can't use OMPI_INT_2_FINT here because of some complications
+       with include files.  :-( So just do the casting manually. */
+
+    f_status[0] = (MPI_Fint) c_status->MPI_SOURCE;
+    f_status[1] = (MPI_Fint) c_status->MPI_TAG;
+    f_status[2] = (MPI_Fint) c_status->MPI_ERROR;
+    f_status[3] = (MPI_Fint) c_status->_count;
+
+    return MPI_SUCCESS;
 }

src/mpi/c/status_f2c.c

@@ -6,6 +6,7 @@
 
 #include "mpi.h"
 #include "mpi/c/bindings.h"
+#include "mpi/f77/constants.h"
 #include "communicator/communicator.h"
 #include "errhandler/errhandler.h"
 
@@ -22,11 +23,28 @@ static const char FUNC_NAME[] = "MPI_Status_f2c";
 
 int MPI_Status_f2c(MPI_Fint *f_status, MPI_Status *c_status) 
 {
-  if (MPI_PARAM_CHECK) {
-    OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
-  }
+    if (MPI_PARAM_CHECK) {
+        OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
 
-  /* This function is not yet implemented */
+        /* MPI-2:4.12.5 says that if you pass in
+           MPI_STATUS[ES]_IGNORE, it's erroneous */
+        
+        if (NULL == f_status || 
+            OMPI_IS_FORTRAN_STATUS_IGNORE(f_status) ||
+            OMPI_IS_FORTRAN_STATUSES_IGNORE(f_status) ||
+            NULL == c_status) {
+            return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, 
+                                          MPI_ERR_IN_STATUS, FUNC_NAME);
+        }
+    }
 
-  return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME);
+    /* We can't use OMPI_FINT_2_INT here because of some complications
+       with include files.  :-( So just do the casting manually. */
+
+    c_status->MPI_SOURCE = (int) f_status[0];
+    c_status->MPI_TAG = (int) f_status[1];
+    c_status->MPI_ERROR = (int) f_status[2];
+    c_status->_count = (int) f_status[3];
+
+    return MPI_SUCCESS;
 }

src/mpi/f77/test_f.c

@@ -8,6 +8,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 
 #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
 #pragma weak PMPI_TEST = mpi_test_f
@@ -58,9 +59,11 @@ void mpi_test_f(MPI_Fint *request, MPI_Fint *flag,
 				     &c_status));
 
     OMPI_SINGLE_INT_2_FINT(flag);
-    MPI_Status_c2f( &c_status, status); 
 
     if ( (MPI_SUCCESS == *ierr) && (NULL == c_req) ) {
-      *request = -1;
+        *request = 0;
+        if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
+            MPI_Status_c2f(&c_status, status); 
+        }
     }
 }

src/mpi/f77/testall_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -74,9 +75,12 @@ void mpi_testall_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *flag,
     if (MPI_SUCCESS == *ierr && 1 == *flag) {
         for (i = 0; i < *count; i++) {
             if (NULL == c_req[i]) {
-                array_of_requests[i] = -1;
+                array_of_requests[i] = 0;
+            }
+            if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
+                !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
+                MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
             }
-            MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
         }
     }
 

src/mpi/f77/testany_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -74,8 +75,11 @@ void mpi_testany_f(MPI_Fint *count, MPI_Fint *array_of_requests, MPI_Fint *index
     if (MPI_SUCCESS == *ierr) {
         if (MPI_UNDEFINED != *index) {
             *index += 1;
+            array_of_requests[*index] = 0;
+        }
+        if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
+            MPI_Status_c2f(&c_status, status); 
         }
-        MPI_Status_c2f(&c_status, status); 
     }
 
     free(c_req);

src/mpi/f77/testsome_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -92,7 +93,11 @@ void mpi_testsome_f(MPI_Fint *incount, MPI_Fint *array_of_requests,
             }
         }
         for (i = 0; i < *outcount; i++) {
-          MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
+            array_of_requests[array_of_indices[i]] = 0;
+            if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
+                !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
+                MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
+            }
         }
     }
 

src/mpi/f77/wait_f.c

@@ -8,6 +8,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 
 #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER
 #pragma weak PMPI_WAIT = mpi_wait_f
@@ -54,8 +55,9 @@ void mpi_wait_f(MPI_Fint *request, MPI_Fint *status, MPI_Fint *ierr)
     *ierr = OMPI_INT_2_FINT(MPI_Wait(&c_req, &c_status));
 
     if (MPI_SUCCESS == *ierr) {
-        /* reset request handle to MPI_REQUEST_NULL */
-        *request = -1;
-        MPI_Status_c2f(&c_status, status);
+        *request = 0;
+        if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
+            MPI_Status_c2f(&c_status, status);
+        }
     }
 }

src/mpi/f77/waitall_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -77,9 +78,12 @@ void mpi_waitall_f(MPI_Fint *count, MPI_Fint *array_of_requests,
     if (MPI_SUCCESS == *ierr) {
         for (i = 0; i < *count; i++) {
             if (NULL == c_req[i]) {
-              array_of_requests[i] = -1;
+                array_of_requests[i] = 0;
+            }
+            if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
+                !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
+                MPI_Status_c2f( &c_status[i], &array_of_statuses[i]); 
             }
-            MPI_Status_c2f( &c_status[i], &array_of_statuses[i]); 
         }
     }
     free(c_req);

src/mpi/f77/waitany_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -77,16 +78,17 @@ void mpi_waitany_f(MPI_Fint *count, MPI_Fint *array_of_requests,
 					&c_status));
 
     if (MPI_SUCCESS == *ierr) {
-
 	OMPI_SINGLE_INT_2_FINT(index);
-        /*
-         * Increment index by one for fortran conventions
-         */
+
+        /* Increment index by one for fortran conventions */
+
         if (MPI_UNDEFINED != *index) {
             *index += 1;
+            array_of_requests[*index] = 0;
+        }
+        if (!OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
+            MPI_Status_c2f(&c_status, status); 
         }
-        MPI_Status_c2f( &c_status, status); 
-
     }
     free(c_req);
 }

src/mpi/f77/waitsome_f.c

@@ -9,6 +9,7 @@
 
 #include "mpi.h"
 #include "mpi/f77/bindings.h"
+#include "mpi/f77/constants.h"
 #include "errhandler/errhandler.h"
 #include "communicator/communicator.h"
 
@@ -83,16 +84,20 @@ void mpi_waitsome_f(MPI_Fint *incount, MPI_Fint *array_of_requests,
     if (MPI_SUCCESS == *ierr) {
 	OMPI_SINGLE_INT_2_FINT(outcount);
 	OMPI_ARRAY_INT_2_FINT(array_of_indices, *incount);
-        /*
-         * Increment indexes by one for fortran conventions
-         */
+
+        /* Increment indexes by one for fortran conventions */
+
         if (MPI_UNDEFINED != *outcount) {
             for (i = 0; i < *outcount; i++) {
                 array_of_indices[i] += 1;
             }
         }
         for (i = 0; i < *incount; i++) {
-          MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
+            array_of_requests[array_of_indices[i]] = 0;
+            if (!OMPI_IS_FORTRAN_STATUSES_IGNORE(array_of_statuses) &&
+                !OMPI_IS_FORTRAN_STATUS_IGNORE(&array_of_statuses[i])) {
+                MPI_Status_c2f(&c_status[i], &array_of_statuses[i]);
+            }
         }
     }
 

src/mpi/runtime/ompi_mpi_finalize.c

@@ -81,6 +81,11 @@ int ompi_mpi_finalize(void)
       return ret;
   }
 
+  /* free requests */
+  if (OMPI_SUCCESS != (ret = ompi_request_finalize())) {
+      return ret;
+  }
+
   /* Free secondary resources */
 
   /* free attr resources */
@@ -113,8 +118,6 @@ int ompi_mpi_finalize(void)
       return ret;
   }
 
-  /* free request resources */
-
   /* Free all other resources */
 
   /* free op resources */

src/mpi/runtime/ompi_mpi_init.c

@@ -20,6 +20,7 @@
 #include "errhandler/errcode.h"
 #include "errhandler/errclass.h"
 #include "errhandler/errcode-internal.h"
+#include "request/request.h"
 #include "op/op.h"
 #include "file/file.h"
 
@@ -166,11 +167,18 @@ int ompi_mpi_init(int argc, char **argv, int requested, int *provided)
         goto error;
     }
 
+    /* initialize requests */
+    if (OMPI_SUCCESS != (ret = ompi_request_init())) {
+        error = "ompi_request_init() failed";
+        goto error;
+    }
+
     /* initialize info */
     if (OMPI_SUCCESS != (ret = ompi_info_init())) {
         error = "ompi_info_init() failed";
         goto error;
     }
+
     /* initialize error handlers */
     if (OMPI_SUCCESS != (ret = ompi_errhandler_init())) {
         error = "ompi_errhandler_init() failed";

src/request/request.c

@@ -2,24 +2,32 @@
  * $HEADER$
  */
 
+#include "ompi_config.h"
+
+#include "class/ompi_object.h"
 #include "request/request.h"
 #include "include/constants.h"
 
 /*
  * Table for Fortran <-> C Request handle conversion
  */
-ompi_pointer_array_t *ompi_req_f_to_c_table;
-ompi_pointer_array_t ompi_req_table;
+ompi_pointer_array_t ompi_request_f_to_c_table;
+
+/*
+ * MPI_REQUEST_NULL
+ */
+ompi_request_t ompi_mpi_request_null;
+
 
 static void ompi_request_construct(ompi_request_t* req)
 {
-    req->req_state = OMPI_REQUEST_INVALID;
+    OMPI_REQUEST_INIT(req);
 }
 
 
 static void ompi_request_destruct(ompi_request_t* req)
 {
-    req->req_state = OMPI_REQUEST_INVALID;
+    OMPI_REQUEST_FINI(req);
 }
 
 
@@ -30,3 +38,19 @@ OBJ_CLASS_INSTANCE(
     ompi_request_destruct);
 
 
+int ompi_request_init(void)
+{
+    OBJ_CONSTRUCT(&ompi_mpi_request_null, ompi_request_t);
+    if (0 != ompi_pointer_array_add(&ompi_request_f_to_c_table, 
+                                    MPI_REQUEST_NULL)) {
+        return OMPI_ERR_REQUEST;
+    }
+    return OMPI_SUCCESS;
+}
+
+
+int ompi_request_finalize(void)
+{
+    OBJ_DESTRUCT(&ompi_mpi_request_null);
+    return OMPI_SUCCESS;
+}

src/request/request.h

@@ -1,6 +1,11 @@
 /*
  * $HEADER$
  */
+/**
+ * @file
+ *
+ * Top-level description of requests
+ */
 
 #ifndef OMPI_REQUEST_H
 #define OMPI_REQUEST_H
@@ -10,46 +15,117 @@
 #include "class/ompi_pointer_array.h"
 
 
+/**
+ * Request class
+ */
 OBJ_CLASS_DECLARATION(ompi_request_t);
 
+/**
+ * Enum inidicating the type of the request
+ */
 typedef enum {
+    /** MPI point-to-point request */
     OMPI_REQUEST_PML,
+    /** MPI-2 IO request */
     OMPI_REQUEST_IO,
+    /** MPI-2 generalized request */
     OMPI_REQUEST_GEN,
+    /** Maximum request type */
     OMPI_REQUEST_MAX
 } ompi_request_type_t;
 
+/**
+ * Enum indicating the state of the request
+ */
 typedef enum {
+    /** Indicates that the request should not be progressed */
     OMPI_REQUEST_INVALID,
+    /** A defined, but inactive request (i.e., it's valid, but should
+        not be progressed) */
     OMPI_REQUEST_INACTIVE,
+    /** A valid and progressing request */
     OMPI_REQUEST_ACTIVE,
+    /** The request has been cancelled */
     OMPI_REQUEST_CANCELLED
 } ompi_request_state_t;
 
+/**
+ * Main top-level request struct definition 
+ */
 struct ompi_request_t {
+    /** Base type */
     ompi_list_item_t super;
+    /** Enum indicating the type of the request */
     ompi_request_type_t req_type;
-    volatile int req_state;
-    int req_f_to_c_index;   /**< index in Fortran <-> C translation array */
+    /** Enum indicating the state of the request */
+    volatile ompi_request_state_t req_state;
+    /** Index in Fortran <-> C translation array */
+    int req_f_to_c_index;   
 };
+/**
+ * Convenience typedef
+ */
 typedef struct ompi_request_t ompi_request_t;
 
 
-#define OMPI_REQUEST_INIT(request) \
-    do { \
-        (request)->req_state = OMPI_REQUEST_INACTIVE; \
-	(request)->req_f_to_c_index = 0;	      \
-    } while(0); 
-
-#define OMPI_REQUEST_FINI(request) \
-    do { \
-       (request)->req_state = OMPI_REQUEST_INVALID; \
-    } while(0); 
-
 /**
  * Table for Fortran <-> C request handle conversion
  */
-extern ompi_pointer_array_t *ompi_req_f_to_c_table;
+extern ompi_pointer_array_t ompi_request_f_to_c_table;
+
+/**
+ * MPI_REQUEST_NULL
+ */
+extern ompi_request_t ompi_mpi_request_null;
+
+
+/**
+ * Iniitialize a request.  This is a macro to avoid function call
+ * overhead, since this is typically invoked in the critical
+ * performance path (since requests may be re-used, it is possible
+ * that we will have to initialize a request multiple times).
+ */
+#define OMPI_REQUEST_INIT(request) \
+    do { \
+        (request)->req_state = OMPI_REQUEST_INACTIVE; \
+	(request)->req_f_to_c_index = -1;             \
+    } while(0); 
+
+/**
+ * Finalize a request.  This is a macro to avoid function call
+ * overhead, since this is typically invoked in the critical
+ * performance path (since requests may be re-used, it is possible
+ * that we will have to finalize a request multiple times).
+ *
+ * When finalizing a request, if MPI_Request_f2c() was previously
+ * invoked on that request, then this request was added to the f2c
+ * table, and we need to remove it 
+ */
+#define OMPI_REQUEST_FINI(request) \
+    do { \
+        (request)->req_state = OMPI_REQUEST_INVALID; \
+        if (-1 != (request)->req_f_to_c_index) { \
+            ompi_pointer_array_set_item(&ompi_request_f_to_c_table, \
+                                        (request)->req_f_to_c_index, NULL); \
+        } \
+    } while (0); 
+
+
+#if defined(c_plusplus) || defined(__cplusplus)
+extern "C" {
+#endif
+    /**
+     * Initialize the MPI_Request subsystem; invoked during MPI_INIT.
+     */
+    int ompi_request_init(void);
+
+    /**
+     * Shut down the MPI_Request subsystem; invoked during MPI_FINALIZE.
+     */
+    int ompi_request_finalize(void);
+#if defined(c_plusplus) || defined(__cplusplus)
+}
+#endif
 
 #endif