src/smpi/colls/gather/gather-ompi.cpp

   1 /* Copyright (c) 2013-2023. 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 /*
   8  * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
   9  *                         University Research and Technology
  10  *                         Corporation.  All rights reserved.
  11  * Copyright (c) 2004-2009 The University of Tennessee and The University
  12  *                         of Tennessee Research Foundation.  All rights
  13  *                         reserved.
  14  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
  15  *                         University of Stuttgart.  All rights reserved.
  16  * Copyright (c) 2004-2005 The Regents of the University of California.
  17  *                         All rights reserved.
  18  *
  19  * Additional copyrights may follow
  20  */
  21
  22 #include "../coll_tuned_topo.hpp"
  23 #include "../colls_private.hpp"
  24
  25 namespace simgrid::smpi {
  26
  27 int gather__ompi_binomial(const void* sbuf, int scount, MPI_Datatype sdtype, void* rbuf, int rcount,
  28                           MPI_Datatype rdtype, int root, MPI_Comm comm)
  29 {
  30     int line = -1;
  31     int i;
  32     int rank;
  33     int vrank;
  34     int size;
  35     int total_recv = 0;
  36     unsigned char* ptmp    = nullptr;
  37     unsigned char* tempbuf = nullptr;
  38     const unsigned char* src_buf;
  39     int err;
  40     ompi_coll_tree_t* bmtree;
  41     MPI_Status status;
  42     MPI_Aint sextent, slb, strue_lb, strue_extent;
  43     MPI_Aint rextent, rlb, rtrue_lb, rtrue_extent;
  44
  45
  46     size = comm->size();
  47     rank = comm->rank();
  48
  49     XBT_DEBUG("smpi_coll_tuned_gather_ompi_binomial rank %d", rank);
  50
  51     /* create the binomial tree */
  52    // COLL_TUNED_UPDATE_IN_ORDER_BMTREE( comm, tuned_module, root );
  53     bmtree = ompi_coll_tuned_topo_build_in_order_bmtree(comm, root);
  54     // data->cached_in_order_bmtree;
  55
  56     sdtype->extent(&slb, &sextent);
  57     sdtype->extent(&strue_lb, &strue_extent);
  58
  59     vrank = (rank - root + size) % size;
  60
  61     if (rank == root) {
  62         rdtype->extent(&rlb, &rextent);
  63         rdtype->extent(&rtrue_lb, &rtrue_extent);
  64         if (0 == root) {
  65           /* root on 0, just use the recv buffer */
  66           ptmp = static_cast<unsigned char*>(rbuf);
  67           if (sbuf != MPI_IN_PLACE) {
  68             err = Datatype::copy(sbuf, scount, sdtype, ptmp, rcount, rdtype);
  69             if (MPI_SUCCESS != err) {
  70               line = __LINE__;
  71               goto err_hndl;
  72             }
  73           }
  74         } else {
  75           /* root is not on 0, allocate temp buffer for recv,
  76            * rotate data at the end */
  77           tempbuf = smpi_get_tmp_recvbuffer(rtrue_extent + (rcount * size - 1) * rextent);
  78           if (nullptr == tempbuf) {
  79             err  = MPI_ERR_OTHER;
  80             line = __LINE__;
  81             goto err_hndl;
  82           }
  83
  84           ptmp = tempbuf - rlb;
  85           if (sbuf != MPI_IN_PLACE) {
  86             /* copy from sbuf to temp buffer */
  87             err = Datatype::copy(sbuf, scount, sdtype, ptmp, rcount, rdtype);
  88             if (MPI_SUCCESS != err) {
  89               line = __LINE__;
  90               goto err_hndl;
  91             }
  92           } else {
  93             /* copy from rbuf to temp buffer  */
  94             err = Datatype::copy((char*)rbuf + rank * rextent * rcount, rcount, rdtype, ptmp, rcount, rdtype);
  95             if (MPI_SUCCESS != err) {
  96               line = __LINE__;
  97               goto err_hndl;
  98             }
  99           }
 100         }
 101         total_recv = rcount;
 102         src_buf    = ptmp;
 103     } else if (!(vrank % 2)) {
 104       /* other non-leaf nodes, allocate temp buffer for data received from
 105        * children, the most we need is half of the total data elements due
 106        * to the property of binomial tree */
 107       tempbuf = smpi_get_tmp_sendbuffer(strue_extent + (scount * size - 1) * sextent);
 108       if (nullptr == tempbuf) {
 109         err  = MPI_ERR_OTHER;
 110         line = __LINE__;
 111         goto err_hndl;
 112       }
 113
 114       ptmp = tempbuf - slb;
 115       /* local copy to tempbuf */
 116       err = Datatype::copy(sbuf, scount, sdtype, ptmp, scount, sdtype);
 117       if (MPI_SUCCESS != err) {
 118         line = __LINE__;
 119         goto err_hndl;
 120       }
 121
 122       /* use sdtype,scount as rdtype,rdcount since they are ignored on
 123        * non-root procs */
 124       rdtype     = sdtype;
 125       rcount     = scount;
 126       rextent    = sextent;
 127       total_recv = rcount;
 128       src_buf    = ptmp;
 129     } else {
 130       /* leaf nodes, no temp buffer needed, use sdtype,scount as
 131        * rdtype,rdcount since they are ignored on non-root procs */
 132       total_recv = scount;
 133       src_buf    = static_cast<const unsigned char*>(sbuf);
 134     }
 135
 136     if (!(vrank % 2)) {
 137       /* all non-leaf nodes recv from children */
 138       for (i = 0; i < bmtree->tree_nextsize; i++) {
 139         int mycount = 0, vkid;
 140         /* figure out how much data I have to send to this child */
 141         vkid    = (bmtree->tree_next[i] - root + size) % size;
 142         mycount = vkid - vrank;
 143         if (mycount > (size - vkid))
 144           mycount = size - vkid;
 145         mycount *= rcount;
 146
 147         XBT_DEBUG("smpi_coll_tuned_gather_ompi_binomial rank %d recv %d mycount = %d", rank, bmtree->tree_next[i],
 148                   mycount);
 149
 150         Request::recv(ptmp + total_recv * rextent, mycount, rdtype, bmtree->tree_next[i], COLL_TAG_GATHER, comm,
 151                       &status);
 152
 153         total_recv += mycount;
 154       }
 155     }
 156
 157     if (rank != root) {
 158       /* all nodes except root send to parents */
 159       XBT_DEBUG("smpi_coll_tuned_gather_ompi_binomial rank %d send %d count %d\n", rank, bmtree->tree_prev, total_recv);
 160
 161       Request::send(src_buf, total_recv, sdtype, bmtree->tree_prev, COLL_TAG_GATHER, comm);
 162   }
 163     if (rank == root) {
 164       if (root != 0) {
 165         /* rotate received data on root if root != 0 */
 166         err = Datatype::copy(ptmp, rcount * (size - root), rdtype, (char*)rbuf + rextent * root * rcount,
 167                              rcount * (size - root), rdtype);
 168         if (MPI_SUCCESS != err) {
 169           line = __LINE__;
 170           goto err_hndl;
 171         }
 172
 173         err = Datatype::copy(ptmp + rextent * rcount * (size - root), rcount * root, rdtype, (char*)rbuf, rcount * root,
 174                              rdtype);
 175         if (MPI_SUCCESS != err) {
 176           line = __LINE__;
 177           goto err_hndl;
 178         }
 179
 180         smpi_free_tmp_buffer(tempbuf);
 181       }
 182     } else if (!(vrank % 2)) {
 183       /* other non-leaf nodes */
 184       smpi_free_tmp_buffer(tempbuf);
 185     }
 186     ompi_coll_tuned_topo_destroy_tree(&bmtree);
 187     return MPI_SUCCESS;
 188
 189  err_hndl:
 190    if (nullptr != tempbuf)
 191      smpi_free_tmp_buffer(tempbuf);
 192
 193    XBT_DEBUG("%s:%4d\tError occurred %d, rank %2d", __FILE__, line, err, rank);
 194    return err;
 195 }
 196
 197 /*
 198  *  gather_intra_linear_sync
 199  *
 200  *  Function:  - synchronized gather operation with
 201  *  Accepts:  - same arguments as MPI_Gather(), first segment size
 202  *  Returns:  - MPI_SUCCESS or error code
 203  */
 204 int gather__ompi_linear_sync(const void *sbuf, int scount,
 205                              MPI_Datatype sdtype,
 206                              void *rbuf, int rcount,
 207                              MPI_Datatype rdtype,
 208                              int root,
 209                              MPI_Comm comm)
 210 {
 211     int i;
 212     int ret, line;
 213     int rank, size;
 214     int first_segment_count;
 215     size_t typelng;
 216     MPI_Aint extent;
 217     MPI_Aint lb;
 218
 219     int first_segment_size=0;
 220     size = comm->size();
 221     rank = comm->rank();
 222
 223     size_t dsize, block_size;
 224     if (rank == root) {
 225         dsize= rdtype->size();
 226         block_size = dsize * rcount;
 227     } else {
 228         dsize=sdtype->size();
 229         block_size = dsize * scount;
 230     }
 231
 232      if (block_size > 92160){
 233      first_segment_size = 32768;
 234      }else{
 235      first_segment_size = 1024;
 236      }
 237
 238      XBT_DEBUG("smpi_coll_tuned_gather_ompi_linear_sync rank %d, segment %d", rank, first_segment_size);
 239
 240      if (rank != root) {
 241        /* Non-root processes:
 242           - receive zero byte message from the root,
 243           - send the first segment of the data synchronously,
 244           - send the second segment of the data.
 245        */
 246
 247        typelng = sdtype->size();
 248        sdtype->extent(&lb, &extent);
 249        first_segment_count = scount;
 250        COLL_TUNED_COMPUTED_SEGCOUNT((size_t)first_segment_size, typelng, first_segment_count);
 251
 252        Request::recv(nullptr, 0, MPI_BYTE, root, COLL_TAG_GATHER, comm, MPI_STATUS_IGNORE);
 253
 254        Request::send(sbuf, first_segment_count, sdtype, root, COLL_TAG_GATHER, comm);
 255
 256        Request::send((char*)sbuf + extent * first_segment_count, (scount - first_segment_count), sdtype, root,
 257                      COLL_TAG_GATHER, comm);
 258     }
 259
 260     else {
 261       /* Root process,
 262          - For every non-root node:
 263    - post irecv for the first segment of the message
 264    - send zero byte message to signal node to send the message
 265    - post irecv for the second segment of the message
 266    - wait for the first segment to complete
 267          - Copy local data if necessary
 268          - Waitall for all the second segments to complete.
 269 */
 270       char* ptmp;
 271       MPI_Request first_segment_req;
 272       auto* reqs = new (std::nothrow) MPI_Request[size];
 273       if (nullptr == reqs) {
 274         ret  = -1;
 275         line = __LINE__;
 276         goto error_hndl;
 277       }
 278
 279         typelng=rdtype->size();
 280         rdtype->extent(&lb, &extent);
 281         first_segment_count = rcount;
 282         COLL_TUNED_COMPUTED_SEGCOUNT( (size_t)first_segment_size, typelng,
 283                                       first_segment_count );
 284
 285         for (i = 0; i < size; ++i) {
 286             if (i == rank) {
 287                 /* skip myself */
 288                 reqs[i] = MPI_REQUEST_NULL;
 289                 continue;
 290             }
 291
 292             /* irecv for the first segment from i */
 293             ptmp = (char*)rbuf + i * rcount * extent;
 294             first_segment_req = Request::irecv(ptmp, first_segment_count, rdtype, i,
 295                                      COLL_TAG_GATHER, comm
 296                                      );
 297
 298             /* send sync message */
 299             Request::send(rbuf, 0, MPI_BYTE, i,
 300                                     COLL_TAG_GATHER,
 301                                      comm);
 302
 303             /* irecv for the second segment */
 304             ptmp = (char*)rbuf + (i * rcount + first_segment_count) * extent;
 305             reqs[i]=Request::irecv(ptmp, (rcount - first_segment_count),
 306                                      rdtype, i, COLL_TAG_GATHER, comm
 307                                      );
 308
 309             /* wait on the first segment to complete */
 310             Request::wait(&first_segment_req, MPI_STATUS_IGNORE);
 311         }
 312
 313         /* copy local data if necessary */
 314         if (MPI_IN_PLACE != sbuf) {
 315             ret = Datatype::copy(sbuf, scount, sdtype,
 316                                   (char*)rbuf + rank * rcount * extent,
 317                                   rcount, rdtype);
 318             if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
 319         }
 320
 321         /* wait all second segments to complete */
 322         ret = Request::waitall(size, reqs, MPI_STATUSES_IGNORE);
 323         if (ret != MPI_SUCCESS) { line = __LINE__; goto error_hndl; }
 324
 325         delete[] reqs;
 326     }
 327
 328     /* All done */
 329
 330     return MPI_SUCCESS;
 331  error_hndl:
 332     XBT_DEBUG(
 333                    "ERROR_HNDL: node %d file %s line %d error %d\n",
 334                    rank, __FILE__, line, ret );
 335     return ret;
 336 }
 337
 338 /*
 339  * Linear functions are copied from the BASIC coll module
 340  * they do not segment the message and are simple implementations
 341  * but for some small number of nodes and/or small data sizes they
 342  * are just as fast as tuned/tree based segmenting operations
 343  * and as such may be selected by the decision functions
 344  * These are copied into this module due to the way we select modules
 345  * in V1. i.e. in V2 we will handle this differently and so will not
 346  * have to duplicate code.
 347  * JPG following the examples from other coll_tuned implementations. Dec06.
 348  */
 349
 350 /* copied function (with appropriate renaming) starts here */
 351 /*
 352  *  gather_intra
 353  *
 354  *  Function:  - basic gather operation
 355  *  Accepts:  - same arguments as MPI_Gather()
 356  *  Returns:  - MPI_SUCCESS or error code
 357  */
 358 int gather__ompi_basic_linear(const void* sbuf, int scount, MPI_Datatype sdtype, void* rbuf, int rcount,
 359                               MPI_Datatype rdtype, int root, MPI_Comm comm)
 360 {
 361     int i;
 362     int err;
 363     int rank;
 364     int size;
 365     char *ptmp;
 366     MPI_Aint incr;
 367     MPI_Aint extent;
 368     MPI_Aint lb;
 369
 370     size = comm->size();
 371     rank = comm->rank();
 372
 373     /* Everyone but root sends data and returns. */
 374     XBT_DEBUG("ompi_coll_tuned_gather_intra_basic_linear rank %d", rank);
 375
 376     if (rank != root) {
 377         Request::send(sbuf, scount, sdtype, root,
 378                                  COLL_TAG_GATHER,
 379                                   comm);
 380         return MPI_SUCCESS;
 381     }
 382
 383     /* I am the root, loop receiving the data. */
 384
 385     rdtype->extent(&lb, &extent);
 386     incr = extent * rcount;
 387     for (i = 0, ptmp = (char *) rbuf; i < size; ++i, ptmp += incr) {
 388         if (i == rank) {
 389             if (MPI_IN_PLACE != sbuf) {
 390                 err = Datatype::copy(sbuf, scount, sdtype,
 391                                       ptmp, rcount, rdtype);
 392             } else {
 393                 err = MPI_SUCCESS;
 394             }
 395         } else {
 396             Request::recv(ptmp, rcount, rdtype, i,
 397                                     COLL_TAG_GATHER,
 398                                     comm, MPI_STATUS_IGNORE);
 399             err = MPI_SUCCESS;
 400         }
 401         if (MPI_SUCCESS != err) {
 402             return err;
 403         }
 404     }
 405
 406     /* All done */
 407
 408     return MPI_SUCCESS;
 409 }
 410
 411 } // namespace simgrid::smpi