bool _request_get_status(const MPI_Request& req, MPI_Status& status) {
int flag;
MPI_Request_get_status(req, &flag, &status);
//Work around a bug prestn in Open MPI 1.3.3
//and eailer.
//MPI_Request_get_status may return false on
//the first call even though a message
//is waiting. The second call should work.
if(!flag)
MPI_Request_get_status(req, &flag, &status);
return flag;
}
int MPI_Recv_Nospin(void* buff, const int count, MPI_Datatype datatype,
const int from, const int tag, MPI_Comm comm,
MPI_Status* status)
{
MPI_Request req;
const int ret = MPI_Irecv(buff, count, datatype, from, tag, comm, &req);
if (ret != MPI_SUCCESS)
return ret;
timespec ts{0, nsec_start};
int flag = 0;
while (!flag)
{
nanosleep(&ts, nullptr);
ts.tv_nsec = std::min(size_t(ts.tv_nsec << 1), nsec_max);
MPI_Request_get_status(req, &flag, status); // Always returns success
}
return MPI_Wait(&req, status); // release the request object
}
int MPI_Send_Nospin(void* buff, const int count, MPI_Datatype datatype,
const int dest, const int tag, MPI_Comm comm)
{
MPI_Request req;
const int ret = MPI_Isend(buff, count, datatype, dest, tag, comm, &req);
if (ret != MPI_SUCCESS)
return ret;
timespec ts{0, nsec_start};
int flag = 0;
while (!flag)
{
nanosleep(&ts, nullptr);
ts.tv_nsec = std::min(size_t(ts.tv_nsec << 1), nsec_max);
// Always returns success. Status unused for single send operations.
MPI_Request_get_status(req, &flag, MPI_STATUS_IGNORE);
}
return MPI_Wait(&req, MPI_STATUS_IGNORE); // release the request object
}
void mpi_request_get_status_f(MPI_Fint *request, ompi_fortran_logical_t *flag,
MPI_Fint *status, MPI_Fint *ierr)
{
MPI_Status c_status;
MPI_Request c_req = MPI_Request_f2c( *request );
OMPI_LOGICAL_NAME_DECL(flag);
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*flag = OMPI_INT_2_LOGICAL(0);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = OMPI_INT_2_FINT(MPI_Request_get_status(c_req,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag),
&c_status));
OMPI_SINGLE_INT_2_LOGICAL(flag);
MPI_Status_c2f( &c_status, status );
}
}
/*
* Probe for and deal with incoming messages
*/
void CMPIManager::processQueue()
{
MPI_Status pStatus;
int iFlag = 0;
bReceiving = false;
if ( this->iNodeCount <= 1 )
return;
// Pending send operation has completed?
if ( this->sendOps.size() > 0 )
{
for( int i = this->sendOps.size() - 1; i >= 0; i-- )
{
wrapError( MPI_Request_get_status(
this->sendOps[i].pRequest,
&iFlag,
&pStatus
) );
if ( iFlag )
{
MPI_Test( &this->sendOps[i].pRequest, &iFlag, &pStatus );
if ( iFlag )
{
delete [] this->sendOps[i].pData;
this->sendOps.erase( this->sendOps.begin() + i );
}
} else {
if ( this->sendOps[i].iTarget < this->iNodeID )
{
MPI_Wait(
&this->sendOps[i].pRequest,
&pStatus
);
delete [] this->sendOps[i].pData;
this->sendOps.erase( this->sendOps.begin() + i );
}
}
}
}
int iSize = 0;
iFlag = 0;
// Check for new messages
wrapError(
MPI_Iprobe(
MPI_ANY_SOURCE,
MPI_ANY_TAG,
MPI_COMM_WORLD,
&iFlag,
&pStatus
)
);
if ( !iFlag )
{
return;
}
// A broadcast is likely to come in with a negative tag...
if ( pStatus.MPI_TAG < 0 )
return;
// Some MPI implementations (incl. Microsoft) can supply the count
// within the status struct...
wrapError( MPI_Get_count( &pStatus, MPI_BYTE, &iSize ) );
if ( iSize <= 0 )
return;
if ( iSize == MPI_UNDEFINED )
{
model::doError(
"Got undefined size from an MPI receive...",
model::errorCodes::kLevelWarning
);
return;
}
// Fetch...
if ( this->pRecvBuffer == NULL || iSize > this->uiRecvBufferSize )
{
if ( this->pRecvBuffer != NULL )
delete [] this->pRecvBuffer;
this->pRecvBuffer = new char[ iSize ];
this->uiRecvBufferSize = iSize;
}
bReceiving = true;
wrapError(
MPI_Recv(
this->pRecvBuffer,
iSize,
MPI_BYTE,
pStatus.MPI_SOURCE,
pStatus.MPI_TAG,
MPI_COMM_WORLD,
&pStatus
)
);
this->processIncoming( pStatus.MPI_TAG );
bReceiving = false;
}
