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

diff --git a/src/smpi/smpi_f77.cpp b/src/smpi/smpi_f77.cpp
index 3d551db5b7..3cbb27158a 100644
--- a/src/smpi/smpi_f77.cpp
+++ b/src/smpi/smpi_f77.cpp
@@ -10,13 +10,22 @@
 #include "private.h"
 #include "xbt.h"
 
+//TODO : remove all this.
 static xbt_dict_t comm_lookup = nullptr;
 static xbt_dict_t group_lookup = nullptr;
 static xbt_dict_t request_lookup = nullptr;
-static xbt_dict_t datatype_lookup = nullptr;
+static xbt_dict_t type_lookup = nullptr;
 static xbt_dict_t op_lookup = nullptr;
 static xbt_dict_t win_lookup = nullptr;
 static xbt_dict_t info_lookup = nullptr;
+static int comm_id=0;
+static int group_id=0;
+static int request_id=0;
+static int type_id=0;
+static int op_id=0;
+static int win_id=0;
+static int info_id=0;
+
 
 static int running_processes = 0;
 
@@ -28,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)
 
@@ -63,7 +62,7 @@ static void smpi_init_fortran_types(){
      smpi_comm_add_f(MPI_COMM_WORLD);
      group_lookup = xbt_dict_new_homogeneous(nullptr);
      request_lookup = xbt_dict_new_homogeneous(nullptr);
-     datatype_lookup = xbt_dict_new_homogeneous(nullptr);
+     type_lookup = xbt_dict_new_homogeneous(nullptr);
      win_lookup = xbt_dict_new_homogeneous(nullptr);
      info_lookup = xbt_dict_new_homogeneous(nullptr);
      smpi_type_add_f(MPI_BYTE);//MPI_BYTE
@@ -120,212 +119,115 @@ static void smpi_init_fortran_types(){
    }
 }
 
