Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
add mpi_info_* support to fortran, and activate relevant tests
[simgrid.git] / src / smpi / smpi_pmpi.c
index dac9d03..6a66706 100644 (file)
@@ -253,8 +253,7 @@ int PMPI_Type_dup(MPI_Datatype datatype, MPI_Datatype *newtype){
   if (datatype == MPI_DATATYPE_NULL) {
     retval = MPI_ERR_TYPE;
   } else {
-    *newtype = smpi_datatype_dup(datatype);
-    retval = MPI_SUCCESS;
+    retval = smpi_datatype_dup(datatype, newtype);
   }
   return retval;
 }
@@ -773,8 +772,7 @@ int PMPI_Comm_dup(MPI_Comm comm, MPI_Comm * newcomm)
   } else if (newcomm == NULL) {
     retval = MPI_ERR_ARG;
   } else {
-    *newcomm = smpi_comm_dup(comm);
-    retval = MPI_SUCCESS;
+    retval = smpi_comm_dup(comm, newcomm);
   }
   return retval;
 }
@@ -1381,7 +1379,7 @@ int PMPI_Test(MPI_Request * request, int *flag, MPI_Status * status)
   } else if (*request == MPI_REQUEST_NULL) {
     *flag= TRUE;
     smpi_empty_status(status);
-    retval = MPI_ERR_REQUEST;
+    retval = MPI_SUCCESS;
   } else {
 #ifdef HAVE_TRACING
     int rank = request && (*request)->comm != MPI_COMM_NULL
@@ -1488,7 +1486,7 @@ int PMPI_Wait(MPI_Request * request, MPI_Status * status)
   if (request == NULL) {
     retval = MPI_ERR_ARG;
   } else if (*request == MPI_REQUEST_NULL) {
-    retval = MPI_ERR_REQUEST;
+    retval = MPI_SUCCESS;
   } else {
 
 #ifdef HAVE_TRACING
@@ -2774,7 +2772,15 @@ int PMPI_Win_fence( int assert,  MPI_Win win){
   if (win == MPI_WIN_NULL) {
     retval = MPI_ERR_WIN;
   } else {
-    retval = smpi_mpi_win_fence(assert, win);
+#ifdef HAVE_TRACING
+  int rank = smpi_process_index();
+  TRACE_smpi_collective_in(rank, -1, __FUNCTION__, NULL);
+#endif
+  retval = smpi_mpi_win_fence(assert, win);
+#ifdef HAVE_TRACING
+  TRACE_smpi_collective_out(rank, -1, __FUNCTION__);
+#endif
+
   }
   smpi_bench_begin();
   return retval;
@@ -2800,7 +2806,19 @@ int PMPI_Get( void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
             (!is_datatype_valid(target_datatype))) {
     retval = MPI_ERR_TYPE;
   } else {
+#ifdef HAVE_TRACING
+    int rank = smpi_process_index();
+    MPI_Group group;
+    smpi_mpi_win_get_group(win, &group);
+    int src_traced = smpi_group_index(group, target_rank);
+    TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, NULL);
+#endif
+
     retval = smpi_mpi_get( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count, target_datatype, win);
+
+#ifdef HAVE_TRACING
+    TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
+#endif
   }
   smpi_bench_begin();
   return retval;
@@ -2826,7 +2844,21 @@ int PMPI_Put( void *origin_addr, int origin_count, MPI_Datatype origin_datatype,
             (!is_datatype_valid(target_datatype))) {
     retval = MPI_ERR_TYPE;
   } else {
+#ifdef HAVE_TRACING
+    int rank = smpi_process_index();
+    MPI_Group group;
+    smpi_mpi_win_get_group(win, &group);
+    int dst_traced = smpi_group_index(group, target_rank);
+    TRACE_smpi_ptp_in(rank, rank, dst_traced, __FUNCTION__, NULL);
+    TRACE_smpi_send(rank, rank, dst_traced, origin_count*smpi_datatype_size(origin_datatype));
+#endif
+
     retval = smpi_mpi_put( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count, target_datatype, win);
+
+#ifdef HAVE_TRACING
+    TRACE_smpi_ptp_out(rank, rank, dst_traced, __FUNCTION__);
+#endif
+
   }
   smpi_bench_begin();
   return retval;
@@ -2855,7 +2887,20 @@ int PMPI_Accumulate( void *origin_addr, int origin_count, MPI_Datatype origin_da
   } else if (op == MPI_OP_NULL) {
     retval = MPI_ERR_OP;
   } else {
+#ifdef HAVE_TRACING
+    int rank = smpi_process_index();
+    MPI_Group group;
+    smpi_mpi_win_get_group(win, &group);
+    int src_traced = smpi_group_index(group, target_rank);
+    TRACE_smpi_ptp_in(rank, src_traced, rank, __FUNCTION__, NULL);
+#endif
+
     retval = smpi_mpi_accumulate( origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count, target_datatype, op, win);
+
+#ifdef HAVE_TRACING
+    TRACE_smpi_ptp_out(rank, src_traced, rank, __FUNCTION__);
+#endif
+
   }
   smpi_bench_begin();
   return retval;
@@ -2955,12 +3000,20 @@ MPI_Fint PMPI_Comm_c2f(MPI_Comm comm){
   return smpi_comm_c2f(comm);
 }
 
+MPI_Info PMPI_Info_f2c(MPI_Fint info){
+  return smpi_info_f2c(info);
+}
+
+MPI_Fint PMPI_Info_c2f(MPI_Info info){
+  return smpi_info_c2f(info);
+}
+
 int PMPI_Keyval_create(MPI_Copy_function* copy_fn, MPI_Delete_function* delete_fn, int* keyval, void* extra_state) {
-  return smpi_keyval_create(copy_fn, delete_fn, keyval, extra_state);
+  return smpi_comm_keyval_create(copy_fn, delete_fn, keyval, extra_state);
 }
 
 int PMPI_Keyval_free(int* keyval) {
-  return smpi_keyval_free(keyval);
+  return smpi_comm_keyval_free(keyval);
 }
 
 int PMPI_Attr_delete(MPI_Comm comm, int keyval) {
@@ -2971,7 +3024,7 @@ int PMPI_Attr_delete(MPI_Comm comm, int keyval) {
   else if (comm==MPI_COMM_NULL)
     return MPI_ERR_COMM;
   else
-    return smpi_attr_delete(comm, keyval);
+    return smpi_comm_attr_delete(comm, keyval);
 }
 
 int PMPI_Attr_get(MPI_Comm comm, int keyval, void* attr_value, int* flag) {
@@ -2985,10 +3038,10 @@ int PMPI_Attr_get(MPI_Comm comm, int keyval, void* attr_value, int* flag) {
     //FIXME : not ideal and leaky, but should not be called too much
     int* res = xbt_new(int, 1);
     *res=keyval;
-    attr_value=(void*)res;
+    *(int**)attr_value=res;
     return MPI_SUCCESS;
   } else
-  return smpi_attr_get(comm, keyval, attr_value, flag);
+  return smpi_comm_attr_get(comm, keyval, attr_value, flag);
 }
 
 int PMPI_Attr_put(MPI_Comm comm, int keyval, void* attr_value) {
@@ -2999,44 +3052,229 @@ int PMPI_Attr_put(MPI_Comm comm, int keyval, void* attr_value) {
   else if (comm==MPI_COMM_NULL)
     return MPI_ERR_COMM;
   else
-  return smpi_attr_put(comm, keyval, attr_value);
+  return smpi_comm_attr_put(comm, keyval, attr_value);
 }
 
-/* The following calls are not yet implemented and will fail at runtime. */
-/* Once implemented, please move them above this notice. */
+int PMPI_Comm_get_attr (MPI_Comm comm, int comm_keyval, void *attribute_val, int *flag)
+{
+  return PMPI_Attr_get(comm, comm_keyval, attribute_val,flag);
+}
 
-#define NOT_YET_IMPLEMENTED {                                           \
-    XBT_WARN("Not yet implemented : %s. Please contact the Simgrid team if support is needed", __FUNCTION__); \
-    return MPI_SUCCESS;                                                 \
+int PMPI_Comm_set_attr (MPI_Comm comm, int comm_keyval, void *attribute_val)
+{
+  return PMPI_Attr_put(comm, comm_keyval, attribute_val);
+}
+
+int PMPI_Comm_delete_attr (MPI_Comm comm, int comm_keyval)
+{
+  return PMPI_Attr_delete(comm, comm_keyval);
+}
+
+int PMPI_Comm_create_keyval(MPI_Comm_copy_attr_function* copy_fn, MPI_Comm_delete_attr_function* delete_fn, int* keyval, void* extra_state)
+{
+  return PMPI_Keyval_create(copy_fn, delete_fn, keyval, extra_state);
+}
+
+int PMPI_Comm_free_keyval(int* keyval) {
+  return PMPI_Keyval_free(keyval);
+}
+
+
+int PMPI_Type_get_attr (MPI_Datatype type, int type_keyval, void *attribute_val, int* flag)
+{
+  if (type==MPI_DATATYPE_NULL)
+    return MPI_ERR_TYPE;
+  else
+    return smpi_type_attr_get(type, type_keyval, attribute_val, flag);
+}
+
+int PMPI_Type_set_attr (MPI_Datatype type, int type_keyval, void *attribute_val)
+{
+  if (type==MPI_DATATYPE_NULL)
+    return MPI_ERR_TYPE;
+  else
+    return smpi_type_attr_put(type, type_keyval, attribute_val);
+}
+
+int PMPI_Type_delete_attr (MPI_Datatype type, int type_keyval)
+{
+  if (type==MPI_DATATYPE_NULL)
+    return MPI_ERR_TYPE;
+  else
+    return smpi_type_attr_delete(type, type_keyval);
+}
+
+int PMPI_Type_create_keyval(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval, void* extra_state)
+{
+  return smpi_type_keyval_create(copy_fn, delete_fn, keyval, extra_state);
+}
+
+int PMPI_Type_free_keyval(int* keyval) {
+  return smpi_type_keyval_free(keyval);
+}
+
+int PMPI_Info_create( MPI_Info *info){
+  if (info == NULL)
+    return MPI_ERR_ARG;
+  *info = xbt_new(s_smpi_mpi_info_t, 1);
+  (*info)->info_dict= xbt_dict_new_homogeneous(NULL);
+  (*info)->refcount=1;
+  return MPI_SUCCESS;
+}
+
+int PMPI_Info_set( MPI_Info info, char *key, char *value){
+  if (info == NULL || key == NULL || value == NULL)
+    return MPI_ERR_ARG;
+
+  xbt_dict_set(info->info_dict, key, (void*)value, NULL);
+  return MPI_SUCCESS;
+}
+
+int PMPI_Info_free( MPI_Info *info){
+  if (info == NULL || *info==NULL)
+    return MPI_ERR_ARG;
+  (*info)->refcount--;
+  if((*info)->refcount==0){
+    xbt_dict_free(&((*info)->info_dict));
+    xbt_free(*info);
   }
+  *info=MPI_INFO_NULL;
+  return MPI_SUCCESS;
+}
 
+int PMPI_Info_get(MPI_Info info,char *key,int valuelen, char *value, int *flag){
+  if (info == NULL || key == NULL || valuelen <0)
+    return MPI_ERR_ARG;
+  if (value == NULL)
+    return MPI_ERR_INFO_VALUE;
+  *flag=FALSE;    
+  char* tmpvalue=(char*)xbt_dict_get_or_null(info->info_dict, key);
+  if(tmpvalue){
+    memcpy(value,tmpvalue, (strlen(tmpvalue) + 1 < valuelen) ? 
+                         strlen(tmpvalue) + 1 : valuelen);
+    *flag=TRUE;
+  }
+  return MPI_SUCCESS;
+}
 
-MPI_Info PMPI_Info_f2c(MPI_Fint info){
-  NOT_YET_IMPLEMENTED
+int PMPI_Info_dup(MPI_Info info, MPI_Info *newinfo){
+  if (info == NULL || newinfo==NULL)
+    return MPI_ERR_ARG;
+  *newinfo = xbt_new(s_smpi_mpi_info_t, 1);
+  (*newinfo)->info_dict= xbt_dict_new_homogeneous(NULL);
+  xbt_dict_cursor_t cursor = NULL;
+  int *key;
+  void* data;
+  xbt_dict_foreach(info->info_dict,cursor,key,data){
+    xbt_dict_set((*newinfo)->info_dict, (char*)key, data, NULL);
+  }
+  return MPI_SUCCESS;
 }
 
-MPI_Fint PMPI_Info_c2f(MPI_Info info){
-  NOT_YET_IMPLEMENTED
+int PMPI_Info_delete(MPI_Info info, char *key){
+  xbt_ex_t e;
+  if (info == NULL || key==NULL)
+    return MPI_ERR_ARG;
+  TRY {
+  xbt_dict_remove(info->info_dict, key);
+  }CATCH(e){
+    xbt_ex_free(e);
+    return MPI_ERR_INFO_NOKEY;
+  }
+  return MPI_SUCCESS;
 }
 
-MPI_Errhandler PMPI_Errhandler_f2c(MPI_Fint errhandler){
-  NOT_YET_IMPLEMENTED
+int PMPI_Info_get_nkeys( MPI_Info info, int *nkeys){
+  if (info == NULL || nkeys==NULL)
+    return MPI_ERR_ARG;
+  *nkeys=xbt_dict_size(info->info_dict);
+  return MPI_SUCCESS;
 }
 
-MPI_Fint PMPI_Errhandler_c2f(MPI_Errhandler errhandler){
-  NOT_YET_IMPLEMENTED
+int PMPI_Info_get_nthkey( MPI_Info info, int n, char *key){
+  if (info == NULL || key==NULL || n<0 || n> MPI_MAX_INFO_KEY)
+    return MPI_ERR_ARG;
+
+  xbt_dict_cursor_t cursor = NULL;
+  char *keyn;
+  void* data;
+  int num=0;
+  xbt_dict_foreach(info->info_dict,cursor,keyn,data){
+    if(num==n){
+     strcpy(key,keyn);
+      return MPI_SUCCESS;
+    }
+    num++;
+  }
+  return MPI_ERR_ARG;
+}
+
+int PMPI_Info_get_valuelen( MPI_Info info, char *key, int *valuelen, int *flag){
+  if (info == NULL || key == NULL || valuelen <0)
+    return MPI_ERR_ARG;
+  *flag=FALSE;    
+  char* tmpvalue=(char*)xbt_dict_get_or_null(info->info_dict, key);
+  if(tmpvalue){
+    *valuelen=strlen(tmpvalue);
+    *flag=TRUE;
+  }
+  return MPI_SUCCESS;
+}
+
+int PMPI_Unpack(void* inbuf, int incount, int* position, void* outbuf, int outcount, MPI_Datatype type, MPI_Comm comm) {
+  if(incount<0 || outcount < 0 || inbuf==NULL || outbuf==NULL)
+    return MPI_ERR_ARG;
+  if(!is_datatype_valid(type))
+    return MPI_ERR_TYPE;
+  if(comm==MPI_COMM_NULL)
+    return MPI_ERR_COMM;
+  return smpi_mpi_unpack(inbuf, incount, position, outbuf,outcount,type, comm);
+}
+
+int PMPI_Pack(void* inbuf, int incount, MPI_Datatype type, void* outbuf, int outcount, int* position, MPI_Comm comm) {
+  if(incount<0 || outcount < 0|| inbuf==NULL || outbuf==NULL)
+    return MPI_ERR_ARG;
+  if(!is_datatype_valid(type))
+    return MPI_ERR_TYPE;
+  if(comm==MPI_COMM_NULL)
+    return MPI_ERR_COMM;
+  return smpi_mpi_pack(inbuf, incount, type, outbuf,outcount,position, comm);
 }
 
 int PMPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, int* size) {
+  if(incount<0)
+    return MPI_ERR_ARG;
+  if(!is_datatype_valid(datatype))
+    return MPI_ERR_TYPE;
+  if(comm==MPI_COMM_NULL)
+    return MPI_ERR_COMM;
+    
+  *size=incount*smpi_datatype_size(datatype);
+  
+  return MPI_SUCCESS;
+}
+
+
+/* The following calls are not yet implemented and will fail at runtime. */
+/* Once implemented, please move them above this notice. */
+
+#define NOT_YET_IMPLEMENTED {                                           \
+    XBT_WARN("Not yet implemented : %s. Please contact the Simgrid team if support is needed", __FUNCTION__); \
+    return MPI_SUCCESS;                                                 \
+  }
+
+MPI_Errhandler PMPI_Errhandler_f2c(MPI_Fint errhandler){
   NOT_YET_IMPLEMENTED
 }
 
+MPI_Fint PMPI_Errhandler_c2f(MPI_Errhandler errhandler){
+  NOT_YET_IMPLEMENTED
+}
 
 int PMPI_Cart_map(MPI_Comm comm_old, int ndims, int* dims, int* periods, int* newrank) {
   NOT_YET_IMPLEMENTED
 }
 
-
 int PMPI_Graph_create(MPI_Comm comm_old, int nnodes, int* index, int* edges, int reorder, MPI_Comm* comm_graph) {
   NOT_YET_IMPLEMENTED
 }
@@ -3113,62 +3351,11 @@ int PMPI_Comm_test_inter(MPI_Comm comm, int* flag) {
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Comm_get_attr (MPI_Comm comm, int comm_keyval, void *attribute_val, int *flag)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Comm_set_attr (MPI_Comm comm, int comm_keyval, void *attribute_val)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Comm_delete_attr (MPI_Comm comm, int comm_keyval)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Comm_create_keyval(MPI_Comm_copy_attr_function* copy_fn, MPI_Comm_delete_attr_function* delete_fn, int* keyval, void* extra_state)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Comm_free_keyval(int* keyval) {
-  NOT_YET_IMPLEMENTED
-}
-
 int PMPI_Pcontrol(const int level )
 {
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Unpack(void* inbuf, int insize, int* position, void* outbuf, int outcount, MPI_Datatype type, MPI_Comm comm) {
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Type_get_attr (MPI_Datatype type, int type_keyval, void *attribute_val, int* flag)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Type_set_attr (MPI_Datatype type, int type_keyval, void *attribute_val)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Type_delete_attr (MPI_Datatype type, int comm_keyval)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Type_create_keyval(MPI_Type_copy_attr_function* copy_fn, MPI_Type_delete_attr_function* delete_fn, int* keyval, void* extra_state)
-{
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Type_free_keyval(int* keyval) {
-  NOT_YET_IMPLEMENTED
-}
 
 int PMPI_Intercomm_create(MPI_Comm local_comm, int local_leader, MPI_Comm peer_comm, int remote_leader, int tag, MPI_Comm* comm_out) {
   NOT_YET_IMPLEMENTED
@@ -3214,9 +3401,7 @@ int PMPI_Test_cancelled(MPI_Status* status, int* flag) {
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Pack(void* inbuf, int incount, MPI_Datatype type, void* outbuf, int outcount, int* position, MPI_Comm comm) {
-  NOT_YET_IMPLEMENTED
-}
+
 
 int PMPI_Pack_external_size(char *datarep, int incount, MPI_Datatype datatype, MPI_Aint *size){
   NOT_YET_IMPLEMENTED
@@ -3234,17 +3419,7 @@ int PMPI_Get_elements(MPI_Status* status, MPI_Datatype datatype, int* elements)
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Info_create( MPI_Info *info){
-  NOT_YET_IMPLEMENTED
-}
 
-int PMPI_Info_set( MPI_Info info, char *key, char *value){
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Info_free( MPI_Info *info){
-  NOT_YET_IMPLEMENTED
-}
 
 int PMPI_Type_get_envelope( MPI_Datatype datatype, int *num_integers,
                             int *num_addresses, int *num_datatypes, int *combiner){
@@ -3297,10 +3472,6 @@ int PMPI_Comm_get_info (MPI_Comm comm, MPI_Info* info){
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Info_get(MPI_Info info,char *key,int valuelen, char *value, int *flag){
-  NOT_YET_IMPLEMENTED
-}
-
 int PMPI_Comm_create_errhandler( MPI_Comm_errhandler_fn *function, MPI_Errhandler *errhandler){
   NOT_YET_IMPLEMENTED
 }
@@ -3321,26 +3492,6 @@ int PMPI_Comm_call_errhandler(MPI_Comm comm,int errorcode){
   NOT_YET_IMPLEMENTED
 }
 
-int PMPI_Info_dup(MPI_Info info, MPI_Info *newinfo){
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Info_delete(MPI_Info info, char *key){
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Info_get_nkeys( MPI_Info info, int *nkeys){
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Info_get_nthkey( MPI_Info info, int n, char *key){
-  NOT_YET_IMPLEMENTED
-}
-
-int PMPI_Info_get_valuelen( MPI_Info info, char *key, int *valuelen, int *flag){
-  NOT_YET_IMPLEMENTED
-}
-
 int PMPI_Request_get_status( MPI_Request request, int *flag, MPI_Status *status){
   NOT_YET_IMPLEMENTED
 }