/*@ 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-- */ }