/*@
MPIR_Progress_wait_request
A helper routine that implements the very common case of running the progress
engine until the given request is complete.
@*/
int MPIR_Progress_wait_request(MPID_Request *req)
{
int mpi_errno = MPI_SUCCESS;
if (!MPID_Request_is_complete(req))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(req))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
fn_fail: /* no special err handling at this level */
fn_exit:
return mpi_errno;
}
int MPID_Mrecv(void *buf, int count, MPI_Datatype datatype,
MPID_Request *message, MPI_Status *status)
{
int mpi_errno = MPI_SUCCESS;
MPI_Request req_handle; /* dummy for MPIR_Request_complete */
int active_flag; /* dummy for MPIR_Request_complete */
MPID_Request *rreq = NULL;
if (message == NULL) {
/* treat as though MPI_MESSAGE_NO_PROC was passed */
MPIR_Status_set_procnull(status);
goto fn_exit;
}
/* There is no optimized MPID_Mrecv at this time because there is no real
* optimization potential in that case. MPID_Recv exists to prevent
* creating a request unnecessarily for messages that are already present
* and eligible for immediate completion. */
mpi_errno = MPID_Imrecv(buf, count, datatype, message, &rreq);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
if (!MPID_Request_is_complete(rreq)) {
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(rreq))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno) {
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
MPIU_ERR_POP(mpi_errno);
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
mpi_errno = MPIR_Request_complete(&req_handle, rreq, status, &active_flag);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIC_Wait(MPID_Request * request_ptr, mpir_errflag_t *errflag)
{
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPIC_WAIT);
MPIDI_PT2PT_FUNC_ENTER(MPID_STATE_MPIC_WAIT);
MPIU_DBG_MSG_S(PT2PT, TYPICAL, "IN: errflag = %s", *errflag?"TRUE":"FALSE");
if (request_ptr->kind == MPID_REQUEST_SEND)
request_ptr->status.MPI_TAG = 0;
if (!MPID_Request_is_complete(request_ptr))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(request_ptr))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
}
MPID_Progress_end(&progress_state);
}
if (request_ptr->kind == MPID_REQUEST_RECV)
MPIR_Process_status(&request_ptr->status, errflag);
MPIR_TAG_CLEAR_ERROR_BITS(request_ptr->status.MPI_TAG);
fn_exit:
MPIU_DBG_MSG_D(PT2PT, TYPICAL, "OUT: errflag = %d", *errflag);
MPIDI_PT2PT_FUNC_EXIT(MPID_STATE_MPIC_WAIT);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Test_impl(MPI_Request *request, int *flag, MPI_Status *status)
{
int mpi_errno = MPI_SUCCESS;
int active_flag;
MPID_Request *request_ptr = NULL;
/* If this is a null request handle, then return an empty status */
if (*request == MPI_REQUEST_NULL) {
MPIR_Status_set_empty(status);
*flag = TRUE;
goto fn_exit;
}
*flag = FALSE;
MPID_Request_get_ptr( *request, request_ptr );
/* If the request is already completed AND we want to avoid calling
the progress engine, we could make the call to MPID_Progress_test
conditional on the request not being completed. */
mpi_errno = MPID_Progress_test();
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (request_ptr->kind == MPID_UREQUEST &&
request_ptr->greq_fns != NULL &&
request_ptr->greq_fns->poll_fn != NULL)
{
mpi_errno = (request_ptr->greq_fns->poll_fn)(request_ptr->greq_fns->grequest_extra_state, status);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
}
if (MPID_Request_is_complete(request_ptr)) {
mpi_errno = MPIR_Request_complete(request, request_ptr, status,
&active_flag);
*flag = TRUE;
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Fall through to the exit */
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
static int check_terminating_vcs(void)
{
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_CHECK_TERMINATING_VCS);
MPIDI_FUNC_ENTER(MPID_STATE_CHECK_TERMINATING_VCS);
while (!TERMQ_EMPTY() && MPID_Request_is_complete(TERMQ_HEAD()->req)) {
vc_term_element_t *ep;
TERMQ_DEQUEUE(&ep);
MPID_Request_release(ep->req);
mpi_errno = shm_connection_terminated(ep->vc);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Free(ep);
}
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_CHECK_TERMINATING_VCS);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Recv - Blocking receive for a message
Output Parameters:
+ buf - initial address of receive buffer (choice)
- status - status object (Status)
Input Parameters:
+ count - maximum number of elements in receive buffer (integer)
. datatype - datatype of each receive buffer element (handle)
. source - rank of source (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Notes:
The 'count' argument indicates the maximum length of a message; the actual
length of the message can be determined with 'MPI_Get_count'.
.N ThreadSafe
.N Fortran
.N FortranStatus
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_TAG
.N MPI_ERR_RANK
@*/
int MPI_Recv(void *buf, int count, MPI_Datatype datatype, int source, int tag,
MPI_Comm comm, MPI_Status *status)
{
static const char FCNAME[] = "MPI_Recv";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Request * request_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_RECV);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_PT2PT_FUNC_ENTER_BACK(MPID_STATE_MPI_RECV);
/* Validate handle parameters needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
/* NOTE: MPI_STATUS_IGNORE != NULL */
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);
MPIR_ERRTEST_RECV_TAG(tag, mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* MT: Note that MPID_Recv may release the SINGLE_CS if it
decides to block internally. MPID_Recv in that case will
re-aquire the SINGLE_CS before returnning */
mpi_errno = MPID_Recv(buf, count, datatype, source, tag, comm_ptr,
MPID_CONTEXT_INTRA_PT2PT, status, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (request_ptr == NULL)
{
goto fn_exit;
}
/* If a request was returned, then we need to block until the request is
complete */
if (!MPID_Request_is_complete(request_ptr))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(request_ptr))
{
/* MT: Progress_wait may release the SINGLE_CS while it
waits */
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
if (unlikely(MPIR_CVAR_ENABLE_FT &&
!MPID_Request_is_complete(request_ptr) &&
MPID_Request_is_anysource(request_ptr) &&
!MPID_Comm_AS_enabled(request_ptr->comm))) {
/* --BEGIN ERROR HANDLING-- */
MPID_Cancel_recv(request_ptr);
MPIR_STATUS_SET_CANCEL_BIT(request_ptr->status, FALSE);
MPIU_ERR_SET(request_ptr->status.MPI_ERROR, MPIX_ERR_PROC_FAILED, "**proc_failed");
mpi_errno = request_ptr->status.MPI_ERROR;
goto fn_fail;
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
mpi_errno = request_ptr->status.MPI_ERROR;
MPIR_Request_extract_status(request_ptr, status);
MPID_Request_release(request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT_BACK(MPID_STATE_MPI_RECV);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_recv",
"**mpi_recv %p %d %D %i %t %C %p", buf, count, datatype, source, tag, comm, status);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
static inline int check_window_state(MPID_Win * win_ptr, int *made_progress)
{
MPID_Request *fence_req_ptr = NULL;
int i, mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_CHECK_WINDOW_STATE);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_CHECK_WINDOW_STATE);
(*made_progress) = 0;
switch (win_ptr->states.access_state) {
case MPIDI_RMA_FENCE_ISSUED:
MPID_Request_get_ptr(win_ptr->fence_sync_req, fence_req_ptr);
if (MPID_Request_is_complete(fence_req_ptr)) {
win_ptr->states.access_state = MPIDI_RMA_FENCE_GRANTED;
MPID_Request_release(fence_req_ptr);
win_ptr->fence_sync_req = MPI_REQUEST_NULL;
num_active_issued_win--;
MPIU_Assert(num_active_issued_win >= 0);
(*made_progress) = 1;
}
break;
case MPIDI_RMA_PSCW_ISSUED:
if (win_ptr->start_req == NULL) {
/* for MPI_MODE_NOCHECK and all targets on SHM,
* we do not create PSCW requests on window. */
win_ptr->states.access_state = MPIDI_RMA_PSCW_GRANTED;
num_active_issued_win--;
MPIU_Assert(num_active_issued_win >= 0);
(*made_progress) = 1;
}
else {
for (i = 0; i < win_ptr->start_grp_size; i++) {
MPID_Request *start_req_ptr = NULL;
if (win_ptr->start_req[i] == MPI_REQUEST_NULL)
continue;
MPID_Request_get_ptr(win_ptr->start_req[i], start_req_ptr);
if (MPID_Request_is_complete(start_req_ptr)) {
MPID_Request_release(start_req_ptr);
win_ptr->start_req[i] = MPI_REQUEST_NULL;
}
else {
break;
}
}
if (i == win_ptr->start_grp_size) {
win_ptr->states.access_state = MPIDI_RMA_PSCW_GRANTED;
num_active_issued_win--;
MPIU_Assert(num_active_issued_win >= 0);
(*made_progress) = 1;
MPIU_Free(win_ptr->start_req);
win_ptr->start_req = NULL;
}
}
break;
case MPIDI_RMA_LOCK_ALL_ISSUED:
if (win_ptr->outstanding_locks == 0) {
win_ptr->states.access_state = MPIDI_RMA_LOCK_ALL_GRANTED;
(*made_progress) = 1;
}
break;
default:
break;
} /* end of switch */
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_CHECK_WINDOW_STATE);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPID_nem_ptl_pkt_cancel_send_req_handler(MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt,
MPIDI_msg_sz_t *buflen, MPID_Request **rreqp)
{
int ret, mpi_errno = MPI_SUCCESS;
MPIDI_nem_ptl_pkt_cancel_send_req_t *req_pkt = (MPIDI_nem_ptl_pkt_cancel_send_req_t *)pkt;
MPID_PKT_DECL_CAST(upkt, MPIDI_nem_ptl_pkt_cancel_send_resp_t, resp_pkt);
MPID_Request *search_req, *resp_req;
ptl_me_t me;
MPID_nem_ptl_vc_area *const vc_ptl = VC_PTL(vc);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"received cancel send req pkt, sreq=0x%08x, rank=%d, tag=%d, context=%d",
req_pkt->sender_req_id, req_pkt->match.parts.rank,
req_pkt->match.parts.tag, req_pkt->match.parts.context_id));
/* create a dummy request and search for the message */
/* create a request */
search_req = MPID_Request_create();
MPID_nem_ptl_init_req(search_req);
MPIR_ERR_CHKANDJUMP1(!search_req, mpi_errno, MPI_ERR_OTHER, "**nomem", "**nomem %s", "MPID_Request_create");
MPIU_Object_set_ref(search_req, 2); /* 1 ref for progress engine and 1 ref for us */
search_req->kind = MPID_REQUEST_MPROBE;
/* create a dummy ME to use for searching the list */
me.start = NULL;
me.length = 0;
me.ct_handle = PTL_CT_NONE;
me.uid = PTL_UID_ANY;
me.options = ( PTL_ME_OP_PUT | PTL_ME_USE_ONCE );
me.min_free = 0;
me.match_bits = NPTL_MATCH(req_pkt->match.parts.tag, req_pkt->match.parts.context_id, req_pkt->match.parts.rank);
me.match_id = vc_ptl->id;
me.ignore_bits = NPTL_MATCH_IGNORE;
/* FIXME: this should use a custom handler that throws the data away inline */
REQ_PTL(search_req)->event_handler = handle_mprobe;
/* submit a search request */
ret = PtlMESearch(MPIDI_nem_ptl_ni, MPIDI_nem_ptl_pt, &me, PTL_SEARCH_DELETE, search_req);
MPIR_ERR_CHKANDJUMP1(ret, mpi_errno, MPI_ERR_OTHER, "**ptlmesearch", "**ptlmesearch %s", MPID_nem_ptl_strerror(ret));
DBG_MSG_MESearch("REG", vc ? vc->pg_rank : 0, me, search_req);
/* wait for search request to complete */
do {
mpi_errno = MPID_nem_ptl_poll(FALSE);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
} while (!MPID_Request_is_complete(search_req));
/* send response */
resp_pkt->type = MPIDI_NEM_PKT_NETMOD;
resp_pkt->subtype = MPIDI_NEM_PTL_PKT_CANCEL_SEND_RESP;
resp_pkt->ack = REQ_PTL(search_req)->found;
resp_pkt->sender_req_id = req_pkt->sender_req_id;
MPID_nem_ptl_iStartContigMsg(vc, resp_pkt, sizeof(*resp_pkt), NULL,
0, &resp_req);
/* if the message was found, free the temporary buffer used to copy the data */
if (REQ_PTL(search_req)->found)
MPIU_Free(search_req->dev.tmpbuf);
MPID_Request_release(search_req);
if (resp_req != NULL)
MPID_Request_release(resp_req);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_nem_ptl_improbe(MPIDI_VC_t *vc, int source, int tag, MPID_Comm *comm, int context_offset, int *flag,
MPID_Request **message, MPI_Status *status)
{
int mpi_errno = MPI_SUCCESS;
MPID_nem_ptl_vc_area *const vc_ptl = VC_PTL(vc);
int ret;
ptl_process_t id_any;
ptl_me_t me;
MPID_Request *req;
MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_PTL_IMPROBE);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_PTL_IMPROBE);
id_any.phys.nid = PTL_NID_ANY;
id_any.phys.pid = PTL_PID_ANY;
/* create a request */
req = MPID_Request_create();
MPID_nem_ptl_init_req(req);
MPIR_ERR_CHKANDJUMP1(!req, mpi_errno, MPI_ERR_OTHER, "**nomem", "**nomem %s", "MPID_Request_create");
MPIU_Object_set_ref(req, 2); /* 1 ref for progress engine and 1 ref for us */
REQ_PTL(req)->event_handler = handle_mprobe;
req->kind = MPID_REQUEST_MPROBE;
/* create a dummy ME to use for searching the list */
me.start = NULL;
me.length = 0;
me.ct_handle = PTL_CT_NONE;
me.uid = PTL_UID_ANY;
me.options = ( PTL_ME_OP_PUT | PTL_ME_USE_ONCE );
me.min_free = 0;
me.match_bits = NPTL_MATCH(tag, comm->context_id + context_offset, source);
if (source == MPI_ANY_SOURCE)
me.match_id = id_any;
else {
if (!vc_ptl->id_initialized) {
mpi_errno = MPID_nem_ptl_init_id(vc);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
me.match_id = vc_ptl->id;
}
if (tag == MPI_ANY_TAG)
me.ignore_bits = NPTL_MATCH_IGNORE_ANY_TAG;
else
me.ignore_bits = NPTL_MATCH_IGNORE;
/* submit a search request */
ret = PtlMESearch(MPIDI_nem_ptl_ni, MPIDI_nem_ptl_pt, &me, PTL_SEARCH_DELETE, req);
MPIR_ERR_CHKANDJUMP1(ret, mpi_errno, MPI_ERR_OTHER, "**ptlmesearch", "**ptlmesearch %s", MPID_nem_ptl_strerror(ret));
DBG_MSG_MESearch("REG", vc ? vc->pg_rank : 0, me, req);
/* wait for search request to complete */
do {
mpi_errno = MPID_nem_ptl_poll(FALSE);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
} while (!MPID_Request_is_complete(req));
*flag = REQ_PTL(req)->found;
if (*flag) {
req->comm = comm;
MPIR_Comm_add_ref(comm);
MPIR_Request_extract_status(req, status);
*message = req;
}
else {
MPID_Request_release(req);
}
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_PTL_IMPROBE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Sendrecv_replace - Sends and receives using a single buffer
Input Parameters:
+ count - number of elements in send and receive buffer (integer)
. datatype - type of elements in send and receive buffer (handle)
. dest - rank of destination (integer)
. sendtag - send message tag (integer)
. source - rank of source (integer)
. recvtag - receive message tag (integer)
- comm - communicator (handle)
Output Parameters:
+ buf - initial address of send and receive buffer (choice)
- status - status object (Status)
.N ThreadSafe
.N Fortran
.N FortranStatus
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_TAG
.N MPI_ERR_RANK
.N MPI_ERR_TRUNCATE
.N MPI_ERR_EXHAUSTED
@*/
int MPI_Sendrecv_replace(void *buf, int count, MPI_Datatype datatype,
int dest, int sendtag, int source, int recvtag,
MPI_Comm comm, MPI_Status *status)
{
static const char FCNAME[] = "MPI_Sendrecv_replace";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
#ifdef MPID_LOG_ARROWS
/* This isn't the right test, but it is close enough for now */
int sendcount = count, recvcount = count;
#endif
MPIU_CHKLMEM_DECL(1);
MPID_MPI_STATE_DECL(MPID_STATE_MPI_SENDRECV_REPLACE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_PT2PT_FUNC_ENTER_BOTH(MPID_STATE_MPI_SENDRECV_REPLACE);
/* Convert handles to MPI objects. */
MPID_Comm_get_ptr(comm, comm_ptr);
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate communicator */
MPID_Comm_valid_ptr(comm_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
/* Validate count */
MPIR_ERRTEST_COUNT(count, mpi_errno);
/* Validate status (status_ignore is not the same as null) */
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
/* Validate tags */
MPIR_ERRTEST_SEND_TAG(sendtag, mpi_errno);
MPIR_ERRTEST_RECV_TAG(recvtag, mpi_errno);
/* Validate source and destination */
MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
# if defined(MPID_Sendrecv_replace)
{
mpi_errno = MPID_Sendrecv_replace(buf, count, datatype, dest,
sendtag, source, recvtag, comm_ptr,
status)
}
# else
{
MPID_Request * sreq;
MPID_Request * rreq;
void * tmpbuf = NULL;
int tmpbuf_size = 0;
int tmpbuf_count = 0;
if (count > 0 && dest != MPI_PROC_NULL)
{
MPIR_Pack_size_impl(count, datatype, &tmpbuf_size);
MPIU_CHKLMEM_MALLOC_ORJUMP(tmpbuf, void *, tmpbuf_size, mpi_errno, "temporary send buffer");
mpi_errno = MPIR_Pack_impl(buf, count, datatype, tmpbuf, tmpbuf_size, &tmpbuf_count);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
mpi_errno = MPID_Irecv(buf, count, datatype, source, recvtag,
comm_ptr, MPID_CONTEXT_INTRA_PT2PT, &rreq);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
mpi_errno = MPID_Isend(tmpbuf, tmpbuf_count, MPI_PACKED, dest,
sendtag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT,
&sreq);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
/* FIXME: should we cancel the pending (possibly completed) receive request or wait for it to complete? */
MPID_Request_release(rreq);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
if (!MPID_Request_is_complete(sreq) || !MPID_Request_is_complete(rreq))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(sreq) || !MPID_Request_is_complete(rreq))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
if (status != MPI_STATUS_IGNORE)
{
*status = rreq->status;
}
if (mpi_errno == MPI_SUCCESS)
{
mpi_errno = rreq->status.MPI_ERROR;
if (mpi_errno == MPI_SUCCESS)
{
mpi_errno = sreq->status.MPI_ERROR;
}
}
MPID_Request_release(sreq);
MPID_Request_release(rreq);
}
/*@
MPI_Send - Performs a blocking send
Input Parameters:
+ buf - initial address of send buffer (choice)
. count - number of elements in send buffer (nonnegative integer)
. datatype - datatype of each send buffer element (handle)
. dest - rank of destination (integer)
. tag - message tag (integer)
- comm - communicator (handle)
Notes:
This routine may block until the message is received by the destination
process.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_TAG
.N MPI_ERR_RANK
.seealso: MPI_Isend, MPI_Bsend
@*/
int MPI_Send(const void *buf, int count, MPI_Datatype datatype, int dest, int tag,
MPI_Comm comm)
{
static const char FCNAME[] = "MPI_Send";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_Request * request_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_SEND);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_SEND);
/* Validate handle parameters needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( comm, comm_ptr );
/* Validate parameters if error checking is enabled */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno);
MPIR_ERRTEST_SEND_TAG(tag, mpi_errno);
/* Validate datatype handle */
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype object */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
}
/* Validate buffer */
MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Send(buf, count, datatype, dest, tag, comm_ptr,
MPID_CONTEXT_INTRA_PT2PT, &request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (request_ptr == NULL)
{
goto fn_exit;
}
/* If a request was returned, then we need to block until the request
is complete */
if (!MPID_Request_is_complete(request_ptr))
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPID_Request_is_complete(request_ptr))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno != MPI_SUCCESS)
{
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
goto fn_fail;
/* --END ERROR HANDLING-- */
}
}
MPID_Progress_end(&progress_state);
}
mpi_errno = request_ptr->status.MPI_ERROR;
MPID_Request_release(request_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_SEND);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_send",
"**mpi_send %p %d %D %i %t %C", buf, count, datatype, dest, tag, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}