/*
* Grequest queries are invoked in two places:
*
* 1. MPI_TEST* / MPI_WAIT*, when requests have completed.
*
* 2. MPI_REQUEST_GET_STATUS, when requests may or may not have
* completed.
*
*/
int ompi_grequest_invoke_query(ompi_request_t *request,
ompi_status_public_t *status)
{
int rc = OMPI_SUCCESS;
ompi_grequest_t *g = (ompi_grequest_t*) request;
/* MPI-2:8.2 does not say what to do with the return value from
the query function (i.e., the int return value from the C
function or the ierr argument from the Fortran function).
Making the command decision here to ignore it. If the handler
wants to pass an error back, it should set it in the MPI_ERROR
field in the status (which is always kept, regardless if the
top-level function was invoked with MPI_STATUS[ES]_IGNORE or
not). */
if (NULL != g->greq_query.c_query) {
if (g->greq_funcs_are_c) {
rc = g->greq_query.c_query(g->greq_state, status);
} else {
MPI_Fint ierr;
MPI_Fint fstatus[sizeof(MPI_Status) / sizeof(int)];
g->greq_query.f_query((MPI_Aint*)g->greq_state, fstatus, &ierr);
MPI_Status_f2c(fstatus, status);
rc = OMPI_FINT_2_INT(ierr);
}
}
return rc;
}
// MPI_WAIT(REQUEST, STATUS, IERROR)
// INTEGER REQUEST, STATUS(MPI_STATUS_SIZE), IERROR
// MPI_Request MPI_Request_f2c(MPI_Fint request)
// MPI_Fint MPI_Request_c2f(MPI_Request request)
void mpi_wait(MPI_Fint *request, MPI_Fint *status, int *ierr)
{
__SHIM__REGISTER_F(wait);
caller = __SHIM__get_caller();
MPI_Request cb_request;
cb_request = MPI_Request_f2c(*request);
MPI_Status cb_status;
MPI_Status_f2c(status, &cb_status);
tor_MPI_Wait_pre(&cb_request,&cb_status,caller);
__SHIM__FUNC_F(request,status,ierr);
tor_MPI_Wait_pos(&cb_request,&cb_status,caller,*ierr);
return;
}
void mpi_recv (void *buf, int *count, MPI_Fint *datatype, int *source, int *tag, MPI_Fint *comm, MPI_Fint *status, int *ierr)
{
__SHIM__REGISTER_F(recv);
caller = __SHIM__get_caller();
MPI_Datatype cb_datatype;
MPI_Comm cb_comm;
MPI_Status cb_status;
cb_datatype = MPI_Type_f2c(*datatype);
cb_comm = MPI_Comm_f2c(*comm);
MPI_Status_f2c(status, &cb_status);
tor_MPI_Recv_pre(buf, *count, cb_datatype, *source, *tag, cb_comm, &cb_status, caller);
__SHIM__FUNC_F(buf,count, datatype,source,tag, comm, status, ierr);
tor_MPI_Recv_pos(buf, *count, cb_datatype, *source, *tag, cb_comm, &cb_status, caller, *ierr);
return;
}
void ompi_get_elements_x_f(MPI_Fint *status, MPI_Fint *datatype, MPI_Count *count, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
MPI_Status c_status;
OMPI_SINGLE_NAME_DECL(count);
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*count = OMPI_INT_2_FINT(0);
c_ierr = MPI_SUCCESS;
} else {
c_ierr = MPI_Status_f2c(status, &c_status);
if (MPI_SUCCESS == c_ierr) {
c_ierr = MPI_Get_elements_x(&c_status, c_type, count);
}
}
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void mpi_get_count_f(MPI_Fint *status, MPI_Fint *datatype, MPI_Fint *count, MPI_Fint *ierr)
{
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
MPI_Status c_status;
OMPI_SINGLE_NAME_DECL(count);
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*count = OMPI_INT_2_FINT(0);
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
*ierr = OMPI_INT_2_FINT(MPI_Status_f2c(status, &c_status));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
*ierr = OMPI_INT_2_FINT(MPI_Get_count(&c_status, c_type,
OMPI_SINGLE_NAME_CONVERT(count)));
OMPI_SINGLE_INT_2_FINT(count);
}
}
}
void mpi_status_set_cancelled_f(MPI_Fint *status, ompi_fortran_logical_t *flag, MPI_Fint *ierr)
{
MPI_Status c_status;
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
MPI_Status_f2c( status, &c_status );
*ierr = OMPI_INT_2_FINT(MPI_Status_set_cancelled(&c_status,
OMPI_LOGICAL_2_INT(*flag)));
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
MPI_Status_c2f(&c_status, status);
}
}
}
void ompi_test_cancelled_f(MPI_Fint *status, ompi_fortran_logical_t *flag, MPI_Fint *ierr)
{
int c_ierr;
MPI_Status c_status;
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);
c_ierr = MPI_SUCCESS;
} else {
c_ierr = MPI_Status_f2c( status, &c_status );
if (MPI_SUCCESS == c_ierr) {
c_ierr = MPI_Test_cancelled(&c_status,
OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
OMPI_SINGLE_INT_2_LOGICAL(flag);
}
}
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void ompi_status_set_elements_x_f(MPI_Fint *status, MPI_Fint *datatype,
MPI_Count *count, MPI_Fint *ierr)
{
int c_ierr;
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
MPI_Status c_status;
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
c_ierr = MPI_SUCCESS;
} else {
MPI_Status_f2c( status, &c_status );
c_ierr = MPI_Status_set_elements_x(&c_status, c_type, *count);
/* If datatype is really being set, then that needs to be
converted.... */
if (MPI_SUCCESS == c_ierr) {
MPI_Status_c2f(&c_status, status);
}
}
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
}
void mpi_status_set_elements_f(MPI_Fint *status, MPI_Fint *datatype,
MPI_Fint *count, MPI_Fint *ierr)
{
MPI_Datatype c_type = MPI_Type_f2c(*datatype);
MPI_Status c_status;
/* This seems silly, but someone will do it */
if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
*ierr = OMPI_INT_2_FINT(MPI_SUCCESS);
} else {
MPI_Status_f2c( status, &c_status );
*ierr = OMPI_INT_2_FINT(MPI_Status_set_elements(&c_status, c_type,
OMPI_FINT_2_INT(*count)));
/* If datatype is really being set, then that needs to be
converted.... */
if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
MPI_Status_c2f(&c_status, status);
}
}
}