/*@ 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-- */ }
/*@ MPI_Sendrecv - Sends and receives a message Input Parameters: + sendbuf - initial address of send buffer (choice) . sendcount - number of elements in send buffer (integer) . sendtype - type of elements in send buffer (handle) . dest - rank of destination (integer) . sendtag - send tag (integer) . recvcount - number of elements in receive buffer (integer) . recvtype - type of elements in receive buffer (handle) . source - rank of source (integer) . recvtag - receive tag (integer) - comm - communicator (handle) Output Parameters: + recvbuf - initial address of receive buffer (choice) - status - status object (Status). This refers to the receive operation. .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 @*/ int MPI_Sendrecv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, int dest, int sendtag, void *recvbuf, int recvcount, MPI_Datatype recvtype, int source, int recvtag, MPI_Comm comm, MPI_Status * status) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Request *sreq = NULL; MPIR_Request *rreq = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_SENDRECV); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(VCI_GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_PT2PT_ENTER_BOTH(MPID_STATE_MPI_SENDRECV); /* 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 handles to MPI objects. */ MPIR_Comm_get_ptr(comm, comm_ptr); #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { /* Validate communicator */ MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE); if (mpi_errno) goto fn_fail; /* Validate count */ MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_COUNT(recvcount, 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 */ if (comm_ptr) { MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, mpi_errno); MPIR_ERRTEST_RECV_RANK(comm_ptr, source, mpi_errno); } /* Validate datatype handles */ MPIR_ERRTEST_DATATYPE(sendtype, "datatype", mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "datatype", mpi_errno); /* Validate datatype objects */ if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype *datatype_ptr = NULL; MPIR_Datatype_get_ptr(sendtype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype *datatype_ptr = NULL; MPIR_Datatype_get_ptr(recvtype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } /* Validate buffers */ MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Irecv(recvbuf, recvcount, recvtype, source, recvtag, comm_ptr, MPIR_CONTEXT_INTRA_PT2PT, &rreq); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* FIXME - Performance for small messages might be better if MPID_Send() were used here instead of MPID_Isend() */ mpi_errno = MPID_Isend(sendbuf, sendcount, sendtype, dest, sendtag, comm_ptr, MPIR_CONTEXT_INTRA_PT2PT, &sreq); if (mpi_errno != MPI_SUCCESS) { /* --BEGIN ERROR HANDLING-- */ if (mpi_errno == MPIX_ERR_NOREQ) MPIR_ERR_SET(mpi_errno, MPI_ERR_OTHER, "**nomem"); /* FIXME: should we cancel the pending (possibly completed) receive request or wait for it to complete? */ MPIR_Request_free(rreq); goto fn_fail; /* --END ERROR HANDLING-- */ } if (!MPIR_Request_is_complete(sreq) || !MPIR_Request_is_complete(rreq)) { MPID_Progress_state progress_state; MPID_Progress_start(&progress_state); while (!MPIR_Request_is_complete(sreq) || !MPIR_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-- */ } if (unlikely(MPIR_Request_is_anysrc_mismatched(rreq))) { /* --BEGIN ERROR HANDLING-- */ mpi_errno = MPIR_Request_handle_proc_failed(rreq); if (!MPIR_Request_is_complete(sreq)) { MPID_Cancel_send(sreq); MPIR_STATUS_SET_CANCEL_BIT(sreq->status, FALSE); } goto fn_fail; /* --END ERROR HANDLING-- */ } } MPID_Progress_end(&progress_state); } mpi_errno = rreq->status.MPI_ERROR; MPIR_Request_extract_status(rreq, status); MPIR_Request_free(rreq); if (mpi_errno == MPI_SUCCESS) { mpi_errno = sreq->status.MPI_ERROR; } MPIR_Request_free(sreq); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_PT2PT_EXIT_BOTH(MPID_STATE_MPI_SENDRECV); MPID_THREAD_CS_EXIT(VCI_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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_sendrecv", "**mpi_sendrecv %p %d %D %i %t %p %d %D %i %t %C %p", sendbuf, sendcount, sendtype, dest, sendtag, recvbuf, recvcount, recvtype, source, recvtag, comm, status); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
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; }
int MPID_Mprobe(int source, int tag, MPID_Comm *comm, int context_offset, MPID_Request **message, MPI_Status *status) { int mpi_errno = MPI_SUCCESS; MPID_Progress_state progress_state; int found = FALSE; int context_id = comm->recvcontext_id + context_offset; *message = NULL; if (source == MPI_PROC_NULL) { MPIR_Status_set_procnull(status); found = TRUE; *message = NULL; /* should be interpreted as MPI_MESSAGE_NO_PROC */ goto fn_exit; } /* Check to make sure the communicator hasn't already been revoked */ if (comm->revoked) { MPIR_ERR_SETANDJUMP(mpi_errno,MPIX_ERR_REVOKED,"**revoked"); } #ifdef ENABLE_COMM_OVERRIDES if (MPIDI_Anysource_improbe_fn) { if (source == MPI_ANY_SOURCE) { /* if it's anysource, loop while checking the shm recv queue and improbing the netmod, then do a progress test to make some progress. */ do { MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_MSGQ_MUTEX); *message = MPIDI_CH3U_Recvq_FDU_matchonly(source, tag, context_id, comm,&found); MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_MSGQ_MUTEX); if (found) goto fn_exit; mpi_errno = MPIDI_Anysource_improbe_fn(tag, comm, context_offset, &found, message, status); if (mpi_errno) MPIR_ERR_POP(mpi_errno); if (found) goto fn_exit; MPID_THREAD_CS_YIELD(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); /* FIXME could this be replaced with a progress_wait? */ mpi_errno = MPIDI_CH3_Progress_test(); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } while (1); } else { /* it's not anysource, see if this is for the netmod */ MPIDI_VC_t * vc; MPIDI_Comm_get_vc_set_active(comm, source, &vc); if (vc->comm_ops && vc->comm_ops->improbe) { /* netmod has overridden improbe */ do { mpi_errno = vc->comm_ops->improbe(vc, source, tag, comm, context_offset, &found, message, status); if (mpi_errno) MPIR_ERR_POP(mpi_errno); if (found) goto fn_exit; MPID_THREAD_CS_YIELD(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); /* FIXME could this be replaced with a progress_wait? */ mpi_errno = MPIDI_CH3_Progress_test(); if (mpi_errno) MPIR_ERR_POP(mpi_errno); } while (1); } /* fall-through to shm case */ } } #endif /* Inefficient implementation: we poll the unexpected queue looking for a * matching request, interleaved with calls to progress. If there are many * non-matching unexpected messages in the queue then we will end up * needlessly scanning the UQ. * * A smarter implementation would enqueue a partial request (one lacking the * recv buffer triple) onto the PQ. Unfortunately, this is a lot harder to * do than it seems at first because of the spread-out nature of callers to * various CH3U_Recvq routines and especially because of the enqueue/dequeue * hooks for native MX tag matching support. */ MPIDI_CH3_Progress_start(&progress_state); do { MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_MSGQ_MUTEX); *message = MPIDI_CH3U_Recvq_FDU_matchonly(source, tag, context_id, comm, &found); MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_MSGQ_MUTEX); if (found) break; mpi_errno = MPIDI_CH3_Progress_wait(&progress_state); } while(mpi_errno == MPI_SUCCESS); MPIDI_CH3_Progress_end(&progress_state); if (mpi_errno) MPIR_ERR_POP(mpi_errno); if (*message) { (*message)->kind = MPID_REQUEST_MPROBE; MPIR_Request_extract_status((*message), status); } fn_exit: return mpi_errno; fn_fail: goto fn_exit; }
/* Complete a request, saving the status data if necessary. "active" has meaning only if the request is a persistent request; this allows the completion routines to indicate that a persistent request was inactive and did not require any extra completion operation. If debugger information is being provided for pending (user-initiated) send operations, the macros MPIR_SENDQ_FORGET will be defined to call the routine MPIR_Sendq_forget; otherwise that macro will be a no-op. The implementation of the MPIR_Sendq_xxx is in src/mpi/debugger/dbginit.c . */ int MPIR_Request_complete(MPI_Request * request, MPID_Request * request_ptr, MPI_Status * status, int * active) { int mpi_errno = MPI_SUCCESS; *active = TRUE; switch(request_ptr->kind) { case MPID_REQUEST_SEND: { if (status != MPI_STATUS_IGNORE) { MPIR_STATUS_SET_CANCEL_BIT(*status, MPIR_STATUS_GET_CANCEL_BIT(request_ptr->status)); } mpi_errno = request_ptr->status.MPI_ERROR; MPIR_SENDQ_FORGET(request_ptr); MPID_Request_release(request_ptr); if (NULL != request) *request = MPI_REQUEST_NULL; break; } case MPID_REQUEST_RECV: { MPIR_Request_extract_status(request_ptr, status); mpi_errno = request_ptr->status.MPI_ERROR; MPID_Request_release(request_ptr); if (NULL != request) *request = MPI_REQUEST_NULL; break; } case MPID_PREQUEST_SEND: { if (request_ptr->partner_request != NULL) { MPID_Request * prequest_ptr = request_ptr->partner_request; /* reset persistent request to inactive state */ MPID_cc_set(&request_ptr->cc, 0); request_ptr->cc_ptr = &request_ptr->cc; request_ptr->partner_request = NULL; if (prequest_ptr->kind != MPID_UREQUEST) { if (status != MPI_STATUS_IGNORE) { MPIR_STATUS_SET_CANCEL_BIT(*status, MPIR_STATUS_GET_CANCEL_BIT(prequest_ptr->status)); } mpi_errno = prequest_ptr->status.MPI_ERROR; } else { /* This is needed for persistent Bsend requests */ int rc; rc = MPIR_Grequest_query(prequest_ptr); if (mpi_errno == MPI_SUCCESS) { mpi_errno = rc; } if (status != MPI_STATUS_IGNORE) { MPIR_STATUS_SET_CANCEL_BIT(*status, MPIR_STATUS_GET_CANCEL_BIT(prequest_ptr->status)); } if (mpi_errno == MPI_SUCCESS) { mpi_errno = prequest_ptr->status.MPI_ERROR; } rc = MPIR_Grequest_free(prequest_ptr); if (mpi_errno == MPI_SUCCESS) { mpi_errno = rc; } } MPID_Request_release(prequest_ptr); } else { if (request_ptr->status.MPI_ERROR != MPI_SUCCESS) { /* if the persistent request failed to start then make the error code available */ if (status != MPI_STATUS_IGNORE) { MPIR_STATUS_SET_CANCEL_BIT(*status, FALSE); } mpi_errno = request_ptr->status.MPI_ERROR; } else { MPIR_Status_set_empty(status); *active = FALSE; } } break; } case MPID_PREQUEST_RECV: { if (request_ptr->partner_request != NULL) { MPID_Request * prequest_ptr = request_ptr->partner_request; /* reset persistent request to inactive state */ MPID_cc_set(&request_ptr->cc, 0); request_ptr->cc_ptr = &request_ptr->cc; request_ptr->partner_request = NULL; MPIR_Request_extract_status(prequest_ptr, status); mpi_errno = prequest_ptr->status.MPI_ERROR; MPID_Request_release(prequest_ptr); } else { MPIR_Status_set_empty(status); /* --BEGIN ERROR HANDLING-- */ if (request_ptr->status.MPI_ERROR != MPI_SUCCESS) { /* if the persistent request failed to start then make the error code available */ mpi_errno = request_ptr->status.MPI_ERROR; } else { *active = FALSE; } /* --END ERROR HANDLING-- */ } break; } case MPID_UREQUEST: { int rc; rc = MPIR_Grequest_query(request_ptr); if (mpi_errno == MPI_SUCCESS) { mpi_errno = rc; } MPIR_Request_extract_status(request_ptr, status); rc = MPIR_Grequest_free(request_ptr); if (mpi_errno == MPI_SUCCESS) { mpi_errno = rc; } MPID_Request_release(request_ptr); if (NULL != request) *request = MPI_REQUEST_NULL; break; } case MPID_COLL_REQUEST: case MPID_WIN_REQUEST: { mpi_errno = request_ptr->status.MPI_ERROR; MPIR_Request_extract_status(request_ptr, status); MPID_Request_release(request_ptr); if (NULL != request) *request = MPI_REQUEST_NULL; break; } default: { /* --BEGIN ERROR HANDLING-- */ /* This should not happen */ MPIR_ERR_SETANDSTMT1(mpi_errno, MPI_ERR_INTERN,;, "**badcase", "**badcase %d", request_ptr->kind); break; /* --END ERROR HANDLING-- */ } }
/*@ 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) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Request *request_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_RECV); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(VNI_GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_PT2PT_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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters if error checking is enabled */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_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) { MPIR_Datatype *datatype_ptr = NULL; MPIR_Datatype_get_ptr(datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; MPIR_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, MPIR_CONTEXT_INTRA_PT2PT, status, &request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (request_ptr == NULL) { goto fn_exit; } mpi_errno = MPID_Wait(request_ptr, MPI_STATUS_IGNORE); if (mpi_errno != MPI_SUCCESS) goto fn_fail; mpi_errno = request_ptr->status.MPI_ERROR; MPIR_Request_extract_status(request_ptr, status); MPIR_Request_free(request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_PT2PT_EXIT_BACK(MPID_STATE_MPI_RECV); MPID_THREAD_CS_EXIT(VNI_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_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-- */ }