/** * Conversion function. They deal with data-types in 3 ways, always making local copies. * In order to allow performance testings, there are 3 functions: * - one copying directly from one memory location to another one using the * data-type copy function. * - one which use a 2 convertors created with the same data-type * - and one using 2 convertors created from different data-types. * */ static int local_copy_ddt_count( ompi_datatype_t* pdt, int count ) { MPI_Aint extent; void *pdst, *psrc; TIMER_DATA_TYPE start, end; long total_time; ompi_ddt_type_extent( pdt, &extent ); pdst = malloc( extent * count ); psrc = malloc( extent * count ); { int i; for( i = 0; i < (count * extent); i++ ) ((char*)psrc)[i] = i % 128 + 32; } memset( pdst, 0, count * extent ); cache_trash(); /* make sure the cache is useless */ GET_TIME( start ); if( OMPI_SUCCESS != ompi_ddt_copy_content_same_ddt( pdt, count, pdst, psrc ) ) { printf( "Unable to copy the datatype in the function local_copy_ddt_count." " Is the datatype committed ?\n" ); } GET_TIME( end ); total_time = ELAPSED_TIME( start, end ); printf( "direct local copy in %ld microsec\n", total_time ); free( pdst ); free( psrc ); return OMPI_SUCCESS; }
/* * reduce_lin_intra * * Function: - reduction * Accepts: - same as MPI_Reduce() * Returns: - MPI_SUCCESS or error code */ int mca_coll_self_reduce_intra(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, int root, struct ompi_communicator_t *comm) { if (MPI_IN_PLACE == sbuf) { return MPI_SUCCESS; } else { return ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf); } }
/* * reduce_lin_intra * * Function: - reduction using O(N) algorithm * Accepts: - same as MPI_Reduce() * Returns: - MPI_SUCCESS or error code */ int ompi_coll_tuned_reduce_intra_basic_linear(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, int root, struct ompi_communicator_t *comm) { int i, rank, err, size; ptrdiff_t true_lb, true_extent, lb, extent; char *free_buffer = NULL; char *pml_buffer = NULL; char *inplace_temp = NULL; char *inbuf; /* Initialize */ rank = ompi_comm_rank(comm); size = ompi_comm_size(comm); OPAL_OUTPUT((ompi_coll_tuned_stream,"coll:tuned:reduce_intra_basic_linear rank %d", rank)); /* If not root, send data to the root. */ if (rank != root) { err = MCA_PML_CALL(send(sbuf, count, dtype, root, MCA_COLL_BASE_TAG_REDUCE, MCA_PML_BASE_SEND_STANDARD, comm)); return err; } /* see discussion in ompi_coll_basic_reduce_lin_intra about extent and true extend */ /* for reducing buffer allocation lengths.... */ ompi_ddt_get_extent(dtype, &lb, &extent); ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent); if (MPI_IN_PLACE == sbuf) { sbuf = rbuf; inplace_temp = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == inplace_temp) { return OMPI_ERR_OUT_OF_RESOURCE; } rbuf = inplace_temp - lb; } if (size > 1) { free_buffer = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_buffer) { return OMPI_ERR_OUT_OF_RESOURCE; } pml_buffer = free_buffer - lb; } /* Initialize the receive buffer. */ if (rank == (size - 1)) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf); } else { err = MCA_PML_CALL(recv(rbuf, count, dtype, size - 1, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); } if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } /* Loop receiving and calling reduction function (C or Fortran). */ for (i = size - 2; i >= 0; --i) { if (rank == i) { inbuf = (char*)sbuf; } else { err = MCA_PML_CALL(recv(pml_buffer, count, dtype, i, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } inbuf = pml_buffer; } /* Perform the reduction */ ompi_op_reduce(op, inbuf, rbuf, count, dtype); } if (NULL != inplace_temp) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)sbuf, inplace_temp); free(inplace_temp); } if (NULL != free_buffer) { free(free_buffer); } /* All done */ return MPI_SUCCESS; }
int ompi_coll_tuned_alltoall_intra_bruck(void *sbuf, int scount, struct ompi_datatype_t *sdtype, void* rbuf, int rcount, struct ompi_datatype_t *rdtype, struct ompi_communicator_t *comm) { int i, k, line = -1; int rank, size; int sendto, recvfrom, distance, *displs=NULL, *blen=NULL; int maxpacksize, packsize, position; char * tmpbuf=NULL, *packbuf=NULL; ptrdiff_t lb, sext, rext; int err = 0; int weallocated = 0; MPI_Datatype iddt; size = ompi_comm_size(comm); rank = ompi_comm_rank(comm); OPAL_OUTPUT((ompi_coll_tuned_stream,"coll:tuned:alltoall_intra_bruck rank %d", rank)); err = ompi_ddt_get_extent (sdtype, &lb, &sext); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } err = ompi_ddt_get_extent (rdtype, &lb, &rext); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } #ifdef blahblah /* try and SAVE memory by using the data segment hung off the communicator if possible */ if (comm->c_coll_selected_data->mcct_num_reqs >= size) { /* we have enought preallocated for displments and lengths */ displs = (int*) comm->c_coll_basic_data->mcct_reqs; blen = (int *) (displs + size); weallocated = 0; } else { /* allocate the buffers ourself */ #endif displs = (int *) malloc(size*sizeof(int)); if (displs == NULL) { line = __LINE__; err = -1; goto err_hndl; } blen = (int *) malloc(size*sizeof(int)); if (blen == NULL) { line = __LINE__; err = -1; goto err_hndl; } weallocated = 1; #ifdef blahblah } #endif /* Prepare for packing data */ err = MPI_Pack_size( scount*size, sdtype, comm, &maxpacksize ); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* pack buffer allocation */ packbuf = (char*) malloc((unsigned) maxpacksize); if (packbuf == NULL) { line = __LINE__; err = -1; goto err_hndl; } /* tmp buffer allocation for message data */ tmpbuf = (char *) malloc(scount*size*sext); if (tmpbuf == NULL) { line = __LINE__; err = -1; goto err_hndl; } /* Step 1 - local rotation - shift up by rank */ err = ompi_ddt_copy_content_same_ddt (sdtype, (int32_t) ((size-rank)*scount), tmpbuf, ((char*)sbuf)+rank*scount*sext); if (err<0) { line = __LINE__; err = -1; goto err_hndl; } if (rank != 0) { err = ompi_ddt_copy_content_same_ddt (sdtype, (int32_t) (rank*scount), tmpbuf+(size-rank)*scount*sext, (char*)sbuf); if (err<0) { line = __LINE__; err = -1; goto err_hndl; } } /* perform communication step */ for (distance = 1; distance < size; distance<<=1) { /* send data to "sendto" */ sendto = (rank+distance)%size; recvfrom = (rank-distance+size)%size; packsize = 0; k = 0; /* create indexed datatype */ for (i = 1; i < size; i++) { if ((i&distance) == distance) { displs[k] = i*scount; blen[k] = scount; k++; } } /* Set indexes and displacements */ err = MPI_Type_indexed(k, blen, displs, sdtype, &iddt); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* Commit the new datatype */ err = MPI_Type_commit(&iddt); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* have the new distribution ddt, pack and exchange data */ err = MPI_Pack(tmpbuf, 1, iddt, packbuf, maxpacksize, &packsize, comm); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* Sendreceive */ err = ompi_coll_tuned_sendrecv ( packbuf, packsize, MPI_PACKED, sendto, MCA_COLL_BASE_TAG_ALLTOALL, rbuf, packsize, MPI_PACKED, recvfrom, MCA_COLL_BASE_TAG_ALLTOALL, comm, MPI_STATUS_IGNORE, rank); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* Unpack data from rbuf to tmpbuf */ position = 0; err = MPI_Unpack(rbuf, packsize, &position, tmpbuf, 1, iddt, comm); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } /* free ddt */ err = MPI_Type_free(&iddt); if (err != MPI_SUCCESS) { line = __LINE__; goto err_hndl; } } /* end of for (distance = 1... */ /* Step 3 - local rotation - */ for (i = 0; i < size; i++) { err = ompi_ddt_copy_content_same_ddt (rdtype, (int32_t) rcount, ((char*)rbuf)+(((rank-i+size)%size)*rcount*rext), tmpbuf+i*rcount*rext); if (err<0) { line = __LINE__; err = -1; goto err_hndl; } } /* Step 4 - clean up */ if (tmpbuf != NULL) free(tmpbuf); if (packbuf != NULL) free(packbuf); if (weallocated) { if (displs != NULL) free(displs); if (blen != NULL) free(blen); } return OMPI_SUCCESS; err_hndl: OPAL_OUTPUT((ompi_coll_tuned_stream,"%s:%4d\tError occurred %d, rank %2d", __FILE__,line,err,rank)); if (tmpbuf != NULL) free(tmpbuf); if (packbuf != NULL) free(packbuf); if (weallocated) { if (displs != NULL) free(displs); if (blen != NULL) free(blen); } return err; }
/* * reduce_lin_intra * * Function: - reduction using O(N) algorithm * Accepts: - same as MPI_Reduce() * Returns: - MPI_SUCCESS or error code */ int mca_coll_basic_reduce_lin_intra(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, int root, struct ompi_communicator_t *comm) { int i, rank, err, size; ptrdiff_t true_lb, true_extent, lb, extent; char *free_buffer = NULL; char *pml_buffer = NULL; char *inplace_temp = NULL; char *inbuf; /* Initialize */ rank = ompi_comm_rank(comm); size = ompi_comm_size(comm); /* If not root, send data to the root. */ if (rank != root) { err = MCA_PML_CALL(send(sbuf, count, dtype, root, MCA_COLL_BASE_TAG_REDUCE, MCA_PML_BASE_SEND_STANDARD, comm)); return err; } /* Root receives and reduces messages. Allocate buffer to receive * messages. This comment applies to all collectives in this basic * module where we allocate a temporary buffer. For the next few * lines of code, it's tremendously complicated how we decided that * this was the Right Thing to do. Sit back and enjoy. And prepare * to have your mind warped. :-) * * Recall some definitions (I always get these backwards, so I'm * going to put them here): * * extent: the length from the lower bound to the upper bound -- may * be considerably larger than the buffer required to hold the data * (or smaller! But it's easiest to think about when it's larger). * * true extent: the exact number of bytes required to hold the data * in the layout pattern in the datatype. * * For example, consider the following buffer (just talking about * LB, extent, and true extent -- extrapolate for UB; i.e., assume * the UB equals exactly where the data ends): * * A B C * -------------------------------------------------------- * | | | * -------------------------------------------------------- * * There are multiple cases: * * 1. A is what we give to MPI_Send (and friends), and A is where * the data starts, and C is where the data ends. In this case: * * - extent: C-A * - true extent: C-A * - LB: 0 * * A C * -------------------------------------------------------- * | | * -------------------------------------------------------- * <=======================extent=========================> * <======================true extent=====================> * * 2. A is what we give to MPI_Send (and friends), B is where the * data starts, and C is where the data ends. In this case: * * - extent: C-A * - true extent: C-B * - LB: positive * * A B C * -------------------------------------------------------- * | | User buffer | * -------------------------------------------------------- * <=======================extent=========================> * <===============true extent=============> * * 3. B is what we give to MPI_Send (and friends), A is where the * data starts, and C is where the data ends. In this case: * * - extent: C-A * - true extent: C-A * - LB: negative * * A B C * -------------------------------------------------------- * | | User buffer | * -------------------------------------------------------- * <=======================extent=========================> * <======================true extent=====================> * * 4. MPI_BOTTOM is what we give to MPI_Send (and friends), B is * where the data starts, and C is where the data ends. In this * case: * * - extent: C-MPI_BOTTOM * - true extent: C-B * - LB: [potentially very large] positive * * MPI_BOTTOM B C * -------------------------------------------------------- * | | User buffer | * -------------------------------------------------------- * <=======================extent=========================> * <===============true extent=============> * * So in all cases, for a temporary buffer, all we need to malloc() * is a buffer of size true_extent. We therefore need to know two * pointer values: what value to give to MPI_Send (and friends) and * what value to give to free(), because they might not be the same. * * Clearly, what we give to free() is exactly what was returned from * malloc(). That part is easy. :-) * * What we give to MPI_Send (and friends) is a bit more complicated. * Let's take the 4 cases from above: * * 1. If A is what we give to MPI_Send and A is where the data * starts, then clearly we give to MPI_Send what we got back from * malloc(). * * 2. If B is what we get back from malloc, but we give A to * MPI_Send, then the buffer range [A,B) represents "dead space" * -- no data will be put there. So it's safe to give B-LB to * MPI_Send. More specifically, the LB is positive, so B-LB is * actually A. * * 3. If A is what we get back from malloc, and B is what we give to * MPI_Send, then the LB is negative, so A-LB will actually equal * B. * * 4. Although this seems like the weirdest case, it's actually * quite similar to case #2 -- the pointer we give to MPI_Send is * smaller than the pointer we got back from malloc(). * * Hence, in all cases, we give (return_from_malloc - LB) to MPI_Send. * * This works fine and dandy if we only have (count==1), which we * rarely do. ;-) So we really need to allocate (true_extent + * ((count - 1) * extent)) to get enough space for the rest. This may * be more than is necessary, but it's ok. * * Simple, no? :-) * */ ompi_ddt_get_extent(dtype, &lb, &extent); ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent); if (MPI_IN_PLACE == sbuf) { sbuf = rbuf; inplace_temp = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == inplace_temp) { return OMPI_ERR_OUT_OF_RESOURCE; } rbuf = inplace_temp - lb; } if (size > 1) { free_buffer = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_buffer) { return OMPI_ERR_OUT_OF_RESOURCE; } pml_buffer = free_buffer - lb; } /* Initialize the receive buffer. */ if (rank == (size - 1)) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf); } else { err = MCA_PML_CALL(recv(rbuf, count, dtype, size - 1, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); } if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } /* Loop receiving and calling reduction function (C or Fortran). */ for (i = size - 2; i >= 0; --i) { if (rank == i) { inbuf = (char*)sbuf; } else { err = MCA_PML_CALL(recv(pml_buffer, count, dtype, i, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } inbuf = pml_buffer; } /* Perform the reduction */ ompi_op_reduce(op, inbuf, rbuf, count, dtype); } if (NULL != inplace_temp) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)sbuf, inplace_temp); free(inplace_temp); } if (NULL != free_buffer) { free(free_buffer); } /* All done */ return MPI_SUCCESS; }
/* * reduce_log_intra * * Function: - reduction using O(log N) algorithm * Accepts: - same as MPI_Reduce() * Returns: - MPI_SUCCESS or error code */ int mca_coll_basic_reduce_log_intra(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, int root, struct ompi_communicator_t *comm) { int i, size, rank, vrank; int err, peer, dim, mask; ptrdiff_t true_lb, true_extent, lb, extent; char *free_buffer = NULL; char *free_rbuf = NULL; char *pml_buffer = NULL; char *snd_buffer = NULL; char *rcv_buffer = (char*)rbuf; char *inplace_temp = NULL; /* JMS Codearound for now -- if the operations is not communative, * just call the linear algorithm. Need to talk to Edgar / George * about fixing this algorithm here to work with non-communative * operations. */ if (!ompi_op_is_commute(op)) { return mca_coll_basic_reduce_lin_intra(sbuf, rbuf, count, dtype, op, root, comm); } /* Some variables */ size = ompi_comm_size(comm); rank = ompi_comm_rank(comm); vrank = ompi_op_is_commute(op) ? (rank - root + size) % size : rank; dim = comm->c_cube_dim; /* Allocate the incoming and resulting message buffers. See lengthy * rationale above. */ ompi_ddt_get_extent(dtype, &lb, &extent); ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent); free_buffer = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_buffer) { return OMPI_ERR_OUT_OF_RESOURCE; } pml_buffer = free_buffer - lb; /* read the comment about commutative operations (few lines down * the page) */ if (ompi_op_is_commute(op)) { rcv_buffer = pml_buffer; } /* Allocate sendbuf in case the MPI_IN_PLACE option has been used. See lengthy * rationale above. */ if (MPI_IN_PLACE == sbuf) { inplace_temp = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == inplace_temp) { return OMPI_ERR_OUT_OF_RESOURCE; } sbuf = inplace_temp - lb; err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)sbuf, (char*)rbuf); } snd_buffer = (char*)sbuf; if (rank != root && 0 == (vrank & 1)) { /* root is the only one required to provide a valid rbuf. * Assume rbuf is invalid for all other ranks, so fix it up * here to be valid on all non-leaf ranks */ free_rbuf = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_rbuf) { free(free_buffer); return OMPI_ERR_OUT_OF_RESOURCE; } rbuf = free_rbuf - lb; } /* Loop over cube dimensions. High processes send to low ones in the * dimension. */ for (i = 0, mask = 1; i < dim; ++i, mask <<= 1) { /* A high-proc sends to low-proc and stops. */ if (vrank & mask) { peer = vrank & ~mask; if (ompi_op_is_commute(op)) { peer = (peer + root) % size; } err = MCA_PML_CALL(send(snd_buffer, count, dtype, peer, MCA_COLL_BASE_TAG_REDUCE, MCA_PML_BASE_SEND_STANDARD, comm)); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } if (NULL != free_rbuf) { free(free_rbuf); } return err; } snd_buffer = (char*)rbuf; break; } /* A low-proc receives, reduces, and moves to a higher * dimension. */ else { peer = vrank | mask; if (peer >= size) { continue; } if (ompi_op_is_commute(op)) { peer = (peer + root) % size; } /* Most of the time (all except the first one for commutative * operations) we receive in the user provided buffer * (rbuf). But the exception is here to allow us to dont have * to copy from the sbuf to a temporary location. If the * operation is commutative we dont care in which order we * apply the operation, so for the first time we can receive * the data in the pml_buffer and then apply to operation * between this buffer and the user provided data. */ err = MCA_PML_CALL(recv(rcv_buffer, count, dtype, peer, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } if (NULL != free_rbuf) { free(free_rbuf); } return err; } /* Perform the operation. The target is always the user * provided buffer We do the operation only if we receive it * not in the user buffer */ if (snd_buffer != sbuf) { /* the target buffer is the locally allocated one */ ompi_op_reduce(op, rcv_buffer, pml_buffer, count, dtype); } else { /* If we're commutative, we don't care about the order of * operations and we can just reduce the operations now. * If we are not commutative, we have to copy the send * buffer into a temp buffer (pml_buffer) and then reduce * what we just received against it. */ if (!ompi_op_is_commute(op)) { ompi_ddt_copy_content_same_ddt(dtype, count, pml_buffer, (char*)sbuf); ompi_op_reduce(op, rbuf, pml_buffer, count, dtype); } else { ompi_op_reduce(op, sbuf, pml_buffer, count, dtype); } /* now we have to send the buffer containing the computed data */ snd_buffer = pml_buffer; /* starting from now we always receive in the user * provided buffer */ rcv_buffer = (char*)rbuf; } } } /* Get the result to the root if needed. */ err = MPI_SUCCESS; if (0 == vrank) { if (root == rank) { ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, snd_buffer); } else { err = MCA_PML_CALL(send(snd_buffer, count, dtype, root, MCA_COLL_BASE_TAG_REDUCE, MCA_PML_BASE_SEND_STANDARD, comm)); } } else if (rank == root) { err = MCA_PML_CALL(recv(rcv_buffer, count, dtype, 0, MCA_COLL_BASE_TAG_REDUCE, comm, MPI_STATUS_IGNORE)); if (rcv_buffer != rbuf) { ompi_op_reduce(op, rcv_buffer, rbuf, count, dtype); } } if (NULL != inplace_temp) { free(inplace_temp); } if (NULL != free_buffer) { free(free_buffer); } if (NULL != free_rbuf) { free(free_rbuf); } /* All done */ return err; }
/* * exscan_intra * * Function: - basic exscan operation * Accepts: - same arguments as MPI_Exscan() * Returns: - MPI_SUCCESS or error code */ int mca_coll_basic_exscan_intra(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, struct ompi_communicator_t *comm, mca_coll_base_module_t *module) { int size, rank, err; ptrdiff_t true_lb, true_extent, lb, extent; char *free_buffer = NULL; char *reduce_buffer = NULL; char *source; MPI_Request req = MPI_REQUEST_NULL; /* Initialize. */ rank = ompi_comm_rank(comm); size = ompi_comm_size(comm); /* If we're rank 0, then we send our sbuf to the next rank */ if (0 == rank) { return MCA_PML_CALL(send(sbuf, count, dtype, rank + 1, MCA_COLL_BASE_TAG_EXSCAN, MCA_PML_BASE_SEND_STANDARD, comm)); } /* If we're the last rank, then just receive the result from the * prior rank */ else if ((size - 1) == rank) { return MCA_PML_CALL(recv(rbuf, count, dtype, rank - 1, MCA_COLL_BASE_TAG_EXSCAN, comm, MPI_STATUS_IGNORE)); } /* Otherwise, get the result from the prior rank, combine it with my * data, and send it to the next rank */ /* Start the receive for the prior rank's answer */ err = MCA_PML_CALL(irecv(rbuf, count, dtype, rank - 1, MCA_COLL_BASE_TAG_EXSCAN, comm, &req)); if (MPI_SUCCESS != err) { goto error; } /* Get a temporary buffer to perform the reduction into. Rationale * for malloc'ing this size is provided in coll_basic_reduce.c. */ ompi_ddt_get_extent(dtype, &lb, &extent); ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent); free_buffer = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_buffer) { return OMPI_ERR_OUT_OF_RESOURCE; } reduce_buffer = free_buffer - lb; if (ompi_op_is_commute(op)) { /* If we're commutative, we can copy my sbuf into the reduction * buffer before the receive completes */ err = ompi_ddt_copy_content_same_ddt(dtype, count, reduce_buffer, (char*)sbuf); if (MPI_SUCCESS != err) { goto error; } /* Now setup the reduction */ source = (char*)rbuf; /* Finally, wait for the receive to complete (so that we can do * the reduction). */ err = ompi_request_wait(&req, MPI_STATUS_IGNORE); if (MPI_SUCCESS != err) { goto error; } } else { /* Setup the reduction */ source = (char*)sbuf; /* If we're not commutative, we have to wait for the receive to * complete and then copy it into the reduce buffer */ err = ompi_request_wait(&req, MPI_STATUS_IGNORE); if (MPI_SUCCESS != err) { goto error; } err = ompi_ddt_copy_content_same_ddt(dtype, count, reduce_buffer, (char*)rbuf); if (MPI_SUCCESS != err) { goto error; } } /* Now reduce the received answer with my source into the answer * that we send off to the next rank */ ompi_op_reduce(op, source, reduce_buffer, count, dtype); /* Send my result off to the next rank */ err = MCA_PML_CALL(send(reduce_buffer, count, dtype, rank + 1, MCA_COLL_BASE_TAG_EXSCAN, MCA_PML_BASE_SEND_STANDARD, comm)); /* Error */ error: free(free_buffer); if (MPI_REQUEST_NULL != req) { ompi_request_cancel(req); ompi_request_wait(&req, MPI_STATUS_IGNORE); } /* All done */ return err; }
/* * scan * * Function: - basic scan operation * Accepts: - same arguments as MPI_Scan() * Returns: - MPI_SUCCESS or error code */ int mca_coll_basic_scan_intra(void *sbuf, void *rbuf, int count, struct ompi_datatype_t *dtype, struct ompi_op_t *op, struct ompi_communicator_t *comm) { int size, rank, err; ptrdiff_t true_lb, true_extent, lb, extent; char *free_buffer = NULL; char *pml_buffer = NULL; /* Initialize */ rank = ompi_comm_rank(comm); size = ompi_comm_size(comm); /* If I'm rank 0, just copy into the receive buffer */ if (0 == rank) { if (MPI_IN_PLACE != sbuf) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf); if (MPI_SUCCESS != err) { return err; } } } /* Otherwise receive previous buffer and reduce. */ else { /* Allocate a temporary buffer. Rationale for this size is * listed in coll_basic_reduce.c. Use this temporary buffer to * receive into, later. */ ompi_ddt_get_extent(dtype, &lb, &extent); ompi_ddt_get_true_extent(dtype, &true_lb, &true_extent); free_buffer = (char*)malloc(true_extent + (count - 1) * extent); if (NULL == free_buffer) { return OMPI_ERR_OUT_OF_RESOURCE; } pml_buffer = free_buffer - lb; /* Copy the send buffer into the receive buffer. */ if (MPI_IN_PLACE != sbuf) { err = ompi_ddt_copy_content_same_ddt(dtype, count, (char*)rbuf, (char*)sbuf); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } } /* Receive the prior answer */ err = MCA_PML_CALL(recv(pml_buffer, count, dtype, rank - 1, MCA_COLL_BASE_TAG_SCAN, comm, MPI_STATUS_IGNORE)); if (MPI_SUCCESS != err) { if (NULL != free_buffer) { free(free_buffer); } return err; } /* Perform the operation */ ompi_op_reduce(op, pml_buffer, rbuf, count, dtype); /* All done */ if (NULL != free_buffer) { free(free_buffer); } } /* Send result to next process. */ if (rank < (size - 1)) { return MCA_PML_CALL(send(rbuf, count, dtype, rank + 1, MCA_COLL_BASE_TAG_SCAN, MCA_PML_BASE_SEND_STANDARD, comm)); } /* All done */ return MPI_SUCCESS; }