/*@
MPI_Op_commute - Queries an MPI reduction operation for its commutativity.
Input Parameters:
. op - operation (handle)
Output Parameters:
. commute - Flag is true if 'op' is a commutative operation. (logical)
.N NULL
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
.seealso: MPI_Op_create
@*/
int MPI_Op_commutative(MPI_Op op, int *commute)
{
MPIR_Op *op_ptr = NULL;
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_OP_COMMUTATIVE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_OP_COMMUTATIVE);
MPIR_Op_get_ptr(op, op_ptr);
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Op_valid_ptr(op_ptr, mpi_errno);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Op_commutative(op_ptr, commute);
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_OP_COMMUTATIVE);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
#ifdef HAVE_ERROR_CHECKING
fn_fail:
/* --BEGIN ERROR HANDLING-- */
{
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_op_commutative", "**mpi_op_commutative %O %p", op, commute);
}
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
#endif
}
/*@
MPI_Add_error_code - Add an MPI error code to an MPI error class
Input Parameters:
. errorclass - Error class to add an error code.
Output Parameters:
. errorcode - New error code for this error class.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_OTHER
@*/
int MPI_Add_error_code(int errorclass, int *errorcode)
{
int mpi_errno = MPI_SUCCESS;
int new_code;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ADD_ERROR_CODE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ADD_ERROR_CODE);
/* Validate parameters, especially handles needing to be converted */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* FIXME: verify that errorclass is a dynamic class */
MPIR_ERRTEST_ARGNULL(errorcode, "errorcode", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
new_code = MPIR_Err_add_code(errorclass);
MPIR_ERR_CHKANDJUMP(new_code < 0, mpi_errno, MPI_ERR_OTHER, "**noerrcodes");
*errorcode = new_code;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ADD_ERROR_CODE);
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_add_error_code", "**mpi_add_error_code %d %p", errorclass,
errorcode);
}
#endif
mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Testsome - Tests for some given requests to complete
Input Parameters:
+ incount - length of array_of_requests (integer)
- array_of_requests - array of requests (array of handles)
Output Parameters:
+ outcount - number of completed requests (integer)
. array_of_indices - array of indices of operations that
completed (array of integers)
- array_of_statuses - array of status objects for
operations that completed (array of Status). May be 'MPI_STATUSES_IGNORE'.
Notes:
While it is possible to list a request handle more than once in the
'array_of_requests', such an action is considered erroneous and may cause the
program to unexecpectedly terminate or produce incorrect results.
.N ThreadSafe
.N waitstatus
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_IN_STATUS
@*/
int MPI_Testsome(int incount, MPI_Request array_of_requests[], int *outcount,
int array_of_indices[], MPI_Status array_of_statuses[])
{
MPIR_Request *request_ptr_array[MPIR_REQUEST_PTR_ARRAY_SIZE];
MPIR_Request **request_ptrs = request_ptr_array;
MPI_Status *status_ptr;
int i;
int n_inactive;
int proc_failure = FALSE;
int rc = MPI_SUCCESS;
int mpi_errno = MPI_SUCCESS;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TESTSOME);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(VCI_GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_REQUEST_ENTER(MPID_STATE_MPI_TESTSOME);
/* Check the arguments */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COUNT(incount, mpi_errno);
if (incount != 0) {
MPIR_ERRTEST_ARGNULL(array_of_requests, "array_of_requests", mpi_errno);
MPIR_ERRTEST_ARGNULL(array_of_indices, "array_of_indices", mpi_errno);
/* NOTE: MPI_STATUSES_IGNORE != NULL */
MPIR_ERRTEST_ARGNULL(array_of_statuses, "array_of_statuses", mpi_errno);
}
MPIR_ERRTEST_ARGNULL(outcount, "outcount", mpi_errno);
for (i = 0; i < incount; i++) {
MPIR_ERRTEST_ARRAYREQUEST_OR_NULL(array_of_requests[i], i, mpi_errno);
}
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
*outcount = 0;
/* Convert MPI request handles to a request object pointers */
if (incount > MPIR_REQUEST_PTR_ARRAY_SIZE) {
MPIR_CHKLMEM_MALLOC_ORJUMP(request_ptrs, MPIR_Request **, incount * sizeof(MPIR_Request *),
mpi_errno, "request pointers", MPL_MEM_OBJECT);
}
int MPIDI_CH3_EagerContigSend( MPID_Request **sreq_p,
MPIDI_CH3_Pkt_type_t reqtype,
const void * buf, MPIDI_msg_sz_t data_sz, int rank,
int tag, MPID_Comm * comm, int context_offset )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_VC_t * vc;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_send_t * const eager_pkt = &upkt.eager_send;
MPID_Request *sreq = *sreq_p;
MPL_IOV iov[2];
MPIDI_Pkt_init(eager_pkt, reqtype);
eager_pkt->match.parts.rank = comm->rank;
eager_pkt->match.parts.tag = tag;
eager_pkt->match.parts.context_id = comm->context_id + context_offset;
eager_pkt->sender_req_id = MPI_REQUEST_NULL;
eager_pkt->data_sz = data_sz;
iov[0].MPL_IOV_BUF = (MPL_IOV_BUF_CAST)eager_pkt;
iov[0].MPL_IOV_LEN = sizeof(*eager_pkt);
MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST,
"sending contiguous eager message, data_sz=" MPIDI_MSG_SZ_FMT,
data_sz));
iov[1].MPL_IOV_BUF = (MPL_IOV_BUF_CAST) buf;
iov[1].MPL_IOV_LEN = data_sz;
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(eager_pkt, seqnum);
MPIU_DBG_MSGPKT(vc,tag,eager_pkt->match.parts.context_id,rank,data_sz,"EagerContig");
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsgv(vc, iov, 2, sreq_p);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**ch3|eagermsg");
}
sreq = *sreq_p;
if (sreq != NULL)
{
MPIDI_Request_set_seqnum(sreq, seqnum);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
}
fn_fail:
return mpi_errno;
}
/*@
MPI_Comm_create_keyval - Create a new attribute key
Input Parameters:
+ comm_copy_attr_fn - Copy callback function for 'keyval'
. comm_delete_attr_fn - Delete callback function for 'keyval'
- extra_state - Extra state for callback functions
Output Parameters:
. comm_keyval - key value for future access (integer)
Notes:
Key values are global (available for any and all communicators).
Default copy and delete functions are available. These are
+ MPI_COMM_NULL_COPY_FN - empty copy function
. MPI_COMM_NULL_DELETE_FN - empty delete function
- MPI_COMM_DUP_FN - simple dup function
There are subtle differences between C and Fortran that require that the
copy_fn be written in the same language from which 'MPI_Comm_create_keyval'
is called.
This should not be a problem for most users; only programmers using both
Fortran and C in the same program need to be sure that they follow this rule.
.N AttrErrReturn
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.seealso MPI_Comm_free_keyval
@*/
int MPI_Comm_create_keyval(MPI_Comm_copy_attr_function *comm_copy_attr_fn,
MPI_Comm_delete_attr_function *comm_delete_attr_fn,
int *comm_keyval, void *extra_state)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CREATE_KEYVAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CREATE_KEYVAL);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(comm_keyval, "comm_keyval", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_create_keyval_impl(comm_copy_attr_fn, comm_delete_attr_fn, comm_keyval, extra_state);
if (mpi_errno) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CREATE_KEYVAL);
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_comm_create_keyval",
"**mpi_comm_create_keyval %p %p %p %p", comm_copy_attr_fn, comm_delete_attr_fn, comm_keyval, extra_state);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Finalize_async_thread(void)
{
int mpi_errno = MPI_SUCCESS;
#if MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE
MPIR_Request *request_ptr = NULL;
MPI_Request request;
MPI_Status status;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
mpi_errno = MPID_Isend(NULL, 0, MPI_CHAR, 0, WAKE_TAG, progress_comm_ptr,
MPIR_CONTEXT_INTRA_PT2PT, &request_ptr);
MPIR_Assert(!mpi_errno);
request = request_ptr->handle;
mpi_errno = MPIR_Wait_impl(&request, &status);
MPIR_Assert(!mpi_errno);
/* XXX DJG why is this unlock/lock necessary? Should we just YIELD here or later? */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_Thread_mutex_lock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
while (!progress_thread_done) {
MPID_Thread_cond_wait(&progress_cond, &progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
}
MPID_Thread_mutex_unlock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
mpi_errno = MPIR_Comm_free_impl(progress_comm_ptr);
MPIR_Assert(!mpi_errno);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_Thread_cond_destroy(&progress_cond, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_Thread_mutex_destroy(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
#endif /* MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE */
return mpi_errno;
}
static int getConnInfoKVS( int rank, char *buf, int bufsize, MPIDI_PG_t *pg )
{
#ifdef USE_PMI2_API
char key[MPIDI_MAX_KVS_KEY_LEN];
int mpi_errno = MPI_SUCCESS, rc;
int vallen;
rc = MPL_snprintf(key, MPIDI_MAX_KVS_KEY_LEN, "P%d-businesscard", rank );
if (rc < 0 || rc > MPIDI_MAX_KVS_KEY_LEN) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
mpi_errno = PMI2_KVS_Get(pg->connData, PMI2_ID_NULL, key, buf, bufsize, &vallen);
if (mpi_errno) {
MPIDI_PG_CheckForSingleton();
mpi_errno = PMI2_KVS_Get(pg->connData, PMI2_ID_NULL, key, buf, bufsize, &vallen);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
#else
char key[MPIDI_MAX_KVS_KEY_LEN];
int mpi_errno = MPI_SUCCESS, rc, pmi_errno;
rc = MPL_snprintf(key, MPIDI_MAX_KVS_KEY_LEN, "P%d-businesscard", rank );
if (rc < 0 || rc > MPIDI_MAX_KVS_KEY_LEN) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**nomem");
}
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
pmi_errno = PMI_KVS_Get(pg->connData, key, buf, bufsize );
if (pmi_errno) {
MPIDI_PG_CheckForSingleton();
pmi_errno = PMI_KVS_Get(pg->connData, key, buf, bufsize );
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_PMI_MUTEX);
if (pmi_errno) {
MPIR_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**pmi_kvs_get");
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
#endif
}
/*@
MPI_Testany - Tests for completion of any previdously initiated
requests
Input Parameters:
+ count - list length (integer)
- array_of_requests - array of requests (array of handles)
Output Parameters:
+ indx - index of operation that completed, or 'MPI_UNDEFINED' if none
completed (integer)
. flag - true if one of the operations is complete (logical)
- status - status object (Status). May be 'MPI_STATUS_IGNORE'.
Notes:
While it is possible to list a request handle more than once in the
'array_of_requests', such an action is considered erroneous and may cause the
program to unexecpectedly terminate or produce incorrect results.
.N ThreadSafe
.N waitstatus
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Testany(int count, MPI_Request array_of_requests[], int *indx,
int *flag, MPI_Status * status)
{
MPIR_Request *request_ptr_array[MPIR_REQUEST_PTR_ARRAY_SIZE];
MPIR_Request **request_ptrs = request_ptr_array;
int i;
int n_inactive;
int last_disabled_anysource = -1;
int first_nonnull = count;
int mpi_errno = MPI_SUCCESS;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TESTANY);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(VCI_GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_REQUEST_ENTER(MPID_STATE_MPI_TESTANY);
/* Check the arguments */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COUNT(count, mpi_errno);
if (count != 0) {
MPIR_ERRTEST_ARGNULL(array_of_requests, "array_of_requests", mpi_errno);
/* NOTE: MPI_STATUS_IGNORE != NULL */
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
}
MPIR_ERRTEST_ARGNULL(indx, "indx", mpi_errno);
MPIR_ERRTEST_ARGNULL(flag, "flag", mpi_errno);
for (i = 0; i < count; i++) {
MPIR_ERRTEST_ARRAYREQUEST_OR_NULL(array_of_requests[i], i, mpi_errno);
}
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* Convert MPI request handles to a request object pointers */
if (count > MPIR_REQUEST_PTR_ARRAY_SIZE) {
MPIR_CHKLMEM_MALLOC_ORJUMP(request_ptrs, MPIR_Request **, count * sizeof(MPIR_Request *),
mpi_errno, "request pointers", MPL_MEM_OBJECT);
}
/*@
MPI_Add_error_string - Associates an error string with an MPI error code or
class
Input Parameters:
+ errorcode - error code or class (integer)
- string - text corresponding to errorcode (string)
Notes:
The string must be no more than 'MPI_MAX_ERROR_STRING' characters long.
The length of the string is as defined in the calling language.
The length of the string does not include the null terminator in C or C++.
Note that the string is 'const' even though the MPI standard does not
specify it that way.
According to the MPI-2 standard, it is erroneous to call 'MPI_Add_error_string'
for an error code or class with a value less than or equal
to 'MPI_ERR_LASTCODE'. Thus, you cannot replace the predefined error messages
with this routine.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Add_error_string(int errorcode, const char *string)
{
static const char FCNAME[] = "MPI_Add_error_string";
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_ADD_ERROR_STRING);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_ADD_ERROR_STRING);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(string,"string",mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Err_set_msg( errorcode, (const char *)string );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_ADD_ERROR_STRING);
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_add_error_string",
"**mpi_add_error_string %d %s", errorcode, string);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Waitany - Waits for any specified MPI Request to complete
Input Parameters:
+ count - list length (integer)
- array_of_requests - array of requests (array of handles)
Output Parameters:
+ indx - index of handle for operation that completed (integer). In the
range '0' to 'count-1'. In Fortran, the range is '1' to 'count'.
- status - status object (Status). May be 'MPI_STATUS_IGNORE'.
Notes:
If all of the requests are 'MPI_REQUEST_NULL', then 'indx' is returned as
'MPI_UNDEFINED', and 'status' is returned as an empty status.
While it is possible to list a request handle more than once in the
array_of_requests, such an action is considered erroneous and may cause the
program to unexecpectedly terminate or produce incorrect results.
.N waitstatus
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_REQUEST
.N MPI_ERR_ARG
@*/
int MPI_Waitany(int count, MPI_Request array_of_requests[], int *indx,
MPI_Status *status)
{
static const char FCNAME[] = "MPI_Waitany";
MPIR_Request * request_ptr_array[MPIR_REQUEST_PTR_ARRAY_SIZE];
MPIR_Request ** request_ptrs = request_ptr_array;
MPID_Progress_state progress_state;
int i;
int n_inactive;
int active_flag;
int init_req_array;
int found_nonnull_req;
int last_disabled_anysource = -1;
int mpi_errno = MPI_SUCCESS;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WAITANY);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_PT2PT_ENTER(MPID_STATE_MPI_WAITANY);
/* Check the arguments */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COUNT(count, mpi_errno);
if (count != 0) {
MPIR_ERRTEST_ARGNULL(array_of_requests, "array_of_requests", mpi_errno);
/* NOTE: MPI_STATUS_IGNORE != NULL */
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
}
MPIR_ERRTEST_ARGNULL(indx, "indx", mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* Convert MPI request handles to a request object pointers */
if (count > MPIR_REQUEST_PTR_ARRAY_SIZE)
{
MPIR_CHKLMEM_MALLOC_ORJUMP(request_ptrs, MPIR_Request **, count * sizeof(MPIR_Request *), mpi_errno, "request pointers");
}
/* Send a zero-sized message with eager synchronous. This is a temporary
routine, as we may want to replace this with a counterpart to the
Eager Short message */
int MPIDI_CH3_EagerSyncZero(MPIR_Request **sreq_p, int rank, int tag,
MPIR_Comm * comm, int context_offset )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_sync_send_t * const es_pkt = &upkt.eager_sync_send;
MPIDI_VC_t * vc;
MPIR_Request *sreq = *sreq_p;
MPL_DBG_MSG(MPIDI_CH3_DBG_OTHER,VERBOSE,"sending zero length message");
/* MT FIXME what are the two operations we are waiting for? the send and
* the sync response? */
MPIR_cc_set(&sreq->cc, 2);
MPIDI_Request_set_msg_type(sreq, MPIDI_REQUEST_EAGER_MSG);
sreq->dev.OnDataAvail = 0;
MPIDI_Pkt_init(es_pkt, MPIDI_CH3_PKT_EAGER_SYNC_SEND);
es_pkt->match.parts.rank = comm->rank;
es_pkt->match.parts.tag = tag;
es_pkt->match.parts.context_id = comm->context_id + context_offset;
es_pkt->sender_req_id = sreq->handle;
es_pkt->data_sz = 0;
MPIDI_Comm_get_vc_set_active(comm, rank, &vc);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Pkt_set_seqnum(es_pkt, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
MPL_DBG_MSGPKT(vc,tag,es_pkt->match.parts.context_id,rank,(intptr_t)0,"EagerSync0");
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iSend(vc, sreq, es_pkt, sizeof(*es_pkt));
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPIR_Request_free(sreq);
*sreq_p = NULL;
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**ch3|eagermsg");
}
/* --END ERROR HANDLING-- */
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
static void progress_fn(void * data)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Request *request_ptr = NULL;
MPI_Request request;
MPI_Status status;
/* Explicitly add CS_ENTER/EXIT since this thread is created from
* within an internal function and will call NMPI functions
* directly. */
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
/* FIXME: We assume that waiting on some request forces progress
* on all requests. With fine-grained threads, will this still
* work as expected? We can imagine an approach where a request on
* a non-conflicting communicator would not touch the remaining
* requests to avoid locking issues. Once the fine-grained threads
* code is fully functional, we need to revisit this and, if
* appropriate, either change what we do in this thread, or delete
* this comment. */
mpi_errno = MPID_Irecv(NULL, 0, MPI_CHAR, 0, WAKE_TAG, progress_comm_ptr,
MPIR_CONTEXT_INTRA_PT2PT, &request_ptr);
MPIR_Assert(!mpi_errno);
request = request_ptr->handle;
mpi_errno = MPIR_Wait_impl(&request, &status);
MPIR_Assert(!mpi_errno);
/* Send a signal to the main thread saying we are done */
MPID_Thread_mutex_lock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
progress_thread_done = 1;
MPID_Thread_mutex_unlock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_Thread_cond_signal(&progress_cond, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return;
}
int MPIDI_CH3I_Progress_deactivate_hook(int id)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_Assert(id >= 0 && id < MAX_PROGRESS_HOOKS &&
progress_hooks[id].active == TRUE && progress_hooks[id].func_ptr != NULL);
progress_hooks[id].active = FALSE;
fn_exit:
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPIDI_CH3I_PROGRESS_DEACTIVATE_HOOK);
return mpi_errno;
fn_fail:
goto fn_exit;
}
void MPIR_Sendq_forget( MPID_Request *req )
{
MPIR_Sendq *p, *prev;
MPID_THREAD_CS_ENTER(POBJ, req->pobj_mutex);
p = req->dbg_next;
if (!p) {
/* Just ignore it */
MPID_THREAD_CS_EXIT(POBJ, req->pobj_mutex);
return;
}
prev = p->prev;
if (prev != NULL) prev->next = p->next;
else MPIR_Sendq_head = p->next;
if (p->next != NULL) p->next->prev = prev;
/* Return this element to the pool */
p->next = pool;
pool = p;
MPID_THREAD_CS_EXIT(POBJ, req->pobj_mutex);
}
int MPID_NS_Lookup( MPID_NS_Handle handle, const MPID_Info *info_ptr,
const char service_name[], char port[] )
{
int mpi_errno = MPI_SUCCESS;
int rc;
MPIU_UNREFERENCED_ARG(info_ptr);
MPIU_UNREFERENCED_ARG(handle);
#ifdef USE_PMI2_API
/* release the global CS for PMI calls */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
rc = PMI2_Nameserv_lookup(service_name, info_ptr, port, MPI_MAX_PORT_NAME);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
#else
rc = PMI_Lookup_name( service_name, port );
#endif
MPIR_ERR_CHKANDJUMP1(rc, mpi_errno, MPI_ERR_NAME, "**namepubnotfound", "**namepubnotfound %s", service_name);
fn_fail:
return mpi_errno;
}
int MPID_NS_Unpublish( MPID_NS_Handle handle, const MPID_Info *info_ptr,
const char service_name[] )
{
int mpi_errno = MPI_SUCCESS;
int rc;
MPIU_UNREFERENCED_ARG(info_ptr);
MPIU_UNREFERENCED_ARG(handle);
#ifdef USE_PMI2_API
/* release the global CS for PMI calls */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
rc = PMI2_Nameserv_unpublish(service_name, info_ptr);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
#else
rc = PMI_Unpublish_name( service_name );
#endif
MPIR_ERR_CHKANDJUMP1(rc, mpi_errno, MPI_ERR_SERVICE, "**namepubnotunpub", "**namepubnotunpub %s", service_name);
fn_fail:
return mpi_errno;
}
void MPIR_CommL_remember( MPID_Comm *comm_ptr )
{
#if defined(FINEGRAIN_MPI) /* FG: TODO Temporary bypass */
return;
#endif
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Adding communicator %p to remember list",comm_ptr);
MPIU_DBG_MSG_P(COMM,VERBOSE,
"Remember list structure address is %p",&MPIR_All_communicators);
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
if (comm_ptr == MPIR_All_communicators.head) {
MPL_internal_error_printf( "Internal error: communicator is already on free list\n" );
return;
}
comm_ptr->comm_next = MPIR_All_communicators.head;
MPIR_All_communicators.head = comm_ptr;
MPIR_All_communicators.sequence_number++;
MPIU_DBG_MSG_P(COMM,VERBOSE,
"master head is %p", MPIR_All_communicators.head );
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
}
/*
* These routines are called when a receive matches an eager sync send
*/
int MPIDI_CH3_EagerSyncAck( MPIDI_VC_t *vc, MPIR_Request *rreq )
{
int mpi_errno = MPI_SUCCESS;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_eager_sync_ack_t * const esa_pkt = &upkt.eager_sync_ack;
MPIR_Request * esa_req;
MPL_DBG_MSG(MPIDI_CH3_DBG_OTHER,VERBOSE,"sending eager sync ack");
MPIDI_Pkt_init(esa_pkt, MPIDI_CH3_PKT_EAGER_SYNC_ACK);
esa_pkt->sender_req_id = rreq->dev.sender_req_id;
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsg(vc, esa_pkt, sizeof(*esa_pkt), &esa_req);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_POP(mpi_errno);
}
if (esa_req != NULL)
{
MPIR_Request_free(esa_req);
}
fn_fail:
return mpi_errno;
}
int
MPII_Attr_delete_c_proxy(MPI_Comm_delete_attr_function * user_function,
int handle,
int keyval, MPIR_Attr_type attrib_type, void *attrib, void *extra_state)
{
void *attrib_val = NULL;
int ret;
/* Make sure that the attribute value is delieverd as a pointer */
if (MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT))
attrib_val = &attrib;
else
attrib_val = attrib;
/* user functions might call other MPI functions, so we need to
* release the lock here. This is safe to do as GLOBAL is not at
* all recursive in our implementation. */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
ret = user_function(handle, keyval, attrib_val, extra_state);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return ret;
}
/*@
MPI_Startall - Starts a collection of persistent requests
Input Parameters:
+ count - list length (integer)
- array_of_requests - array of requests (array of handle)
Notes:
Unlike 'MPI_Waitall', 'MPI_Startall' does not provide a mechanism for
returning multiple errors nor pinpointing the request(s) involved.
Furthermore, the behavior of 'MPI_Startall' after an error occurs is not
defined by the MPI standard. If well-defined error reporting and behavior
are required, multiple calls to 'MPI_Start' should be used instead.
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
.N MPI_ERR_REQUEST
@*/
int MPI_Startall(int count, MPI_Request array_of_requests[])
{
static const char FCNAME[] = "MPI_Startall";
MPIR_Request * request_ptr_array[MPIR_REQUEST_PTR_ARRAY_SIZE];
MPIR_Request ** request_ptrs = request_ptr_array;
int i;
int mpi_errno = MPI_SUCCESS;
MPIR_CHKLMEM_DECL(1);
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_STARTALL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_PT2PT_ENTER(MPID_STATE_MPI_STARTALL);
/* Validate handle parameters needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_ARGNULL(array_of_requests,"array_of_requests", mpi_errno);
for (i = 0; i < count; i++) {
MPIR_ERRTEST_REQUEST(array_of_requests[i], mpi_errno);
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI request handles to a request object pointers */
if (count > MPIR_REQUEST_PTR_ARRAY_SIZE)
{
MPIR_CHKLMEM_MALLOC_ORJUMP(request_ptrs, MPIR_Request **, count * sizeof(MPIR_Request *), mpi_errno, "request pointers");
}
/*@
MPI_Reduce_local - Applies a reduction operator to local arguments.
Input Parameters:
+ inbuf - address of the input buffer (choice)
. count - number of elements in each buffer (integer)
. datatype - data type of elements in the buffers (handle)
- op - reduction operation (handle)
Output Parameters:
. inoutbuf - address of input-output buffer (choice)
.N ThreadSafe
.N Fortran
.N collops
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COUNT
.N MPI_ERR_TYPE
.N MPI_ERR_BUFFER
.N MPI_ERR_BUFFER_ALIAS
@*/
int MPI_Reduce_local(const void *inbuf, void *inoutbuf, int count, MPI_Datatype datatype, MPI_Op op)
{
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_REDUCE_LOCAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_COLL_FUNC_ENTER(MPID_STATE_MPI_REDUCE_LOCAL);
/* Validate parameters */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_OP(op, mpi_errno);
if (HANDLE_GET_KIND(op) != HANDLE_KIND_BUILTIN) {
MPID_Op *op_ptr;
MPID_Op_get_ptr(op, op_ptr);
MPID_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 (count != 0) {
MPIR_ERRTEST_ALIAS_COLL(inbuf, inoutbuf, mpi_errno);
}
MPIR_ERRTEST_NAMED_BUF_INPLACE(inbuf, "inbuf", count, mpi_errno);
MPIR_ERRTEST_NAMED_BUF_INPLACE(inoutbuf, "inoutbuf", count, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Reduce_local_impl(inbuf, inoutbuf, count, datatype, op);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_COLL_FUNC_EXIT(MPID_STATE_MPI_REDUCE_LOCAL);
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_reduce_local",
"**mpi_reduce_local %p %p %d %D %O", inbuf, inoutbuf, count, datatype, op);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*
* This function does all of the work or either revoking the communciator for
* the first time or keeping track of an ongoing revocation.
*
* comm_ptr - The communicator being revoked
* is_remote - If we received the revocation from a remote process, this should
* be set to true. This way we'll know to decrement the counter twice
* (once for our local revocation and once for the remote).
*/
int MPID_Comm_revoke(MPIR_Comm *comm_ptr, int is_remote)
{
MPIDI_VC_t *vc;
MPL_IOV iov[MPL_IOV_LIMIT];
int mpi_errno = MPI_SUCCESS;
int i, size, my_rank;
MPIR_Request *request;
MPIDI_CH3_Pkt_t upkt;
MPIDI_CH3_Pkt_revoke_t *revoke_pkt = &upkt.revoke;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPID_COMM_REVOKE);
MPIR_FUNC_VERBOSE_ENTER(MPID_STATE_MPID_COMM_REVOKE);
if (0 == comm_ptr->revoked) {
/* Mark the communicator as revoked locally */
comm_ptr->revoked = 1;
if (comm_ptr->node_comm) comm_ptr->node_comm->revoked = 1;
if (comm_ptr->node_roots_comm) comm_ptr->node_roots_comm->revoked = 1;
/* Start a counter to track how many revoke messages we've received from
* other ranks */
comm_ptr->dev.waiting_for_revoke = comm_ptr->local_size - 1 - is_remote; /* Subtract the processes who already know about the revoke */
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_OTHER, VERBOSE, (MPL_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->dev.waiting_for_revoke));
/* Keep a reference to this comm so it doesn't get destroyed while
* it's being revoked */
MPIR_Comm_add_ref(comm_ptr);
/* Send out the revoke message */
MPIDI_Pkt_init(revoke_pkt, MPIDI_CH3_PKT_REVOKE);
revoke_pkt->revoked_comm = comm_ptr->context_id;
size = comm_ptr->remote_size;
my_rank = comm_ptr->rank;
for (i = 0; i < size; i++) {
if (i == my_rank) continue;
request = NULL;
MPIDI_Comm_get_vc_set_active(comm_ptr, i, &vc);
iov[0].MPL_IOV_BUF = (MPL_IOV_BUF_CAST) revoke_pkt;
iov[0].MPL_IOV_LEN = sizeof(*revoke_pkt);
MPID_THREAD_CS_ENTER(POBJ, vc->pobj_mutex);
mpi_errno = MPIDI_CH3_iStartMsgv(vc, iov, 1, &request);
MPID_THREAD_CS_EXIT(POBJ, vc->pobj_mutex);
if (mpi_errno) comm_ptr->dev.waiting_for_revoke--;
if (NULL != request)
/* We don't need to keep a reference to this request. The
* progress engine will keep a reference until it completes
* later */
MPIR_Request_free(request);
}
/* Check to see if we are done revoking */
if (comm_ptr->dev.waiting_for_revoke == 0) {
MPIR_Comm_release(comm_ptr);
}
/* Go clean up all of the existing operations involving this
* communicator. This includes completing existing MPI requests, MPID
* requests, and cleaning up the unexpected queue to make sure there
* aren't any unexpected messages hanging around. */
/* Clean up the receive and unexpected queues */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_MSGQ_MUTEX);
MPIDI_CH3U_Clean_recvq(comm_ptr);
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_MSGQ_MUTEX);
} else if (is_remote) { /* If this is local, we've already revoked and don't need to do it again. */
/* Decrement the revoke counter */
comm_ptr->dev.waiting_for_revoke--;
MPL_DBG_MSG_FMT(MPIDI_CH3_DBG_OTHER, VERBOSE, (MPL_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->dev.waiting_for_revoke));
/* Check to see if we are done revoking */
if (comm_ptr->dev.waiting_for_revoke == 0) {
MPIR_Comm_release(comm_ptr);
}
}
MPIR_FUNC_VERBOSE_EXIT(MPID_STATE_MPID_COMM_REVOKE);
return MPI_SUCCESS;
}
/*@
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-- */
}
/*@
MPIX_Comm_failure_get_acked - Get the group of acknowledged failures.
Input Parameters:
. comm - Communicator (handle)
Output Parameters:
. failed_group - Group (handle)
Notes:
.N COMMNULL
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
@*/
int MPIX_Comm_failure_get_acked( MPI_Comm comm, MPI_Group *failedgrp )
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Group *group_ptr;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED);
/* 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;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE );
/* 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 ... */
mpi_errno = MPID_Comm_failure_get_acked(comm_ptr, &group_ptr);
if (mpi_errno) goto fn_fail;
*failedgrp = group_ptr->handle;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIX_COMM_FAILURE_GET_ACKED);
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, "**mpix_comm_failure_get_acked",
"**mpix_comm_failure_get_acked %C %p", comm, failedgrp);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_connect - Make a request to form a new intercommunicator
Input Parameters:
+ port_name - network address (string, used only on root)
. info - implementation-dependent information (handle, used only on root)
. root - rank in comm of root node (integer)
- comm - intracommunicator over which call is collective (handle)
Output Parameters:
. newcomm - intercommunicator with server as remote group (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_INFO
.N MPI_ERR_PORT
@*/
int MPI_Comm_connect(const char *port_name, MPI_Info info, int root, MPI_Comm comm,
MPI_Comm *newcomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Comm *newcomm_ptr = NULL;
MPIR_Info *info_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_COMM_CONNECT);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_COMM_CONNECT);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(comm, mpi_errno);
MPIR_ERRTEST_INFO_OR_NULL(info, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr( comm, comm_ptr );
MPIR_Info_get_ptr( info, info_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
/* 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 ... */
mpi_errno = MPIR_Comm_connect_impl(port_name, info_ptr, root, comm_ptr, &newcomm_ptr);
if (mpi_errno) goto fn_fail;
MPIR_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_COMM_CONNECT);
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_comm_connect",
"**mpi_comm_connect %s %I %d %C %p", port_name, info, root, comm, newcomm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Win_get_errhandler - Get the error handler for the MPI RMA window
Input Parameters:
. win - window (handle)
Output Parameters:
. errhandler - error handler currently associated with window (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_WIN
.N MPI_ERR_OTHER
@*/
int MPI_Win_get_errhandler(MPI_Win win, MPI_Errhandler * errhandler)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Win *win_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_WIN_GET_ERRHANDLER);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_WIN_GET_ERRHANDLER);
/* 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
/* 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_ERRTEST_ARGNULL(errhandler, "errhandler", mpi_errno);
/* Validate win_ptr */
MPIR_Win_valid_ptr(win_ptr, mpi_errno);
/* If win_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 ... */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr));
if (win_ptr->errhandler) {
*errhandler = win_ptr->errhandler->handle;
MPIR_Errhandler_add_ref(win_ptr->errhandler);
} else {
/* Use the default */
*errhandler = MPI_ERRORS_ARE_FATAL;
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_WIN_MUTEX(win_ptr));
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_WIN_GET_ERRHANDLER);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
#ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno =
MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_win_get_errhandler", "**mpi_win_get_errhandler %W %p", win,
errhandler);
}
mpi_errno = MPIR_Err_return_win(win_ptr, FCNAME, mpi_errno);
goto fn_exit;
#endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Errhandler_set - Sets the error handler for a communicator
Input Parameters:
+ comm - communicator to set the error handler for (handle)
- errhandler - new MPI error handler for communicator (handle)
.N ThreadSafe
.N Deprecated
The replacement for this routine is 'MPI_Comm_set_errhandler'.
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_ARG
.seealso: MPI_Comm_set_errhandler, MPI_Errhandler_create, MPI_Comm_create_errhandler
@*/
int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler errhandler)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_Errhandler *errhan_ptr;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_ERRHANDLER_SET);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_ERRHANDLER_SET);
/* 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
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr( comm, comm_ptr );
MPIR_Errhandler_get_ptr( errhandler, errhan_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr; if comm_ptr is not value, it will be reset to null */
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE );
if (mpi_errno) goto fn_fail;
MPIR_ERRTEST_ERRHANDLER(errhandler, mpi_errno);
if (HANDLE_GET_KIND(errhandler) != HANDLE_KIND_BUILTIN) {
MPIR_Errhandler_valid_ptr( errhan_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Comm_set_errhandler_impl(comm_ptr, errhan_ptr);
/* ... end of body of routine ... */
# ifdef HAVE_ERROR_CHECKING
fn_exit:
# endif
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_ERRHANDLER_SET);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
return mpi_errno;
# ifdef HAVE_ERROR_CHECKING
fn_fail:
/* --BEGIN ERROR HANDLING-- */
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_errhandler_set",
"**mpi_errhandler_set %C %E", comm, errhandler);
}
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
# endif
}
/*@
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_Ialltoallw - Nonblocking generalized all-to-all communication allowing
different datatypes, counts, and displacements for each partner
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. sendcounts - non-negative integer array (of length 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
. sendtypes - array of datatypes (of length group size). Entry j specifies the type of data to send to process j (array of handles)
. recvcounts - non-negative integer array (of length group size) specifying the 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
. recvtypes - array of datatypes (of length group size). Entry i specifies the type of data received from process i (array of handles)
- comm - communicator (handle)
Output Parameters:
+ recvbuf - starting address of the receive buffer (choice)
- request - communication request (handle)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Ialltoallw(const void *sendbuf, const int sendcounts[], const int sdispls[],
const MPI_Datatype sendtypes[], void *recvbuf, const int recvcounts[],
const int rdispls[], const MPI_Datatype recvtypes[], 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_IALLTOALLW);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_IALLTOALLW);
/* 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 */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (sendbuf != MPI_IN_PLACE) {
MPIR_ERRTEST_ARGNULL(sendcounts,"sendcounts", mpi_errno);
MPIR_ERRTEST_ARGNULL(sdispls,"sdispls", mpi_errno);
MPIR_ERRTEST_ARGNULL(sendtypes,"sendtypes", mpi_errno);
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM &&
sendcounts == recvcounts &&
sendtypes == recvtypes)
MPIR_ERRTEST_ALIAS_COLL(sendbuf,recvbuf,mpi_errno);
}
MPIR_ERRTEST_ARGNULL(recvcounts,"recvcounts", mpi_errno);
MPIR_ERRTEST_ARGNULL(rdispls,"rdispls", mpi_errno);
MPIR_ERRTEST_ARGNULL(recvtypes,"recvtypes", mpi_errno);
if (comm_ptr->comm_kind == MPIR_COMM_KIND__INTERCOMM && sendbuf == MPI_IN_PLACE) {
MPIR_ERR_SETANDJUMP(mpi_errno, MPI_ERR_OTHER, "**sendbuf_inplace");
}
MPIR_ERRTEST_ARGNULL(request,"request", mpi_errno);
/* TODO more checks may be appropriate (counts, in_place, etc) */
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Ialltoallw(sendbuf, sendcounts, sdispls, sendtypes, recvbuf,
recvcounts, rdispls, recvtypes, comm_ptr, &request_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* return the handle of the request to the user */
if(request_ptr)
*request = request_ptr->handle;
else *request = MPI_REQUEST_NULL;
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_IALLTOALLW);
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_ialltoallw", "**mpi_ialltoallw %p %p %p %p %p %p %p %p %C %p", sendbuf, sendcounts, sdispls, sendtypes, recvbuf, recvcounts, rdispls, recvtypes, comm, request);
}
# endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Dist_graph_neighbors - Provides adjacency information for a distributed graph topology.
Input Parameters:
+ comm - communicator with distributed graph topology (handle)
. maxindegree - size of sources and sourceweights arrays (non-negative integer)
- maxoutdegree - size of destinations and destweights arrays (non-negative integer)
Output Parameters:
+ sources - processes for which the calling process is a destination (array of non-negative integers)
. sourceweights - weights of the edges into the calling process (array of non-negative integers)
. destinations - processes for which the calling process is a source (array of non-negative integers)
- destweights - weights of the edges out of the calling process (array of non-negative integers)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
@*/
int MPI_Dist_graph_neighbors(MPI_Comm comm,
int maxindegree, int sources[], int sourceweights[],
int maxoutdegree, int destinations[], int destweights[])
{
int mpi_errno = MPI_SUCCESS;
MPIR_Comm *comm_ptr = NULL;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS);
MPIR_ERRTEST_INITIALIZED_ORDIE();
/* FIXME: Why does this routine need a CS */
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS);
/* 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
/* Convert MPI object handles to object pointers */
MPIR_Comm_get_ptr(comm, comm_ptr);
/* Validate parameters */
#ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_Topology *topo_ptr = NULL;
topo_ptr = MPIR_Topology_get(comm_ptr);
MPIR_ERR_CHKANDJUMP(!topo_ptr ||
topo_ptr->kind != MPI_DIST_GRAPH, mpi_errno, MPI_ERR_TOPOLOGY,
"**notdistgraphtopo");
MPIR_ERRTEST_ARGNEG(maxindegree, "maxindegree", mpi_errno);
MPIR_ERRTEST_ARGNEG(maxoutdegree, "maxoutdegree", mpi_errno);
MPIR_ERR_CHKANDJUMP3((maxindegree < topo_ptr->topo.dist_graph.indegree), mpi_errno,
MPI_ERR_ARG, "**argtoosmall", "**argtoosmall %s %d %d",
"maxindegree", maxindegree, topo_ptr->topo.dist_graph.indegree);
MPIR_ERR_CHKANDJUMP3((maxoutdegree < topo_ptr->topo.dist_graph.outdegree), mpi_errno,
MPI_ERR_ARG, "**argtoosmall", "**argtoosmall %s %d %d",
"maxoutdegree", maxoutdegree, topo_ptr->topo.dist_graph.outdegree);
}
MPID_END_ERROR_CHECKS;
}
#endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Dist_graph_neighbors_impl(comm_ptr,
maxindegree, sources, sourceweights,
maxoutdegree, destinations, destweights);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_DIST_GRAPH_NEIGHBORS);
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_dist_graph_neighbors",
"**mpi_dist_graph_neighbors %C %d %p %p %d %p %p", comm, maxindegree,
sources, sourceweights, maxoutdegree, destinations, destweights);
#endif
mpi_errno = MPIR_Err_return_comm(comm_ptr, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
