/*==========================================================================*/ int PMPI_Irecv (void* message, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request* request) { int retval, req; retval=_MPI_checks(message, count, datatype, source, tag, comm); if (retval != MPI_SUCCESS) { _MPI_ERR_ROUTINE (retval, "MPI_IRECV: argument error"); MPI_Abort (comm, retval); return retval; } #if 0 /* Not sure what this is doing.... */ if (*request == MPI_REQUEST_NULL) { _MPI_Set_Request(request, message, count, datatype, _MPI_FALSE, tag, comm);/* KDDKDD Passing request pointer */ } #endif if (retval == MPI_SUCCESS) { /* Check for New Request and Insert it into the Request queque */ #if 0 /* TODO: WHAT IS THIS DOING? */ req = _MPI_Req_Find(tag, comm); #else req = -1; #endif if ( req < 0 ) { /* It is a new request */ req = _MPI_Req_Post(message, count, datatype, tag, comm, _MPI_FALSE); *request = &_MPI_REQ_LIST[req]; } #if 0 /* TODO: This should wait until for the "wait" */ size = _MPI_calculateSize(count, datatype); index = _MPI_Buff_Ifind(tag, comm); if (index == _MPI_NOT_OK) { return MPI_ERR_PENDING; } /*MESSAGE IS THERE*/ _MPI_Req_Invalid(req); if (size < _MPI_DATA_BUFF[index].size) { /*MESSAGE IS TRUNCATED */ message = memcpy(message, _MPI_DATA_BUFF[index].buffer, size); printf("MPI_RECV : Message truncated.\n"); MPI_Abort(comm, MPI_ERR_COUNT); } else { message = memcpy(message, _MPI_DATA_BUFF[index].buffer, size); } _MPI_Data_Invalid(index); return MPI_SUCCESS; #endif } return retval; }
int PMPI_Init ( int *argc, char **argv[]) { int i; int retval = MPI_ERR_IN_STATUS; _MPI_COVERAGE(); _MPI_INITIALIZED_FLAG = _MPI_TRUE; /* -------------------------------------*/ /* Check for the current status of MPI */ if ( (_MPI_INIT_STATUS == _MPI_ENDED) || (_MPI_INIT_STATUS == _MPI_STARTED) ) { if (_MPI_INIT_STATUS == _MPI_ENDED) { _MPI_COVERAGE(); _MPI_ERR_ROUTINE(MPI_ERR_IN_STATUS, "MPI was already finalized"); } else { _MPI_COVERAGE(); _MPI_ERR_ROUTINE(MPI_ERR_IN_STATUS, "MPI was already initialized"); } MPI_ERRORS_ARE_FATAL((MPI_Comm)NULL, &retval); return MPI_ERR_OTHER; } /* -------------------------------------------------------------- */ else /* If the status is fine, initialize the internal data structures */ { _MPI_COVERAGE(); /* --------------------------- */ /* Create the MPI_REQUEST_NULL */ /* _MPI_REQNULL = (MPI_Request *)_MPI_safeMalloc(sizeof(MPI_Request),"Error with malloc for MPI_REQUEST_NULL"); * _MPI_REQNULL = MPI_REQUEST_NULL; * MPI_REQUEST_NULL = _MPI_REQNULL; */ #ifndef PREALLOCATION_SIZE #define PREALLOCATION_SIZE 10 #endif _MPI_INIT_STATUS = _MPI_STARTED; /* ---------- */ /* Allocation */ _MPI_COMM_ARRAY_SIZE = PREALLOCATION_SIZE; _MPI_DATA_ARRAY_SIZE = PREALLOCATION_SIZE; _MPI_TYPE_ARRAY_SIZE = PREALLOCATION_SIZE; _MPI_OP_ARRAY_SIZE = PREALLOCATION_SIZE; _MPI_REQ_ARRAY_SIZE = PREALLOCATION_SIZE; _MPI_COMM_LIST = (_MPI_COMM_IMPL *) _MPI_safeMalloc (_MPI_COMM_ARRAY_SIZE*sizeof(_MPI_COMM_IMPL), "Error with malloc of COMM_LIST"); _MPI_DATA_BUFF = (_MPI_DATA_ENTRY *) _MPI_safeMalloc (_MPI_DATA_ARRAY_SIZE*sizeof(_MPI_DATA_ENTRY), "Error with malloc of DATA_BUFF"); _MPI_TYPE_LIST = (_MPI_TYPE_DES *) _MPI_safeMalloc (_MPI_TYPE_ARRAY_SIZE*sizeof(_MPI_TYPE_DES), "Error with malloc of TYPE_LIST"); _MPI_OP_LIST = (_MPI_OP_TYPE *) _MPI_safeMalloc (_MPI_OP_ARRAY_SIZE*sizeof(_MPI_OP_TYPE), "Error with malloc of OP_LIST"); _MPI_REQ_LIST = (_MPI_REQUEST_OBJECT *) _MPI_safeMalloc (_MPI_OP_ARRAY_SIZE*sizeof(_MPI_REQUEST_OBJECT), "Error with malloc of REQ_LIST"); /* ----------------------------------------------- */ /* Communicators are not set up */ /* ----------------------------------------------- */ for (i=1; i<_MPI_COMM_ARRAY_SIZE; i++) { _MPI_COMM_LIST[i].valid = _MPI_NOT_VALID; } for (i=1; i<_MPI_DATA_ARRAY_SIZE; i++) { _MPI_DATA_BUFF[i].valid = _MPI_NOT_VALID; } for (i=1; i<_MPI_OP_ARRAY_SIZE; i++) { _MPI_OP_LIST[i].valid = _MPI_NOT_VALID; } for (i=1; i<_MPI_TYPE_ARRAY_SIZE; i++) { _MPI_TYPE_LIST[i].id = _MPI_NOT_VALID; _MPI_TYPE_LIST[i].info = 0; _MPI_TYPE_LIST[i].next = 0; } _MPI_COMM_COUNT = 0; _MPI_DATA_BUFF_COUNT = 0; _MPI_TYPE_COUNT = 0; _MPI_OP_COUNT = 0; _MPI_REQ_COUNT = 0; /* ------------------------- */ /* Set entries all to "null" */ for (i=0; i<PREALLOCATION_SIZE; i++) { _MPI_COVERAGE(); _MPI_Data_Invalid(i); _MPI_Comm_Invalid(i); _MPI_Type_Invalid(i); _MPI_Req_Invalid(i); } /* --------------------------------------------------- */ _MPI_Comm_Insert0(0, MPI_COMM_WORLD, MPI_ERRORS_ARE_FATAL); /* This inserts MPI_COMM_WORLD as the 1st communicator */ return MPI_SUCCESS; } }
/*==========================================================================*/ int PMPI_Wait(MPI_Request* request, MPI_Status* status) { int retval; MPI_Status recv_status; if ( !request ) { _MPI_ERR_ROUTINE(MPI_ERR_REQUEST,"Request pointer is null"); return _MPI_NOT_OK; } /* ----------------------------------------------- */ /* A null request requires no wait */ /* ----------------------------------------------- */ if ((*request) == MPI_REQUEST_NULL) return MPI_SUCCESS; /* ----------------------------------------------- */ /* Send requests are always ready (eager) */ /* We may have to actually do a recv() here if it */ /* is not a send request. */ /* ----------------------------------------------- */ if (!(*request)->send) { retval = PMPI_Recv((*request)->buffer, (*request)->count, (*request)->type, _MPI_RANK, (*request)->tag, (*request)->comm, &recv_status); if ( retval == MPI_ERR_TAG && (*request)->cancel ) { /* no matching send and the recv request has been cancelled */ _MPI_Req_Invalid((*request)); *request = MPI_REQUEST_NULL; return MPI_SUCCESS; } else if (retval != MPI_SUCCESS) { return retval; } } /* Copy in the status */ if ( status && status != MPI_STATUS_IGNORE) { status->MPI_SOURCE = _MPI_RANK; status->MPI_TAG = (*request)->tag; status->MPI_ERROR = MPI_SUCCESS; if ((*request)->send) { status->__count = _MPI_calculateSize((*request)->count, (*request)->type); } else { status->__count = recv_status.__count; } } /* ----------------------------------------------- */ /* Mark the request available in the pool and then */ /* write REQUEST_NULL back into the original req */ /* so that subsequent requests will immediately */ /* succeed. */ /* ----------------------------------------------- */ _MPI_Req_Invalid((*request)); *request = MPI_REQUEST_NULL; return MPI_SUCCESS; }