src/smpi/smpi_comm.cpp

   1 /* Copyright (c) 2010-2015. The SimGrid Team.
   2  * All rights reserved.                                                     */
   3
   4 /* This program is free software; you can redistribute it and/or modify it
   5  * under the terms of the license (GNU LGPL) which comes with this package. */
   6
   7 #include <stdlib.h>
   8
   9 #include "private.h"
  10 #include "xbt/dict.h"
  11 #include "smpi_mpi_dt_private.h"
  12 #include "limits.h"
  13 #include "src/simix/smx_private.h"
  14 #include "colls/colls.h"
  15 #include "xbt/ex.h"
  16
  17 XBT_LOG_NEW_DEFAULT_SUBCATEGORY(smpi_comm, smpi, "Logging specific to SMPI (comm)");
  18
  19 xbt_dict_t smpi_comm_keyvals = NULL;
  20 int comm_keyval_id = 0;//avoid collisions
  21
  22 /* Support for cartesian topology was added, but there are 2 other types of topology, graph et dist graph. In order to
  23  * support them, we have to add a field MPIR_Topo_type, and replace the MPI_Topology field by an union. */
  24
  25 typedef struct s_smpi_mpi_communicator {
  26   MPI_Group group;
  27   MPIR_Topo_type topoType;
  28   MPI_Topology topo; // to be replaced by an union
  29   int refcount;
  30   MPI_Comm leaders_comm;//inter-node communicator
  31   MPI_Comm intra_comm;//intra-node communicator . For MPI_COMM_WORLD this can't be used, as var is global.
  32   //use an intracomm stored in the process data instead
  33   int* leaders_map; //who is the leader of each process
  34   int is_uniform;
  35   int* non_uniform_map; //set if smp nodes have a different number of processes allocated
  36   int is_blocked;// are ranks allocated on the same smp node contiguous ?
  37   xbt_dict_t attributes;
  38 } s_smpi_mpi_communicator_t;
  39
  40 static int smpi_compare_rankmap(const void *a, const void *b)
  41 {
  42   const int* x = (const int*)a;
  43   const int* y = (const int*)b;
  44
  45   if (x[1] < y[1]) {
  46     return -1;
  47   }
  48   if (x[1] == y[1]) {
  49     if (x[0] < y[0]) {
  50       return -1;
  51     }
  52     if (x[0] == y[0]) {
  53       return 0;
  54     }
  55     return 1;
  56   }
  57   return 1;
  58 }
  59
  60 MPI_Comm smpi_comm_new(MPI_Group group, MPI_Topology topo)
  61 {
  62   MPI_Comm comm;
  63
  64   comm = xbt_new(s_smpi_mpi_communicator_t, 1);
  65   comm->group = group;
  66   comm->refcount=1;
  67   comm->topoType = MPI_INVALID_TOPO;
  68   comm->topo = topo;
  69   comm->intra_comm = MPI_COMM_NULL;
  70   comm->leaders_comm = MPI_COMM_NULL;
  71   comm->is_uniform=1;
  72   comm->non_uniform_map = NULL;
  73   comm->leaders_map = NULL;
  74   comm->is_blocked=0;
  75   comm->attributes=NULL;
  76   return comm;
  77 }
  78
  79 void smpi_comm_destroy(MPI_Comm comm)
  80 {
  81   if (comm == MPI_COMM_UNINITIALIZED)
  82     comm = smpi_process_comm_world();
  83   smpi_topo_destroy(comm->topo); // there's no use count on topos
  84   smpi_comm_unuse(comm);
  85 }
  86
  87 int smpi_comm_dup(MPI_Comm comm, MPI_Comm* newcomm){
  88   if(smpi_privatize_global_variables){ //we need to switch as the called function may silently touch global variables
  89      smpi_switch_data_segment(smpi_process_index());
  90    }
  91   MPI_Group cp=smpi_group_copy(smpi_comm_group(comm));
  92   (*newcomm) = smpi_comm_new(cp, smpi_comm_topo(comm));
  93   int ret = MPI_SUCCESS;
  94   //todo: faire en sorte que ça fonctionne avec un communicator dupliqué (refaire un init_smp ?)
  95
  96  /* MPI_Comm tmp=smpi_comm_get_intra_comm(comm);
  97   if( tmp != MPI_COMM_NULL)
  98     smpi_comm_set_intra_comm((*newcomm), smpi_comm_dup(tmp));
  99   tmp=smpi_comm_get_leaders_comm(comm);
 100   if( tmp != MPI_COMM_NULL)
 101     smpi_comm_set_leaders_comm((*newcomm), smpi_comm_dup(tmp));
 102   if(comm->non_uniform_map !=NULL){
 103     (*newcomm)->non_uniform_map=
 104       xbt_malloc(smpi_comm_size(comm->leaders_comm)*sizeof(int));
 105     memcpy((*newcomm)->non_uniform_map,
 106       comm->non_uniform_map,smpi_comm_size(comm->leaders_comm)*sizeof(int) );
 107   }
 108   if(comm->leaders_map !=NULL){
 109     (*newcomm)->leaders_map=xbt_malloc(smpi_comm_size(comm)*sizeof(int));
 110     memcpy((*newcomm)->leaders_map,
 111       comm->leaders_map,smpi_comm_size(comm)*sizeof(int) );
 112   }*/
 113   if(comm->attributes !=NULL){
 114       (*newcomm)->attributes=xbt_dict_new();
 115       xbt_dict_cursor_t cursor = NULL;
 116       int *key;
 117       int flag;
 118       void* value_in;
 119       void* value_out;
 120       xbt_dict_foreach(comm->attributes, cursor, key, value_in){
 121         smpi_comm_key_elem elem =
 122            static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null_ext(smpi_comm_keyvals, (const char*)key, sizeof(int)));
 123         if(elem && elem->copy_fn!=MPI_NULL_COPY_FN){
 124           ret = elem->copy_fn(comm, *key, NULL, value_in, &value_out, &flag );
 125           if(ret!=MPI_SUCCESS){
 126             smpi_comm_destroy(*newcomm);
 127             *newcomm=MPI_COMM_NULL;
 128             return ret;
 129           }
 130           if(flag)
 131             xbt_dict_set_ext((*newcomm)->attributes, (const char*)key, sizeof(int),value_out, NULL);
 132         }
 133       }
 134     }
 135   return ret;
 136 }
 137
 138 MPI_Group smpi_comm_group(MPI_Comm comm)
 139 {
 140   if (comm == MPI_COMM_UNINITIALIZED)
 141     comm = smpi_process_comm_world();
 142   return comm->group;
 143 }
 144
 145 MPI_Topology smpi_comm_topo(MPI_Comm comm) {
 146   if (comm != MPI_COMM_NULL)
 147     return comm->topo;
 148   return NULL;
 149 }
 150
 151 int smpi_comm_size(MPI_Comm comm)
 152 {
 153   if (comm == MPI_COMM_UNINITIALIZED)
 154     comm = smpi_process_comm_world();
 155   return smpi_group_size(smpi_comm_group(comm));
 156 }
 157
 158 int smpi_comm_rank(MPI_Comm comm)
 159 {
 160   if (comm == MPI_COMM_UNINITIALIZED)
 161     comm = smpi_process_comm_world();
 162   return smpi_group_rank(smpi_comm_group(comm), smpi_process_index());
 163 }
 164
 165 void smpi_comm_get_name (MPI_Comm comm, char* name, int* len)
 166 {
 167   if (comm == MPI_COMM_UNINITIALIZED)
 168     comm = smpi_process_comm_world();
 169   if(comm == MPI_COMM_WORLD) {
 170     strcpy(name, "WORLD");
 171     *len = 5;
 172   } else {
 173     *len = snprintf(name, MPI_MAX_NAME_STRING, "%p", comm);
 174   }
 175 }
 176
 177 void smpi_comm_set_leaders_comm(MPI_Comm comm, MPI_Comm leaders){
 178   if (comm == MPI_COMM_UNINITIALIZED)
 179     comm = smpi_process_comm_world();
 180   comm->leaders_comm=leaders;
 181 }
 182
 183 void smpi_comm_set_intra_comm(MPI_Comm comm, MPI_Comm leaders){
 184   comm->intra_comm=leaders;
 185 }
 186
 187 int* smpi_comm_get_non_uniform_map(MPI_Comm comm){
 188   if (comm == MPI_COMM_UNINITIALIZED)
 189     comm = smpi_process_comm_world();
 190   return comm->non_uniform_map;
 191 }
 192
 193 int* smpi_comm_get_leaders_map(MPI_Comm comm){
 194   if (comm == MPI_COMM_UNINITIALIZED)
 195     comm = smpi_process_comm_world();
 196   return comm->leaders_map;
 197 }
 198
 199 MPI_Comm smpi_comm_get_leaders_comm(MPI_Comm comm){
 200   if (comm == MPI_COMM_UNINITIALIZED)
 201     comm = smpi_process_comm_world();
 202   return comm->leaders_comm;
 203 }
 204
 205 MPI_Comm smpi_comm_get_intra_comm(MPI_Comm comm){
 206   if (comm == MPI_COMM_UNINITIALIZED || comm==MPI_COMM_WORLD)
 207     return smpi_process_get_comm_intra();
 208   else return comm->intra_comm;
 209 }
 210
 211 int smpi_comm_is_uniform(MPI_Comm comm){
 212   if (comm == MPI_COMM_UNINITIALIZED)
 213     comm = smpi_process_comm_world();
 214   return comm->is_uniform;
 215 }
 216
 217 int smpi_comm_is_blocked(MPI_Comm comm){
 218   if (comm == MPI_COMM_UNINITIALIZED)
 219     comm = smpi_process_comm_world();
 220   return comm->is_blocked;
 221 }
 222
 223 MPI_Comm smpi_comm_split(MPI_Comm comm, int color, int key)
 224 {
 225   if (comm == MPI_COMM_UNINITIALIZED)
 226     comm = smpi_process_comm_world();
 227   int system_tag = 123;
 228   int index, rank, size, i, j, count, reqs;
 229   int* sendbuf;
 230   int* recvbuf;
 231   int* rankmap;
 232   MPI_Group group, group_root, group_out;
 233   MPI_Group* group_snd;
 234   MPI_Request* requests;
 235
 236   group_root = group_out = NULL;
 237   group = smpi_comm_group(comm);
 238   rank = smpi_comm_rank(comm);
 239   size = smpi_comm_size(comm);
 240   /* Gather all colors and keys on rank 0 */
 241   sendbuf = xbt_new(int, 2);
 242   sendbuf[0] = color;
 243   sendbuf[1] = key;
 244   if(rank == 0) {
 245     recvbuf = xbt_new(int, 2 * size);
 246   } else {
 247     recvbuf = NULL;
 248   }
 249   smpi_mpi_gather(sendbuf, 2, MPI_INT, recvbuf, 2, MPI_INT, 0, comm);
 250   xbt_free(sendbuf);
 251   /* Do the actual job */
 252   if(rank == 0) {
 253     group_snd = xbt_new(MPI_Group, size);
 254     rankmap = xbt_new(int, 2 * size);
 255     for(i = 0; i < size; i++) {
 256       if(recvbuf[2 * i] == MPI_UNDEFINED) {
 257         continue;
 258       }
 259       count = 0;
 260       for(j = i + 1; j < size; j++)  {
 261         if(recvbuf[2 * i] == recvbuf[2 * j]) {
 262           recvbuf[2 * j] = MPI_UNDEFINED;
 263           rankmap[2 * count] = j;
 264           rankmap[2 * count + 1] = recvbuf[2 * j + 1];
 265           count++;
 266         }
 267       }
 268       /* Add self in the group */
 269       recvbuf[2 * i] = MPI_UNDEFINED;
 270       rankmap[2 * count] = i;
 271       rankmap[2 * count + 1] = recvbuf[2 * i + 1];
 272       count++;
 273       qsort(rankmap, count, 2 * sizeof(int), &smpi_compare_rankmap);
 274       group_out = smpi_group_new(count);
 275       if(i == 0) {
 276         group_root = group_out; /* Save root's group */
 277       }
 278       for(j = 0; j < count; j++) {
 279         index = smpi_group_index(group, rankmap[2 * j]);
 280         smpi_group_set_mapping(group_out, index, j);
 281       }
 282       requests = xbt_new(MPI_Request, count);
 283       reqs = 0;
 284       for(j = 0; j < count; j++) {
 285         if(rankmap[2 * j] != 0) {
 286           group_snd[reqs]=smpi_group_copy(group_out);
 287           requests[reqs] = smpi_mpi_isend(&(group_snd[reqs]), 1, MPI_PTR, rankmap[2 * j], system_tag, comm);
 288           reqs++;
 289         }
 290       }
 291       if(i != 0) {
 292         smpi_group_destroy(group_out);
 293       }
 294       smpi_mpi_waitall(reqs, requests, MPI_STATUS_IGNORE);
 295       xbt_free(requests);
 296     }
 297     xbt_free(recvbuf);
 298     xbt_free(rankmap);
 299     xbt_free(group_snd);
 300     group_out = group_root; /* exit with root's group */
 301   } else {
 302     if(color != MPI_UNDEFINED) {
 303       smpi_mpi_recv(&group_out, 1, MPI_PTR, 0, system_tag, comm, MPI_STATUS_IGNORE);
 304     } /* otherwise, exit with group_out == NULL */
 305   }
 306   return group_out ? smpi_comm_new(group_out, NULL) : MPI_COMM_NULL;
 307 }
 308
 309 void smpi_comm_use(MPI_Comm comm){
 310   if (comm == MPI_COMM_UNINITIALIZED)
 311     comm = smpi_process_comm_world();
 312   smpi_group_use(comm->group);
 313   comm->refcount++;
 314 }
 315
 316 void smpi_comm_cleanup_attributes(MPI_Comm comm){
 317   if(comm->attributes !=NULL){
 318     xbt_dict_cursor_t cursor = NULL;
 319     int* key;
 320     void * value;
 321     int flag;
 322     xbt_dict_foreach(comm->attributes, cursor, key, value){
 323       smpi_comm_key_elem elem =
 324          static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null(smpi_comm_keyvals, (const char*)key));
 325       if(elem &&  elem->delete_fn)
 326         elem->delete_fn(comm, *key, value, &flag);
 327     }
 328     xbt_dict_free(&comm->attributes);
 329   }
 330 }
 331
 332 void smpi_comm_cleanup_smp(MPI_Comm comm){
 333     if(comm->intra_comm != MPI_COMM_NULL)
 334       smpi_comm_unuse(comm->intra_comm);
 335     if(comm->leaders_comm != MPI_COMM_NULL)
 336       smpi_comm_unuse(comm->leaders_comm);
 337     if(comm->non_uniform_map !=NULL)
 338       xbt_free(comm->non_uniform_map);
 339     if(comm->leaders_map !=NULL)
 340       xbt_free(comm->leaders_map);
 341 }
 342
 343 void smpi_comm_unuse(MPI_Comm comm){
 344   if (comm == MPI_COMM_UNINITIALIZED)
 345     comm = smpi_process_comm_world();
 346   comm->refcount--;
 347   smpi_group_unuse(comm->group);
 348
 349   if(comm->refcount==0){
 350     smpi_comm_cleanup_smp(comm);
 351     smpi_comm_cleanup_attributes(comm);
 352     xbt_free(comm);
 353   }
 354 }
 355
 356 static int compare_ints (const void *a, const void *b)
 357 {
 358   const int *da = (const int *) a;
 359   const int *db = (const int *) b;
 360
 361   return (*da > *db) - (*da < *db);
 362 }
 363
 364 void smpi_comm_init_smp(MPI_Comm comm){
 365   int leader = -1;
 366
 367   if (comm == MPI_COMM_UNINITIALIZED)
 368     comm = smpi_process_comm_world();
 369
 370   int comm_size =smpi_comm_size(comm);
 371
 372   // If we are in replay - perform an ugly hack
 373   // tell SimGrid we are not in replay for a while, because we need the buffers to be copied for the following calls
 374   int replaying = 0; //cache data to set it back again after
 375   if(smpi_process_get_replaying()){
 376    replaying=1;
 377    smpi_process_set_replaying(0);
 378   }
 379
 380   if(smpi_privatize_global_variables){ //we need to switch as the called function may silently touch global variables
 381      smpi_switch_data_segment(smpi_process_index());
 382    }
 383   //identify neighbours in comm
 384   //get the indexes of all processes sharing the same simix host
 385   xbt_swag_t process_list = SIMIX_host_self()->processes();
 386   int intra_comm_size = 0;
 387   //only one process/node, disable SMP support and return
 388 //  if(intra_comm_size==1){
 389 //      smpi_comm_set_intra_comm(comm, MPI_COMM_SELF);
 390 //      //smpi_comm_set_leaders_comm(comm, comm);
 391 //      smpi_process_set_comm_intra(MPI_COMM_SELF);
 392 //      return;
 393 //  }
 394   int i =0;
 395   int min_index=INT_MAX;//the minimum index will be the leader
 396   smx_process_t process = NULL;
 397   xbt_swag_foreach(process, process_list) {
 398     //is_in_comm=0;
 399     int index = SIMIX_process_get_PID(process) -1;
 400
 401     if(smpi_group_rank(smpi_comm_group(comm),  index)!=MPI_UNDEFINED){
 402         intra_comm_size++;
 403       //the process is in the comm
 404       if(index < min_index)
 405         min_index=index;
 406       i++;
 407     }
 408   }
 409   XBT_DEBUG("number of processes deployed on my node : %d", intra_comm_size);
 410   MPI_Group group_intra = smpi_group_new(intra_comm_size);
 411   i=0;
 412   process = NULL;
 413   xbt_swag_foreach(process, process_list) {
 414     //is_in_comm=0;
 415     int index = SIMIX_process_get_PID(process) -1;
 416     if(smpi_group_rank(smpi_comm_group(comm),  index)!=MPI_UNDEFINED){
 417       smpi_group_set_mapping(group_intra, index, i);
 418       i++;
 419     }
 420   }
 421
 422   MPI_Comm comm_intra = smpi_comm_new(group_intra, NULL);
 423   //MPI_Comm shmem_comm = smpi_process_comm_intra();
 424   //int intra_rank = smpi_comm_rank(shmem_comm);
 425
 426   //if(smpi_process_index()==min_index)
 427   leader=min_index;
 428
 429   int * leaders_map= (int*)xbt_malloc0(sizeof(int)*comm_size);
 430   int * leader_list= (int*)xbt_malloc0(sizeof(int)*comm_size);
 431   for(i=0; i<comm_size; i++){
 432       leader_list[i]=-1;
 433   }
 434
 435   smpi_coll_tuned_allgather_mpich(&leader, 1, MPI_INT , leaders_map, 1, MPI_INT, comm);
 436
 437   if(smpi_privatize_global_variables){ //we need to switch as the called function may silently touch global variables
 438      smpi_switch_data_segment(smpi_process_index());
 439    }
 440
 441   if(!comm->leaders_map){
 442     comm->leaders_map= leaders_map;
 443   }else{
 444     xbt_free(leaders_map);
 445   }
 446   int j=0;
 447   int leader_group_size = 0;
 448   for(i=0; i<comm_size; i++){
 449       int already_done=0;
 450       for(j=0;j<leader_group_size; j++){
 451         if(comm->leaders_map[i]==leader_list[j]){
 452             already_done=1;
 453         }
 454       }
 455       if(!already_done){
 456         leader_list[leader_group_size]=comm->leaders_map[i];
 457         leader_group_size++;
 458       }
 459   }
 460   qsort(leader_list, leader_group_size, sizeof(int),compare_ints);
 461
 462   MPI_Group leaders_group = smpi_group_new(leader_group_size);
 463
 464   MPI_Comm leader_comm = MPI_COMM_NULL;
 465   if(MPI_COMM_WORLD!=MPI_COMM_UNINITIALIZED && comm!=MPI_COMM_WORLD){
 466     //create leader_communicator
 467     for (i=0; i< leader_group_size;i++)
 468       smpi_group_set_mapping(leaders_group, leader_list[i], i);
 469     leader_comm = smpi_comm_new(leaders_group, NULL);
 470     smpi_comm_set_leaders_comm(comm, leader_comm);
 471     smpi_comm_set_intra_comm(comm, comm_intra);
 472
 473    //create intracommunicator
 474    // smpi_comm_set_intra_comm(comm, smpi_comm_split(comm, *(int*)SIMIX_host_self(), comm_rank));
 475   }else{
 476     for (i=0; i< leader_group_size;i++)
 477       smpi_group_set_mapping(leaders_group, leader_list[i], i);
 478
 479     if(smpi_comm_get_leaders_comm(comm)==MPI_COMM_NULL){
 480       leader_comm = smpi_comm_new(leaders_group, NULL);
 481       smpi_comm_set_leaders_comm(comm, leader_comm);
 482     }else{
 483       leader_comm=smpi_comm_get_leaders_comm(comm);
 484       smpi_group_unuse(leaders_group);
 485     }
 486     smpi_process_set_comm_intra(comm_intra);
 487   }
 488
 489   int is_uniform = 1;
 490
 491   // Are the nodes uniform ? = same number of process/node
 492   int my_local_size=smpi_comm_size(comm_intra);
 493   if(smpi_comm_rank(comm_intra)==0) {
 494     int* non_uniform_map = xbt_new0(int,leader_group_size);
 495     smpi_coll_tuned_allgather_mpich(&my_local_size, 1, MPI_INT,
 496         non_uniform_map, 1, MPI_INT, leader_comm);
 497     for(i=0; i < leader_group_size; i++) {
 498       if(non_uniform_map[0] != non_uniform_map[i]) {
 499         is_uniform = 0;
 500         break;
 501       }
 502     }
 503     if(!is_uniform && smpi_comm_is_uniform(comm)){
 504         comm->non_uniform_map= non_uniform_map;
 505     }else{
 506         xbt_free(non_uniform_map);
 507     }
 508     comm->is_uniform=is_uniform;
 509   }
 510   smpi_coll_tuned_bcast_mpich(&(comm->is_uniform),1, MPI_INT, 0, comm_intra );
 511
 512   if(smpi_privatize_global_variables){ //we need to switch as the called function may silently touch global variables
 513      smpi_switch_data_segment(smpi_process_index());
 514    }
 515   // Are the ranks blocked ? = allocated contiguously on the SMP nodes
 516   int is_blocked=1;
 517   int prev=smpi_group_rank(smpi_comm_group(comm), smpi_group_index(smpi_comm_group(comm_intra), 0));
 518     for (i=1; i<my_local_size; i++){
 519       int that=smpi_group_rank(smpi_comm_group(comm),smpi_group_index(smpi_comm_group(comm_intra), i));
 520       if(that!=prev+1){
 521         is_blocked=0;
 522         break;
 523       }
 524       prev = that;
 525   }
 526
 527   int global_blocked;
 528   smpi_mpi_allreduce(&is_blocked, &(global_blocked), 1, MPI_INT, MPI_LAND, comm);
 529
 530   if(MPI_COMM_WORLD==MPI_COMM_UNINITIALIZED || comm==MPI_COMM_WORLD){
 531     if(smpi_comm_rank(comm)==0){
 532         comm->is_blocked=global_blocked;
 533     }
 534   }else{
 535     comm->is_blocked=global_blocked;
 536   }
 537   xbt_free(leader_list);
 538
 539   if(replaying==1)
 540     smpi_process_set_replaying(1);
 541 }
 542
 543 int smpi_comm_attr_delete(MPI_Comm comm, int keyval){
 544   smpi_comm_key_elem elem =
 545      static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null_ext(smpi_comm_keyvals, (const char*)&keyval, sizeof(int)));
 546   if(!elem)
 547     return MPI_ERR_ARG;
 548   if(elem->delete_fn!=MPI_NULL_DELETE_FN){
 549     void * value;
 550     int flag;
 551     if(smpi_comm_attr_get(comm, keyval, &value, &flag)==MPI_SUCCESS){
 552       int ret = elem->delete_fn(comm, keyval, value, &flag);
 553       if(ret!=MPI_SUCCESS) return ret;
 554     }
 555   }
 556   if(comm->attributes==NULL)
 557     return MPI_ERR_ARG;
 558
 559   xbt_dict_remove_ext(comm->attributes, (const char*)&keyval, sizeof(int));
 560   return MPI_SUCCESS;
 561 }
 562
 563 int smpi_comm_attr_get(MPI_Comm comm, int keyval, void* attr_value, int* flag){
 564   smpi_comm_key_elem elem =
 565     static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null_ext(smpi_comm_keyvals, (const char*)&keyval, sizeof(int)));
 566   if(!elem)
 567     return MPI_ERR_ARG;
 568   xbt_ex_t ex;
 569   if(comm->attributes==NULL){
 570     *flag=0;
 571     return MPI_SUCCESS;
 572   }
 573   TRY {
 574     *(void**)attr_value = xbt_dict_get_ext(comm->attributes,  (const char*)&keyval, sizeof(int));
 575     *flag=1;
 576   } CATCH(ex) {
 577     *flag=0;
 578     xbt_ex_free(ex);
 579   }
 580   return MPI_SUCCESS;
 581 }
 582
 583 int smpi_comm_attr_put(MPI_Comm comm, int keyval, void* attr_value){
 584   if(!smpi_comm_keyvals)
 585   smpi_comm_keyvals = xbt_dict_new();
 586   smpi_comm_key_elem elem =
 587     static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null_ext(smpi_comm_keyvals,  (const char*)&keyval, sizeof(int)));
 588   if(!elem )
 589     return MPI_ERR_ARG;
 590   int flag;
 591   void* value;
 592   smpi_comm_attr_get(comm, keyval, &value, &flag);
 593   if(flag && elem->delete_fn!=MPI_NULL_DELETE_FN){
 594     int ret = elem->delete_fn(comm, keyval, value, &flag);
 595     if(ret!=MPI_SUCCESS) return ret;
 596   }
 597   if(comm->attributes==NULL)
 598     comm->attributes=xbt_dict_new();
 599
 600   xbt_dict_set_ext(comm->attributes,  (const char*)&keyval, sizeof(int), attr_value, NULL);
 601   return MPI_SUCCESS;
 602 }
 603
 604 int smpi_comm_keyval_create(MPI_Comm_copy_attr_function* copy_fn, MPI_Comm_delete_attr_function* delete_fn, int* keyval,
 605                             void* extra_state){
 606   if(!smpi_comm_keyvals)
 607   smpi_comm_keyvals = xbt_dict_new();
 608
 609   smpi_comm_key_elem value = (smpi_comm_key_elem) xbt_new0(s_smpi_mpi_comm_key_elem_t,1);
 610
 611   value->copy_fn=copy_fn;
 612   value->delete_fn=delete_fn;
 613
 614   *keyval = comm_keyval_id;
 615   xbt_dict_set_ext(smpi_comm_keyvals, (const char*)keyval, sizeof(int),(void*)value, NULL);
 616   comm_keyval_id++;
 617   return MPI_SUCCESS;
 618 }
 619
 620 int smpi_comm_keyval_free(int* keyval){
 621   smpi_comm_key_elem elem =
 622      static_cast<smpi_comm_key_elem>(xbt_dict_get_or_null_ext(smpi_comm_keyvals,  (const char*)keyval, sizeof(int)));
 623   if(!elem){
 624     return MPI_ERR_ARG;
 625   }
 626   xbt_dict_remove_ext(smpi_comm_keyvals,  (const char*)keyval, sizeof(int));
 627   xbt_free(elem);
 628   return MPI_SUCCESS;
 629 }