/*@
MPI_Iprobe - Nonblocking test for a message
Input Parameters:
+ source - source rank, or 'MPI_ANY_SOURCE' (integer)
. tag - tag value or 'MPI_ANY_TAG' (integer)
- comm - communicator (handle)
Output Parameter:
+ flag - (logical)
- status - status object (Status)
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_TAG
.N MPI_ERR_RANK
@*/
EXPORT_MPI_API int MPI_Iprobe( int source, int tag, MPI_Comm comm, int *flag,
MPI_Status *status )
{
MPI_Status __status;
int mpi_errno = MPI_SUCCESS;
struct MPIR_COMMUNICATOR *comm_ptr;
static char myname[] = "MPI_IPROBE";
TR_PUSH(myname);
if(status == MPI_STATUS_IGNORE) status = &__status;
comm_ptr = MPIR_GET_COMM_PTR(comm);
#ifndef MPIR_NO_ERROR_CHECKING
MPIR_TEST_MPI_COMM(comm,comm_ptr,comm_ptr,myname);
MPIR_TEST_RECV_TAG(tag);
MPIR_TEST_RECV_RANK(comm_ptr,source);
if (mpi_errno)
return MPIR_ERROR(comm_ptr, mpi_errno, myname );
#endif
if (source == MPI_PROC_NULL) {
status->MPI_SOURCE = MPI_PROC_NULL;
status->MPI_TAG = MPI_ANY_TAG;
MPID_ZERO_STATUS_COUNT(status);
return MPI_SUCCESS;
}
MPID_Iprobe( comm_ptr, tag, comm_ptr->recv_context, source, flag,
&mpi_errno, status );
TR_POP;
MPIR_RETURN( comm_ptr, mpi_errno, myname );
}
/*@
MPI_Recv - Basic receive
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
number can be determined with 'MPI_Get_count'.
.N fortran
.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 )
{
struct MPIR_COMMUNICATOR *comm_ptr;
struct MPIR_DATATYPE *dtype_ptr;
static char myname[] = "MPI_RECV";
int mpi_errno = MPI_SUCCESS;
/*
Because this is a very common routine, we show how it can be
optimized to be run "inline"; In addition, this lets us exploit
features in the ADI to simplify the execution of blocking receive
calls.
*/
if (source != MPI_PROC_NULL)
{
disableSignal();
comm_ptr = MPIR_GET_COMM_PTR(comm);
MPIR_TEST_MPI_COMM(comm,comm_ptr,comm_ptr,myname);
dtype_ptr = MPIR_GET_DTYPE_PTR(datatype);
MPIR_TEST_DTYPE(datatype,dtype_ptr,comm_ptr,myname);
#ifndef MPIR_NO_ERROR_CHECKING
MPIR_TEST_COUNT(count);
MPIR_TEST_RECV_TAG(tag);
MPIR_TEST_RECV_RANK(comm_ptr,source);
if (mpi_errno) {
revertSignal();
return MPIR_ERROR(comm_ptr, mpi_errno, myname );
}
#endif
MPID_RecvDatatype( comm_ptr, buf, count, dtype_ptr, source, tag,
comm_ptr->recv_context, status, &mpi_errno );
revertSignal();
MPIR_RETURN(comm_ptr, mpi_errno, myname );
}
else {
if (status != MPI_STATUS_IGNORE) {
/* See MPI standard section 3.11 */
MPID_ZERO_STATUS_COUNT(status);
status->MPI_SOURCE = MPI_PROC_NULL;
status->MPI_TAG = MPI_ANY_TAG;
}
}
return MPI_SUCCESS;
}
/*@
MPI_Testall - Tests for the completion of all previously initiated
communications
Input Parameters:
+ count - lists length (integer)
- array_of_requests - array of requests (array of handles)
Output Parameters:
+ flag - (logical)
- array_of_statuses - array of status objects (array of Status). May be
'MPI_STATUSES_IGNORE'.
Notes:
'flag' is true only if all requests have completed. Otherwise, flag is
false and neither the 'array_of_requests' nor the 'array_of_statuses' is
modified.
.N waitstatus
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_IN_STATUS
@*/
int MPI_Testall(
int count,
MPI_Request array_of_requests[],
int *flag,
MPI_Status array_of_statuses[] )
{
int i, mpi_errno = MPI_SUCCESS;
MPI_Request request;
int nready;
static char myname[] = "MPI_TESTALL";
disableSignal();
TR_PUSH(myname);
MPID_DeviceCheck( MPID_NOTBLOCKING );
/* It is a good thing that the receive requests contain the status object!
We need this to save the status information in the case where not
all of the requests have completed.
Note that this routine forces some changes on the ADI test routines.
It must be possible to test a completed request multiple times;
once the "is_complete" field is set, the data must be saved until
the request is explicitly freed. That is, unlike the MPI tests,
the ADI tests must be nondestructive.
*/
nready = 0;
for (i = 0; i < count; i++ ) {
request = array_of_requests[i];
if (!request) {
nready ++;
continue;
}
switch (request->handle_type) {
case MPIR_SEND:
if (MPID_SendRequestCancelled(request)) {
if (array_of_statuses) {
array_of_statuses[i].MPI_TAG = MPIR_MSG_CANCELLED;
array_of_statuses[i].MPI_ERROR = MPI_SUCCESS;
}
nready++; }
else if (!request->shandle.is_complete) {
if (MPID_SendIcomplete( request, &mpi_errno ))
nready++;
}
else nready++;
break;
case MPIR_RECV:
if (request->rhandle.s.MPI_TAG == MPIR_MSG_CANCELLED) {
if (array_of_statuses)
array_of_statuses[i].MPI_TAG = MPIR_MSG_CANCELLED;
nready++; }
else if (!request->rhandle.is_complete) {
if (MPID_RecvIcomplete( request, (MPI_Status *)0, &mpi_errno ))
nready++;
}
else nready++;
break;
case MPIR_PERSISTENT_SEND:
if (request->persistent_shandle.active &&
!request->persistent_shandle.shandle.is_complete) {
if (MPID_SendIcomplete( request, &mpi_errno ))
nready++;
}
else nready++;
break;
case MPIR_PERSISTENT_RECV:
if (request->persistent_rhandle.active &&
!request->persistent_rhandle.rhandle.is_complete) {
if (MPID_RecvIcomplete( request, (MPI_Status *)0, &mpi_errno ))
nready++;
}
else nready++;
break;
}
if (mpi_errno) {
if (array_of_statuses)
MPIR_Set_Status_error_array( array_of_requests, count, i,
mpi_errno, array_of_statuses );
mpi_errno = MPI_ERR_IN_STATUS;
TR_POP;
revertSignal();
MPIR_RETURN(MPIR_COMM_WORLD, mpi_errno, myname );
}
}
*flag = (nready == count);
/* Because a request may have completed with an error (such as
MPI_ERR_TRUNCATE), we need to check here as well.
Only if all are ready do we set complete the requests. Fortunately,
the standard allows us to say that the values in array_of_statuses
is undefined if all requests are not ready. */
if (nready == count) {
for (i=0; i<count; i++) {
request = array_of_requests[i];
if (!request) {
/* See MPI Standard, 3.7 */
if (array_of_statuses) {
array_of_statuses[i].MPI_TAG = MPI_ANY_TAG;
array_of_statuses[i].MPI_SOURCE = MPI_ANY_SOURCE;
array_of_statuses[i].MPI_ERROR = MPI_SUCCESS;
MPID_ZERO_STATUS_COUNT(&array_of_statuses[i]);
}
continue;
}
switch (request->handle_type) {
case MPIR_SEND:
/* There was a test on
array_of_statuses[i].MPI_TAG != MPIR_MSG_CANCELLED
here to avoid the MPID_SendRequestCancelled call,
but that depends on setting the MPI_TAG field
in the array of statuses. It would be better to
make the MPID_SendRequestCancelled routine a
macro */
if (!MPID_SendRequestCancelled(request)) {
MPIR_FORGET_SEND( &request->shandle );
MPID_SendFree( array_of_requests[i] );
array_of_requests[i] = MPI_REQUEST_NULL;
}
break;
case MPIR_RECV:
if (request->rhandle.s.MPI_TAG != MPIR_MSG_CANCELLED) {
if (request->rhandle.s.MPI_ERROR)
mpi_errno = request->rhandle.s.MPI_ERROR;
/*
if (request->rhandle.s.MPI_ERROR && mpi_errno == MPI_SUCCESS) {
for (j=0; j<count; j++) {
if (!array_of_requests[i] ||
array_of_requests[i].is_complete)
array_of_statuses[j].MPI_ERROR = MPI_SUCCESS;
else
array_of_statuses[j].MPI_ERROR = MPI_ERR_PENDING;
}
mpi_errno = MPI_ERR_IN_STATUS;
}
*/
if (array_of_statuses)
array_of_statuses[i] = request->rhandle.s;
MPID_RecvFree( array_of_requests[i] );
array_of_requests[i] = MPI_REQUEST_NULL;
}
break;
case MPIR_PERSISTENT_SEND:
if (request->persistent_shandle.active) {
/* array_of_statuses[i] =
request->persistent_shandle.shandle.s; */
if (array_of_statuses)
array_of_statuses[i].MPI_ERROR =
MPID_SendRequestErrval(&request->persistent_shandle.shandle);
request->persistent_shandle.active = 0;
}
else {
/* See MPI Standard, 3.7 */
/* Thanks to [email protected] for this fix */
if (array_of_statuses) {
if (MPID_SendRequestCancelled(&request->persistent_shandle))
array_of_statuses[i].MPI_TAG = MPIR_MSG_CANCELLED;
else
array_of_statuses[i].MPI_TAG = MPI_ANY_TAG;
array_of_statuses[i].MPI_SOURCE = MPI_ANY_SOURCE;
array_of_statuses[i].MPI_ERROR = MPI_SUCCESS;
MPID_ZERO_STATUS_COUNT(&array_of_statuses[i]);
}
}
break;
case MPIR_PERSISTENT_RECV:
if (request->persistent_rhandle.active) {
if (array_of_statuses)
array_of_statuses[i] =
request->persistent_rhandle.rhandle.s;
mpi_errno = request->persistent_rhandle.rhandle.s.MPI_ERROR;
request->persistent_rhandle.active = 0;
}
else {
/* See MPI Standard, 3.7 */
/* Thanks to [email protected] for this fix */
if (array_of_statuses) {
if (request->persistent_rhandle.rhandle.s.MPI_TAG ==
MPIR_MSG_CANCELLED)
array_of_statuses[i].MPI_TAG = MPIR_MSG_CANCELLED;
else
array_of_statuses[i].MPI_TAG = MPI_ANY_TAG;
array_of_statuses[i].MPI_SOURCE = MPI_ANY_SOURCE;
array_of_statuses[i].MPI_ERROR = MPI_SUCCESS;
MPID_ZERO_STATUS_COUNT(&array_of_statuses[i]);
}
}
break;
}
if (mpi_errno) {
if (array_of_statuses)
MPIR_Set_Status_error_array( array_of_requests, count, i,
mpi_errno, array_of_statuses );
mpi_errno = MPI_ERR_IN_STATUS;
TR_POP;
revertSignal();
MPIR_RETURN(MPIR_COMM_WORLD, mpi_errno, myname );
}
}
}
TR_POP;
revertSignal();
MPIR_RETURN(MPIR_COMM_WORLD, mpi_errno, myname );
}
/*@
MPI_Waitany - Waits for any specified send or receive to complete
Input Parameters:
+ count - list length (integer)
- array_of_requests - array of requests (array of handles)
Output Parameters:
+ index - 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)
Notes:
If all of the requests are 'MPI_REQUEST_NULL', then 'index' is returned as
'MPI_UNDEFINED', and 'status' is returned as an empty status.
.N waitstatus
.N fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_REQUEST
.N MPI_ERR_ARG
@*/
EXPORT_MPI_API int MPI_Waitany(
int count,
MPI_Request array_of_requests[],
int *index,
MPI_Status *status )
{
int i, mpi_errno = MPI_SUCCESS;
int done;
MPI_Request request;
static char myname[] = "MPI_WAITANY";
TR_PUSH(myname);
*index = MPI_UNDEFINED;
/* Check for all requests either null or inactive persistent */
for (i=0; i < count; i++) {
request = array_of_requests[i];
if (!request) continue;
if (request->handle_type == MPIR_PERSISTENT_SEND) {
if (request->persistent_shandle.active) break;
if (MPID_SendRequestCancelled(&request->persistent_shandle))
break;
}
else if (request->handle_type == MPIR_PERSISTENT_RECV) {
if (request->persistent_rhandle.active) break;
if (request->persistent_rhandle.rhandle.s.MPI_TAG ==
MPIR_MSG_CANCELLED) break;
}
else
break;
}
if (i == count) {
/* MPI Standard 1.1 requires an empty status in this case */
status->MPI_TAG = MPI_ANY_TAG;
status->MPI_SOURCE = MPI_ANY_SOURCE;
status->MPI_ERROR = MPI_SUCCESS;
MPID_ZERO_STATUS_COUNT(status);
*index = MPI_UNDEFINED;
TR_POP;
return mpi_errno;
}
done = 0;
while (!done) {
for (i=0; !done && i<count; i++) {
request = array_of_requests[i];
if (!request) continue;
switch (request->handle_type) {
case MPIR_SEND:
if (MPID_SendRequestCancelled(request)) {
status->MPI_TAG = MPIR_MSG_CANCELLED;
*index = i;
done = 1;
}
else {
if (MPID_SendIcomplete( request, &mpi_errno )) {
if (mpi_errno)
MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
MPIR_FORGET_SEND( &request->shandle );
MPID_Send_free( array_of_requests[i] );
*index = i;
array_of_requests[i] = 0;
done = 1;
}
}
break;
case MPIR_RECV:
if (request->rhandle.s.MPI_TAG == MPIR_MSG_CANCELLED) {
status->MPI_TAG = MPIR_MSG_CANCELLED;
MPID_Recv_free( array_of_requests[i] );
*index = i;
array_of_requests[i] = 0;
done = 1;
}
else {
if (MPID_RecvIcomplete( request, status, &mpi_errno )) {
if (mpi_errno)
MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
MPID_Recv_free( array_of_requests[i] );
*index = i;
array_of_requests[i] = 0;
done = 1;
}
}
break;
case MPIR_PERSISTENT_SEND:
if (request->persistent_shandle.active) {
if (MPID_SendIcomplete( request, &mpi_errno )) {
if (mpi_errno)
MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
request->persistent_shandle.active = 0;
*index = i;
done = 1;
}
}
else {
if (MPID_SendRequestCancelled(&request->persistent_shandle)) {
status->MPI_TAG = MPIR_MSG_CANCELLED;
*index = i;
done = 1;
}
}
break;
case MPIR_PERSISTENT_RECV:
if (request->persistent_rhandle.active) {
if (MPID_RecvIcomplete( request, status, &mpi_errno )) {
if (mpi_errno)
MPIR_ERROR( MPIR_COMM_WORLD, mpi_errno, myname );
request->persistent_rhandle.active = 0;
*index = i;
done = 1;
}
}
else {
if (request->persistent_rhandle.rhandle.s.MPI_TAG ==
MPIR_MSG_CANCELLED) {
status->MPI_TAG = MPIR_MSG_CANCELLED;
*index = i;
done = 1;
}
}
break;
}
}
if (!done) {
/* Do a NON blocking check */
MPID_DeviceCheck( MPID_NOTBLOCKING );
}
else
break;
}
TR_POP;
return mpi_errno;
}
