src/smpi/smpi_mpi.c

   1 /* $Id$tag */
   2
   3 /* smpi_mpi.c --
   4  *
   5  * Eventually will contain the user level MPI primitives and its corresponding
   6  * internal wrapper. The implementations of these primitives should go to specific
   7  * files. For example, a SMPI_MPI_Bcast() in this file, should call the wrapper
   8  * smpi_mpi_bcast(), which decides which implementation to call. Currently, it
   9  * calls nary_tree_bcast() in smpi_coll.c.  (Stéphane Genaud).
  10  * */
  11
  12
  13
  14 #include "private.h"
  15 #include "smpi_coll_private.h"
  16 #include "smpi_mpi_dt_private.h"
  17
  18 XBT_LOG_NEW_DEFAULT_SUBCATEGORY(smpi_mpi, smpi,
  19                                 "Logging specific to SMPI (mpi)");
  20
  21 int SMPI_MPI_Init(int *argc, char ***argv)
  22 {
  23   smpi_process_init(argc, argv);
  24   smpi_bench_begin();
  25   return MPI_SUCCESS;
  26 }
  27
  28 int SMPI_MPI_Finalize()
  29 {
  30   smpi_bench_end();
  31   smpi_process_finalize();
  32   return MPI_SUCCESS;
  33 }
  34
  35 // right now this just exits the current node, should send abort signal to all
  36 // hosts in the communicator (TODO)
  37 int SMPI_MPI_Abort(MPI_Comm comm, int errorcode)
  38 {
  39   smpi_exit(errorcode);
  40   return 0;
  41 }
  42
  43 int SMPI_MPI_Comm_size(MPI_Comm comm, int *size)
  44 {
  45   int retval = MPI_SUCCESS;
  46
  47   smpi_bench_end();
  48
  49   if (NULL == comm) {
  50     retval = MPI_ERR_COMM;
  51   } else if (NULL == size) {
  52     retval = MPI_ERR_ARG;
  53   } else {
  54     *size = comm->size;
  55   }
  56
  57   smpi_bench_begin();
  58
  59   return retval;
  60 }
  61
  62 int SMPI_MPI_Comm_rank(MPI_Comm comm, int *rank)
  63 {
  64   int retval = MPI_SUCCESS;
  65
  66   smpi_bench_end();
  67
  68   if (NULL == comm) {
  69     retval = MPI_ERR_COMM;
  70   } else if (NULL == rank) {
  71     retval = MPI_ERR_ARG;
  72   } else {
  73     *rank = smpi_mpi_comm_rank(comm);
  74   }
  75
  76   smpi_bench_begin();
  77
  78   return retval;
  79 }
  80
  81
  82
  83 /**
  84  * Barrier
  85  **/
  86 int SMPI_MPI_Barrier(MPI_Comm comm)
  87 {
  88   int retval = MPI_SUCCESS;
  89   int arity=4;
  90
  91   smpi_bench_end();
  92
  93   if (NULL == comm) {
  94     retval = MPI_ERR_COMM;
  95   } else {
  96
  97     /*
  98      * original implemantation:
  99      * retval = smpi_mpi_barrier(comm);
 100      * this one is unrealistic: it just cond_waits, means no time.
 101      */
 102      retval = nary_tree_barrier( comm, arity );
 103   }
 104
 105   smpi_bench_begin();
 106
 107   return retval;
 108 }
 109
 110
 111
 112 int SMPI_MPI_Irecv(void *buf, int count, MPI_Datatype datatype, int src,
 113                    int tag, MPI_Comm comm, MPI_Request * request)
 114 {
 115   int retval = MPI_SUCCESS;
 116   int rank;
 117
 118   smpi_bench_end();
 119   rank = smpi_mpi_comm_rank(comm);
 120   retval = smpi_create_request(buf, count, datatype, src, rank, tag, comm,
 121                                request);
 122   if (NULL != *request && MPI_SUCCESS == retval) {
 123     retval = smpi_mpi_irecv(*request);
 124   }
 125
 126   smpi_bench_begin();
 127
 128   return retval;
 129 }
 130
 131 int SMPI_MPI_Recv(void *buf, int count, MPI_Datatype datatype, int src,
 132                   int tag, MPI_Comm comm, MPI_Status * status)
 133 {
 134   int retval = MPI_SUCCESS;
 135   int rank;
 136   smpi_mpi_request_t request;
 137
 138   smpi_bench_end();
 139
 140   rank = smpi_mpi_comm_rank(comm);
 141   retval = smpi_create_request(buf, count, datatype, src, rank, tag, comm,
 142                                &request);
 143   if (NULL != request && MPI_SUCCESS == retval) {
 144     retval = smpi_mpi_irecv(request);
 145     if (MPI_SUCCESS == retval) {
 146       retval = smpi_mpi_wait(request, status);
 147     }
 148     xbt_mallocator_release(smpi_global->request_mallocator, request);
 149   }
 150
 151   smpi_bench_begin();
 152
 153   return retval;
 154 }
 155
 156 int SMPI_MPI_Isend(void *buf, int count, MPI_Datatype datatype, int dst,
 157                    int tag, MPI_Comm comm, MPI_Request * request)
 158 {
 159   int retval = MPI_SUCCESS;
 160   int rank;
 161
 162   smpi_bench_end();
 163
 164   rank = smpi_mpi_comm_rank(comm);
 165   retval = smpi_create_request(buf, count, datatype, rank, dst, tag, comm,
 166                                request);
 167   if (NULL != *request && MPI_SUCCESS == retval) {
 168     retval = smpi_mpi_isend(*request);
 169   }
 170
 171   smpi_bench_begin();
 172
 173   return retval;
 174 }
 175
 176 /**
 177  * MPI_Send user level
 178  **/
 179 int SMPI_MPI_Send(void *buf, int count, MPI_Datatype datatype, int dst,
 180                   int tag, MPI_Comm comm)
 181 {
 182   int retval = MPI_SUCCESS;
 183   int rank;
 184   smpi_mpi_request_t request;
 185
 186   smpi_bench_end();
 187
 188   rank = smpi_mpi_comm_rank(comm);
 189   retval = smpi_create_request(buf, count, datatype, rank, dst, tag, comm,
 190                                &request);
 191   if (NULL != request && MPI_SUCCESS == retval) {
 192     retval = smpi_mpi_isend(request);
 193     if (MPI_SUCCESS == retval) {
 194       smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 195     }
 196     xbt_mallocator_release(smpi_global->request_mallocator, request);
 197   }
 198
 199   smpi_bench_begin();
 200
 201   return retval;
 202 }
 203
 204
 205 /**
 206  * MPI_Sendrecv internal level
 207  **/
 208 int smpi_mpi_sendrecv(void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag,
 209                     void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag,
 210                     MPI_Comm comm, MPI_Status *status)
 211 {
 212 int rank;
 213 int retval = MPI_SUCCESS;
 214 smpi_mpi_request_t srequest;
 215 smpi_mpi_request_t rrequest;
 216
 217           rank = smpi_mpi_comm_rank(comm);
 218
 219           /* send */
 220           retval = smpi_create_request(sendbuf, sendcount, sendtype,
 221                                 rank,dest,sendtag,
 222                                 comm, &srequest);
 223           smpi_mpi_isend(srequest);
 224
 225           /* recv */
 226           retval = smpi_create_request(recvbuf, recvcount, recvtype,
 227                                 source, rank,recvtag,
 228                                 comm, &rrequest);
 229           smpi_mpi_irecv(rrequest);
 230
 231           smpi_mpi_wait(srequest, MPI_STATUS_IGNORE);
 232           //printf("[%d] isend request src=%d dst=%d tag=%d COMPLETED (retval=%d) \n",rank,rank,dest,sendtag,retval);
 233           smpi_mpi_wait(rrequest, MPI_STATUS_IGNORE);
 234           //printf("[%d] irecv request src=%d -> dst=%d tag=%d COMPLETED (retval=%d)\n",rank,source,rank,recvtag,retval);
 235
 236           return(retval);
 237 }
 238 /**
 239  * MPI_Sendrecv user entry point
 240  **/
 241 int SMPI_MPI_Sendrecv(void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag,
 242                     void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag,
 243                     MPI_Comm comm, MPI_Status *status)
 244 {
 245 int retval = MPI_SUCCESS;
 246
 247   smpi_bench_end();
 248   smpi_mpi_sendrecv( sendbuf, sendcount, sendtype, dest, sendtag,
 249                          recvbuf, recvcount, recvtype, source, recvtag,
 250                          comm, status);
 251   smpi_bench_begin();
 252
 253   return retval;
 254
 255
 256 }
 257
 258 /**
 259  * MPI_Wait and friends
 260  **/
 261 int SMPI_MPI_Wait(MPI_Request * request, MPI_Status * status)
 262 {
 263   int retval;
 264
 265   smpi_bench_end();
 266   retval = smpi_mpi_wait(*request, status);
 267   smpi_bench_begin();
 268   return retval;
 269 }
 270
 271 int SMPI_MPI_Waitall(int count, MPI_Request requests[], MPI_Status status[])
 272 {
 273   int retval;
 274
 275   smpi_bench_end();
 276   retval = smpi_mpi_waitall(count, requests, status);
 277   smpi_bench_begin();
 278   return retval;
 279 }
 280
 281 int SMPI_MPI_Waitany(int count, MPI_Request requests[], int *index,
 282                      MPI_Status status[])
 283 {
 284   int retval;
 285
 286   smpi_bench_end();
 287   retval = smpi_mpi_waitany(count, requests, index, status);
 288   smpi_bench_begin();
 289   return retval;
 290 }
 291
 292 /**
 293  * MPI_Bcast
 294  **/
 295
 296 /**
 297  * flat bcast
 298  **/
 299 int flat_tree_bcast(void *buf, int count, MPI_Datatype datatype, int root, MPI_Comm comm);
 300 int flat_tree_bcast(void *buf, int count, MPI_Datatype datatype, int root,
 301                 MPI_Comm comm)
 302 {
 303         int rank;
 304         int retval = MPI_SUCCESS;
 305         smpi_mpi_request_t request;
 306
 307         rank = smpi_mpi_comm_rank(comm);
 308         if (rank == root) {
 309                 retval = smpi_create_request(buf, count, datatype, root,
 310                                 (root + 1) % comm->size, 0, comm, &request);
 311                 request->forward = comm->size - 1;
 312                 smpi_mpi_isend(request);
 313         } else {
 314                 retval = smpi_create_request(buf, count, datatype, MPI_ANY_SOURCE, rank,
 315                                 0, comm, &request);
 316                 smpi_mpi_irecv(request);
 317         }
 318
 319         smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 320         xbt_mallocator_release(smpi_global->request_mallocator, request);
 321
 322         return(retval);
 323
 324 }
 325 /**
 326  * Bcast internal level
 327  **/
 328 int smpi_mpi_bcast(void *buf, int count, MPI_Datatype datatype, int root,
 329                    MPI_Comm comm)
 330 {
 331   int retval = MPI_SUCCESS;
 332   int rank = smpi_mpi_comm_rank(comm);
 333
 334   DEBUG1("<%d> entered smpi_mpi_bcast(). Calls nary_tree_bcast()",rank);
 335   //retval = flat_tree_bcast(buf, count, datatype, root, comm);
 336   retval = nary_tree_bcast(buf, count, datatype, root, comm, 2 );
 337   return retval;
 338 }
 339
 340 /**
 341  * Bcast user entry point
 342  **/
 343 int SMPI_MPI_Bcast(void *buf, int count, MPI_Datatype datatype, int root,
 344                    MPI_Comm comm)
 345 {
 346   int retval = MPI_SUCCESS;
 347
 348   smpi_bench_end();
 349   smpi_mpi_bcast(buf,count,datatype,root,comm);
 350   smpi_bench_begin();
 351
 352   return retval;
 353 }
 354
 355
 356
 357 #ifdef DEBUG_REDUCE
 358 /**
 359  * debugging helper function
 360  **/
 361 static void print_buffer_int(void *buf, int len, char *msg, int rank)
 362 {
 363   int tmp, *v;
 364   printf("**[%d] %s: ", rank, msg);
 365   for (tmp = 0; tmp < len; tmp++) {
 366     v = buf;
 367     printf("[%d]", v[tmp]);
 368   }
 369   printf("\n");
 370   free(msg);
 371 }
 372 static void print_buffer_double(void *buf, int len, char *msg, int rank)
 373 {
 374   int tmp;
 375   double *v;
 376   printf("**[%d] %s: ", rank, msg);
 377   for (tmp = 0; tmp < len; tmp++) {
 378     v = buf;
 379     printf("[%lf]", v[tmp]);
 380   }
 381   printf("\n");
 382   free(msg);
 383 }
 384
 385
 386 #endif
 387 /**
 388  * MPI_Reduce internal level
 389  **/
 390 int smpi_mpi_reduce(void *sendbuf, void *recvbuf, int count,
 391                 MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
 392 {
 393         int retval = MPI_SUCCESS;
 394         int rank;
 395         int size;
 396         int i;
 397         int system_tag = 666;
 398         smpi_mpi_request_t *requests;
 399         smpi_mpi_request_t request;
 400
 401         smpi_bench_end();
 402
 403         rank = smpi_mpi_comm_rank(comm);
 404         size = comm->size;
 405         DEBUG1("<%d> entered smpi_mpi_reduce()",rank);
 406
 407         if (rank != root) {           // if i am not ROOT, simply send my buffer to root
 408
 409 #ifdef DEBUG_REDUCE
 410                 print_buffer_int(sendbuf, count, xbt_strdup("sndbuf"), rank);
 411 #endif
 412                 retval = smpi_create_request(sendbuf, count, datatype, rank, root, system_tag, comm,
 413                                         &request);
 414                 smpi_mpi_isend(request);
 415                 smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 416                 xbt_mallocator_release(smpi_global->request_mallocator, request);
 417
 418         } else {
 419                 // i am the ROOT: wait for all buffers by creating one request by sender
 420                 int src;
 421                 requests = xbt_malloc((size-1) * sizeof(smpi_mpi_request_t));
 422
 423                 void **tmpbufs = xbt_malloc((size-1) * sizeof(void *));
 424                 for (i = 0; i < size-1; i++) {
 425                         // we need 1 buffer per request to store intermediate receptions
 426                         tmpbufs[i] = xbt_malloc(count * datatype->size);
 427                 }
 428                 // root: initiliaze recv buf with my own snd buf
 429                 memcpy(recvbuf, sendbuf, count * datatype->size * sizeof(char));
 430
 431                 // i can not use: 'request->forward = size-1;' (which would progagate size-1 receive reqs)
 432                 // since we should op values as soon as one receiving request matches.
 433                 for (i = 0; i < size-1; i++) {
 434                         // reminder: for smpi_create_request() the src is always the process sending.
 435                         src = i < root ? i : i + 1;
 436                         retval = smpi_create_request(tmpbufs[i], count, datatype,
 437                                         src, root, system_tag, comm, &(requests[i]));
 438                         if (NULL != requests[i] && MPI_SUCCESS == retval) {
 439                                 if (MPI_SUCCESS == retval) {
 440                                         smpi_mpi_irecv(requests[i]);
 441                                 }
 442                         }
 443                 }
 444                 // now, wait for completion of all irecv's.
 445                 for (i = 0; i < size-1; i++) {
 446                         int index = MPI_UNDEFINED;
 447                         smpi_mpi_waitany( size-1, requests, &index, MPI_STATUS_IGNORE);
 448                         DEBUG3("<%d> waitany() unblocked by reception (completes request[%d]) (%d reqs remaining)",
 449                                         rank,index,size-i-2);
 450 #ifdef DEBUG_REDUCE
 451                         print_buffer_int(tmpbufs[index], count, bprintf("tmpbufs[index=%d] (value received)", index),
 452                                         rank);
 453 #endif
 454
 455                         // arg 2 is modified
 456                         op->func(tmpbufs[index], recvbuf, &count, &datatype);
 457 #ifdef DEBUG_REDUCE
 458                         print_buffer_int(recvbuf, count, xbt_strdup("rcvbuf"), rank);
 459 #endif
 460                         xbt_free(tmpbufs[index]);
 461                         /* FIXME: with the following line, it  generates an
 462                          * [xbt_ex/CRITICAL] Conditional list not empty 162518800.
 463                          * Fixed ?
 464                          */
 465                         xbt_mallocator_release(smpi_global->request_mallocator, requests[index]);
 466                 }
 467                 xbt_free(requests);
 468                 xbt_free(tmpbufs);
 469         }
 470         return retval;
 471 }
 472
 473 /**
 474  * MPI_Reduce user entry point
 475  **/
 476 int SMPI_MPI_Reduce(void *sendbuf, void *recvbuf, int count,
 477                     MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm)
 478 {
 479 int retval = MPI_SUCCESS;
 480
 481           smpi_bench_end();
 482
 483           retval = smpi_mpi_reduce(sendbuf, recvbuf, count, datatype, op, root, comm);
 484
 485           smpi_bench_begin();
 486           return retval;
 487 }
 488
 489
 490
 491 /**
 492  * MPI_Allreduce
 493  *
 494  * Same as MPI_Reduce except that the result appears in the receive buffer of all the group members.
 495  **/
 496 int SMPI_MPI_Allreduce( void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype,
 497                     MPI_Op op, MPI_Comm comm )
 498 {
 499 int retval = MPI_SUCCESS;
 500 int root=0;  // arbitrary choice
 501
 502           smpi_bench_end();
 503
 504           retval = smpi_mpi_reduce( sendbuf, recvbuf, count, datatype, op, root, comm);
 505           if (MPI_SUCCESS != retval)
 506                     return(retval);
 507
 508           retval = smpi_mpi_bcast( sendbuf, count, datatype, root, comm);
 509
 510           smpi_bench_end();
 511           return( retval );
 512 }
 513
 514
 515 /**
 516  * MPI_Scatter user entry point
 517  **/
 518 int SMPI_MPI_Scatter(void *sendbuf, int sendcount, MPI_Datatype datatype,
 519                          void *recvbuf, int recvcount, MPI_Datatype recvtype,
 520                            int root, MPI_Comm comm)
 521 {
 522   int retval = MPI_SUCCESS;
 523   int i;
 524   int cnt=0;
 525   int rank;
 526   int tag=0;
 527   char *cptr;  // to manipulate the void * buffers
 528   smpi_mpi_request_t *requests;
 529   smpi_mpi_request_t request;
 530   smpi_mpi_status_t status;
 531
 532
 533   smpi_bench_end();
 534
 535   rank = smpi_mpi_comm_rank(comm);
 536
 537   requests = xbt_malloc((comm->size-1) * sizeof(smpi_mpi_request_t));
 538   if (rank == root) {
 539           // i am the root: distribute my sendbuf
 540           //print_buffer_int(sendbuf, comm->size, xbt_strdup("rcvbuf"), rank);
 541           cptr = sendbuf;
 542           for (i=0; i < comm->size; i++) {
 543                   if ( i!=root ) { // send to processes ...
 544
 545                           retval = smpi_create_request((void *)cptr, sendcount,
 546                                           datatype, root, i, tag, comm, &(requests[cnt]));
 547                           if (NULL != requests[cnt] && MPI_SUCCESS == retval) {
 548                                   if (MPI_SUCCESS == retval) {
 549                                           smpi_mpi_isend(requests[cnt]);
 550                                   }
 551                                   }
 552                                   cnt++;
 553                         }
 554                         else { // ... except if it's me.
 555                                   memcpy(recvbuf, (void *)cptr, recvcount*recvtype->size*sizeof(char));
 556                         }
 557                   cptr += sendcount*datatype->size;
 558             }
 559             for(i=0; i<cnt; i++) { // wait for send to complete
 560                             /* FIXME: waitall() should be slightly better */
 561                             smpi_mpi_wait(requests[i], &status);
 562                             xbt_mallocator_release(smpi_global->request_mallocator, requests[i]);
 563
 564             }
 565   }
 566   else {  // i am a non-root process: wait data from the root
 567             retval = smpi_create_request(recvbuf,recvcount,
 568                                   recvtype, root, rank, tag, comm, &request);
 569             if (NULL != request && MPI_SUCCESS == retval) {
 570                         if (MPI_SUCCESS == retval) {
 571                                   smpi_mpi_irecv(request);
 572                         }
 573             }
 574             smpi_mpi_wait(request, &status);
 575             xbt_mallocator_release(smpi_global->request_mallocator, request);
 576   }
 577   xbt_free(requests);
 578
 579   smpi_bench_begin();
 580
 581   return retval;
 582 }
 583
 584
 585 /**
 586  * MPI_Alltoall user entry point
 587  *
 588  * Uses the logic of OpenMPI (upto 1.2.7 or greater) for the optimizations
 589  * ompi/mca/coll/tuned/coll_tuned_module.c
 590  **/
 591 int SMPI_MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype datatype,
 592                           void *recvbuf, int recvcount, MPI_Datatype recvtype,
 593                             MPI_Comm comm)
 594 {
 595   int retval = MPI_SUCCESS;
 596   int block_dsize;
 597   int rank;
 598
 599   smpi_bench_end();
 600
 601   rank = smpi_mpi_comm_rank(comm);
 602   block_dsize = datatype->size * sendcount;
 603   DEBUG2("<%d> optimized alltoall() called. Block size sent to each rank: %d bytes.",rank,block_dsize);
 604
 605   if ((block_dsize < 200) && (comm->size > 12)) {
 606             retval = smpi_coll_tuned_alltoall_bruck(sendbuf, sendcount, datatype,
 607                                   recvbuf, recvcount, recvtype, comm);
 608
 609   } else if (block_dsize < 3000) {
 610             retval = smpi_coll_tuned_alltoall_basic_linear(sendbuf, sendcount, datatype,
 611                                   recvbuf, recvcount, recvtype, comm);
 612   } else {
 613
 614   retval = smpi_coll_tuned_alltoall_pairwise(sendbuf, sendcount, datatype,
 615                                   recvbuf, recvcount, recvtype, comm);
 616   }
 617
 618   smpi_bench_begin();
 619
 620   return retval;
 621 }
 622
 623 /**
 624  * MPI_Alltoallv user entry point
 625  *
 626  * As in OpenMPI, alltoallv is not optimized
 627  * ompi/mca/coll/basic/coll_basic_alltoallv.c
 628  **/
 629 int SMPI_MPI_Alltoallv(void *sendbuf, int *scounts, int *sdisps, MPI_Datatype datatype,
 630                            void *recvbuf, int *rcounts, int *rdisps, MPI_Datatype recvtype,
 631                              MPI_Comm comm)
 632 {
 633   int retval = MPI_SUCCESS;
 634   int rank;
 635
 636   smpi_bench_end();
 637   rank = smpi_mpi_comm_rank(comm);
 638   DEBUG1("<%d> basic alltoallv() called.",rank);
 639
 640   retval = smpi_coll_basic_alltoallv(sendbuf, scounts, sdisps, datatype,
 641                                      recvbuf, rcounts, rdisps, recvtype,
 642                                      comm);
 643   smpi_bench_begin();
 644   return retval;
 645 }
 646
 647
 648
 649
 650 // used by comm_split to sort ranks based on key values
 651 int smpi_compare_rankkeys(const void *a, const void *b);
 652 int smpi_compare_rankkeys(const void *a, const void *b)
 653 {
 654   int *x = (int *) a;
 655   int *y = (int *) b;
 656
 657   if (x[1] < y[1])
 658     return -1;
 659
 660   if (x[1] == y[1]) {
 661     if (x[0] < y[0])
 662       return -1;
 663     if (x[0] == y[0])
 664       return 0;
 665     return 1;
 666   }
 667
 668   return 1;
 669 }
 670
 671 int SMPI_MPI_Comm_split(MPI_Comm comm, int color, int key,
 672                         MPI_Comm * comm_out)
 673 {
 674   int retval = MPI_SUCCESS;
 675
 676   int index, rank;
 677   smpi_mpi_request_t request;
 678   int colorkey[2];
 679   smpi_mpi_status_t status;
 680
 681   smpi_bench_end();
 682
 683   // FIXME: need to test parameters
 684
 685   index = smpi_process_index();
 686   rank = comm->index_to_rank_map[index];
 687
 688   // default output
 689   comm_out = NULL;
 690
 691   // root node does most of the real work
 692   if (0 == rank) {
 693     int colormap[comm->size];
 694     int keymap[comm->size];
 695     int rankkeymap[comm->size * 2];
 696     int i, j;
 697     smpi_mpi_communicator_t tempcomm = NULL;
 698     int count;
 699     int indextmp;
 700
 701     colormap[0] = color;
 702     keymap[0] = key;
 703
 704     // FIXME: use scatter/gather or similar instead of individual comms
 705     for (i = 1; i < comm->size; i++) {
 706       retval = smpi_create_request(colorkey, 2, MPI_INT, MPI_ANY_SOURCE,
 707                                    rank, MPI_ANY_TAG, comm, &request);
 708       smpi_mpi_irecv(request);
 709       smpi_mpi_wait(request, &status);
 710       colormap[status.MPI_SOURCE] = colorkey[0];
 711       keymap[status.MPI_SOURCE] = colorkey[1];
 712       xbt_mallocator_release(smpi_global->request_mallocator, request);
 713     }
 714
 715     for (i = 0; i < comm->size; i++) {
 716       if (MPI_UNDEFINED == colormap[i]) {
 717         continue;
 718       }
 719       // make a list of nodes with current color and sort by keys
 720       count = 0;
 721       for (j = i; j < comm->size; j++) {
 722         if (colormap[i] == colormap[j]) {
 723           colormap[j] = MPI_UNDEFINED;
 724           rankkeymap[count * 2] = j;
 725           rankkeymap[count * 2 + 1] = keymap[j];
 726           count++;
 727         }
 728       }
 729       qsort(rankkeymap, count, sizeof(int) * 2, &smpi_compare_rankkeys);
 730
 731       // new communicator
 732       tempcomm = xbt_new(s_smpi_mpi_communicator_t, 1);
 733       tempcomm->barrier_count = 0;
 734       tempcomm->size = count;
 735       tempcomm->barrier_mutex = SIMIX_mutex_init();
 736       tempcomm->barrier_cond = SIMIX_cond_init();
 737       tempcomm->rank_to_index_map = xbt_new(int, count);
 738       tempcomm->index_to_rank_map = xbt_new(int, smpi_global->process_count);
 739       for (j = 0; j < smpi_global->process_count; j++) {
 740         tempcomm->index_to_rank_map[j] = -1;
 741       }
 742       for (j = 0; j < count; j++) {
 743         indextmp = comm->rank_to_index_map[rankkeymap[j * 2]];
 744         tempcomm->rank_to_index_map[j] = indextmp;
 745         tempcomm->index_to_rank_map[indextmp] = j;
 746       }
 747       for (j = 0; j < count; j++) {
 748         if (rankkeymap[j * 2]) {
 749           retval = smpi_create_request(&j, 1, MPI_INT, 0,
 750                                        rankkeymap[j * 2], 0, comm, &request);
 751           request->data = tempcomm;
 752           smpi_mpi_isend(request);
 753           smpi_mpi_wait(request, &status);
 754           xbt_mallocator_release(smpi_global->request_mallocator, request);
 755         } else {
 756           *comm_out = tempcomm;
 757         }
 758       }
 759     }
 760   } else {
 761     colorkey[0] = color;
 762     colorkey[1] = key;
 763     retval = smpi_create_request(colorkey, 2, MPI_INT, rank, 0, 0, comm,
 764                                  &request);
 765     smpi_mpi_isend(request);
 766     smpi_mpi_wait(request, &status);
 767     xbt_mallocator_release(smpi_global->request_mallocator, request);
 768     if (MPI_UNDEFINED != color) {
 769       retval = smpi_create_request(colorkey, 1, MPI_INT, 0, rank, 0, comm,
 770                                    &request);
 771       smpi_mpi_irecv(request);
 772       smpi_mpi_wait(request, &status);
 773       *comm_out = request->data;
 774     }
 775   }
 776
 777   smpi_bench_begin();
 778
 779   return retval;
 780 }
 781
 782 double SMPI_MPI_Wtime(void)
 783 {
 784   double time;
 785
 786   smpi_bench_end();
 787   time = SIMIX_get_clock();
 788   smpi_bench_begin();
 789   return time;
 790 }
 791
 792 int SMPI_MPI_Gather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
 793                     void* recvbuf, int recvcount, MPI_Datatype recvtype,
 794                     int root, MPI_Comm comm)
 795 {
 796   int retval = MPI_SUCCESS;
 797   int system_tag = 666;
 798   int rank, size;
 799
 800   smpi_bench_end();
 801   rank = smpi_mpi_comm_rank(comm);
 802   size = comm->size;
 803   if(rank != root) {
 804     // Send buffer to root
 805     smpi_mpi_request_t request;
 806
 807     retval = smpi_create_request(sendbuf, sendcount, sendtype,
 808                                  rank, root, system_tag, comm, &request);
 809     smpi_mpi_isend(request);
 810     smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 811     xbt_mallocator_release(smpi_global->request_mallocator, request);
 812   } else {
 813     // Receive buffers from senders
 814     int src;
 815     smpi_mpi_request_t* requests;
 816
 817     requests = xbt_malloc((size-1) * sizeof(smpi_mpi_request_t));
 818     for(src = 0; src < size; src++) {
 819       if(src == root) {
 820         // Local copy from root
 821         memcpy(&((char*)recvbuf)[src*recvcount*recvtype->size],
 822                sendbuf, sendcount*sendtype->size*sizeof(char));
 823       } else {
 824         int index = src < root ? src : src - 1;
 825         retval = smpi_create_request(&((char*)recvbuf)[src*recvcount*recvtype->size],
 826                                      recvcount, recvtype, src, root, system_tag,
 827                                      comm, &requests[index]);
 828         if(NULL != requests[index] && MPI_SUCCESS == retval) {
 829           smpi_mpi_irecv(requests[index]);
 830         }
 831       }
 832     }
 833     // Wait for completion of irecv's.
 834     for(src = 0; src < size - 1; src++) {
 835       int index = MPI_UNDEFINED;
 836       smpi_mpi_waitany(size - 1, requests, &index, MPI_STATUS_IGNORE);
 837       xbt_mallocator_release(smpi_global->request_mallocator, requests[index]);
 838     }
 839     xbt_free(requests);
 840   }
 841   smpi_bench_begin();
 842   return retval;
 843 }
 844
 845 int SMPI_MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
 846                      void* recvbuf, int* recvcounts, int* displs, MPI_Datatype recvtype,
 847                      int root, MPI_Comm comm)
 848 {
 849   int retval = MPI_SUCCESS;
 850   int system_tag = 666;
 851   int rank, size;
 852
 853   smpi_bench_end();
 854   rank = smpi_mpi_comm_rank(comm);
 855   size = comm->size;
 856   if(rank != root) {
 857     // Send buffer to root
 858     smpi_mpi_request_t request;
 859
 860     retval = smpi_create_request(sendbuf, sendcount, sendtype,
 861                                  rank, root, system_tag, comm, &request);
 862     smpi_mpi_isend(request);
 863     smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 864     xbt_mallocator_release(smpi_global->request_mallocator, request);
 865   } else {
 866     // Receive buffers from senders
 867     int src;
 868     smpi_mpi_request_t* requests;
 869
 870     requests = xbt_malloc((size-1) * sizeof(smpi_mpi_request_t));
 871     for(src = 0; src < size; src++) {
 872       if(src == root) {
 873         // Local copy from root
 874         memcpy(&((char*)recvbuf)[displs[src]],
 875                sendbuf, sendcount*sendtype->size*sizeof(char));
 876       } else {
 877         int index = src < root ? src : src - 1;
 878         retval = smpi_create_request(&((char*)recvbuf)[displs[src]],
 879                                      recvcounts[src], recvtype, src, root, system_tag,
 880                                      comm, &requests[index]);
 881         if(NULL != requests[index] && MPI_SUCCESS == retval) {
 882           smpi_mpi_irecv(requests[index]);
 883         }
 884       }
 885     }
 886     // Wait for completion of irecv's.
 887     for(src = 0; src < size - 1; src++) {
 888       int index = MPI_UNDEFINED;
 889       smpi_mpi_waitany(size - 1, requests, &index, MPI_STATUS_IGNORE);
 890       xbt_mallocator_release(smpi_global->request_mallocator, requests[index]);
 891     }
 892     xbt_free(requests);
 893   }
 894   smpi_bench_begin();
 895   return retval;
 896 }
 897
 898 int SMPI_MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs, MPI_Datatype sendtype,
 899                       void* recvbuf, int recvcount, MPI_Datatype recvtype,
 900                       int root, MPI_Comm comm)
 901 {
 902   int retval = MPI_SUCCESS;
 903   int system_tag = 666;
 904   int rank, size;
 905
 906   smpi_bench_end();
 907   rank = smpi_mpi_comm_rank(comm);
 908   size = comm->size;
 909   if(rank != root) {
 910     // Receive buffer from root
 911     smpi_mpi_request_t request;
 912
 913     retval = smpi_create_request(recvbuf, recvcount, recvtype,
 914                                  root, rank, system_tag, comm, &request);
 915     smpi_mpi_isend(request);
 916     smpi_mpi_wait(request, MPI_STATUS_IGNORE);
 917     xbt_mallocator_release(smpi_global->request_mallocator, request);
 918   } else {
 919     // Send buffers to receivers
 920     int dst;
 921     smpi_mpi_request_t* requests;
 922
 923     requests = xbt_malloc((size-1) * sizeof(smpi_mpi_request_t));
 924     for(dst = 0; dst < size; dst++) {
 925       if(dst == root) {
 926         // Local copy from root
 927         memcpy(recvbuf, &((char*)sendbuf)[displs[dst]],
 928                sendcounts[dst]*sendtype->size*sizeof(char));
 929       } else {
 930         int index = dst < root ? dst : dst - 1;
 931         retval = smpi_create_request(&((char*)sendbuf)[displs[dst]], sendcounts[dst], sendtype,
 932                                      root, dst, system_tag, comm, &requests[index]);
 933         if(NULL != requests[index] && MPI_SUCCESS == retval) {
 934           smpi_mpi_isend(requests[index]);
 935         }
 936       }
 937     }
 938     // Wait for completion of isend's.
 939     for(dst = 0; dst < size - 1; dst++) {
 940       int index = MPI_UNDEFINED;
 941       smpi_mpi_waitany(size - 1, requests, &index, MPI_STATUS_IGNORE);
 942       xbt_mallocator_release(smpi_global->request_mallocator, requests[index]);
 943     }
 944     xbt_free(requests);
 945   }
 946   smpi_bench_begin();
 947   return retval;
 948 }
 949
 950 int SMPI_MPI_Reduce_scatter(void* sendbuf, void* recvbuf, int *recvcounts,
 951                             MPI_Datatype datatype, MPI_Op op, MPI_Comm comm)
 952 {
 953   // FIXME: Suboptimal implementation
 954   int retval = MPI_SUCCESS;
 955   int count = 0;
 956   int root = 0;
 957   int i, rank;
 958   int* displs;
 959
 960   smpi_bench_end();
 961   rank = smpi_mpi_comm_rank(comm);
 962   displs = xbt_new(int, comm->size);
 963   for(i = 0; i < comm->size; i++) {
 964     count += recvcounts[i];
 965     displs[i] = 0;
 966   }
 967   retval = smpi_mpi_reduce(sendbuf, recvbuf, count, datatype, op, root, comm);
 968   retval = SMPI_MPI_Scatterv(recvbuf, recvcounts, displs, datatype, recvbuf, recvcounts[rank], datatype, root, comm);
 969   xbt_free(displs);
 970   smpi_bench_begin();
 971   return retval;
 972 }
 973
 974 int SMPI_MPI_Allgather(void* sendbuf, int sendcount, MPI_Datatype sendtype,
 975                        void* recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm)
 976 {
 977   // FIXME: Suboptimal implementation
 978   int root = 0;
 979   int retval;
 980
 981   smpi_bench_end();
 982   retval = SMPI_MPI_Gather(sendbuf, sendcount, sendtype,
 983                            recvbuf, recvcount, recvtype, root, comm);
 984   if(retval == MPI_SUCCESS) {
 985     retval = SMPI_MPI_Bcast(recvbuf, recvcount, recvtype, root, comm);
 986   }
 987   smpi_bench_begin();
 988   return retval;
 989 }
 990
 991 int SMPI_MPI_Allgatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype,
 992                         void* recvbuf, int *recvcounts, int *displs, MPI_Datatype recvtype,
 993                         MPI_Comm comm)
 994 {
 995   // FIXME: Suboptimal implementation
 996   int root = 0;
 997   int last, retval;
 998
 999   smpi_bench_end();
1000   retval = SMPI_MPI_Gatherv(sendbuf, sendcount, sendtype,
1001                             recvbuf, recvcounts, displs, recvtype, root, comm);
1002   if(retval == MPI_SUCCESS) {
1003     last = comm->size - 1;
1004     retval = SMPI_MPI_Bcast(recvbuf, displs[last] + recvcounts[last], recvtype, root, comm);
1005   }
1006   smpi_bench_begin();
1007   return retval;
1008 }