-int smpi_comm_add_f(MPI_Comm comm) {
-  static int comm_id = 0;
+template <typename T> int smpi_add_f(T t, xbt_dict_t dict, int* id) {
   char key[KEY_SIZE];
-  xbt_dict_set(comm_lookup, comm==MPI_COMM_WORLD? get_key(key, comm_id) : get_key_id(key, comm_id), comm, nullptr);
-  comm_id++;
-  return comm_id-1;
+  xbt_dict_set(dict, get_key(key, *id), t, nullptr);
+  (*id)++;
+  return *id-1;
 }
 
-int smpi_comm_c2f(MPI_Comm comm) {
-  char* existing_key = xbt_dict_get_key(comm_lookup, comm);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_comm_add_f(comm);
-}
-
-static void free_comm(int comm) {
+template <> int smpi_add_f<MPI_Comm>(MPI_Comm comm, xbt_dict_t dict, int* id) {
   char key[KEY_SIZE];
-  xbt_dict_remove(comm_lookup, comm==0? get_key(key, comm) : get_key_id(key, comm));
+  xbt_dict_set(dict, comm==MPI_COMM_WORLD? get_key(key, *id) : get_key_id(key, *id), comm, nullptr);
+  (*id)++;
+  return *id-1;
 }
 
-MPI_Comm smpi_comm_f2c(int comm) {
-  smpi_init_fortran_types();
-  if(comm == -2) {
-    return MPI_COMM_SELF;
-  } else if(comm==0){
-    return MPI_COMM_WORLD;
-  } else if(comm_lookup != nullptr && comm >= 0) {
-      char key[KEY_SIZE];
-      MPI_Comm tmp =  static_cast<MPI_Comm>(xbt_dict_get_or_null(comm_lookup,get_key_id(key, comm)));
-      return tmp != nullptr ? tmp : MPI_COMM_NULL ;
-  } else {
-    return MPI_COMM_NULL;
-  }
-}
-
-int smpi_group_add_f(MPI_Group group) {
-  static int group_id = 0;
+template <> int smpi_add_f<MPI_Request>(MPI_Request request, xbt_dict_t dict, int* id) {
   char key[KEY_SIZE];
-  xbt_dict_set(group_lookup, get_key(key, group_id), group, nullptr);
-  group_id++;
-  return group_id-1;
+  xbt_dict_set(dict, get_key_id(key, *id), request, nullptr);
+  (*id)++;
+  return *id-1;
 }
 
-int smpi_group_c2f(MPI_Group group) {
-  char* existing_key = xbt_dict_get_key(group_lookup, group);
+template <typename T> int smpi_c2f(T t, xbt_dict_t dict, int* id) {
+  char* existing_key = xbt_dict_get_key(dict, t);
   if(existing_key!=nullptr)
     return atoi(existing_key);
   else
-    return smpi_group_add_f(group);
+    return smpi_add_f<T>(t,dict,id);
 }
 
-MPI_Group smpi_group_f2c(int group) {
-  smpi_init_fortran_types();
-  if(group == -2) {
-    return MPI_GROUP_EMPTY;
-  } else if(group_lookup != nullptr && group >= 0) {
-    char key[KEY_SIZE];
-    return static_cast<MPI_Group>(xbt_dict_get_or_null(group_lookup, get_key(key, group)));
-  } else {
-    return MPI_GROUP_NULL;
-  }
-}
-
-static void free_group(int group) {
-  char key[KEY_SIZE];
-  xbt_dict_remove(group_lookup, get_key(key, group));
-}
-
-int smpi_request_add_f(MPI_Request request) {
-  static int request_id = 0;
-  char key[KEY_SIZE];
-  xbt_dict_set(request_lookup, get_key_id(key, request_id), request, nullptr);
-  request_id++;
-  return request_id-1;
-}
-
-int smpi_request_c2f(MPI_Request request) {
-  char* existing_key = xbt_dict_get_key(request_lookup, request);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_request_add_f(request);
-}
-
-MPI_Request smpi_request_f2c(int request) {
-  smpi_init_fortran_types();
+template <typename T> void free_f(int id, xbt_dict_t dict) {
   char key[KEY_SIZE];
-  if(request==MPI_FORTRAN_REQUEST_NULL)
-    return MPI_REQUEST_NULL;
-  return static_cast<MPI_Request>(xbt_dict_get(request_lookup, get_key_id(key, request)));
+  xbt_dict_remove(dict, get_key(key, id));
 }
 
-static void free_request(int request) {
+template <> void free_f<MPI_Comm>(int id, xbt_dict_t dict) {
   char key[KEY_SIZE];
-  if(request!=MPI_FORTRAN_REQUEST_NULL)
-  xbt_dict_remove(request_lookup, get_key_id(key, request));
+  xbt_dict_remove(dict, id==0? get_key(key, id) : get_key_id(key, id));
 }
 
-int smpi_type_add_f(MPI_Datatype datatype){
-  static int datatype_id = 0;
+template <> void free_f<MPI_Request>(int id, xbt_dict_t dict) {
   char key[KEY_SIZE];
-  xbt_dict_set(datatype_lookup, get_key(key, datatype_id), datatype, nullptr);
-  datatype_id++;
-  return datatype_id-1;
-}
-
-int smpi_type_c2f(MPI_Datatype datatype) {
-  char* existing_key = xbt_dict_get_key(datatype_lookup, datatype);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_type_add_f(datatype);
+  if(id!=MPI_FORTRAN_REQUEST_NULL)
+  xbt_dict_remove(dict, get_key_id(key, id));
 }
 
-MPI_Datatype smpi_type_f2c(int datatype) {
+template <typename T> T smpi_f2c(int id, xbt_dict_t dict, void* null_id ) {
   smpi_init_fortran_types();
   char key[KEY_SIZE];
-  return datatype >= 0 ? static_cast<MPI_Datatype>(xbt_dict_get_or_null(datatype_lookup, get_key(key, datatype))): MPI_DATATYPE_NULL;
-}
-
-static void free_datatype(int datatype) {
-  char key[KEY_SIZE];
-  xbt_dict_remove(datatype_lookup, get_key(key, datatype));
-}
-
-int smpi_op_add_f(MPI_Op op) {
-  static int op_id = 0;
-  char key[KEY_SIZE];
-  xbt_dict_set(op_lookup, get_key(key, op_id), op, nullptr);
-  op_id++;
-  return op_id-1;
+  return id >= 0 ? static_cast<T>(xbt_dict_get_or_null(dict, get_key(key, id))): static_cast<T>(null_id);
 }
 
-int smpi_op_c2f(MPI_Op op) {
-  char* existing_key = xbt_dict_get_key(op_lookup, op);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_op_add_f(op);
-}
-
-MPI_Op smpi_op_f2c(int op) {
+template <> MPI_Comm smpi_f2c<MPI_Comm>(int comm, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
-  char key[KEY_SIZE];
-   return op >= 0 ? static_cast<MPI_Op>(xbt_dict_get_or_null(op_lookup,  get_key(key, op))): MPI_OP_NULL;
-}
-
-static void free_op(int op) {
-  char key[KEY_SIZE];
-  xbt_dict_remove(op_lookup, get_key(key, op));
-}
-
-int smpi_win_add_f(MPI_Win win) {
-  static int win_id = 0;
-  char key[KEY_SIZE];
-  xbt_dict_set(win_lookup, get_key(key, win_id), win, nullptr);
-  win_id++;
-  return win_id-1;
-}
-
-int smpi_win_c2f(MPI_Win win) {
-  char* existing_key = xbt_dict_get_key(win_lookup, win);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_win_add_f(win);
+  if(comm == -2) {
+    return MPI_COMM_SELF;
+  } else if(comm==0){
+    return MPI_COMM_WORLD;
+  } 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 : static_cast<MPI_Comm>(null_id) ;
+  } else {
+    return static_cast<MPI_Comm>(null_id);
+  }
 }
 
-MPI_Win smpi_win_f2c(int win) {
+template <> MPI_Group smpi_f2c<MPI_Group>(int group, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
-  char key[KEY_SIZE];
-   return win >= 0 ? static_cast<MPI_Win>(xbt_dict_get_or_null(win_lookup,  get_key(key, win))) : MPI_WIN_NULL;
-}
-
-static void free_win(int win) {
-  char key[KEY_SIZE];
-  xbt_dict_remove(win_lookup, get_key(key, win));
-}
-
-int smpi_info_add_f(MPI_Info info) {
-  static int info_id = 0;
-  char key[KEY_SIZE];
-  xbt_dict_set(info_lookup, get_key(key, info_id), info, nullptr);
-  info_id++;
-  return info_id-1;
-}
-
-int smpi_info_c2f(MPI_Info info) {
-  char* existing_key = xbt_dict_get_key(info_lookup, info);
-  if(existing_key!=nullptr)
-    return atoi(existing_key);
-  else
-    return smpi_info_add_f(info);
+  if(group == -2) {
+    return MPI_GROUP_EMPTY;
+  } else if(dict != nullptr && group >= 0) {
+    char key[KEY_SIZE];
+    return static_cast<MPI_Group>(xbt_dict_get_or_null(dict, get_key(key, group)));
+  } else {
+    return static_cast<MPI_Group>(null_id);
+  }
 }
 
-MPI_Info smpi_info_f2c(int info) {
+template <> MPI_Request smpi_f2c<MPI_Request>(int request, xbt_dict_t dict, void* null_id) {
   smpi_init_fortran_types();
   char key[KEY_SIZE];
-   return info >= 0 ? static_cast<MPI_Info>(xbt_dict_get_or_null(info_lookup,  get_key(key, info))) : MPI_INFO_NULL;
-}
-
-static void free_info(int info) {
-  char key[KEY_SIZE];
-  xbt_dict_remove(info_lookup, get_key(key, info));
-}
+  if(request==MPI_FORTRAN_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, null_id)\
+int smpi_##name##_add_f(type name){\
+  return smpi_add_f<type>(name, name##_lookup, &name##_id);\
+}\
+int smpi_##name##_c2f(type name){\
+  return smpi_c2f<type>(name, name##_lookup, &name##_id);\
+}\
+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, 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, 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();
@@ -338,7 +240,7 @@ void mpi_finalize_(int* ierr) {
    running_processes--;
    if(running_processes==0){
      xbt_dict_free(&op_lookup);
-     xbt_dict_free(&datatype_lookup);
+     xbt_dict_free(&type_lookup);
      xbt_dict_free(&request_lookup);
      xbt_dict_free(&group_lookup);
      xbt_dict_free(&comm_lookup);
@@ -600,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));
@@ -609,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));
@@ -728,7 +630,7 @@ void mpi_type_free_(int* datatype, int* ierr){
   MPI_Datatype tmp= smpi_type_f2c(*datatype);
   *ierr= MPI_Type_free (&tmp);
   if(*ierr == MPI_SUCCESS) {
-    free_datatype(*datatype);
+    free_type(*datatype);
   }
 }
 
@@ -1837,3 +1739,4 @@ void mpi_file_write_ ( int* fh, void* buf, int* count, int* datatype, MPI_Status
   *ierr=  MPI_File_write(reinterpret_cast<MPI_File>(*fh), buf, *count, smpi_type_f2c(*datatype), status);
 }
 
+} // extern "C"