void MPIR_Type_get_envelope_impl(MPI_Datatype datatype,
int *num_integers,
int *num_addresses,
int *num_datatypes,
int *combiner)
{
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN ||
datatype == MPI_FLOAT_INT ||
datatype == MPI_DOUBLE_INT ||
datatype == MPI_LONG_INT ||
datatype == MPI_SHORT_INT ||
datatype == MPI_LONG_DOUBLE_INT)
{
*combiner = MPI_COMBINER_NAMED;
*num_integers = 0;
*num_addresses = 0;
*num_datatypes = 0;
}
else {
MPID_Datatype *dtp;
MPID_Datatype_get_ptr(datatype, dtp);
*combiner = dtp->contents->combiner;
*num_integers = dtp->contents->nr_ints;
*num_addresses = dtp->contents->nr_aints;
*num_datatypes = dtp->contents->nr_types;
}
}
static inline int
MPID_PSendRequest(const void * buf,
int count,
MPI_Datatype datatype,
int rank,
int tag,
MPID_Comm * comm,
int context_offset,
MPID_Request ** request)
{
MPID_Request* sreq = *request = MPIDI_Request_create2();
sreq->kind = MPID_PREQUEST_SEND;
sreq->comm = comm;
MPIR_Comm_add_ref(comm);
MPIDI_Request_setMatch(sreq, tag, rank, comm->context_id+context_offset);
sreq->mpid.userbuf = (void*)buf;
sreq->mpid.userbufcount = count;
sreq->mpid.datatype = datatype;
sreq->partner_request = NULL;
MPIDI_Request_complete(sreq);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype_get_ptr(datatype, sreq->mpid.datatype_ptr);
MPID_Datatype_add_ref(sreq->mpid.datatype_ptr);
}
return MPI_SUCCESS;
}
/*@
MPI_Type_contiguous - Creates a contiguous datatype
Input Parameters:
+ count - replication count (nonnegative integer)
- oldtype - old datatype (handle)
Output Parameter:
. newtype - new datatype (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_EXHAUSTED
@*/
int MPI_Type_contiguous(int count,
MPI_Datatype old_type,
MPI_Datatype *new_type_p)
{
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_CONTIGUOUS);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_CONTIGUOUS);
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *datatype_ptr = NULL;
/* MPIR_ERRTEST_XXX macros defined in mpiimpl.h */
MPIR_ERRTEST_COUNT(count, mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIR_ERRTEST_DATATYPE(old_type, "datatype", mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
if (HANDLE_GET_KIND(old_type) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(old_type, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
}
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Type_contiguous_impl(count, old_type, new_type_p);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_CONTIGUOUS);
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_type_contiguous",
"**mpi_type_contiguous %d %D %p", count, old_type, new_type_p);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPID_Recv_init(void * buf,
int count,
MPI_Datatype datatype,
int rank,
int tag,
MPID_Comm * comm,
int context_offset,
MPID_Request ** request)
{
MPID_Request * rreq = *request = MPIDI_Request_create2();
rreq->kind = MPID_PREQUEST_RECV;
rreq->comm = comm;
MPIR_Comm_add_ref(comm);
MPIDI_Request_setMatch(rreq, tag, rank, comm->recvcontext_id+context_offset);
rreq->mpid.userbuf = buf;
rreq->mpid.userbufcount = count;
rreq->mpid.datatype = datatype;
rreq->partner_request = NULL;
MPIDI_Request_complete(rreq);
MPIDI_Request_setPType(rreq, MPIDI_REQUEST_PTYPE_RECV);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype_get_ptr(datatype, rreq->mpid.datatype_ptr);
MPID_Datatype_add_ref(rreq->mpid.datatype_ptr);
}
return MPI_SUCCESS;
}
int MPIR_Type_contiguous_impl(int count,
MPI_Datatype old_type,
MPI_Datatype *new_type_p)
{
int mpi_errno = MPI_SUCCESS;
MPID_Datatype *new_dtp;
MPI_Datatype new_handle;
mpi_errno = MPID_Type_contiguous(count,
old_type,
&new_handle);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_CONTIGUOUS,
1, /* ints (count) */
0,
1,
&count,
NULL,
&old_type);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIU_OBJ_PUBLISH_HANDLE(*new_type_p, new_handle);
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
MPI_Get_count - Gets the number of "top level" elements
Input Parameters:
+ status - return status of receive operation (Status)
- datatype - datatype of each receive buffer element (handle)
Output Parameters:
. count - number of received elements (integer)
Notes:
If the size of the datatype is zero, this routine will return a count of
zero. If the amount of data in 'status' is not an exact multiple of the
size of 'datatype' (so that 'count' would not be integral), a 'count' of
'MPI_UNDEFINED' is returned instead.
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
@*/
int MPI_Get_count( const MPI_Status *status, MPI_Datatype datatype, int *count )
{
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_GET_COUNT);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_GET_COUNT);
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *datatype_ptr = NULL;
MPIR_ERRTEST_ARGNULL(status, "status", mpi_errno);
MPIR_ERRTEST_ARGNULL(count, "count", mpi_errno);
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype_ptr */
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
if (mpi_errno) goto fn_fail;
/* Q: Must the type be committed to be used with this function? */
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIR_Get_count_impl(status, datatype, count);
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_GET_COUNT);
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_get_count",
"**mpi_get_count %p %D %p", status, datatype, count);
}
mpi_errno = MPIR_Err_return_comm( 0, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
/*@
MPI_Status_set_elements - Set the number of elements in a status
Input Parameters:
+ status - status to associate count with (Status)
. datatype - datatype associated with count (handle)
- count - number of elements to associate with status (integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_ARG
.N MPI_ERR_TYPE
@*/
int MPI_Status_set_elements(MPI_Status *status, MPI_Datatype datatype,
int count)
{
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_STATUS_SET_ELEMENTS);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_STATUS_SET_ELEMENTS);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Datatype *datatype_ptr = NULL;
MPIR_ERRTEST_COUNT(count,mpi_errno);
MPIR_ERRTEST_ARGNULL(status,"status",mpi_errno);
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* Validate datatype_ptr */
MPID_Datatype_get_ptr( datatype, datatype_ptr );
MPID_Datatype_valid_ptr( datatype_ptr, mpi_errno );
/* If datatype_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_Status_set_elements_x_impl(status, datatype, (MPI_Count)count);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_STATUS_SET_ELEMENTS);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_status_set_elements",
"**mpi_status_set_elements %p %D %d", status, datatype, count);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Type_indexed_impl(int count, const int *array_of_blocklengths,
const int *array_of_displacements,
MPI_Datatype oldtype, MPI_Datatype *newtype)
{
int mpi_errno = MPI_SUCCESS;
MPI_Datatype new_handle;
MPID_Datatype *new_dtp;
int i, *ints;
MPIU_CHKLMEM_DECL(1);
mpi_errno = MPID_Type_indexed(count,
array_of_blocklengths,
array_of_displacements,
0, /* displacements not in bytes */
oldtype,
&new_handle);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* copy all integer values into a temporary buffer; this
* includes the count, the blocklengths, and the displacements.
*/
MPIU_CHKLMEM_MALLOC(ints, int *, (2 * count + 1) * sizeof(int), mpi_errno, "contents integer array");
ints[0] = count;
for (i=0; i < count; i++) {
ints[i+1] = array_of_blocklengths[i];
}
for (i=0; i < count; i++) {
ints[i + count + 1] = array_of_displacements[i];
}
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_INDEXED,
2*count + 1, /* ints */
0, /* aints */
1, /* types */
ints,
NULL,
&oldtype);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
fn_exit:
MPIU_CHKLMEM_FREEALL();
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_Type_commit(MPI_Datatype *datatype_p)
{
int mpi_errno=MPI_SUCCESS;
MPID_Datatype *datatype_ptr;
MPIU_Assert(HANDLE_GET_KIND(*datatype_p) != HANDLE_KIND_BUILTIN);
MPID_Datatype_get_ptr(*datatype_p, datatype_ptr);
if (datatype_ptr->is_committed == 0) {
datatype_ptr->is_committed = 1;
#ifdef MPID_NEEDS_DLOOP_ALL_BYTES
/* If MPID implementation needs use to reduce everything to
a byte stream, do that. */
MPID_Dataloop_create(*datatype_p,
&datatype_ptr->dataloop,
&datatype_ptr->dataloop_size,
&datatype_ptr->dataloop_depth,
MPID_DATALOOP_ALL_BYTES);
#else
MPID_Dataloop_create(*datatype_p,
&datatype_ptr->dataloop,
&datatype_ptr->dataloop_size,
&datatype_ptr->dataloop_depth,
MPID_DATALOOP_HOMOGENEOUS);
#endif
/* create heterogeneous dataloop */
MPID_Dataloop_create(*datatype_p,
&datatype_ptr->hetero_dloop,
&datatype_ptr->hetero_dloop_size,
&datatype_ptr->hetero_dloop_depth,
MPID_DATALOOP_HETEROGENEOUS);
MPL_DBG_MSG_D(MPIR_DBG_DATATYPE,TERSE,"# contig blocks = %d\n",
(int) datatype_ptr->max_contig_blocks);
#if 0
MPIDI_Dataloop_dot_printf(datatype_ptr->dataloop, 0, 1);
#endif
#ifdef MPID_Dev_datatype_commit_hook
MPID_Dev_datatype_commit_hook(datatype_p);
#endif /* MPID_Dev_datatype_commit_hook */
}
return mpi_errno;
}
void MPIR_Type_get_true_extent_impl(MPI_Datatype datatype, MPI_Aint *true_lb, MPI_Aint *true_extent)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN) {
*true_lb = 0;
*true_extent = MPID_Datatype_get_basic_size(datatype);
}
else {
*true_lb = datatype_ptr->true_lb;
*true_extent = datatype_ptr->true_ub - datatype_ptr->true_lb;
}
}
void MPIR_Type_get_extent_x_impl(MPI_Datatype datatype, MPI_Count *lb, MPI_Count *extent)
{
MPID_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN) {
*lb = 0;
*extent = MPID_Datatype_get_basic_size(datatype);
}
else {
*lb = datatype_ptr->lb;
*extent = datatype_ptr->extent; /* derived, should be same as ub - lb */
}
}
int MPIR_Type_get_contig_blocks(MPI_Datatype type,
int *nr_blocks_p)
{
MPID_Datatype *datatype_ptr;
if (HANDLE_GET_KIND(type) == HANDLE_KIND_BUILTIN) {
*nr_blocks_p = 1;
return 0;
}
MPID_Datatype_get_ptr(type, datatype_ptr);
MPIU_Assert(datatype_ptr->is_committed);
*nr_blocks_p = datatype_ptr->max_contig_blocks;
return 0;
}
int MPIR_Type_create_struct_impl(int count,
int array_of_blocklengths[],
MPI_Aint array_of_displacements[],
MPI_Datatype array_of_types[],
MPI_Datatype *newtype)
{
int mpi_errno = MPI_SUCCESS;
int i, *ints;
MPI_Datatype new_handle;
MPID_Datatype *new_dtp;
MPIU_CHKLMEM_DECL(1);
mpi_errno = MPID_Type_struct(count,
array_of_blocklengths,
array_of_displacements,
array_of_types,
&new_handle);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_CHKLMEM_MALLOC_ORJUMP(ints, int *, (count + 1) * sizeof(int), mpi_errno, "content description");
ints[0] = count;
for (i=0; i < count; i++)
ints[i+1] = array_of_blocklengths[i];
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_STRUCT,
count+1, /* ints (cnt,blklen) */
count, /* aints (disps) */
count, /* types */
ints,
array_of_displacements,
array_of_types);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
fn_exit:
MPIU_CHKLMEM_FREEALL();
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPID_Recv_init(void * buf, int count, MPI_Datatype datatype, int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPID_Request * rreq;
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_RECV_INIT);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_RECV_INIT);
rreq = MPID_Request_create();
if (rreq == NULL)
{
/* --BEGIN ERROR HANDLING-- */
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_FATAL, FCNAME, __LINE__, MPI_ERR_OTHER, "**nomemreq", 0);
/* --END ERROR HANDLING-- */
goto fn_exit;
}
MPIU_Object_set_ref(rreq, 1);
rreq->kind = MPID_PREQUEST_RECV;
rreq->comm = comm;
MPID_cc_set(&rreq->cc, 0);
MPIR_Comm_add_ref(comm);
rreq->dev.match.parts.rank = rank;
rreq->dev.match.parts.tag = tag;
rreq->dev.match.parts.context_id = comm->recvcontext_id + context_offset;
rreq->dev.user_buf = (void *) buf;
rreq->dev.user_count = count;
rreq->dev.datatype = datatype;
rreq->partner_request = NULL;
MPIDI_Request_set_type(rreq, MPIDI_REQUEST_TYPE_RECV);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype_get_ptr(datatype, rreq->dev.datatype_ptr);
MPID_Datatype_add_ref(rreq->dev.datatype_ptr);
}
*request = rreq;
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPID_RECV_INIT);
return mpi_errno;
}
int MPID_Bsend_init(const void * buf, int count, MPI_Datatype datatype, int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** request)
{
MPID_Request * sreq;
int mpi_errno = MPI_SUCCESS;
MPIDI_STATE_DECL(MPID_STATE_MPID_BSEND_INIT);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_BSEND_INIT);
MPIDI_Request_create_psreq(sreq, mpi_errno, goto fn_exit);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_BSEND);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN)
{
MPID_Datatype_get_ptr(datatype, sreq->dev.datatype_ptr);
MPID_Datatype_add_ref(sreq->dev.datatype_ptr);
}
*request = sreq;
fn_exit:
MPIDI_FUNC_EXIT(MPID_STATE_MPID_BSEND_INIT);
return mpi_errno;
}
void MPID_Datatype_free_contents(MPID_Datatype *dtp)
{
int i, struct_sz = sizeof(MPID_Datatype_contents);
int align_sz = 8, epsilon;
MPID_Datatype *old_dtp;
MPI_Datatype *array_of_types;
if ((epsilon = struct_sz % align_sz)) {
struct_sz += align_sz - epsilon;
}
/* note: relies on types being first after structure */
array_of_types = (MPI_Datatype *) ((char *)dtp->contents + struct_sz);
for (i=0; i < dtp->contents->nr_types; i++) {
if (HANDLE_GET_KIND(array_of_types[i]) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(array_of_types[i], old_dtp);
MPID_Datatype_release(old_dtp);
}
}
MPL_free(dtp->contents);
dtp->contents = NULL;
}
/*@
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_Neighbor_allgather - In this function, each process i gathers data items
from each process j if an edge (j,i) exists in the topology graph, and each
process i sends the same data items to all processes j where an edge (i,j)
exists. The send buffer is sent to each neighboring process and the l-th block
in the receive buffer is received from the l-th neighbor.
Input Parameters:
+ sendbuf - starting address of the send buffer (choice)
. sendcount - number of elements sent to each neighbor (non-negative integer)
. sendtype - data type of send buffer elements (handle)
. recvcount - number of elements received from each neighbor (non-negative integer)
. recvtype - data type of receive buffer elements (handle)
- comm - communicator (handle)
Output Parameters:
. recvbuf - starting address of the receive buffer (choice)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Neighbor_allgather(const void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_ERRTEST_DATATYPE(sendtype, "sendtype", mpi_errno);
MPIR_ERRTEST_DATATYPE(recvtype, "recvtype", mpi_errno);
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
{
if (HANDLE_GET_KIND(sendtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype *sendtype_ptr = NULL;
MPID_Datatype_get_ptr(sendtype, sendtype_ptr);
MPID_Datatype_valid_ptr(sendtype_ptr, mpi_errno);
MPID_Datatype_committed_ptr(sendtype_ptr, mpi_errno);
}
if (HANDLE_GET_KIND(recvtype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype *recvtype_ptr = NULL;
MPID_Datatype_get_ptr(recvtype, recvtype_ptr);
MPID_Datatype_valid_ptr(recvtype_ptr, mpi_errno);
MPID_Datatype_committed_ptr(recvtype_ptr, mpi_errno);
}
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, FALSE );
/* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Neighbor_allgather_impl(sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_NEIGHBOR_ALLGATHER);
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_neighbor_allgather", "**mpi_neighbor_allgather %p %d %D %p %d %D %C", sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm);
}
# endif
mpi_errno = MPIR_Err_return_comm(NULL, 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)
{
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-- */
}
int MPIDI_CH3I_Get_accumulate(const void *origin_addr, int origin_count,
MPI_Datatype origin_datatype, void *result_addr, int result_count,
MPI_Datatype result_datatype, int target_rank, MPI_Aint target_disp,
int target_count, MPI_Datatype target_datatype, MPI_Op op,
MPID_Win * win_ptr, MPID_Request * ureq)
{
int mpi_errno = MPI_SUCCESS;
MPIDI_msg_sz_t orig_data_sz, target_data_sz;
int rank;
int dt_contig ATTRIBUTE((unused));
MPI_Aint dt_true_lb ATTRIBUTE((unused));
MPID_Datatype *dtp;
MPIDI_VC_t *orig_vc = NULL, *target_vc = NULL;
int made_progress = 0;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_CH3I_GET_ACCUMULATE);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_MPIDI_CH3I_GET_ACCUMULATE);
MPIR_ERR_CHKANDJUMP(win_ptr->states.access_state == MPIDI_RMA_NONE,
mpi_errno, MPI_ERR_RMA_SYNC, "**rmasync");
if (target_rank == MPI_PROC_NULL) {
goto fn_exit;
}
MPIDI_Datatype_get_info(target_count, target_datatype, dt_contig, target_data_sz, dtp,
dt_true_lb);
if (target_data_sz == 0) {
goto fn_exit;
}
rank = win_ptr->comm_ptr->rank;
if (win_ptr->shm_allocated == TRUE && target_rank != rank &&
win_ptr->create_flavor != MPI_WIN_FLAVOR_SHARED) {
/* check if target is local and shared memory is allocated on window,
* if so, we directly perform this operation on shared memory region. */
/* FIXME: Here we decide whether to perform SHM operations by checking if origin and target are on
* the same node. However, in ch3:sock, even if origin and target are on the same node, they do
* not within the same SHM region. Here we filter out ch3:sock by checking shm_allocated flag first,
* which is only set to TRUE when SHM region is allocated in nemesis.
* In future we need to figure out a way to check if origin and target are in the same "SHM comm".
*/
MPIDI_Comm_get_vc(win_ptr->comm_ptr, rank, &orig_vc);
MPIDI_Comm_get_vc(win_ptr->comm_ptr, target_rank, &target_vc);
}
/* Do =! rank first (most likely branch?) */
if (target_rank == rank || win_ptr->create_flavor == MPI_WIN_FLAVOR_SHARED ||
(win_ptr->shm_allocated == TRUE && orig_vc->node_id == target_vc->node_id)) {
mpi_errno = MPIDI_CH3I_Shm_get_acc_op(origin_addr, origin_count, origin_datatype,
result_addr, result_count, result_datatype,
target_rank, target_disp, target_count,
target_datatype, op, win_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if (ureq) {
/* Complete user request and release the ch3 ref */
mpi_errno = MPID_Request_complete(ureq);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_POP(mpi_errno);
}
}
}
else {
MPIDI_RMA_Op_t *op_ptr = NULL;
MPIDI_CH3_Pkt_get_accum_t *get_accum_pkt;
MPI_Aint origin_type_size;
MPI_Aint target_type_size;
int use_immed_pkt = FALSE, i;
int is_origin_contig, is_target_contig, is_result_contig;
MPI_Aint stream_elem_count, stream_unit_count;
MPI_Aint predefined_dtp_size, predefined_dtp_count, predefined_dtp_extent;
MPID_Datatype *origin_dtp = NULL, *target_dtp = NULL, *result_dtp = NULL;
int is_empty_origin = FALSE;
/* Judge if origin buffer is empty */
if (op == MPI_NO_OP)
is_empty_origin = TRUE;
/* Append the operation to the window's RMA ops queue */
mpi_errno = MPIDI_CH3I_Win_get_op(win_ptr, &op_ptr);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
/* TODO: Can we use the MPIDI_RMA_ACC_CONTIG optimization? */
MPIR_T_PVAR_TIMER_START(RMA, rma_rmaqueue_set);
/******************** Setting operation struct areas ***********************/
op_ptr->origin_addr = (void *) origin_addr;
op_ptr->origin_count = origin_count;
op_ptr->origin_datatype = origin_datatype;
op_ptr->result_addr = result_addr;
op_ptr->result_count = result_count;
op_ptr->result_datatype = result_datatype;
op_ptr->target_rank = target_rank;
/* Remember user request */
op_ptr->ureq = ureq;
/* if source or target datatypes are derived, increment their
* reference counts */
if (is_empty_origin == FALSE && !MPIR_DATATYPE_IS_PREDEFINED(origin_datatype)) {
MPID_Datatype_get_ptr(origin_datatype, origin_dtp);
}
if (!MPIR_DATATYPE_IS_PREDEFINED(result_datatype)) {
MPID_Datatype_get_ptr(result_datatype, result_dtp);
}
if (!MPIR_DATATYPE_IS_PREDEFINED(target_datatype)) {
MPID_Datatype_get_ptr(target_datatype, target_dtp);
}
if (is_empty_origin == FALSE) {
MPID_Datatype_get_size_macro(origin_datatype, origin_type_size);
MPIU_Assign_trunc(orig_data_sz, origin_count * origin_type_size, MPIDI_msg_sz_t);
}
else {
/* If origin buffer is empty, set origin data size to 0 */
orig_data_sz = 0;
}
MPID_Datatype_get_size_macro(target_datatype, target_type_size);
/* Get size and count for predefined datatype elements */
if (MPIR_DATATYPE_IS_PREDEFINED(target_datatype)) {
predefined_dtp_size = target_type_size;
predefined_dtp_count = target_count;
MPID_Datatype_get_extent_macro(target_datatype, predefined_dtp_extent);
}
else {
MPIU_Assert(target_dtp->basic_type != MPI_DATATYPE_NULL);
MPID_Datatype_get_size_macro(target_dtp->basic_type, predefined_dtp_size);
predefined_dtp_count = target_data_sz / predefined_dtp_size;
MPID_Datatype_get_extent_macro(target_dtp->basic_type, predefined_dtp_extent);
}
MPIU_Assert(predefined_dtp_count > 0 && predefined_dtp_size > 0 &&
predefined_dtp_extent > 0);
/* Calculate number of predefined elements in each stream unit, and
* total number of stream units. */
stream_elem_count = MPIDI_CH3U_Acc_stream_size / predefined_dtp_extent;
stream_unit_count = (predefined_dtp_count - 1) / stream_elem_count + 1;
MPIU_Assert(stream_elem_count > 0 && stream_unit_count > 0);
for (i = 0; i < stream_unit_count; i++) {
if (origin_dtp != NULL) {
MPID_Datatype_add_ref(origin_dtp);
}
if (target_dtp != NULL) {
MPID_Datatype_add_ref(target_dtp);
}
if (result_dtp != NULL) {
MPID_Datatype_add_ref(result_dtp);
}
}
if (is_empty_origin == FALSE) {
MPID_Datatype_is_contig(origin_datatype, &is_origin_contig);
}
else {
/* If origin buffer is empty, mark origin data as contig data */
is_origin_contig = 1;
}
MPID_Datatype_is_contig(target_datatype, &is_target_contig);
MPID_Datatype_is_contig(result_datatype, &is_result_contig);
/* Judge if we can use IMMED data packet */
if ((is_empty_origin == TRUE || MPIR_DATATYPE_IS_PREDEFINED(origin_datatype)) &&
MPIR_DATATYPE_IS_PREDEFINED(result_datatype) &&
MPIR_DATATYPE_IS_PREDEFINED(target_datatype) &&
is_origin_contig && is_target_contig && is_result_contig) {
if (target_data_sz <= MPIDI_RMA_IMMED_BYTES)
use_immed_pkt = TRUE;
}
/* Judge if this operation is a piggyback candidate */
if ((is_empty_origin == TRUE || MPIR_DATATYPE_IS_PREDEFINED(origin_datatype)) &&
MPIR_DATATYPE_IS_PREDEFINED(result_datatype) &&
MPIR_DATATYPE_IS_PREDEFINED(target_datatype)) {
/* FIXME: currently we only piggyback LOCK flag with op using predefined datatypes
* for origin, target and result data. We should extend this optimization to derived
* datatypes as well. */
if (orig_data_sz <= MPIR_CVAR_CH3_RMA_OP_PIGGYBACK_LOCK_DATA_SIZE)
op_ptr->piggyback_lock_candidate = 1;
}
/************** Setting packet struct areas in operation ****************/
get_accum_pkt = &(op_ptr->pkt.get_accum);
if (use_immed_pkt) {
MPIDI_Pkt_init(get_accum_pkt, MPIDI_CH3_PKT_GET_ACCUM_IMMED);
}
else {
MPIDI_Pkt_init(get_accum_pkt, MPIDI_CH3_PKT_GET_ACCUM);
}
get_accum_pkt->addr = (char *) win_ptr->basic_info_table[target_rank].base_addr +
win_ptr->basic_info_table[target_rank].disp_unit * target_disp;
get_accum_pkt->count = target_count;
get_accum_pkt->datatype = target_datatype;
get_accum_pkt->info.dataloop_size = 0;
get_accum_pkt->op = op;
get_accum_pkt->target_win_handle = win_ptr->basic_info_table[target_rank].win_handle;
get_accum_pkt->flags = MPIDI_CH3_PKT_FLAG_NONE;
if (use_immed_pkt) {
void *src = (void *) origin_addr, *dest = (void *) (get_accum_pkt->info.data);
mpi_errno = immed_copy(src, dest, orig_data_sz);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
MPIR_T_PVAR_TIMER_END(RMA, rma_rmaqueue_set);
mpi_errno = MPIDI_CH3I_Win_enqueue_op(win_ptr, op_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIDI_CH3I_RMA_Make_progress_target(win_ptr, target_rank, &made_progress);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
if (MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD >= 0 &&
MPIDI_CH3I_RMA_Active_req_cnt >= MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD) {
while (MPIDI_CH3I_RMA_Active_req_cnt >= MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD) {
mpi_errno = wait_progress_engine();
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
}
}
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_MPIDI_CH3I_GET_ACCUMULATE);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIDI_CH3I_Put(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, MPID_Win * win_ptr,
MPID_Request * ureq)
{
int mpi_errno = MPI_SUCCESS;
int dt_contig ATTRIBUTE((unused)), rank;
MPID_Datatype *dtp;
MPI_Aint dt_true_lb ATTRIBUTE((unused));
MPIDI_msg_sz_t data_sz;
MPIDI_VC_t *orig_vc = NULL, *target_vc = NULL;
int made_progress = 0;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_CH3I_PUT);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_MPIDI_CH3I_PUT);
MPIR_ERR_CHKANDJUMP(win_ptr->states.access_state == MPIDI_RMA_NONE,
mpi_errno, MPI_ERR_RMA_SYNC, "**rmasync");
if (target_rank == MPI_PROC_NULL) {
goto fn_exit;
}
MPIDI_Datatype_get_info(origin_count, origin_datatype, dt_contig, data_sz, dtp, dt_true_lb);
if (data_sz == 0) {
goto fn_exit;
}
rank = win_ptr->comm_ptr->rank;
if (win_ptr->shm_allocated == TRUE && target_rank != rank &&
win_ptr->create_flavor != MPI_WIN_FLAVOR_SHARED) {
/* check if target is local and shared memory is allocated on window,
* if so, we directly perform this operation on shared memory region. */
/* FIXME: Here we decide whether to perform SHM operations by checking if origin and target are on
* the same node. However, in ch3:sock, even if origin and target are on the same node, they do
* not within the same SHM region. Here we filter out ch3:sock by checking shm_allocated flag first,
* which is only set to TRUE when SHM region is allocated in nemesis.
* In future we need to figure out a way to check if origin and target are in the same "SHM comm".
*/
MPIDI_Comm_get_vc(win_ptr->comm_ptr, rank, &orig_vc);
MPIDI_Comm_get_vc(win_ptr->comm_ptr, target_rank, &target_vc);
}
/* If the put is a local operation, do it here */
if (target_rank == rank || win_ptr->create_flavor == MPI_WIN_FLAVOR_SHARED ||
(win_ptr->shm_allocated == TRUE && orig_vc->node_id == target_vc->node_id)) {
mpi_errno = MPIDI_CH3I_Shm_put_op(origin_addr, origin_count, origin_datatype, target_rank,
target_disp, target_count, target_datatype, win_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if (ureq) {
/* Complete user request and release the ch3 ref */
mpi_errno = MPID_Request_complete(ureq);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_POP(mpi_errno);
}
}
}
else {
MPIDI_RMA_Op_t *op_ptr = NULL;
MPIDI_CH3_Pkt_put_t *put_pkt = NULL;
int use_immed_pkt = FALSE;
int is_origin_contig, is_target_contig;
/* queue it up */
mpi_errno = MPIDI_CH3I_Win_get_op(win_ptr, &op_ptr);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
MPIR_T_PVAR_TIMER_START(RMA, rma_rmaqueue_set);
/******************** Setting operation struct areas ***********************/
/* FIXME: For contig and very short operations, use a streamlined op */
op_ptr->origin_addr = (void *) origin_addr;
op_ptr->origin_count = origin_count;
op_ptr->origin_datatype = origin_datatype;
op_ptr->target_rank = target_rank;
/* Remember user request */
op_ptr->ureq = ureq;
/* if source or target datatypes are derived, increment their
* reference counts */
if (!MPIR_DATATYPE_IS_PREDEFINED(origin_datatype)) {
MPID_Datatype_get_ptr(origin_datatype, dtp);
MPID_Datatype_add_ref(dtp);
}
if (!MPIR_DATATYPE_IS_PREDEFINED(target_datatype)) {
MPID_Datatype_get_ptr(target_datatype, dtp);
MPID_Datatype_add_ref(dtp);
}
MPID_Datatype_is_contig(origin_datatype, &is_origin_contig);
MPID_Datatype_is_contig(target_datatype, &is_target_contig);
/* Judge if we can use IMMED data packet */
if (MPIR_DATATYPE_IS_PREDEFINED(origin_datatype) &&
MPIR_DATATYPE_IS_PREDEFINED(target_datatype) && is_origin_contig && is_target_contig) {
if (data_sz <= MPIDI_RMA_IMMED_BYTES)
use_immed_pkt = TRUE;
}
/* Judge if this operation is an piggyback candidate */
if (MPIR_DATATYPE_IS_PREDEFINED(origin_datatype) &&
MPIR_DATATYPE_IS_PREDEFINED(target_datatype)) {
/* FIXME: currently we only piggyback LOCK flag with op using predefined datatypes
* for both origin and target data. We should extend this optimization to derived
* datatypes as well. */
if (data_sz <= MPIR_CVAR_CH3_RMA_OP_PIGGYBACK_LOCK_DATA_SIZE)
op_ptr->piggyback_lock_candidate = 1;
}
/************** Setting packet struct areas in operation ****************/
put_pkt = &(op_ptr->pkt.put);
if (use_immed_pkt) {
MPIDI_Pkt_init(put_pkt, MPIDI_CH3_PKT_PUT_IMMED);
}
else {
MPIDI_Pkt_init(put_pkt, MPIDI_CH3_PKT_PUT);
}
put_pkt->addr = (char *) win_ptr->basic_info_table[target_rank].base_addr +
win_ptr->basic_info_table[target_rank].disp_unit * target_disp;
put_pkt->count = target_count;
put_pkt->datatype = target_datatype;
put_pkt->info.dataloop_size = 0;
put_pkt->target_win_handle = win_ptr->basic_info_table[target_rank].win_handle;
put_pkt->source_win_handle = win_ptr->handle;
put_pkt->flags = MPIDI_CH3_PKT_FLAG_NONE;
if (use_immed_pkt) {
void *src = (void *) origin_addr, *dest = (void *) (put_pkt->info.data);
mpi_errno = immed_copy(src, dest, data_sz);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
MPIR_T_PVAR_TIMER_END(RMA, rma_rmaqueue_set);
mpi_errno = MPIDI_CH3I_Win_enqueue_op(win_ptr, op_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIDI_CH3I_RMA_Make_progress_target(win_ptr, target_rank, &made_progress);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
if (MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD >= 0 &&
MPIDI_CH3I_RMA_Active_req_cnt >= MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD) {
while (MPIDI_CH3I_RMA_Active_req_cnt >= MPIR_CVAR_CH3_RMA_ACTIVE_REQ_THRESHOLD) {
mpi_errno = wait_progress_engine();
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
}
}
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_MPIDI_CH3I_PUT);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Type_size_x - Return the number of bytes occupied by entries
in the datatype
Input Parameters:
. datatype - datatype (handle)
Output Parameters:
. size - datatype size (integer)
.N ThreadSafe
.N Fortran
.N Errors
@*/
int MPI_Type_size_x(MPI_Datatype datatype, MPI_Count *size)
{
int mpi_errno = MPI_SUCCESS;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_SIZE_X);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_SIZE_X);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
/* TODO more checks may be appropriate */
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS
{
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPIR_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr);
MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
}
/* TODO more checks may be appropriate (counts, in_place, buffer aliasing, etc) */
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Type_size_x_impl(datatype, size);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* ... end of body of routine ... */
fn_exit:
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_SIZE_X);
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_type_size_x", "**mpi_type_size_x %D %p", datatype, size);
}
# endif
mpi_errno = MPIR_Err_return_comm(NULL, 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_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_Type_hindexed - Creates an indexed datatype with offsets in bytes
Input Parameters:
+ count - number of blocks -- also number of entries in indices and blocklens
. blocklens - number of elements in each block (array of nonnegative integers)
. indices - byte displacement of each block (array of MPI_Aint)
- old_type - old datatype (handle)
Output Parameter:
. newtype - new datatype (handle)
.N Deprecated
This routine is replaced by 'MPI_Type_create_hindexed'.
.N ThreadSafe
.N Fortran
The indices are displacements, and are based on a zero origin. A common error
is to do something like to following
.vb
integer a(100)
integer blens(10), indices(10)
do i=1,10
blens(i) = 1
10 indices(i) = (1 + (i-1)*10) * sizeofint
call MPI_TYPE_HINDEXED(10,blens,indices,MPI_INTEGER,newtype,ierr)
call MPI_TYPE_COMMIT(newtype,ierr)
call MPI_SEND(a,1,newtype,...)
.ve
expecting this to send 'a(1),a(11),...' because the indices have values
'1,11,...'. Because these are `displacements` from the beginning of 'a',
it actually sends 'a(1+1),a(1+11),...'.
If you wish to consider the displacements as indices into a Fortran array,
consider declaring the Fortran array with a zero origin
.vb
integer a(0:99)
.ve
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_COUNT
.N MPI_ERR_EXHAUSTED
.N MPI_ERR_ARG
@*/
int MPI_Type_hindexed(int count,
int blocklens[],
MPI_Aint indices[],
MPI_Datatype old_type,
MPI_Datatype *newtype)
{
static const char FCNAME[] = "MPI_Type_hindexed";
int mpi_errno = MPI_SUCCESS;
MPI_Datatype new_handle;
MPID_Datatype *new_dtp;
int i, *ints;
MPIU_CHKLMEM_DECL(1);
MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_HINDEXED);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_HINDEXED);
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
int j;
MPID_Datatype *datatype_ptr = NULL;
MPIR_ERRTEST_COUNT(count, mpi_errno);
MPIR_ERRTEST_DATATYPE(old_type, "datatype", mpi_errno);
if (count > 0) {
MPIR_ERRTEST_ARGNULL(blocklens, "blocklens", mpi_errno);
MPIR_ERRTEST_ARGNULL(indices, "indices", mpi_errno);
}
if (mpi_errno == MPI_SUCCESS) {
if (HANDLE_GET_KIND(old_type) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr( old_type, datatype_ptr );
MPID_Datatype_valid_ptr(datatype_ptr, mpi_errno);
}
/* verify that all blocklengths are >= 0 */
for (j=0; j < count; j++) {
MPIR_ERRTEST_ARGNEG(blocklens[j], "blocklen", mpi_errno);
}
}
MPIR_ERRTEST_ARGNULL(newtype, "newtype", mpi_errno);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPID_Type_indexed(count,
blocklens,
indices,
1, /* displacements in bytes */
old_type,
&new_handle);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIU_CHKLMEM_MALLOC(ints, int *, (count + 1) * sizeof(int), mpi_errno, "contents integer array");
/* copy ints into temporary buffer (count and blocklengths) */
ints[0] = count;
for (i=0; i < count; i++)
{
ints[i+1] = blocklens[i];
}
MPID_Datatype_get_ptr(new_handle, new_dtp);
mpi_errno = MPID_Datatype_set_contents(new_dtp,
MPI_COMBINER_HINDEXED,
count+1, /* ints */
count, /* aints (displs) */
1, /* types */
ints,
indices,
&old_type);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
MPIU_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
/* ... end of body of routine ... */
fn_exit:
MPIU_CHKLMEM_FREEALL();
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_HINDEXED);
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_type_hindexed",
"**mpi_type_hindexed %d %p %p %D %p", count, blocklens, indices, old_type, newtype);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, 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-- */
}
int MPID_nem_mxm_issend(MPIDI_VC_t * vc, const void *buf, int count, MPI_Datatype datatype,
int rank, int tag, MPID_Comm * comm, int context_offset,
MPID_Request ** sreq_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPID_Request *sreq = NULL;
MPID_Datatype *dt_ptr;
int dt_contig;
MPIDI_msg_sz_t data_sz;
MPI_Aint dt_true_lb;
MPID_nem_mxm_vc_area *vc_area = NULL;
MPID_nem_mxm_req_area *req_area = NULL;
MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_MXM_ISSEND);
MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_MXM_ISSEND);
MPIDI_Datatype_get_info(count, datatype, dt_contig, data_sz, dt_ptr, dt_true_lb);
/* create a request */
MPIDI_Request_create_sreq(sreq, mpi_errno, goto fn_exit);
MPIU_Assert(sreq != NULL);
MPIDI_Request_set_type(sreq, MPIDI_REQUEST_TYPE_SEND);
MPIDI_VC_FAI_send_seqnum(vc, seqnum);
MPIDI_Request_set_seqnum(sreq, seqnum);
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(datatype, sreq->dev.datatype_ptr);
MPID_Datatype_add_ref(sreq->dev.datatype_ptr);
}
sreq->partner_request = NULL;
sreq->dev.OnDataAvail = NULL;
sreq->dev.tmpbuf = NULL;
sreq->ch.vc = vc;
sreq->ch.noncontig = FALSE;
_dbg_mxm_output(5,
"isSend ========> Sending USER msg for req %p (context %d to %d tag %d size %d) \n",
sreq, comm->context_id + context_offset, rank, tag, data_sz);
vc_area = VC_BASE(vc);
req_area = REQ_BASE(sreq);
req_area-> ctx = sreq;
req_area->iov_buf = req_area->tmp_buf;
req_area->iov_count = 0;
req_area->iov_buf[0].ptr = NULL;
req_area->iov_buf[0].length = 0;
if (data_sz) {
if (dt_contig) {
req_area->iov_count = 1;
req_area->iov_buf[0].ptr = (char *) (buf) + dt_true_lb;
req_area->iov_buf[0].length = data_sz;
}
else {
MPIDI_msg_sz_t last;
MPI_Aint packsize = 0;
sreq->ch.noncontig = TRUE;
sreq->dev.segment_ptr = MPID_Segment_alloc();
MPIU_ERR_CHKANDJUMP1((sreq->dev.segment_ptr == NULL), mpi_errno, MPI_ERR_OTHER,
"**nomem", "**nomem %s", "MPID_Segment_alloc");
MPIR_Pack_size_impl(count, datatype, &packsize);
last = data_sz;
if (packsize > 0) {
sreq->dev.tmpbuf = MPIU_Malloc((size_t) packsize);
MPIU_Assert(sreq->dev.tmpbuf);
MPID_Segment_init(buf, count, datatype, sreq->dev.segment_ptr, 0);
MPID_Segment_pack(sreq->dev.segment_ptr, 0, &last, sreq->dev.tmpbuf);
req_area->iov_count = 1;
req_area->iov_buf[0].ptr = sreq->dev.tmpbuf;
req_area->iov_buf[0].length = last;
}
}
}
vc_area->pending_sends += 1;
mpi_errno = _mxm_isend(vc_area->mxm_ep, req_area, MXM_MPICH_ISEND_SYNC,
(mxm_mq_h) comm->dev.ch.netmod_priv, comm->rank, tag, _mxm_tag_mpi2mxm(tag,
comm->context_id
+
context_offset),
0);
if (mpi_errno)
MPIU_ERR_POP(mpi_errno);
_dbg_mxm_out_req(sreq);
fn_exit:
*sreq_ptr = sreq;
MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_MXM_ISSEND);
return mpi_errno;
fn_fail:
goto fn_exit;
}
/* MPIR_Type_get_elements
*
* Arguments:
* - bytes_p - input/output byte count
* - count - maximum number of this type to subtract from the bytes; a count
* of <0 indicates use as many as we like
* - datatype - input datatype
*
* Returns number of elements available given the two constraints of number of
* bytes and count of types. Also reduces the byte count by the amount taken
* up by the types.
*
* This is called from MPI_Get_elements() when it sees a type with multiple
* element types (datatype_ptr->element_sz = -1). This function calls itself too.
*/
PMPI_LOCAL MPI_Count MPIR_Type_get_elements(MPI_Count *bytes_p,
MPI_Count count,
MPI_Datatype datatype)
{
MPIR_Datatype *datatype_ptr = NULL;
MPID_Datatype_get_ptr(datatype, datatype_ptr); /* invalid if builtin */
/* if we have gotten down to a type with only one element type,
* call MPIR_Type_get_basic_type_elements() and return.
*/
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN ||
datatype == MPI_FLOAT_INT ||
datatype == MPI_DOUBLE_INT ||
datatype == MPI_LONG_INT ||
datatype == MPI_SHORT_INT ||
datatype == MPI_LONG_DOUBLE_INT)
{
return MPIR_Type_get_basic_type_elements(bytes_p, count, datatype);
}
else if (datatype_ptr->builtin_element_size >= 0) {
MPI_Datatype basic_type = MPI_DATATYPE_NULL;
MPID_Datatype_get_basic_type(datatype_ptr->basic_type, basic_type);
return MPIR_Type_get_basic_type_elements(bytes_p,
count * datatype_ptr->n_builtin_elements,
basic_type);
}
else {
/* we have bytes left and still don't have a single element size; must
* recurse.
*/
int i, j, *ints;
MPI_Count typecount = 0, nr_elements = 0, last_nr_elements;
MPI_Aint *aints;
MPI_Datatype *types;
/* Establish locations of arrays */
MPID_Type_access_contents(datatype_ptr->handle, &ints, &aints, &types);
if (!ints || !aints || !types)
return MPI_ERR_TYPE;
switch (datatype_ptr->contents->combiner) {
case MPI_COMBINER_NAMED:
case MPI_COMBINER_DUP:
case MPI_COMBINER_RESIZED:
return MPIR_Type_get_elements(bytes_p, count, *types);
break;
case MPI_COMBINER_CONTIGUOUS:
case MPI_COMBINER_VECTOR:
case MPI_COMBINER_HVECTOR_INTEGER:
case MPI_COMBINER_HVECTOR:
/* count is first in ints array */
return MPIR_Type_get_elements(bytes_p, count * (*ints), *types);
break;
case MPI_COMBINER_INDEXED_BLOCK:
case MPI_COMBINER_HINDEXED_BLOCK:
/* count is first in ints array, blocklength is second */
return MPIR_Type_get_elements(bytes_p,
count * ints[0] * ints[1],
*types);
break;
case MPI_COMBINER_INDEXED:
case MPI_COMBINER_HINDEXED_INTEGER:
case MPI_COMBINER_HINDEXED:
for (i=0; i < (*ints); i++) {
/* add up the blocklengths to get a max. # of the next type */
typecount += ints[i+1];
}
return MPIR_Type_get_elements(bytes_p, count * typecount, *types);
break;
case MPI_COMBINER_STRUCT_INTEGER:
case MPI_COMBINER_STRUCT:
/* In this case we can't simply multiply the count of the next
* type by the count of the current type, because we need to
* cycle through the types just as the struct would. thus the
* nested loops.
*
* We need to keep going until we get less elements than expected
* or we run out of bytes.
*/
last_nr_elements = 1; /* seed value */
for (j=0;
(count < 0 || j < count) &&
*bytes_p > 0 && last_nr_elements > 0;
j++)
{
/* recurse on each type; bytes are reduced in calls */
for (i=0; i < (*ints); i++) {
/* skip zero-count elements of the struct */
if (ints[i+1] == 0) continue;
last_nr_elements = MPIR_Type_get_elements(bytes_p,
ints[i+1],
types[i]);
nr_elements += last_nr_elements;
MPIR_Assert(last_nr_elements >= 0);
if (last_nr_elements < ints[i+1]) break;
}
}
return nr_elements;
break;
case MPI_COMBINER_SUBARRAY:
case MPI_COMBINER_DARRAY:
case MPI_COMBINER_F90_REAL:
case MPI_COMBINER_F90_COMPLEX:
case MPI_COMBINER_F90_INTEGER:
default:
/* --BEGIN ERROR HANDLING-- */
MPIR_Assert(0);
return -1;
break;
/* --END ERROR HANDLING-- */
}
}
}
/*@
MPI_Pack_external - Packs a datatype into contiguous memory, using the
external32 format
Input Parameters:
+ datarep - data representation (string)
. inbuf - input buffer start (choice)
. incount - number of input data items (integer)
. datatype - datatype of each input data item (handle)
- outsize - output buffer size, in bytes (address integer)
Output Parameters:
. outbuf - output buffer start (choice)
Input/Output Parameters:
. position - current position in buffer, in bytes (address integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_TYPE
.N MPI_ERR_ARG
.N MPI_ERR_COUNT
@*/
int MPI_Pack_external(const char datarep[],
const void *inbuf,
int incount,
MPI_Datatype datatype,
void *outbuf,
MPI_Aint outsize,
MPI_Aint *position)
{
static const char FCNAME[] = "MPI_Pack_external";
int mpi_errno = MPI_SUCCESS;
MPI_Aint first, last;
MPID_Segment *segp;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_PACK_EXTERNAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_PACK_EXTERNAL);
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COUNT(incount, mpi_errno);
MPIR_ERRTEST_COUNT(outsize, mpi_errno);
/* NOTE: inbuf could be null (MPI_BOTTOM) */
if (incount > 0) {
MPIR_ERRTEST_ARGNULL(outbuf, "output buffer", mpi_errno);
}
MPIR_ERRTEST_ARGNULL(position, "position", mpi_errno);
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
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 != MPI_SUCCESS) goto fn_fail;
}
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
if (incount == 0) {
goto fn_exit;
}
segp = MPID_Segment_alloc();
/* --BEGIN ERROR HANDLING-- */
if (segp == NULL)
{
mpi_errno = MPIR_Err_create_code(MPI_SUCCESS,
MPIR_ERR_RECOVERABLE,
FCNAME,
__LINE__,
MPI_ERR_OTHER,
"**nomem",
"**nomem %s",
"MPID_Segment");
goto fn_fail;
}
/* --END ERROR HANDLING-- */
mpi_errno = MPID_Segment_init(inbuf, incount, datatype, segp, 1);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* NOTE: the use of buffer values and positions in MPI_Pack_external and
* in MPID_Segment_pack_external are quite different. See code or docs
* or something.
*/
first = 0;
last = SEGMENT_IGNORE_LAST;
/* Ensure that pointer increment fits in a pointer */
MPID_Ensure_Aint_fits_in_pointer((MPI_VOID_PTR_CAST_TO_MPI_AINT outbuf) + *position);
MPID_Segment_pack_external32(segp,
first,
&last,
(void *)((char *) outbuf + *position));
*position += last;
MPID_Segment_free(segp);
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_PACK_EXTERNAL);
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_pack_external",
"**mpi_pack_external %s %p %d %D %p %d %p", datarep, inbuf, incount, datatype, outbuf, outsize, position);
}
# endif
mpi_errno = MPIR_Err_return_comm(0, FCNAME, mpi_errno);
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Get_elements_x_impl(const MPI_Status *status, MPI_Datatype datatype, MPI_Count *elements)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Datatype *datatype_ptr = NULL;
MPI_Count byte_count;
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPID_Datatype_get_ptr(datatype, datatype_ptr);
}
/* three cases:
* - nice, simple, single element type
* - derived type with a zero size
* - type with multiple element types (nastiest)
*/
if (HANDLE_GET_KIND(datatype) == HANDLE_KIND_BUILTIN ||
(datatype_ptr->builtin_element_size != -1 && datatype_ptr->size > 0))
{
byte_count = MPIR_STATUS_GET_COUNT(*status);
/* QUESTION: WHAT IF SOMEONE GAVE US AN MPI_UB OR MPI_LB???
*/
/* in both cases we do not limit the number of types that might
* be in bytes
*/
if (HANDLE_GET_KIND(datatype) != HANDLE_KIND_BUILTIN) {
MPI_Datatype basic_type = MPI_DATATYPE_NULL;
MPID_Datatype_get_basic_type(datatype_ptr->basic_type, basic_type);
*elements = MPIR_Type_get_basic_type_elements(&byte_count,
-1,
basic_type);
}
else {
/* Behaves just like MPI_Get_Count in the predefined case */
MPI_Count size;
MPID_Datatype_get_size_macro(datatype, size);
if ((byte_count % size) != 0)
*elements = MPI_UNDEFINED;
else
*elements = MPIR_Type_get_basic_type_elements(&byte_count,
-1,
datatype);
}
MPIR_Assert(byte_count >= 0);
}
else if (datatype_ptr->size == 0) {
if (MPIR_STATUS_GET_COUNT(*status) > 0) {
/* --BEGIN ERROR HANDLING-- */
/* datatype size of zero and count > 0 should never happen. */
(*elements) = MPI_UNDEFINED;
/* --END ERROR HANDLING-- */
}
else {
/* This is ambiguous. However, discussions on MPI Forum
* reached a consensus that this is the correct return
* value
*/
(*elements) = 0;
}
}
else /* derived type with weird element type or weird size */ {
MPIR_Assert(datatype_ptr->builtin_element_size == -1);
byte_count = MPIR_STATUS_GET_COUNT(*status);
*elements = MPIR_Type_get_elements(&byte_count, -1, datatype);
}
return mpi_errno;
}
