int ompi_osc_pt2pt_free(ompi_win_t *win) { int ret = OMPI_SUCCESS; ompi_osc_pt2pt_module_t *module = GET_MODULE(win); if (NULL == module) { return OMPI_SUCCESS; } if (NULL != module->comm) { opal_output_verbose(1, ompi_osc_base_framework.framework_output, "pt2pt component destroying window with id %d", ompi_comm_get_cid(module->comm)); /* finish with a barrier */ if (ompi_group_size(win->w_group) > 1) { ret = module->comm->c_coll.coll_barrier(module->comm, module->comm->c_coll.coll_barrier_module); } /* remove from component information */ OPAL_THREAD_SCOPED_LOCK(&mca_osc_pt2pt_component.lock, opal_hash_table_remove_value_uint32(&mca_osc_pt2pt_component.modules, ompi_comm_get_cid(module->comm))); } win->w_osc_module = NULL; OBJ_DESTRUCT(&module->outstanding_locks); OBJ_DESTRUCT(&module->locks_pending); OBJ_DESTRUCT(&module->locks_pending_lock); OBJ_DESTRUCT(&module->acc_lock); OBJ_DESTRUCT(&module->cond); OBJ_DESTRUCT(&module->lock); /* it is erroneous to close a window with active operations on it so we should * probably produce an error here instead of cleaning up */ OPAL_LIST_DESTRUCT(&module->pending_acc); OPAL_LIST_DESTRUCT(&module->pending_posts); osc_pt2pt_gc_clean (module); OPAL_LIST_DESTRUCT(&module->request_gc); OPAL_LIST_DESTRUCT(&module->buffer_gc); OBJ_DESTRUCT(&module->gc_lock); if (NULL != module->peers) { for (int i = 0 ; i < ompi_comm_size (module->comm) ; ++i) { OBJ_DESTRUCT(module->peers + i); } free(module->peers); } if (NULL != module->epoch_outgoing_frag_count) free(module->epoch_outgoing_frag_count); if (NULL != module->frag_request) { module->frag_request->req_complete_cb = NULL; ompi_request_cancel (module->frag_request); ompi_request_free (&module->frag_request); } if (NULL != module->comm) { ompi_comm_free(&module->comm); } if (NULL != module->incoming_buffer) free (module->incoming_buffer); if (NULL != module->free_after) free(module->free_after); free (module); return ret; }
/* * 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; }