int PMPI_Finalize (void) {
int i;
_MPI_FINALIZED_FLAG = _MPI_TRUE;
if ( (_MPI_INIT_STATUS)!=(_MPI_STARTED) ) {
_MPI_ERR_ROUTINE(MPI_ERR_IN_STATUS, "MPI_FINALIZE: MPI has not been initialized.");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_IN_STATUS);
return _MPI_NOT_OK;
} else {
_MPI_INIT_STATUS = _MPI_ENDED;
for (i = 1; i < _MPI_PREALLOCATION_SIZE; i++) {
_MPI_Comm_Invalid(i);
_MPI_Data_Invalid(i);
_MPI_Type_Invalid(i);
}
free(_MPI_COMM_LIST); _MPI_COMM_LIST = 0;
free(_MPI_DATA_BUFF);_MPI_DATA_BUFF = 0;
free(_MPI_TYPE_LIST);_MPI_TYPE_LIST = 0;
free(_MPI_OP_LIST);_MPI_OP_LIST = 0;
for(i=0;i<_MPI_REQ_ARRAY_SIZE;++i) {
free(_MPI_REQ_LIST_OF_LISTS[i]);
_MPI_REQ_LIST_OF_LISTS[i] = 0;
}
free(_MPI_REQ_LIST_OF_LISTS);_MPI_REQ_LIST_OF_LISTS = 0;
free(_MPI_REQNULL);_MPI_REQNULL = 0;
return MPI_SUCCESS;
}
}
/*==========================================================================*/
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_Recv (void* message, int count, MPI_Datatype datatype, int source,
int tag, MPI_Comm comm, MPI_Status* status)
{
int retval, receiver_size, message_size, index;
retval=_MPI_checks(message, count, datatype, source, tag, comm);
if (retval == MPI_SUCCESS) {
receiver_size = _MPI_calculateSize(count, datatype);
/* ----------------------------------------------- */
/* Look up the send that matches this receive */
/* ----------------------------------------------- */
index = _MPI_Buff_Find(tag, comm);
if (index == _MPI_NOT_OK) {
return MPI_ERR_TAG; /* this return value is relied upon by some */
} /* internal calls to indicate no matching send */
message_size = _MPI_calculateSize(_MPI_DATA_BUFF[index].count,
_MPI_DATA_BUFF[index].type);
if (status != MPI_STATUS_IGNORE) {
status->MPI_SOURCE = _MPI_RANK;
status->MPI_TAG = _MPI_DATA_BUFF[index].tag;
status->__count = message_size;
}
if (message_size > receiver_size) {
_MPI_ERR_ROUTINE(MPI_ERR_COUNT, "MPI_RECV : Message buffer too small for message");
if (status != MPI_STATUS_IGNORE) status->MPI_ERROR = MPI_ERR_COUNT;
_MPI_Data_Invalid(index);
return MPI_ERR_COUNT;
}
memcpy(message, _MPI_DATA_BUFF[index].buffer, message_size);
if (status != MPI_STATUS_IGNORE) status->MPI_ERROR = MPI_SUCCESS;
_MPI_Data_Invalid(index);
return MPI_SUCCESS;
}
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;
}
}
