/*==========================================================================*/
int _MPI_Free_datatype (MPI_Datatype datatype)
{
int index;
_MPI_TYPE_DES* child;
_MPI_COVERAGE();
index = _MPI_FindType(datatype);
if (index == _MPI_NOT_OK) {
_MPI_COVERAGE();
return _MPI_NOT_OK;
}
#ifdef KDD_REMOVED_DEBUG
printf("%s:%d: BOGUS value??? %d %d 0x%x\n",__FILE__,__LINE__,datatype, index, (int)_MPI_TYPE_LIST[index].next);
#endif
child = _MPI_TYPE_LIST[index].next;
if ( child ) _MPI_deleteAll(child);
_MPI_safeFree(_MPI_TYPE_LIST[index].info,"type info");
/*
_MPI_safeFree(_MPI_TYPE_LIST[index].next,"type next");
*/
_MPI_TYPE_LIST[index].id = _MPI_NOT_VALID;
_MPI_TYPE_LIST[index].info = 0;
_MPI_TYPE_LIST[index].next = 0;
return MPI_SUCCESS;
}
int PMPI_Type_lb ( MPI_Datatype datatype, MPI_Aint *displacement )
{
int index;
index = _MPI_FindType(datatype);
if (datatype == _MPI_NOT_OK)
{
_MPI_ERR_ROUTINE (MPI_ERR_TYPE, "MPI_TYPE_LB: invalid datatype.");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_TYPE);
}
*displacement = _MPI_TYPE_LIST[index].lb;
return MPI_SUCCESS;
}
/*==========================================================================*/
int _MPI_checkSendType (MPI_Datatype type)
{
int index;
_MPI_COVERAGE();
index = _MPI_FindType(type);
if (index == _MPI_NOT_OK)
{
_MPI_COVERAGE();
return _MPI_DEFAULT;
}
return _MPI_TYPE_LIST[index].sendType;
}
int PMPI_Type_get_contents(
MPI_Datatype datatype,
int max_integers,
int max_addresses,
int max_datatypes,
int *array_of_integers,
MPI_Aint *array_of_addresses,
MPI_Datatype *array_of_datatypes)
{
int index, position;
position = _MPI_FindType(datatype);
if (position == _MPI_NOT_OK)
{
position = _MPI_BasicType (datatype);
if (position == MPI_SUCCESS)
{
array_of_integers[0] = 1;
array_of_addresses[0] = (MPI_Aint) 0;
array_of_datatypes[0] = datatype;
return MPI_SUCCESS;
} else {
_MPI_ERR_ROUTINE (MPI_ERR_TYPE, "MPI_TYPE_GET_CONTENTS: datatype error");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_TYPE);
}
}
if ( (_MPI_TYPE_LIST[position].info->count < max_addresses) || (_MPI_TYPE_LIST[position].info->count < max_integers) ||
(_MPI_TYPE_LIST[position].info->count < max_datatypes) )
{
_MPI_ERR_ROUTINE (MPI_ERR_TYPE, "MPI_TYPE_GET_CONTENTS: invalid max_* error");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_TYPE);
}
if (_MPI_TYPE_LIST[position].sendType == _MPI_STRUCT)
{
for (index=0; index<max_integers; index++)
{
array_of_integers[index] = _MPI_TYPE_LIST[position].info->blocklen[index];
}
for (index=0; index<max_addresses; index++)
{
array_of_addresses[index] = _MPI_TYPE_LIST[position].info->stride[index];
}
for (index=0; index<max_datatypes; index++)
{
array_of_addresses[index] = _MPI_TYPE_LIST[position].info->types[index];
}
} else {
_MPI_ERR_ROUTINE (MPI_ERR_TYPE, "MPI_TYPE_GET_CONTENTS: Not Struct datatype error");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_TYPE);
}
return MPI_SUCCESS;
}
int PMPI_Type_size ( MPI_Datatype datatype, int *size )
{
int index;
*size = 0;
if ( _MPI_BasicType(datatype) == MPI_SUCCESS ) {
*size = _MPI_getSize(datatype);
}
else
{
index = _MPI_FindType (datatype);
if (index == _MPI_NOT_OK)
{
_MPI_ERR_ROUTINE (MPI_ERR_TYPE, "MPI_TYPE_SIZE: datatype error");
MPI_Abort (MPI_COMM_NULL, MPI_ERR_TYPE);
}
*size = _MPI_TYPE_LIST[index].extent;
}
return MPI_SUCCESS;
}
/*=============================================================================================*/
int PMPI_Send (void* message, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm) {
int size, retval, sendType, index;
MPI_Aint position, copiedPointer;
_MPI_TYPE_INFO *info;
char* p;
_MPI_COVERAGE();
_MPI_CHECK_STATUS(&comm);
retval = _MPI_checks(message, count, datatype, dest, tag, comm);
if (retval == MPI_SUCCESS) {
sendType = _MPI_checkSendType(datatype);
switch (sendType) {
case _MPI_DEFAULT:
{
size = _MPI_calculateSize(count, datatype);
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_CONTIG:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
p = memcpy(p, message, size);
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_INDEXED:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* ================================================== */
/* Determine the correct parts to save to the buffers */
info = _MPI_TYPE_LIST[sendType].info;
position = (MPI_Aint) 0;
copiedPointer = (MPI_Aint) 0;
for (index = 0; index < info->count; index++)
{
position = info->stride[index]*sizeof(info->types[0]);
p = memcpy(p+copiedPointer, ((char*)message)+position, info->blocklen[index]*sizeof(info->types[0]));
copiedPointer += info->blocklen[index]*sizeof(info->types[0]);
}
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_VECTOR:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* =================================== */
/* Figure out the correct ones to pass */
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
case _MPI_STRUCT:
{
sendType = _MPI_FindType(datatype);
size = _MPI_TYPE_LIST[sendType].extent;
p = (char *)_MPI_safeMalloc(size, "Error with malloc for send buffer.");
/* =================================== */
/* Figure out the correct ones to pass */
retval =_MPI_Buff_Insert(p, count, datatype, tag, comm);
return retval;
}
default:
{
fprintf(stderr,"SEND: mpi_Hindexed or mpi_Hvector not implemented\n");
MPI_Abort (comm, _MPI_NOT_OK);
}
}
} else {
_MPI_ERR_ROUTINE (retval, "MPI_SEND / MPI_ISEND: argument error");
MPI_Abort (comm, retval);
}
_MPI_COVERAGE();
return _MPI_NOT_OK;
}
