X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/b3f2daa8ba97d28b224597331ac3b8d9a719aa30..36fa571a13985879dc627c70ecc2340af606aa42:/src/smpi/smpi_f77.cpp

diff --git a/src/smpi/smpi_f77.cpp b/src/smpi/smpi_f77.cpp
index 17ed153abd..3cbb27158a 100644
--- a/src/smpi/smpi_f77.cpp
+++ b/src/smpi/smpi_f77.cpp
@@ -37,22 +37,12 @@ typedef long int integer;
 typedef unsigned long int uinteger;
 #endif
 
-/* Bindings for MPI special values */
-  struct s_smpi_common {
-    integer _MPI_IN_PLACE;
-    integer _MPI_BOTTOM;
-    integer _MPI_STATUS_IGNORE;
-    integer _MPI_STATUSES_IGNORE;
-  } smpi_;
-
 /* Convert between Fortran and C */
-#define FORT_ADDR(addr, val)                                         \
-  (((void *)(addr) == (void*) &(smpi_._ ## val))                  \
-   ? (val) : (void *)(addr))
-#define FORT_BOTTOM(addr)          FORT_ADDR(addr, MPI_BOTTOM)
-#define FORT_IN_PLACE(addr)        FORT_ADDR(addr, MPI_IN_PLACE)
-#define FORT_STATUS_IGNORE(addr)   static_cast<MPI_Status*>(FORT_ADDR(addr, MPI_STATUS_IGNORE))
-#define FORT_STATUSES_IGNORE(addr) static_cast<MPI_Status*>(FORT_ADDR(addr, MPI_STATUSES_IGNORE))
+
+#define FORT_BOTTOM(addr)          ((*(int*)addr) == -200 ? MPI_BOTTOM : (void*)addr)
+#define FORT_IN_PLACE(addr)        ((*(int*)addr) == -100 ? MPI_IN_PLACE : (void*)addr)
+#define FORT_STATUS_IGNORE(addr)   (static_cast<MPI_Status*>((*(int*)addr) == -300 ? MPI_STATUS_IGNORE : (void*)addr))
+#define FORT_STATUSES_IGNORE(addr) (static_cast<MPI_Status*>((*(int*)addr) == -400 ? MPI_STATUSES_IGNORE : (void*)addr))
 
 #define KEY_SIZE (sizeof(int) * 2 + 1)
 
@@ -174,35 +164,13 @@ template <> void free_f<MPI_Request>(int id, xbt_dict_t dict) {
   xbt_dict_remove(dict, get_key_id(key, id));
 }
 
-template <typename T> T smpi_f2c(int , xbt_dict_t ) {
-  return NULL;
-}
-
-template <> MPI_Datatype smpi_f2c<MPI_Datatype>(int id, xbt_dict_t dict) {
-  smpi_init_fortran_types();
-  char key[KEY_SIZE];
-  return id >= 0 ? static_cast<MPI_Datatype>(xbt_dict_get_or_null(dict, get_key(key, id))): MPI_DATATYPE_NULL;
-}
-
-template <> MPI_Op smpi_f2c<MPI_Op> (int id, xbt_dict_t dict) {
-  smpi_init_fortran_types();
-  char key[KEY_SIZE];
-  return id >= 0 ? static_cast<MPI_Op>(xbt_dict_get_or_null(dict, get_key(key, id))): MPI_OP_NULL;
-}
-
-template <> MPI_Info smpi_f2c<MPI_Info>(int id, xbt_dict_t dict) {
+template <typename T> T smpi_f2c(int id, xbt_dict_t dict, void* null_id ) {
   smpi_init_fortran_types();
   char key[KEY_SIZE];
-  return id >= 0 ? static_cast<MPI_Info>(xbt_dict_get_or_null(dict, get_key(key, id))): MPI_INFO_NULL;
+  return id >= 0 ? static_cast<T>(xbt_dict_get_or_null(dict, get_key(key, id))): static_cast<T>(null_id);
 }
 
-template <> MPI_Win smpi_f2c<MPI_Win>(int id, xbt_dict_t dict) {
-  smpi_init_fortran_types();
-  char key[KEY_SIZE];
-  return id >= 0 ? static_cast<MPI_Win>(xbt_dict_get_or_null(dict, get_key(key, id))): MPI_WIN_NULL;
-}
-
-template <> MPI_Comm smpi_f2c<MPI_Comm>(int comm, xbt_dict_t dict) {
+template <> MPI_Comm smpi_f2c<MPI_Comm>(int comm, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
   if(comm == -2) {
     return MPI_COMM_SELF;
@@ -211,13 +179,13 @@ template <> MPI_Comm smpi_f2c<MPI_Comm>(int comm, xbt_dict_t dict) {
   } else if(dict != nullptr && comm >= 0) {
       char key[KEY_SIZE];
       MPI_Comm tmp =  static_cast<MPI_Comm>(xbt_dict_get_or_null(dict,get_key_id(key, comm)));
-      return tmp != nullptr ? tmp : MPI_COMM_NULL ;
+      return tmp != nullptr ? tmp : static_cast<MPI_Comm>(null_id) ;
   } else {
-    return MPI_COMM_NULL;
+    return static_cast<MPI_Comm>(null_id);
   }
 }
 
-template <> MPI_Group smpi_f2c<MPI_Group>(int group, xbt_dict_t dict) {
+template <> MPI_Group smpi_f2c<MPI_Group>(int group, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
   if(group == -2) {
     return MPI_GROUP_EMPTY;
@@ -225,19 +193,19 @@ template <> MPI_Group smpi_f2c<MPI_Group>(int group, xbt_dict_t dict) {
     char key[KEY_SIZE];
     return static_cast<MPI_Group>(xbt_dict_get_or_null(dict, get_key(key, group)));
   } else {
-    return MPI_GROUP_NULL;
+    return static_cast<MPI_Group>(null_id);
   }
 }
 
-template <> MPI_Request smpi_f2c<MPI_Request>(int request, xbt_dict_t dict) {
+template <> MPI_Request smpi_f2c<MPI_Request>(int request, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
   char key[KEY_SIZE];
   if(request==MPI_FORTRAN_REQUEST_NULL)
-    return MPI_REQUEST_NULL;
+    return static_cast<MPI_Request>(null_id);
   return static_cast<MPI_Request>(xbt_dict_get(dict, get_key_id(key, request)));
 }
 
-#define SMPI_F2C_C2F(type, name)\
+#define SMPI_F2C_C2F(type, name, null_id)\
 int smpi_##name##_add_f(type name){\
   return smpi_add_f<type>(name, name##_lookup, &name##_id);\
 }\
@@ -248,18 +216,18 @@ static void free_##name(int id) {\
   free_f<type>(id, name##_lookup);\
 }\
 type smpi_##name##_f2c(int id){\
-  return smpi_f2c<type>(id, name##_lookup);\
+  return smpi_f2c<type>(id, name##_lookup, static_cast<void*>(null_id));\
 }
 
 extern "C" { // This should really use the C linkage to be usable from Fortran
 
-SMPI_F2C_C2F(MPI_Comm, comm)
-SMPI_F2C_C2F(MPI_Group, group)
-SMPI_F2C_C2F(MPI_Request, request)
-SMPI_F2C_C2F(MPI_Datatype, type)
-SMPI_F2C_C2F(MPI_Win, win)
-SMPI_F2C_C2F(MPI_Op, op)
-SMPI_F2C_C2F(MPI_Info, info)
+SMPI_F2C_C2F(MPI_Comm, comm, MPI_COMM_NULL)
+SMPI_F2C_C2F(MPI_Group, group, MPI_GROUP_NULL)
+SMPI_F2C_C2F(MPI_Request, request, MPI_REQUEST_NULL)
+SMPI_F2C_C2F(MPI_Datatype, type, MPI_DATATYPE_NULL)
+SMPI_F2C_C2F(MPI_Win, win, MPI_WIN_NULL)
+SMPI_F2C_C2F(MPI_Op, op, MPI_OP_NULL)
+SMPI_F2C_C2F(MPI_Info, info, MPI_INFO_NULL)
 
 void mpi_init_(int* ierr) {
     smpi_init_fortran_types();
@@ -534,7 +502,7 @@ void mpi_scatterv_(void* sendbuf, int* sendcounts, int* displs, int* sendtype,
 void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, int* recvcount, int* recvtype,
                   int* root, int* comm, int* ierr) {
   sendbuf = static_cast<char *>( FORT_IN_PLACE(sendbuf));
-  sendbuf = static_cast<char *>( FORT_BOTTOM(sendbuf));
+  sendbuf = sendbuf!=MPI_IN_PLACE ? static_cast<char *>( FORT_BOTTOM(sendbuf)) : MPI_IN_PLACE;
   recvbuf = static_cast<char *>( FORT_BOTTOM(recvbuf));
   *ierr = MPI_Gather(sendbuf, *sendcount, smpi_type_f2c(*sendtype),
                      recvbuf, *recvcount, smpi_type_f2c(*recvtype), *root, smpi_comm_f2c(*comm));
@@ -543,7 +511,7 @@ void mpi_gather_(void* sendbuf, int* sendcount, int* sendtype, void* recvbuf, in
 void mpi_gatherv_(void* sendbuf, int* sendcount, int* sendtype,
                   void* recvbuf, int* recvcounts, int* displs, int* recvtype, int* root, int* comm, int* ierr) {
   sendbuf = static_cast<char *>( FORT_IN_PLACE(sendbuf));
-  sendbuf = static_cast<char *>( FORT_BOTTOM(sendbuf));
+  sendbuf = sendbuf!=MPI_IN_PLACE ? static_cast<char *>( FORT_BOTTOM(sendbuf)) : MPI_IN_PLACE;
   recvbuf = static_cast<char *>( FORT_BOTTOM(recvbuf));
   *ierr = MPI_Gatherv(sendbuf, *sendcount, smpi_type_f2c(*sendtype),
                      recvbuf, recvcounts, displs, smpi_type_f2c(*recvtype), *root, smpi_comm_f2c(*comm));