/*@ 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-- */ }
/*@ 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_Igatherv - XXX description here Input Parameters: + sendbuf - starting address of the send buffer (choice) . sendcount - number of elements in send buffer (non-negative integer) . sendtype - data type of send buffer elements (handle) . recvcounts - non-negative integer array (of length group size) containing the number of elements that are received from each process (significant only at root) . displs - integer array (of length group size). Entry i specifies the displacement relative to recvbuf at which to place the incoming data from process i (significant only at root) . recvtype - data type of receive buffer elements (significant only at root) (handle) . root - rank of receiving process (integer) - comm - communicator (handle) Output Parameters: + recvbuf - starting address of the receive buffer (significant only at root) (choice) - request - communication request (handle) .N ThreadSafe .N Fortran .N Errors @*/ int MPI_Igatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int recvcounts[], const int displs[], MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request *request) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_IGATHERV); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_IGATHERV); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS { MPIR_ERRTEST_COMM(comm, mpi_errno); /* TODO more checks may be appropriate */ } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* 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 { MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL; int i, rank, comm_size; MPID_Comm_valid_ptr( comm_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->comm_kind == MPID_INTRACOMM) { MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno); if (sendbuf != MPI_IN_PLACE) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(sendtype, sendtype_ptr); MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_USERBUFFER(sendbuf,sendcount,sendtype,mpi_errno); } rank = comm_ptr->rank; if (rank == root) { comm_size = comm_ptr->local_size; for (i=0; i<comm_size; i++) { MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(recvtype, recvtype_ptr); MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } for (i=0; i<comm_size; i++) { if (recvcounts[i] > 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno); break; } } } else MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); } if (comm_ptr->comm_kind == MPID_INTERCOMM) { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); if (root == MPI_ROOT) { comm_size = comm_ptr->remote_size; for (i=0; i<comm_size; i++) { MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(recvtype, recvtype_ptr); MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } for (i=0; i<comm_size; i++) { if (recvcounts[i] > 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno); break; } } } else if (root != MPI_PROC_NULL) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(sendtype, sendtype_ptr); MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(sendbuf,sendcount,sendtype,mpi_errno); } } } MPID_END_ERROR_CHECKS } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Igatherv_impl(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm_ptr, request); if (mpi_errno) MPIU_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_IGATHERV); 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_igatherv", "**mpi_igatherv %p %d %D %p %p %p %D %d %C %p", sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm, request); } # endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ goto fn_exit; }
/*@ MPI_Igather - Gathers together values from a group of processes in a nonblocking way Input Parameters: + sendbuf - starting address of the send buffer (choice) . sendcount - number of elements in send buffer (non-negative integer) . sendtype - data type of send buffer elements (handle) . recvcount - number of elements for any single receive (non-negative integer, significant only at root) . recvtype - data type of receive buffer elements (significant only at root) (handle) . root - rank of receiving process (integer) - comm - communicator (handle) Output Parameters: + recvbuf - starting address of the receive buffer (significant only at root) (choice) - request - communication request (handle) .N ThreadSafe .N Fortran .N Errors @*/ int MPI_Igather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm, MPI_Request * request) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Request *request_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IGATHER); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IGATHER); /* Validate parameters, especially handles 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *sendtype_ptr = NULL, *recvtype_ptr = NULL; int rank; MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM) { MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno); if (sendbuf != MPI_IN_PLACE) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(sendtype, sendtype_ptr); MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); } rank = comm_ptr->rank; if (rank == root) { MPIR_ERRTEST_COUNT(recvcount, mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(recvtype, recvtype_ptr); MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno); /* catch common aliasing cases */ if (recvbuf != MPI_IN_PLACE && sendtype == recvtype && sendcount == recvcount && sendcount != 0) { MPI_Aint recvtype_size; MPIR_Datatype_get_size_macro(recvtype, recvtype_size); MPIR_ERRTEST_ALIAS_COLL(sendbuf, (char *) recvbuf + comm_ptr->rank * recvcount * recvtype_size, mpi_errno); } } else MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); } if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM) { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); if (root == MPI_ROOT) { MPIR_ERRTEST_COUNT(recvcount, mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(recvtype, recvtype_ptr); MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcount, recvtype, mpi_errno); } else if (root != MPI_PROC_NULL) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(sendtype, sendtype_ptr); MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); } } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Igather(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm_ptr, &request_ptr); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* create a complete request, if needed */ if (!request_ptr) request_ptr = MPIR_Request_create_complete(MPIR_REQUEST_KIND__COLL); /* return the handle of the request to the user */ *request = request_ptr->handle; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IGATHER); 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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_igather", "**mpi_igather %p %d %D %p %d %D %d %C %p", sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm, request); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Allreduce - Combines values from all processes and distributes the result back to all processes Input Parameters: + sendbuf - starting address of send buffer (choice) . count - number of elements in send buffer (integer) . datatype - data type of elements of send buffer (handle) . op - operation (handle) - comm - communicator (handle) Output Parameter: . recvbuf - starting address of receive buffer (choice) .N ThreadSafe .N Fortran .N collops .N Errors .N MPI_ERR_BUFFER .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_OP .N MPI_ERR_COMM @*/ int MPI_Allreduce ( void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm ) { static const char FCNAME[] = "MPI_Allreduce"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; int errflag = FALSE; MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLREDUCE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLREDUCE); /* 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 /* HAVE_ERROR_CHECKING */ /* 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; { MPID_Datatype *datatype_ptr = NULL; MPID_Op *op_ptr = NULL; MPID_Comm_valid_ptr( comm_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_COUNT(count, mpi_errno); MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno); MPIR_ERRTEST_OP(op, mpi_errno); if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(datatype, datatype_ptr); MPID_Datatype_valid_ptr( datatype_ptr, mpi_errno ); MPID_Datatype_committed_ptr( datatype_ptr, mpi_errno ); } if (comm_ptr->comm_kind == MPID_INTERCOMM) MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, count, mpi_errno); if (sendbuf != MPI_IN_PLACE) MPIR_ERRTEST_USERBUFFER(sendbuf,count,datatype,mpi_errno); MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, count, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf,count,datatype,mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) { MPID_Op_get_ptr(op, op_ptr); MPID_Op_valid_ptr( op_ptr, mpi_errno ); } if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) { mpi_errno = ( * MPIR_Op_check_dtype_table[op%16 - 1] )(datatype); } if (count != 0) { MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno); } if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Allreduce_impl(sendbuf, recvbuf, count, datatype, op, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLREDUCE); 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_allreduce", "**mpi_allreduce %p %p %d %D %O %C", sendbuf, recvbuf, count, datatype, op, comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Alltoallv - Sends data from all to all processes; each process may send a different amount of data and provide displacements for the input and output data. Input Parameters: + sendbuf - starting address of send buffer (choice) . sendcounts - integer array equal to the group size specifying the number of elements to send to each processor . sdispls - integer array (of length group size). Entry 'j' specifies the displacement (relative to sendbuf from which to take the outgoing data destined for process 'j' . sendtype - data type of send buffer elements (handle) . recvcounts - integer array equal to the group size specifying the maximum number of elements that can be received from each processor . rdispls - integer array (of length group size). Entry 'i' specifies the displacement (relative to recvbuf at which to place the incoming data from process 'i' . recvtype - data type of receive buffer elements (handle) - comm - communicator (handle) Output Parameters: . recvbuf - address of receive buffer (choice) .N ThreadSafe .N Fortran .N Errors .N MPI_ERR_COMM .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_BUFFER @*/ int MPI_Alltoallv(const void *sendbuf, const int *sendcounts, const int *sdispls, MPI_Datatype sendtype, void *recvbuf, const int *recvcounts, const int *rdispls, MPI_Datatype recvtype, MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPID_MPI_STATE_DECL(MPID_STATE_MPI_ALLTOALLV); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_ALLTOALLV); /* Validate parameters, especially handles 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 and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPID_Datatype *sendtype_ptr=NULL, *recvtype_ptr=NULL; int i, comm_size; int check_send = (comm_ptr->comm_kind == MPID_INTRACOMM && sendbuf != MPI_IN_PLACE); MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->comm_kind == MPID_INTRACOMM) { comm_size = comm_ptr->local_size; if (sendbuf != MPI_IN_PLACE && sendtype == recvtype && sendcounts == recvcounts) MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno); } else comm_size = comm_ptr->remote_size; if (comm_ptr->comm_kind == MPID_INTERCOMM && sendbuf == MPI_IN_PLACE) { MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace"); } for (i=0; i<comm_size; i++) { if (check_send) { MPIR_ERRTEST_COUNT(sendcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); } MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (check_send && HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(sendtype, sendtype_ptr); MPID_Datatype_valid_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( sendtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(recvtype, recvtype_ptr); MPID_Datatype_valid_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( recvtype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } for (i=0; i<comm_size && check_send; i++) { if (sendcounts[i] > 0) { MPIR_ERRTEST_USERBUFFER(sendbuf,sendcounts[i],sendtype,mpi_errno); } } for (i=0; i<comm_size; i++) { if (recvcounts[i] > 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf,recvcounts[i],recvtype,mpi_errno); break; } } } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Alltoallv_impl(sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_ALLTOALLV); 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_alltoallv", "**mpi_alltoallv %p %p %p %D %p %p %p %D %C", sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Rsend_init - Creates a persistent request for a ready send Input Parameters: + buf - initial address of send buffer (choice) . count - number of elements sent (integer) . datatype - type of each element (handle) . dest - rank of destination (integer) . tag - message tag (integer) - comm - communicator (handle) Output Parameters: . request - communication request (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_RANK .N MPI_ERR_TAG .N MPI_ERR_COMM .N MPI_ERR_EXHAUSTED .seealso: MPI_Start, MPI_Request_free, MPI_Send_init @*/ int MPI_Rsend_init(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request) { static const char FCNAME[] = "MPI_Rsend_init"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Request *request_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_RSEND_INIT); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_PT2PT_FUNC_ENTER(MPID_STATE_MPI_RSEND_INIT); /* 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); MPIR_ERRTEST_ARGNULL(request,"request",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_Rsend_init(buf, count, datatype, dest, tag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT, &request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* return the handle of the request to the user */ MPID_OBJ_PUBLISH_HANDLE(*request, request_ptr->handle); /* ... end of body of routine ... */ fn_exit: MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_RSEND_INIT); 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_rsend_init", "**mpi_rsend_init %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request); } # 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_Exscan - Computes the exclusive scan (partial reductions) of data on a collection of processes Input Parameters: + sendbuf - starting address of send buffer (choice) . count - number of elements in input buffer (integer) . datatype - data type of elements of input buffer (handle) . op - operation (handle) - comm - communicator (handle) Output Parameters: . recvbuf - starting address of receive buffer (choice) Notes: 'MPI_Exscan' is like 'MPI_Scan', except that the contribution from the calling process is not included in the result at the calling process (it is contributed to the subsequent processes, of course). .N ThreadSafe .N Fortran .N collops .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_BUFFER .N MPI_ERR_BUFFER_ALIAS @*/ int MPI_Exscan(const void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_EXSCAN); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_COLL_ENTER(MPID_STATE_MPI_EXSCAN); /* Validate parameters, especially handles 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 */ MPIR_Comm_get_ptr( comm, comm_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *datatype_ptr = NULL; MPIR_Op *op_ptr = NULL; int rank; MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_COMM_INTRA(comm_ptr, mpi_errno); MPIR_ERRTEST_COUNT(count, mpi_errno); MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno); MPIR_ERRTEST_OP(op, mpi_errno); if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) { MPID_Datatype_get_ptr(datatype, datatype_ptr); MPIR_Datatype_valid_ptr( datatype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr( datatype_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } rank = comm_ptr->rank; MPIR_ERRTEST_USERBUFFER(sendbuf,count,datatype,mpi_errno); if (rank != 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, count, mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf,count,datatype,mpi_errno); } if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) { MPIR_Op_get_ptr(op, op_ptr); MPIR_Op_valid_ptr( op_ptr, mpi_errno ); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } if (HANDLE_GET_KIND(op) == HANDLE_KIND_BUILTIN) { mpi_errno = ( * MPIR_OP_HDL_TO_DTYPE_FN(op) )(datatype); } if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (sendbuf != MPI_IN_PLACE && count != 0) MPIR_ERRTEST_ALIAS_COLL(sendbuf, recvbuf, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Exscan(sendbuf, recvbuf, count, datatype, op, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_COLL_EXIT(MPID_STATE_MPI_EXSCAN); 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_exscan", "**mpi_exscan %p %p %d %D %O %C", sendbuf, recvbuf, count, datatype, op, comm); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Bcast - Broadcasts a message from the process with rank "root" to all other processes of the communicator Input/Output Parameters: . buffer - starting address of buffer (choice) Input Parameters: + count - number of entries in buffer (integer) . datatype - data type of buffer (handle) . root - rank of broadcast root (integer) - comm - communicator (handle) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_BUFFER .N MPI_ERR_ROOT @*/ int MPI_Bcast(void *buffer, int count, MPI_Datatype datatype, int root, MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_BCAST); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_COLL_ENTER(MPID_STATE_MPI_BCAST); /* Validate parameters, especially handles 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *datatype_ptr = NULL; MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_ERRTEST_COUNT(count, mpi_errno); MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno); if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM) { MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno); } else { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); } if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_BUF_INPLACE(buffer, count, mpi_errno); MPIR_ERRTEST_USERBUFFER(buffer, count, datatype, mpi_errno); } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Bcast(buffer, count, datatype, root, comm_ptr, &errflag); if (mpi_errno) MPIR_ERR_POP(mpi_errno); /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_COLL_EXIT(MPID_STATE_MPI_BCAST); 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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_bcast", "**mpi_bcast %p %d %D %d %C", buffer, count, datatype, root, comm); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Ssend - Blocking synchronous 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) .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 @*/ int MPI_Ssend(void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) { static const char FCNAME[] = "MPI_Ssend"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Request * request_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_SSEND); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_SSEND); /* Validate handle parameters needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); if (mpi_errno) goto fn_fail; } 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 ); 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); if (mpi_errno) goto fn_fail; /* 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); MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } /* Validate buffer */ MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno); if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Ssend(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 */ mpi_errno = MPIR_Progress_wait_request(request_ptr); if (mpi_errno) MPIU_ERR_POP(mpi_errno); 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_SSEND); 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_ssend", "**mpi_ssend %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-- */ }
/*@ MPI_Gatherv - Gathers into specified locations from all processes in a group Input Parameters: + sendbuf - starting address of send buffer (choice) . sendcount - number of elements in send buffer (integer) . sendtype - data type of send buffer elements (handle) . recvcounts - integer array (of length group size) containing the number of elements that are received from each process (significant only at 'root') . displs - integer array (of length group size). Entry 'i' specifies the displacement relative to recvbuf at which to place the incoming data from process 'i' (significant only at root) . recvtype - data type of recv buffer elements (significant only at 'root') (handle) . root - rank of receiving process (integer) - comm - communicator (handle) Output Parameters: . recvbuf - address of receive buffer (choice, significant only at 'root') .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_TYPE .N MPI_ERR_BUFFER @*/ int MPI_Gatherv(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, const int *recvcounts, const int *displs, MPI_Datatype recvtype, int root, MPI_Comm comm) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_Errflag_t errflag = MPIR_ERR_NONE; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_GATHERV); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_COLL_ENTER(MPID_STATE_MPI_GATHERV); /* Validate parameters, especially handles 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters and objects (post conversion) */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Datatype *sendtype_ptr = NULL, *recvtype_ptr = NULL; int i, rank, comm_size; MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE); if (mpi_errno != MPI_SUCCESS) goto fn_fail; if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM) { MPIR_ERRTEST_INTRA_ROOT(comm_ptr, root, mpi_errno); if (sendbuf != MPI_IN_PLACE) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(sendtype, sendtype_ptr); MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); } rank = comm_ptr->rank; if (rank == root) { comm_size = comm_ptr->local_size; for (i = 0; i < comm_size; i++) { MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(recvtype, recvtype_ptr); MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } for (i = 0; i < comm_size; i++) { if (recvcounts[i] > 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcounts[i], recvtype, mpi_errno); break; } } /* catch common aliasing cases */ if (sendbuf != MPI_IN_PLACE && sendtype == recvtype && recvcounts[comm_ptr->rank] != 0 && sendcount != 0) { int recvtype_size; MPIR_Datatype_get_size_macro(recvtype, recvtype_size); MPIR_ERRTEST_ALIAS_COLL(sendbuf, (char *) recvbuf + displs[comm_ptr->rank] * recvtype_size, mpi_errno); } } else MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); } if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM) { MPIR_ERRTEST_INTER_ROOT(comm_ptr, root, mpi_errno); if (root == MPI_ROOT) { comm_size = comm_ptr->remote_size; for (i = 0; i < comm_size; i++) { MPIR_ERRTEST_COUNT(recvcounts[i], mpi_errno); MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno); } if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(recvtype, recvtype_ptr); MPIR_Datatype_valid_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(recvtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } for (i = 0; i < comm_size; i++) { if (recvcounts[i] > 0) { MPIR_ERRTEST_RECVBUF_INPLACE(recvbuf, recvcounts[i], mpi_errno); MPIR_ERRTEST_USERBUFFER(recvbuf, recvcounts[i], recvtype, mpi_errno); break; } } } else if (root != MPI_PROC_NULL) { MPIR_ERRTEST_COUNT(sendcount, mpi_errno); MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno); if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype_get_ptr(sendtype, sendtype_ptr); MPIR_Datatype_valid_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_Datatype_committed_ptr(sendtype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } MPIR_ERRTEST_SENDBUF_INPLACE(sendbuf, sendcount, mpi_errno); MPIR_ERRTEST_USERBUFFER(sendbuf, sendcount, sendtype, mpi_errno); } } } MPID_END_ERROR_CHECKS; } #endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPIR_Gatherv(sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm_ptr, &errflag); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_COLL_EXIT(MPID_STATE_MPI_GATHERV); 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, __func__, __LINE__, MPI_ERR_OTHER, "**mpi_gatherv", "**mpi_gatherv %p %d %D %p %p %p %D %d %C", sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, __func__, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Irsend - Starts a nonblocking ready send Input Parameters: + buf - initial address of send buffer (choice) . count - number of elements in send buffer (integer) . datatype - datatype of each send buffer element (handle) . dest - rank of destination (integer) . tag - message tag (integer) - comm - communicator (handle) Output Parameter: . request - communication request (handle) .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 .N MPI_ERR_EXHAUSTED @*/ int MPI_Irsend(void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request) { static const char FCNAME[] = "MPI_Irsend"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Request *request_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_IRSEND); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPIU_THREAD_CS_ENTER(ALLFUNC,); MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_IRSEND); /* Validate handle parameters needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COMM(comm, mpi_errno); if (mpi_errno) goto fn_fail; } 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 ); 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); MPIR_ERRTEST_ARGNULL(request,"request",mpi_errno); if (mpi_errno) goto fn_fail; /* 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); MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno) goto fn_fail; } /* Validate buffer */ MPIR_ERRTEST_USERBUFFER(buf,count,datatype,mpi_errno); if (mpi_errno) goto fn_fail; } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Irsend(buf, count, datatype, dest, tag, comm_ptr, MPID_CONTEXT_INTRA_PT2PT, &request_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPIR_SENDQ_REMEMBER(request_ptr,dest,tag,comm_ptr->context_id); /* return the handle of the request to the user */ /* MPIU_OBJ_HANDLE_PUBLISH is unnecessary for irsend, lower-level access is * responsible for its own consistency, while upper-level field access is * controlled by the completion counter */ *request = request_ptr->handle; /* ... end of body of routine ... */ fn_exit: MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_IRSEND); 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_irsend", "**mpi_irsend %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request); } # endif mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Accumulate - Accumulate data into the target process using remote memory access Input Parameters: + origin_addr - initial address of buffer (choice) . origin_count - number of entries in buffer (nonnegative integer) . origin_datatype - datatype of each buffer entry (handle) . target_rank - rank of target (nonnegative integer) . target_disp - displacement from start of window to beginning of target buffer (nonnegative integer) . target_count - number of entries in target buffer (nonnegative integer) . target_datatype - datatype of each entry in target buffer (handle) . op - predefined reduce operation (handle) - win - window object (handle) Notes: The basic components of both the origin and target datatype must be the same predefined datatype (e.g., all 'MPI_INT' or all 'MPI_DOUBLE_PRECISION'). .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_ARG .N MPI_ERR_COUNT .N MPI_ERR_RANK .N MPI_ERR_TYPE .N MPI_ERR_WIN .seealso: MPI_Raccumulate @*/ int MPI_Accumulate(const void *origin_addr, int origin_count, MPI_Datatype origin_datatype, int target_rank, MPI_Aint target_disp, int target_count, MPI_Datatype target_datatype, MPI_Op op, MPI_Win win) { static const char FCNAME[] = "MPI_Accumulate"; int mpi_errno = MPI_SUCCESS; MPIR_Win *win_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ACCUMULATE); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_RMA_ENTER(MPID_STATE_MPI_ACCUMULATE); /* Validate parameters, especially handles needing to be converted */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_WIN(win, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* Convert MPI object handles to object pointers */ MPIR_Win_get_ptr( win, win_ptr ); /* Validate parameters and objects (post conversion) */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_Comm * comm_ptr; /* Validate win_ptr */ MPIR_Win_valid_ptr( win_ptr, mpi_errno ); if (mpi_errno) goto fn_fail; MPIR_ERRTEST_COUNT(origin_count, mpi_errno); MPIR_ERRTEST_DATATYPE(origin_datatype, "origin_datatype", mpi_errno); MPIR_ERRTEST_USERBUFFER(origin_addr, origin_count, origin_datatype, mpi_errno); MPIR_ERRTEST_COUNT(target_count, mpi_errno); MPIR_ERRTEST_DATATYPE(target_datatype, "target_datatype", mpi_errno); if (win_ptr->create_flavor != MPI_WIN_FLAVOR_DYNAMIC) MPIR_ERRTEST_DISP(target_disp, mpi_errno); if (HANDLE_GET_KIND(origin_datatype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype *datatype_ptr = NULL; MPID_Datatype_get_ptr(origin_datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } if (HANDLE_GET_KIND(target_datatype) != HANDLE_KIND_BUILTIN) { MPIR_Datatype *datatype_ptr = NULL; MPID_Datatype_get_ptr(target_datatype, datatype_ptr); MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; MPID_Datatype_committed_ptr(datatype_ptr, mpi_errno); if (mpi_errno != MPI_SUCCESS) goto fn_fail; } comm_ptr = win_ptr->comm_ptr; MPIR_ERRTEST_SEND_RANK(comm_ptr, target_rank, mpi_errno); MPIR_ERRTEST_OP_ACC(op, mpi_errno); } MPID_END_ERROR_CHECKS; } # endif /* HAVE_ERROR_CHECKING */ /* ... body of routine ... */ mpi_errno = MPID_Accumulate(origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count, target_datatype, op, win_ptr); if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_RMA_EXIT(MPID_STATE_MPI_ACCUMULATE); 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_accumulate", "**mpi_accumulate %p %d %D %d %d %d %D %O %W", origin_addr, origin_count, origin_datatype, target_rank, target_disp, target_count, target_datatype, op, win); } # endif mpi_errno = MPIR_Err_return_win( win_ptr, FCNAME, mpi_errno ); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Ibsend - Starts a nonblocking buffered send Input Parameters: + buf - initial address of send buffer (choice) . count - number of elements in send buffer (integer) . datatype - datatype of each send buffer element (handle) . dest - rank of destination (integer) . tag - message tag (integer) - comm - communicator (handle) Output Parameters: . request - communication request (handle) .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 .N MPI_ERR_BUFFER @*/ int MPI_Ibsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request * request) { int mpi_errno = MPI_SUCCESS; MPIR_Comm *comm_ptr = NULL; MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_IBSEND); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPIR_FUNC_TERSE_PT2PT_ENTER_FRONT(MPID_STATE_MPI_IBSEND); /* 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 */ MPIR_Comm_get_ptr(comm, comm_ptr); /* Validate parameters if error checking is enabled */ #ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COUNT(count, mpi_errno); /* Validate comm_ptr */ MPIR_Comm_valid_ptr(comm_ptr, mpi_errno, FALSE); if (mpi_errno) goto fn_fail; /* If comm_ptr is not valid, it will be reset to null */ if (comm_ptr) { MPIR_ERRTEST_SEND_TAG(tag, mpi_errno); MPIR_ERRTEST_SEND_RANK(comm_ptr, dest, 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 ... */ mpi_errno = MPIR_Ibsend_impl(buf, count, datatype, dest, tag, comm_ptr, request); if (mpi_errno) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPIR_FUNC_TERSE_PT2PT_EXIT(MPID_STATE_MPI_IBSEND); MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); return mpi_errno; fn_fail: /* --BEGIN ERROR HANDLING-- */ /* FIXME: should we be setting the request at all in the case of an error? */ *request = MPI_REQUEST_NULL; #ifdef HAVE_ERROR_REPORTING { mpi_errno = MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_ibsend", "**mpi_ibsend %p %d %D %i %t %C %p", buf, count, datatype, dest, tag, comm, request); } #endif mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno); goto fn_exit; /* --END ERROR HANDLING-- */ }
/*@ MPI_Bsend - Basic send with user-provided buffering 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 send is provided as a convenience function; it allows the user to send messages without worring about where they are buffered (because the user `must` have provided buffer space with 'MPI_Buffer_attach'). In deciding how much buffer space to allocate, remember that the buffer space is not available for reuse by subsequent 'MPI_Bsend's unless you are certain that the message has been received (not just that it should have been received). For example, this code does not allocate enough buffer space .vb MPI_Buffer_attach( b, n*sizeof(double) + MPI_BSEND_OVERHEAD ); for (i=0; i<m; i++) { MPI_Bsend( buf, n, MPI_DOUBLE, ... ); } .ve because only enough buffer space is provided for a single send, and the loop may start a second 'MPI_Bsend' before the first is done making use of the buffer. In C, you can force the messages to be delivered by .vb MPI_Buffer_detach( &b, &n ); MPI_Buffer_attach( b, n ); .ve (The 'MPI_Buffer_detach' will not complete until all buffered messages are delivered.) .N ThreadSafe .N Fortran .N Errors .N MPI_SUCCESS .N MPI_ERR_COMM .N MPI_ERR_COUNT .N MPI_ERR_TYPE .N MPI_ERR_RANK .N MPI_ERR_TAG .seealso: MPI_Buffer_attach, MPI_Ibsend, MPI_Bsend_init @*/ int MPI_Bsend(const void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) { static const char FCNAME[] = "MPI_Bsend"; int mpi_errno = MPI_SUCCESS; MPID_Comm *comm_ptr = NULL; MPID_Request *request_ptr = NULL; MPID_MPI_STATE_DECL(MPID_STATE_MPI_BSEND); MPIR_ERRTEST_INITIALIZED_ORDIE(); MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX); MPID_MPI_PT2PT_FUNC_ENTER_FRONT(MPID_STATE_MPI_BSEND); /* 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 object pointers if error checking is enabled */ # ifdef HAVE_ERROR_CHECKING { MPID_BEGIN_ERROR_CHECKS; { MPIR_ERRTEST_COUNT(count,mpi_errno); /* Validate comm_ptr */ MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE ); if (mpi_errno) goto fn_fail; /* If comm_ptr is not valid, it will be reset to null */ if (comm_ptr) { MPIR_ERRTEST_SEND_TAG(tag,mpi_errno); MPIR_ERRTEST_SEND_RANK(comm_ptr,dest,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 ... */ # ifdef MPID_HAS_TBSEND { mpi_errno = MPID_tBsend( buf, count, datatype, dest, tag, comm_ptr, 0 ); if (mpi_errno == MPI_SUCCESS) { goto fn_exit; } /* FIXME: Check for MPID_WOULD_BLOCK? */ } # endif mpi_errno = MPIR_Bsend_isend( buf, count, datatype, dest, tag, comm_ptr, BSEND, &request_ptr ); /* Note that we can ignore the request_ptr because it is handled internally by the bsend util routines */ if (mpi_errno != MPI_SUCCESS) goto fn_fail; /* ... end of body of routine ... */ fn_exit: MPID_MPI_PT2PT_FUNC_EXIT(MPID_STATE_MPI_BSEND); 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_bsend", "**mpi_bsend %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-- */ }
/*@ 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-- */ }