/*@
MPIDI_CH3U_VC_WaitForClose - Wait for all virtual connections to close
@*/
int MPIDI_CH3U_VC_WaitForClose( void )
{
MPID_Progress_state progress_state;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3U_VC_WAITFORCLOSE);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3U_VC_WAITFORCLOSE);
MPID_Progress_start(&progress_state);
while(MPIDI_Outstanding_close_ops > 0) {
MPL_DBG_MSG_D(MPIDI_CH3_DBG_DISCONNECT,TYPICAL,
"Waiting for %d close operations",
MPIDI_Outstanding_close_ops);
mpi_errno = MPID_Progress_wait(&progress_state);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_SET(mpi_errno,MPI_ERR_OTHER,"**ch3|close_progress");
break;
}
/* --END ERROR HANDLING-- */
}
MPID_Progress_end(&progress_state);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3U_VC_WAITFORCLOSE);
return mpi_errno;
}
/*@
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;
}
static int MPIR_Bsend_check_active( void )
{
int mpi_errno = MPI_SUCCESS;
MPIR_Bsend_data_t *active = BsendBuffer.active, *next_active;
MPIU_DBG_MSG_P(BSEND,TYPICAL,"Checking active starting at %p", active);
while (active) {
MPI_Request r = active->request->handle;
int flag;
next_active = active->next;
if (active->kind == IBSEND) {
/* We handle ibsend specially to allow for the user
to attempt and cancel the request. Also, to allow
for a cancel attempt (which must be attempted before
a successful test or wait), we only start
testing when the user has successfully released
the request (it is a grequest, the free call will do it) */
flag = 0;
/* XXX DJG FIXME-MT should we be checking this? */
if (MPIU_Object_get_ref(active->request) == 1) {
mpi_errno = MPIR_Test_impl(&r, &flag, MPI_STATUS_IGNORE );
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
} else {
/* We need to invoke the progress engine in case we
need to advance other, incomplete communication. */
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
mpi_errno = MPID_Progress_test( );
MPID_Progress_end(&progress_state);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
}
} else {
mpi_errno = MPIR_Test_impl( &r, &flag, MPI_STATUS_IGNORE );
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
}
if (flag) {
/* We're done. Remove this segment */
MPIU_DBG_MSG_P(BSEND,TYPICAL,"Removing segment %p", active);
MPIR_Bsend_free_segment( active );
}
active = next_active;
MPIU_DBG_MSG_P(BSEND,TYPICAL,"Next active is %p",active);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_Mrecv(void *buf, int count, MPI_Datatype datatype,
MPIR_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 */
MPIR_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) MPIR_ERR_POP(mpi_errno);
if (!MPIR_Request_is_complete(rreq)) {
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (!MPIR_Request_is_complete(rreq))
{
mpi_errno = MPID_Progress_wait(&progress_state);
if (mpi_errno) {
/* --BEGIN ERROR HANDLING-- */
MPID_Progress_end(&progress_state);
MPIR_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) MPIR_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-- */
}
/*@
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-- */
}
static int MPIDI_Create_inter_root_communicator_accept(const char *port_name,
MPID_Comm **comm_pptr,
MPIDI_VC_t **vc_pptr)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *tmp_comm;
MPIDI_VC_t *new_vc = NULL;
MPID_Progress_state progress_state;
int port_name_tag;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_CREATE_INTER_ROOT_COMMUNICATOR_ACCEPT);
MPIDI_FUNC_ENTER(MPID_STATE_MPIDI_CREATE_INTER_ROOT_COMMUNICATOR_ACCEPT);
/* extract the tag from the port_name */
mpi_errno = MPIDI_GetTagFromPort( port_name, &port_name_tag);
if (mpi_errno != MPIU_STR_SUCCESS) {
MPIU_ERR_POP(mpi_errno);
}
/* FIXME: Describe the algorithm used here, and what routine
is user on the other side of this connection */
/* dequeue the accept queue to see if a connection with the
root on the connect side has been formed in the progress
engine (the connection is returned in the form of a vc). If
not, poke the progress engine. */
MPID_Progress_start(&progress_state);
for(;;)
{
MPIDI_CH3I_Acceptq_dequeue(&new_vc, port_name_tag);
if (new_vc != NULL)
{
break;
}
mpi_errno = MPID_Progress_wait(&progress_state);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno)
{
MPID_Progress_end(&progress_state);
MPIU_ERR_POP(mpi_errno);
}
/* --END ERROR HANDLING-- */
}
MPID_Progress_end(&progress_state);
mpi_errno = MPIDI_CH3I_Initialize_tmp_comm(&tmp_comm, new_vc, 0, port_name_tag);
if (mpi_errno != MPI_SUCCESS) {
MPIU_ERR_POP(mpi_errno);
}
*comm_pptr = tmp_comm;
*vc_pptr = new_vc;
MPIU_DBG_MSG_FMT(CH3_CONNECT,VERBOSE,(MPIU_DBG_FDEST,
"new_vc=%p", new_vc));
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPIDI_CREATE_INTER_ROOT_COMMUNICATOR_ACCEPT);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Comm_disconnect - Disconnect from a communicator
Input Parameter:
. comm - communicator (handle)
Notes:
This routine waits for all pending communication to complete, then frees the
communicator and sets 'comm' to 'MPI_COMM_NULL'. It may not be called
with 'MPI_COMM_WORLD' or 'MPI_COMM_SELF'.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.seealso MPI_Comm_connect, MPI_Comm_join
@*/
int MPI_Comm_disconnect(MPI_Comm * comm)
{
static const char FCNAME[] = "MPI_Comm_disconnect";
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_DISCONNECT);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_DISCONNECT);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(*comm, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Comm_get_ptr( *comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno );
/* If comm_ptr is not valid, it will be reset to null */
if (mpi_errno)
{
goto fn_fail;
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/*
* Since outstanding I/O bumps the reference count on the communicator,
* we wait until we hold the last reference count to
* ensure that all communication has completed. The reference count
* is 1 when the communicator is created, and it is incremented
* only for pending communication operations (and decremented when
* those complete).
*/
/* FIXME-MT should we be checking this? */
if (MPIU_Object_get_ref(comm_ptr) > 1)
{
MPID_Progress_state progress_state;
MPID_Progress_start(&progress_state);
while (MPIU_Object_get_ref(comm_ptr) > 1)
{
mpi_errno = MPID_Progress_wait(&progress_state);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPID_Progress_end(&progress_state);
goto fn_fail;
}
/* --END ERROR HANDLING-- */
}
MPID_Progress_end(&progress_state);
}
mpi_errno = MPID_Comm_disconnect(comm_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
*comm = MPI_COMM_NULL;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_DISCONNECT);
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_comm_disconnect",
"**mpi_comm_disconnect %C", *comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
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;
MPIR_Comm *comm_ptr = NULL;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_SENDRECV_REPLACE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_PT2PT_ENTER_BOTH(MPID_STATE_MPI_SENDRECV_REPLACE);
/* 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(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)
{
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 ... */
# if defined(MPID_Sendrecv_replace)
{
mpi_errno = MPID_Sendrecv_replace(buf, count, datatype, dest,
sendtag, source, recvtag, comm_ptr,
status)
}
# else
{
MPIR_Request * sreq;
MPIR_Request * rreq;
void * tmpbuf = NULL;
MPI_Aint tmpbuf_size = 0;
MPI_Aint tmpbuf_count = 0;
if (count > 0 && dest != MPI_PROC_NULL)
{
MPIR_Pack_size_impl(count, datatype, &tmpbuf_size);
MPIR_CHKLMEM_MALLOC_ORJUMP(tmpbuf, void *, tmpbuf_size, mpi_errno, "temporary send buffer", MPL_MEM_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, MPIR_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, MPIR_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? */
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-- */
}
}
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;
}
}
MPIR_Request_free(sreq);
MPIR_Request_free(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-- */
}
int MPIDI_Win_free(MPID_Win **win_ptr)
{
int mpi_errno=MPI_SUCCESS, total_pt_rma_puts_accs;
int in_use;
MPID_Comm *comm_ptr;
int errflag = FALSE;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_WIN_FREE);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_MPIDI_WIN_FREE);
comm_ptr = (*win_ptr)->comm_ptr;
MPIU_INSTR_DURATION_START(winfree_rs);
mpi_errno = MPIR_Reduce_scatter_block_impl((*win_ptr)->pt_rma_puts_accs,
&total_pt_rma_puts_accs, 1,
MPI_INT, MPI_SUM, comm_ptr, &errflag);
if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
MPIU_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
MPIU_INSTR_DURATION_END(winfree_rs);
if (total_pt_rma_puts_accs != (*win_ptr)->my_pt_rma_puts_accs)
{
MPID_Progress_state progress_state;
/* poke the progress engine until the two are equal */
MPIU_INSTR_DURATION_START(winfree_complete);
MPID_Progress_start(&progress_state);
while (total_pt_rma_puts_accs != (*win_ptr)->my_pt_rma_puts_accs)
{
mpi_errno = MPID_Progress_wait(&progress_state);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPID_Progress_end(&progress_state);
MPIU_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**winnoprogress");
}
/* --END ERROR HANDLING-- */
}
MPID_Progress_end(&progress_state);
MPIU_INSTR_DURATION_END(winfree_complete);
}
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Free((*win_ptr)->base_addrs);
MPIU_Free((*win_ptr)->disp_units);
MPIU_Free((*win_ptr)->all_win_handles);
MPIU_Free((*win_ptr)->pt_rma_puts_accs);
MPIU_Object_release_ref(*win_ptr, &in_use);
/* MPI windows don't have reference count semantics, so this should always be true */
MPIU_Assert(!in_use);
MPIU_Handle_obj_free( &MPID_Win_mem, *win_ptr );
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_MPIDI_WIN_FREE);
return mpi_errno;
fn_fail:
goto fn_exit;
}