-static void *MTestTypeVectorFree( MTestDatatype *mtype )
-{
- if (mtype->buf) {
- free( mtype->buf );
- mtype->buf = 0;
- }
- return 0;
-}
-
-/* ------------------------------------------------------------------------ */
-/* Datatype routines for indexed block datatypes */
-/* ------------------------------------------------------------------------ */
-
-/*
- * Setup a buffer for one copy of an indexed datatype.
- */
-static void *MTestTypeIndexedInit( MTestDatatype *mtype )
-{
- MPI_Aint totsize;
- int merr;
-
- if (mtype->count > 1) {
- MTestError( "This datatype is supported only for a single count" );
- }
- if (mtype->count == 1) {
- signed char *p;
- int i, k, offset, j;
-
- /* Allocate the send/recv buffer */
- merr = MPI_Type_extent( mtype->datatype, &totsize );
- if (merr) MTestPrintError( merr );
- if (!mtype->buf) {
- mtype->buf = (void *) malloc( totsize );
- }
- p = (signed char *)(mtype->buf);
- if (!p) {
- MTestError( "Out of memory in type buffer init\n" );
- }
- /* Initialize the elements */
- /* First, set to -1 */
- for (i=0; i<totsize; i++) p[i] = 0xff;
-
- /* Now, set the actual elements to the successive values.
- We require that the base type is a contiguous type */
- k = 0;
- for (i=0; i<mtype->nelm; i++) {
- int b;
- /* Compute the offset: */
- offset = mtype->displs[i] * mtype->basesize;
- /* For each element in the block */
- for (b=0; b<mtype->index[i]; b++) {
- for (j=0; j<mtype->basesize; j++) {
- p[offset+j] = 0xff ^ (k++ & 0xff);
- }
- offset += mtype->basesize;
- }
- }
- }
- else {
- /* count == 0 */
- if (mtype->buf) {
- free( mtype->buf );
- }
- mtype->buf = 0;
- }
- return mtype->buf;
-}
-
-/*
- * Setup indexed buffers for 1 copy of a datatype. Initialize for
- * reception (e.g., set initial data to detect failure)
- */
-static void *MTestTypeIndexedInitRecv( MTestDatatype *mtype )
-{
- MPI_Aint totsize;
- int merr;
-
- if (mtype->count > 1) {
- MTestError( "This datatype is supported only for a single count" );
- }
- if (mtype->count == 1) {
- signed char *p;
- int i;
- merr = MPI_Type_extent( mtype->datatype, &totsize );
- if (merr) MTestPrintError( merr );
- if (!mtype->buf) {
- mtype->buf = (void *) malloc( totsize );
- }
- p = (signed char *)(mtype->buf);
- if (!p) {
- /* Error - out of memory */
- MTestError( "Out of memory in type buffer init\n" );
- }
- for (i=0; i<totsize; i++) {
- p[i] = 0xff;
- }
- }
- else {
- /* count == 0 */
- if (mtype->buf) {
- free( mtype->buf );
- }
- mtype->buf = 0;
- }
- return mtype->buf;
-}
-
-static void *MTestTypeIndexedFree( MTestDatatype *mtype )
-{
- if (mtype->buf) {
- free( mtype->buf );
- free( mtype->displs );
- free( mtype->index );
- mtype->buf = 0;
- mtype->displs = 0;
- mtype->index = 0;
- }
- return 0;
-}
-
-static int MTestTypeIndexedCheckbuf( MTestDatatype *mtype )
-{
- unsigned char *p;
- unsigned char expected;
- int i, err = 0, merr;
- MPI_Aint totsize;
-
- p = (unsigned char *)mtype->buf;
- if (p) {
- int j, k, offset;
- merr = MPI_Type_extent( mtype->datatype, &totsize );
- if (merr) MTestPrintError( merr );
-
- k = 0;
- for (i=0; i<mtype->nelm; i++) {
- int b;
- /* Compute the offset: */
- offset = mtype->displs[i] * mtype->basesize;
- for (b=0; b<mtype->index[i]; b++) {
- for (j=0; j<mtype->basesize; j++) {
- expected = (0xff ^ (k & 0xff));
- if (p[offset+j] != expected) {
- err++;
- if (mtype->printErrors && err < 10) {
- printf( "Data expected = %x but got p[%d,%d] = %x\n",
- expected, i,j, p[offset+j] );
- fflush( stdout );
- }
- }
- k++;
- }
- offset += mtype->basesize;
- }
- }
- }
- return err;
-}
-
-
-/* ------------------------------------------------------------------------ */
-/* Routines to select a datatype and associated buffer create/fill/check */
-/* routines */
-/* ------------------------------------------------------------------------ */
-
-/*
- Create a range of datatypes with a given count elements.
- This uses a selection of types, rather than an exhaustive collection.
- It allocates both send and receive types so that they can have the same
- type signature (collection of basic types) but different type maps (layouts
- in memory)
- */
-int MTestGetDatatypes( MTestDatatype *sendtype, MTestDatatype *recvtype,
- int count )
-{
- int merr;
- int i;
-
- sendtype->InitBuf = 0;
- sendtype->FreeBuf = 0;
- sendtype->CheckBuf = 0;
- sendtype->datatype = 0;
- sendtype->isBasic = 0;
- sendtype->printErrors = 0;
- recvtype->InitBuf = 0;
- recvtype->FreeBuf = 0;
-
- recvtype->CheckBuf = 0;
- recvtype->datatype = 0;
- recvtype->isBasic = 0;
- recvtype->printErrors = 0;
-
- sendtype->buf = 0;
- recvtype->buf = 0;
-
- /* Set the defaults for the message lengths */
- sendtype->count = count;
- recvtype->count = count;
- /* Use datatype_index to choose a datatype to use. If at the end of the
- list, return 0 */
- switch (datatype_index) {
- case 0:
- sendtype->datatype = MPI_INT;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_INT;
- recvtype->isBasic = 1;
- break;
- case 1:
- sendtype->datatype = MPI_DOUBLE;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_DOUBLE;
- recvtype->isBasic = 1;
- break;
- case 2:
- sendtype->datatype = MPI_FLOAT_INT;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_FLOAT_INT;
- recvtype->isBasic = 1;
- break;
- case 3:
- merr = MPI_Type_dup( MPI_INT, &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( sendtype->datatype,
- (char*)"dup of MPI_INT" );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_dup( MPI_INT, &recvtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( recvtype->datatype,
- (char*)"dup of MPI_INT" );
- if (merr) MTestPrintError( merr );
- /* dup'ed types are already committed if the original type
- was committed (MPI-2, section 8.8) */
- break;
- case 4:
- /* vector send type and contiguous receive type */
- /* These sizes are in bytes (see the VectorInit code) */
- sendtype->stride = 3 * sizeof(int);
- sendtype->blksize = sizeof(int);
- sendtype->nelm = recvtype->count;
-
- merr = MPI_Type_vector( recvtype->count, 1, 3, MPI_INT,
- &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_commit( &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( sendtype->datatype,
- (char*)"int-vector" );
- if (merr) MTestPrintError( merr );
- sendtype->count = 1;
- recvtype->datatype = MPI_INT;
- recvtype->isBasic = 1;
- sendtype->InitBuf = MTestTypeVectorInit;
- recvtype->InitBuf = MTestTypeContigInitRecv;
- sendtype->FreeBuf = MTestTypeVectorFree;
- recvtype->FreeBuf = MTestTypeContigFree;
- sendtype->CheckBuf = 0;
- recvtype->CheckBuf = MTestTypeContigCheckbuf;
- break;
-
- case 5:
- /* Indexed send using many small blocks and contig receive */
- sendtype->blksize = sizeof(int);
- sendtype->nelm = recvtype->count;
- sendtype->basesize = sizeof(int);
- sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
- sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
- if (!sendtype->displs || !sendtype->index) {
- MTestError( "Out of memory in type init\n" );
- }
- /* Make the sizes larger (4 ints) to help push the total
- size to over 256k in some cases, as the MPICH code as of
- 10/1/06 used large internal buffers for packing non-contiguous
- messages */
- for (i=0; i<sendtype->nelm; i++) {
- sendtype->index[i] = 4;
- sendtype->displs[i] = 5*i;
- }
- merr = MPI_Type_indexed( sendtype->nelm,
- sendtype->index, sendtype->displs,
- MPI_INT, &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_commit( &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( sendtype->datatype,
- (char*)"int-indexed(4-int)" );
- if (merr) MTestPrintError( merr );
- sendtype->count = 1;
- sendtype->InitBuf = MTestTypeIndexedInit;
- sendtype->FreeBuf = MTestTypeIndexedFree;
- sendtype->CheckBuf = 0;
-
- recvtype->datatype = MPI_INT;
- recvtype->isBasic = 1;
- recvtype->count = count * 4;
- recvtype->InitBuf = MTestTypeContigInitRecv;
- recvtype->FreeBuf = MTestTypeContigFree;
- recvtype->CheckBuf = MTestTypeContigCheckbuf;
- break;
-
- case 6:
- /* Indexed send using 2 large blocks and contig receive */
- sendtype->blksize = sizeof(int);
- sendtype->nelm = 2;
- sendtype->basesize = sizeof(int);
- sendtype->displs = (int *)malloc( sendtype->nelm * sizeof(int) );
- sendtype->index = (int *)malloc( sendtype->nelm * sizeof(int) );
- if (!sendtype->displs || !sendtype->index) {
- MTestError( "Out of memory in type init\n" );
- }
- /* index -> block size */
- sendtype->index[0] = (recvtype->count + 1) / 2;
- sendtype->displs[0] = 0;
- sendtype->index[1] = recvtype->count - sendtype->index[0];
- sendtype->displs[1] = sendtype->index[0] + 1;
- /* There is a deliberate gap here */
-
- merr = MPI_Type_indexed( sendtype->nelm,
- sendtype->index, sendtype->displs,
- MPI_INT, &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_commit( &sendtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( sendtype->datatype,
- (char*)"int-indexed(2 blocks)" );
- if (merr) MTestPrintError( merr );
- sendtype->count = 1;
- sendtype->InitBuf = MTestTypeIndexedInit;
- sendtype->FreeBuf = MTestTypeIndexedFree;
- sendtype->CheckBuf = 0;
-
- recvtype->datatype = MPI_INT;
- recvtype->isBasic = 1;
- recvtype->count = sendtype->index[0] + sendtype->index[1];
- recvtype->InitBuf = MTestTypeContigInitRecv;
- recvtype->FreeBuf = MTestTypeContigFree;
- recvtype->CheckBuf = MTestTypeContigCheckbuf;
- break;
-
- case 7:
- /* Indexed receive using many small blocks and contig send */
- recvtype->blksize = sizeof(int);
- recvtype->nelm = recvtype->count;
- recvtype->basesize = sizeof(int);
- recvtype->displs = (int *)malloc( recvtype->nelm * sizeof(int) );
- recvtype->index = (int *)malloc( recvtype->nelm * sizeof(int) );
- if (!recvtype->displs || !recvtype->index) {
- MTestError( "Out of memory in type recv init\n" );
- }
- /* Make the sizes larger (4 ints) to help push the total
- size to over 256k in some cases, as the MPICH code as of
- 10/1/06 used large internal buffers for packing non-contiguous
- messages */
- /* Note that there are gaps in the indexed type */
- for (i=0; i<recvtype->nelm; i++) {
- recvtype->index[i] = 4;
- recvtype->displs[i] = 5*i;
- }
- merr = MPI_Type_indexed( recvtype->nelm,
- recvtype->index, recvtype->displs,
- MPI_INT, &recvtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_commit( &recvtype->datatype );
- if (merr) MTestPrintError( merr );
- merr = MPI_Type_set_name( recvtype->datatype,
- (char*)"recv-int-indexed(4-int)" );
- if (merr) MTestPrintError( merr );
- recvtype->count = 1;
- recvtype->InitBuf = MTestTypeIndexedInitRecv;
- recvtype->FreeBuf = MTestTypeIndexedFree;
- recvtype->CheckBuf = MTestTypeIndexedCheckbuf;
-
- sendtype->datatype = MPI_INT;
- sendtype->isBasic = 1;
- sendtype->count = count * 4;
- sendtype->InitBuf = MTestTypeContigInit;
- sendtype->FreeBuf = MTestTypeContigFree;
- sendtype->CheckBuf = 0;
- break;
-
- /* Less commonly used but still simple types */
- case 8:
- sendtype->datatype = MPI_SHORT;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_SHORT;
- recvtype->isBasic = 1;
- break;
- case 9:
- sendtype->datatype = MPI_LONG;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_LONG;
- recvtype->isBasic = 1;
- break;
- case 10:
- sendtype->datatype = MPI_CHAR;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_CHAR;
- recvtype->isBasic = 1;
- break;
- case 11:
- sendtype->datatype = MPI_UINT64_T;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_UINT64_T;
- recvtype->isBasic = 1;
- break;
- case 12:
- sendtype->datatype = MPI_FLOAT;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_FLOAT;
- recvtype->isBasic = 1;
- break;
-
-#ifndef USE_STRICT_MPI
- /* MPI_BYTE may only be used with MPI_BYTE in strict MPI */
- case 13:
- sendtype->datatype = MPI_INT;
- sendtype->isBasic = 1;
- recvtype->datatype = MPI_BYTE;
- recvtype->isBasic = 1;
- recvtype->count *= sizeof(int);
- break;
-#endif
- default:
- datatype_index = -1;
- }
-
- if (!sendtype->InitBuf) {
- sendtype->InitBuf = MTestTypeContigInit;
- recvtype->InitBuf = MTestTypeContigInitRecv;
- sendtype->FreeBuf = MTestTypeContigFree;
- recvtype->FreeBuf = MTestTypeContigFree;
- sendtype->CheckBuf = MTestTypeContigCheckbuf;
- recvtype->CheckBuf = MTestTypeContigCheckbuf;
- }
- datatype_index++;
-
- if (dbgflag && datatype_index > 0) {
- int typesize;
- fprintf( stderr, "%d: sendtype is %s\n", wrank, MTestGetDatatypeName( sendtype ) );
- merr = MPI_Type_size( sendtype->datatype, &typesize );
- if (merr) MTestPrintError( merr );
- fprintf( stderr, "%d: sendtype size = %d\n", wrank, typesize );
- fprintf( stderr, "%d: recvtype is %s\n", wrank, MTestGetDatatypeName( recvtype ) );
- merr = MPI_Type_size( recvtype->datatype, &typesize );
- if (merr) MTestPrintError( merr );
- fprintf( stderr, "%d: recvtype size = %d\n", wrank, typesize );
- fflush( stderr );
-
- }
- else if (verbose && datatype_index > 0) {
- printf( "Get new datatypes: send = %s, recv = %s\n",
- MTestGetDatatypeName( sendtype ),
- MTestGetDatatypeName( recvtype ) );
- fflush( stdout );
- }
-
- return datatype_index;
-}
-
-/* Reset the datatype index (start from the initial data type.
- Note: This routine is rarely needed; MTestGetDatatypes automatically
- starts over after the last available datatype is used.
-*/
-void MTestResetDatatypes( void )
-{
- datatype_index = 0;
-}
-/* Return the index of the current datatype. This is rarely needed and
- is provided mostly to enable debugging of the MTest package itself */
-int MTestGetDatatypeIndex( void )
-{
- return datatype_index;
-}
-
-/* Free the storage associated with a datatype */
-void MTestFreeDatatype( MTestDatatype *mtype )
-{
- int merr;
- /* Invoke a datatype-specific free function to handle
- both the datatype and the send/receive buffers */
- if (mtype->FreeBuf) {
- (mtype->FreeBuf)( mtype );
- }
- /* Free the datatype itself if it was created */
- if (!mtype->isBasic) {
- merr = MPI_Type_free( &mtype->datatype );
- if (merr) MTestPrintError( merr );
- }
-}
-
-/* Check that a message was received correctly. Returns the number of
- errors detected. Status may be NULL or MPI_STATUS_IGNORE */
-int MTestCheckRecv( MPI_Status *status, MTestDatatype *recvtype )
-{
- int count;
- int errs = 0, merr;
-
- if (status && status != MPI_STATUS_IGNORE) {
- merr = MPI_Get_count( status, recvtype->datatype, &count );
- if (merr) MTestPrintError( merr );
-
- /* Check count against expected count */
- if (count != recvtype->count) {
- errs ++;
- }
- }
-
- /* Check received data */
- if (!errs && recvtype->CheckBuf( recvtype )) {
- errs++;
- }
- return errs;
-}
-
-/* This next routine uses a circular buffer of static name arrays just to
- simplify the use of the routine */
-const char *MTestGetDatatypeName( MTestDatatype *dtype )
-{
- static char name[4][MPI_MAX_OBJECT_NAME];
- static int sp=0;
- int rlen, merr;
-
- if (sp >= 4) sp = 0;
- merr = MPI_Type_get_name( dtype->datatype, name[sp], &rlen );
- if (merr) MTestPrintError( merr );
- return (const char *)name[sp++];
-}