PetscErrorCode MPIPetsc_Type_compare(MPI_Datatype a,MPI_Datatype b,PetscBool *match)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscMPIInt bintcount,baddrcount,btypecount,bcombiner;
PetscBool freeatype, freebtype;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype,&freeatype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype,&freebtype);CHKERRQ(ierr);
*match = PETSC_FALSE;
if (atype == btype) {
*match = PETSC_TRUE;
goto free_types;
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
ierr = MPI_Type_get_envelope(btype,&bintcount,&baddrcount,&btypecount,&bcombiner);CHKERRQ(ierr);
if (acombiner == bcombiner && aintcount == bintcount && aaddrcount == baddrcount && atypecount == btypecount && (aintcount > 0 || aaddrcount > 0 || atypecount > 0)) {
PetscMPIInt *aints,*bints;
MPI_Aint *aaddrs,*baddrs;
MPI_Datatype *atypes,*btypes;
PetscInt i;
PetscBool same;
ierr = PetscMalloc6(aintcount,&aints,bintcount,&bints,aaddrcount,&aaddrs,baddrcount,&baddrs,atypecount,&atypes,btypecount,&btypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(btype,bintcount,baddrcount,btypecount,bints,baddrs,btypes);CHKERRQ(ierr);
ierr = PetscMemcmp(aints,bints,aintcount*sizeof(aints[0]),&same);CHKERRQ(ierr);
if (same) {
ierr = PetscMemcmp(aaddrs,baddrs,aaddrcount*sizeof(aaddrs[0]),&same);CHKERRQ(ierr);
if (same) {
/* Check for identity first */
ierr = PetscMemcmp(atypes,btypes,atypecount*sizeof(atypes[0]),&same);CHKERRQ(ierr);
if (!same) {
/* If the atype or btype were not predefined data types, then the types returned from MPI_Type_get_contents
* will merely be equivalent to the types used in the construction, so we must recursively compare. */
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_compare(atypes[i],btypes[i],&same);CHKERRQ(ierr);
if (!same) break;
}
}
}
}
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_free(&(atypes[i]));CHKERRQ(ierr);
ierr = MPIPetsc_Type_free(&(btypes[i]));CHKERRQ(ierr);
}
ierr = PetscFree6(aints,bints,aaddrs,baddrs,atypes,btypes);CHKERRQ(ierr);
if (same) *match = PETSC_TRUE;
}
free_types:
if (freeatype) {
ierr = MPIPetsc_Type_free(&atype);CHKERRQ(ierr);
}
if (freebtype) {
ierr = MPIPetsc_Type_free(&btype);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode MPIPetsc_Type_compare(MPI_Datatype a,MPI_Datatype b,PetscBool *match)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscMPIInt bintcount,baddrcount,btypecount,bcombiner;
PetscBool freeatype, freebtype;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype,&freeatype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype,&freebtype);CHKERRQ(ierr);
*match = PETSC_FALSE;
if (atype == btype) {
*match = PETSC_TRUE;
goto free_types;
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
ierr = MPI_Type_get_envelope(btype,&bintcount,&baddrcount,&btypecount,&bcombiner);CHKERRQ(ierr);
if (acombiner == bcombiner && aintcount == bintcount && aaddrcount == baddrcount && atypecount == btypecount && (aintcount > 0 || aaddrcount > 0 || atypecount > 0)) {
PetscMPIInt *aints,*bints;
MPI_Aint *aaddrs,*baddrs;
MPI_Datatype *atypes,*btypes;
PetscInt i;
PetscBool same;
ierr = PetscMalloc6(aintcount,&aints,bintcount,&bints,aaddrcount,&aaddrs,baddrcount,&baddrs,atypecount,&atypes,btypecount,&btypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(btype,bintcount,baddrcount,btypecount,bints,baddrs,btypes);CHKERRQ(ierr);
ierr = PetscMemcmp(aints,bints,aintcount*sizeof(aints[0]),&same);CHKERRQ(ierr);
if (same) {
ierr = PetscMemcmp(aaddrs,baddrs,aaddrcount*sizeof(aaddrs[0]),&same);CHKERRQ(ierr);
if (same) {
/* This comparison should be recursive */
ierr = PetscMemcmp(atypes,btypes,atypecount*sizeof(atypes[0]),&same);CHKERRQ(ierr);
}
}
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_free(&(atypes[i]));CHKERRQ(ierr);
ierr = MPIPetsc_Type_free(&(btypes[i]));CHKERRQ(ierr);
}
ierr = PetscFree6(aints,bints,aaddrs,baddrs,atypes,btypes);CHKERRQ(ierr);
if (same) *match = PETSC_TRUE;
}
free_types:
if (freeatype) {
ierr = MPIPetsc_Type_free(&atype);CHKERRQ(ierr);
}
if (freebtype) {
ierr = MPIPetsc_Type_free(&btype);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
static void unpack_envelope(MPI_Datatype type, flat_repr& f) {
int num_ints, num_addr, num_dt, comb;
MPI_Type_get_envelope(type, &num_ints, &num_addr, &num_dt, &comb);
if (comb == MPI_COMBINER_NAMED) {
//std::cout << "Type: " << builtin_typename_map::get_typeid_name(type) << std::endl;
f.m.emplace(f.cur_offset, type);
return;
}
// allocate the output for get_contents
std::vector<int> ints; ints.resize(num_ints);
std::vector<MPI_Aint> addrs; addrs.resize(num_addr);
std::vector<MPI_Datatype> types; types.resize(num_dt);
MPI_Type_get_contents(type, num_ints, num_addr, num_dt,
&ints[0], &addrs[0], &types[0]);
switch(comb) {
case MPI_COMBINER_DUP:
MXX_ASSERT(num_ints == 0 && num_addr == 0 && num_dt == 1);
unpack_envelope(types[0], f);
break;
case MPI_COMBINER_CONTIGUOUS:
std::cout << "Contiguous: " << ints[0] << " x ";
unpack_envelope(types[0], f);
break;
case MPI_COMBINER_VECTOR:
case MPI_COMBINER_HVECTOR:
case MPI_COMBINER_INDEXED:
case MPI_COMBINER_HINDEXED:
case MPI_COMBINER_INDEXED_BLOCK:
case MPI_COMBINER_HINDEXED_BLOCK:
std::cout << "NOT YET SUPPORTED vector/indexed/indexed_block" << std::endl;
break;
case MPI_COMBINER_STRUCT:
{
int count = ints[0];
std::vector<int> blen(&ints[1], &ints[0]+count);
std::vector<MPI_Aint> displ = addrs;
std::cout << "Struct: " << std::endl;
MPI_Aint offset = f.cur_offset;
for (int i = 0; i < count; ++i) {
f.cur_offset = offset + displ[i];
unpack_envelope(types[i], f);
}
f.cur_offset = offset;
}
break;
case MPI_COMBINER_RESIZED:
// TODO
std::cout << "resized to [" << addrs[0] << "," << addrs[1] << "): " << std::endl;
unpack_envelope(types[0], f);
break;
case MPI_COMBINER_SUBARRAY:
case MPI_COMBINER_DARRAY:
std::cout << "NOT YET SUPPORTED subarray/darray" << std::endl;
break;
}
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
PetscFunctionReturn(0);
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
if (atypes[0] == btype) *n = aints[0];
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscFunctionReturn(0);
}
PetscErrorCode MPIPetsc_Type_unwrap(MPI_Datatype a,MPI_Datatype *atype,PetscBool *flg)
{
PetscMPIInt nints,naddrs,ntypes,combiner;
PetscErrorCode ierr;
PetscFunctionBegin;
*flg = PETSC_FALSE;
ierr = MPI_Type_get_envelope(a,&nints,&naddrs,&ntypes,&combiner);CHKERRQ(ierr);
if (combiner == MPI_COMBINER_DUP) {
PetscMPIInt ints[1];
MPI_Aint addrs[1];
MPI_Datatype types[1];
if (nints != 0 || naddrs != 0 || ntypes != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Unexpected returns from MPI_Type_get_envelope()");
ierr = MPI_Type_get_contents(a,0,0,1,ints,addrs,types);CHKERRQ(ierr);
/* Recursively unwrap dupped types. */
ierr = MPIPetsc_Type_unwrap(types[0],atype,flg);CHKERRQ(ierr);
if (*flg) {
/* If the recursive call returns a new type, then that means that atype[0] != types[0] and we're on the hook to
* free types[0]. Note that this case occurs if combiner(types[0]) is MPI_COMBINER_DUP, so we're safe to
* directly call MPI_Type_free rather than MPIPetsc_Type_free here. */
ierr = MPI_Type_free(&(types[0]));CHKERRQ(ierr);
}
/* In any case, it's up to the caller to free the returned type in this case. */
*flg = PETSC_TRUE;
} else *atype = a;
PetscFunctionReturn(0);
}
PetscErrorCode MPIPetsc_Type_unwrap(MPI_Datatype a,MPI_Datatype *atype)
{
PetscMPIInt nints,naddrs,ntypes,combiner;
PetscErrorCode ierr;
PetscFunctionBegin;
ierr = MPI_Type_get_envelope(a,&nints,&naddrs,&ntypes,&combiner);CHKERRQ(ierr);
if (combiner == MPI_COMBINER_DUP) {
PetscMPIInt ints[1];
MPI_Aint addrs[1];
MPI_Datatype types[1];
if (nints != 0 || naddrs != 0 || ntypes != 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Unexpected returns from MPI_Type_get_envelope()");
ierr = MPI_Type_get_contents(a,0,0,1,ints,addrs,types);CHKERRQ(ierr);
*atype = types[0];
} else *atype = a;
PetscFunctionReturn(0);
}
/* Check whether a was created via MPI_Type_contiguous from b
*
*/
PetscErrorCode MPIPetsc_Type_compare_contig(MPI_Datatype a,MPI_Datatype b,PetscInt *n)
{
PetscErrorCode ierr;
MPI_Datatype atype,btype;
PetscMPIInt aintcount,aaddrcount,atypecount,acombiner;
PetscBool freeatype,freebtype;
PetscFunctionBegin;
ierr = MPIPetsc_Type_unwrap(a,&atype,&freeatype);CHKERRQ(ierr);
ierr = MPIPetsc_Type_unwrap(b,&btype,&freebtype);CHKERRQ(ierr);
*n = PETSC_FALSE;
if (atype == btype) {
*n = 1;
goto free_types;
}
ierr = MPI_Type_get_envelope(atype,&aintcount,&aaddrcount,&atypecount,&acombiner);CHKERRQ(ierr);
if (acombiner == MPI_COMBINER_CONTIGUOUS && aintcount >= 1) {
PetscMPIInt *aints;
MPI_Aint *aaddrs;
MPI_Datatype *atypes;
PetscInt i;
PetscBool same;
ierr = PetscMalloc3(aintcount,&aints,aaddrcount,&aaddrs,atypecount,&atypes);CHKERRQ(ierr);
ierr = MPI_Type_get_contents(atype,aintcount,aaddrcount,atypecount,aints,aaddrs,atypes);CHKERRQ(ierr);
/* Check for identity first. */
if (atypes[0] == btype) {
*n = aints[0];
} else {
/* atypes[0] merely has to be equivalent to the type used to create atype. */
ierr = MPIPetsc_Type_compare(atypes[0],btype,&same);CHKERRQ(ierr);
if (same) *n = aints[0];
}
for (i=0; i<atypecount; i++) {
ierr = MPIPetsc_Type_free(&(atypes[i]));CHKERRQ(ierr);
}
ierr = PetscFree3(aints,aaddrs,atypes);CHKERRQ(ierr);
}
free_types:
if (freeatype) {
ierr = MPIPetsc_Type_free(&atype);CHKERRQ(ierr);
}
if (freebtype) {
ierr = MPIPetsc_Type_free(&btype);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void ADIOI_Datatype_iscontig(MPI_Datatype datatype, int *flag)
{
int nints, nadds, ntypes, combiner;
int *ints, ni, na, nt, cb;
MPI_Aint *adds;
MPI_Datatype *types;
MPI_Type_get_envelope(datatype, &nints, &nadds, &ntypes, &combiner);
switch (combiner) {
case MPI_COMBINER_NAMED:
*flag = 1;
break;
case MPI_COMBINER_CONTIGUOUS:
ints = (int *) ADIOI_Malloc((nints+1)*sizeof(int));
adds = (MPI_Aint *) ADIOI_Malloc((nadds+1)*sizeof(MPI_Aint));
types = (MPI_Datatype *) ADIOI_Malloc((ntypes+1)*sizeof(MPI_Datatype));
MPI_Type_get_contents(datatype, nints, nadds, ntypes, ints,
adds, types);
ADIOI_Datatype_iscontig(types[0], flag);
#ifndef MPISGI
/* There is a bug in SGI's impl. of MPI_Type_get_contents. It doesn't
return new datatypes. Therefore no need to free. */
MPI_Type_get_envelope(types[0], &ni, &na, &nt, &cb);
if (cb != MPI_COMBINER_NAMED) MPI_Type_free(types);
#endif
ADIOI_Free(ints);
ADIOI_Free(adds);
ADIOI_Free(types);
break;
default:
*flag = 0;
break;
}
/* This function needs more work. It should check for contiguity
in other cases as well.*/
}
/* Definitions of Fortran Wrapper routines */
EXPORT_MPI_API void FORTRAN_API mpi_type_get_contents_(MPI_Fint *datatype, MPI_Fint *max_integers, MPI_Fint *max_addresses, MPI_Fint *max_datatypes,
MPI_Fint *array_of_integers, MPI_Fint *array_of_addresses, MPI_Fint *array_of_datatypes, MPI_Fint *__ierr )
{
int i;
int *l_array_of_integers;
MPI_Aint *l_array_of_addresses;
MPI_Datatype *l_array_of_datatypes;
MPIR_FALLOC(l_array_of_integers, (int*)MALLOC(sizeof(int)* (int)*
max_integers), MPIR_COMM_WORLD, MPI_ERR_EXHAUSTED,
"MPI_TYPE_GET_CONTENTS");
MPIR_FALLOC(l_array_of_addresses, (MPI_Aint *)MALLOC(sizeof(MPI_Aint) *
(int)*max_addresses), MPIR_COMM_WORLD, MPI_ERR_EXHAUSTED,
"MPI_TYPE_GET_CONTENTS");
MPIR_FALLOC(l_array_of_datatypes, (MPI_Datatype *)MALLOC(sizeof
(MPI_Datatype) * (int)*max_datatypes), MPIR_COMM_WORLD,
MPI_ERR_EXHAUSTED, "MPI_TYPE_GET_CONTENTS");
*__ierr = MPI_Type_get_contents( MPI_Type_f2c(*datatype),
(int)*max_integers,
(int)*max_addresses,
(int)*max_datatypes,
l_array_of_integers,
l_array_of_addresses,
l_array_of_datatypes );
for (i=0; i<(int)*max_integers; i++)
array_of_integers[i] = (MPI_Fint)l_array_of_integers[i];
for (i=0; i<(int)*max_addresses; i++)
array_of_addresses[i] = (MPI_Aint)l_array_of_addresses[i];
for (i=0; i<(int)*max_datatypes; i++)
array_of_datatypes[i] = MPI_Type_c2f(l_array_of_datatypes[i]);
FREE( l_array_of_integers );
FREE( l_array_of_addresses );
FREE( l_array_of_datatypes );
}
/* indexed_of_vectors_test()
*
* Builds an indexed type of vectors of ints.
*
* MPICH1 fails this test because it converts the vectors into hvectors.
*
* Returns the number of errors encountered.
*/
int indexed_of_vectors_test(void)
{
MPI_Datatype inner_vector, inner_vector_copy;
MPI_Datatype outer_indexed;
int i_count = 3, i_blocklengths[3] = { 3, 2, 1 };
int i_displacements[3] = { 10, 20, 30 };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(2,
1,
2,
MPI_INT,
&inner_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
err = MPI_Type_indexed(i_count,
i_blocklengths,
i_displacements,
inner_vector,
&outer_indexed);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
/* decode outer vector (get envelope, then contents) */
err = MPI_Type_get_envelope(outer_indexed,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 7) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_INDEXED) errs++;
if (verbose) {
if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_INDEXED)
fprintf(stderr, "combiner = %s; should be indexed\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
/* get contents of outer vector */
err = MPI_Type_get_contents(outer_indexed,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != i_count) errs++;
if (ints[1] != i_blocklengths[0]) errs++;
if (ints[2] != i_blocklengths[1]) errs++;
if (ints[3] != i_blocklengths[2]) errs++;
if (ints[4] != i_displacements[0]) errs++;
if (ints[5] != i_displacements[1]) errs++;
if (ints[6] != i_displacements[2]) errs++;
if (verbose) {
if (ints[0] != i_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], i_count);
if (ints[1] != i_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], i_blocklengths[0]);
if (ints[2] != i_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], i_blocklengths[1]);
if (ints[3] != i_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], i_blocklengths[2]);
if (ints[4] != i_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], i_displacements[0]);
if (ints[5] != i_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], i_displacements[1]);
if (ints[6] != i_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], i_displacements[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
inner_vector_copy = types[0];
free(ints);
if (nadds) free(adds);
free(types);
/* decode inner vector */
err = MPI_Type_get_envelope(inner_vector_copy,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"inner vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"inner vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"inner vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "inner vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
err = MPI_Type_get_contents(inner_vector_copy,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"inner vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"inner vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr,
"inner vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &inner_vector_copy );
MPI_Type_free( &inner_vector );
MPI_Type_free( &outer_indexed );
return 0;
}
/* ADIOI_Flatten()
*
* Assumption: input datatype is not a basic!!!!
*/
void ADIOI_Flatten(MPI_Datatype datatype, ADIOI_Flatlist_node *flat,
ADIO_Offset st_offset, MPI_Count *curr_index)
{
int i, k, m, n, basic_num, nonzeroth, is_hindexed_block=0;
int combiner, old_combiner, old_is_contig;
int nints, nadds, ntypes, old_nints, old_nadds, old_ntypes;
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset top_count;
MPI_Count j, old_size, prev_index, num;
MPI_Aint old_extent;/* Assume extents are non-negative */
int *ints;
MPI_Aint *adds; /* Make no assumptions about +/- sign on these */
MPI_Datatype *types;
MPI_Type_get_envelope(datatype, &nints, &nadds, &ntypes, &combiner);
ints = (int *) ADIOI_Malloc((nints+1)*sizeof(int));
adds = (MPI_Aint *) ADIOI_Malloc((nadds+1)*sizeof(MPI_Aint));
types = (MPI_Datatype *) ADIOI_Malloc((ntypes+1)*sizeof(MPI_Datatype));
MPI_Type_get_contents(datatype, nints, nadds, ntypes, ints, adds, types);
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: st_offset %#llX, curr_index %#llX\n",st_offset,*curr_index);
DBG_FPRINTF(stderr,"ADIOI_Flatten:: nints %#X, nadds %#X, ntypes %#X\n",nints, nadds, ntypes);
for(i=0; i< nints; ++i)
{
DBG_FPRINTF(stderr,"ADIOI_Flatten:: ints[%d]=%#X\n",i,ints[i]);
}
for(i=0; i< nadds; ++i)
{
DBG_FPRINTF(stderr,"ADIOI_Flatten:: adds[%d]="MPI_AINT_FMT_HEX_SPEC"\n",i,adds[i]);
}
for(i=0; i< ntypes; ++i)
{
DBG_FPRINTF(stderr,"ADIOI_Flatten:: types[%d]=%#llX\n",i,(unsigned long long)(unsigned long)types[i]);
}
#endif
/* Chapter 4, page 83: when processing datatypes, note this item from the
* standard:
Most datatype constructors have replication count or block length
arguments. Allowed values are non-negative integers. If the value is
zero, no elements are generated in the type map and there is no effect
on datatype bounds or extent. */
switch (combiner) {
#ifdef MPIIMPL_HAVE_MPI_COMBINER_DUP
case MPI_COMBINER_DUP:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_DUP\n");
#endif
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
ADIOI_Flatten(types[0], flat, st_offset, curr_index);
break;
#endif
#ifdef MPIIMPL_HAVE_MPI_COMBINER_SUBARRAY
case MPI_COMBINER_SUBARRAY:
{
int dims = ints[0];
MPI_Datatype stype;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_SUBARRAY\n");
#endif
ADIO_Type_create_subarray(dims,
&ints[1], /* sizes */
&ints[dims+1], /* subsizes */
&ints[2*dims+1], /* starts */
ints[3*dims+1], /* order */
types[0], /* type */
&stype);
ADIOI_Flatten(stype, flat, st_offset, curr_index);
MPI_Type_free(&stype);
}
break;
#endif
#ifdef MPIIMPL_HAVE_MPI_COMBINER_DARRAY
case MPI_COMBINER_DARRAY:
{
int dims = ints[2];
MPI_Datatype dtype;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_DARRAY\n");
#endif
ADIO_Type_create_darray(ints[0], /* size */
ints[1], /* rank */
dims,
&ints[3], /* gsizes */
&ints[dims+3], /* distribs */
&ints[2*dims+3], /* dargs */
&ints[3*dims+3], /* psizes */
ints[4*dims+3], /* order */
types[0],
&dtype);
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_DARRAY <ADIOI_Flatten(dtype, flat->indices[%#X] %#llX, flat->blocklens[%#X] %#llX, st_offset %#llX, curr_index %#llX);\n",
0, flat->indices[0], 0, flat->blocklens[0], st_offset, *curr_index);
#endif
ADIOI_Flatten(dtype, flat, st_offset, curr_index);
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_DARRAY >ADIOI_Flatten(dtype, flat->indices[%#X] %#llX, flat->blocklens[%#X] %#llX, st_offset %#llX, curr_index %#llX);\n",
0, flat->indices[0], 0, flat->blocklens[0], st_offset, *curr_index);
#endif
MPI_Type_free(&dtype);
}
break;
#endif
case MPI_COMBINER_CONTIGUOUS:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_CONTIGUOUS\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
ADIOI_Flatten(types[0], flat, st_offset, curr_index);
if (prev_index == *curr_index) {
/* simplest case, made up of basic or contiguous types */
j = *curr_index;
flat->indices[j] = st_offset;
MPI_Type_size_x(types[0], &old_size);
flat->blocklens[j] = top_count * old_size;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",j, flat->indices[j], j, flat->blocklens[j]);
#endif
(*curr_index)++;
}
else {
/* made up of noncontiguous derived types */
j = *curr_index;
num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated count times */
MPI_Type_extent(types[0], &old_extent);
for (m=1; m<top_count; m++) {
for (i=0; i<num; i++) {
flat->indices[j] = flat->indices[j-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: derived flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",j, flat->indices[j], j, flat->blocklens[j]);
#endif
j++;
}
}
*curr_index = j;
}
break;
case MPI_COMBINER_VECTOR:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_VECTOR\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
ADIOI_Flatten(types[0], flat, st_offset, curr_index);
if (prev_index == *curr_index) {
/* simplest case, vector of basic or contiguous types */
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1], stride = ints[2];
j = *curr_index;
flat->indices[j] = st_offset;
MPI_Type_size_x(types[0], &old_size);
flat->blocklens[j] = blocklength * old_size;
for (i=j+1; i<j+top_count; i++) {
flat->indices[i] = flat->indices[i-1] + stride * old_size;
flat->blocklens[i] = flat->blocklens[j];
}
*curr_index = i;
}
else {
/* vector of noncontiguous derived types */
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1], stride = ints[2];
j = *curr_index;
num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklen times
and then strided. Replicate the first one. */
MPI_Type_extent(types[0], &old_extent);
for (m=1; m<blocklength; m++) {
for (i=0; i<num; i++) {
flat->indices[j] = flat->indices[j-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
/* Now repeat with strides. */
num = *curr_index - prev_index;
for (i=1; i<top_count; i++) {
for (m=0; m<num; m++) {
flat->indices[j] = flat->indices[j-num] + stride * ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
}
break;
case MPI_COMBINER_HVECTOR:
case MPI_COMBINER_HVECTOR_INTEGER:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_HVECTOR_INTEGER\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
ADIOI_Flatten(types[0], flat, st_offset, curr_index);
if (prev_index == *curr_index) {
/* simplest case, vector of basic or contiguous types */
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1];
j = *curr_index;
flat->indices[j] = st_offset;
MPI_Type_size_x(types[0], &old_size);
flat->blocklens[j] = blocklength * old_size;
for (i=j+1; i<j+top_count; i++) {
flat->indices[i] = flat->indices[i-1] + adds[0];
flat->blocklens[i] = flat->blocklens[j];
}
*curr_index = i;
}
else {
/* vector of noncontiguous derived types */
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1];
j = *curr_index;
num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklen times
and then strided. Replicate the first one. */
MPI_Type_extent(types[0], &old_extent);
for (m=1; m<blocklength; m++) {
for (i=0; i<num; i++) {
flat->indices[j] = flat->indices[j-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
/* Now repeat with strides. */
num = *curr_index - prev_index;
for (i=1; i<top_count; i++) {
for (m=0; m<num; m++) {
flat->indices[j] = flat->indices[j-num] + adds[0];
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
}
break;
case MPI_COMBINER_INDEXED:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_INDEXED\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
MPI_Type_extent(types[0], &old_extent);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
{
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset stride = ints[top_count+1];
ADIOI_Flatten(types[0], flat,
st_offset+stride* ADIOI_AINT_CAST_TO_OFFSET old_extent, curr_index);
}
if (prev_index == *curr_index) {
/* simplest case, indexed type made up of basic or contiguous types */
j = *curr_index;
for (i=j, nonzeroth=i; i<j+top_count; i++) {
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1+i-j], stride = ints[top_count+1+i-j];
if (blocklength > 0) {
flat->indices[nonzeroth] =
st_offset + stride* ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] =
blocklength* ADIOI_AINT_CAST_TO_OFFSET old_extent;
nonzeroth++;
} else {
flat->count--; /* don't count/consider any zero-length blocklens */
}
}
*curr_index = i;
}
else {
/* indexed type made up of noncontiguous derived types */
j = *curr_index;
num = *curr_index - prev_index;
basic_num = num;
/* The noncontiguous types have to be replicated blocklens[i] times
and then strided. Replicate the first one. */
for (m=1; m<ints[1]; m++) {
for (i=0, nonzeroth = j; i<num; i++) {
if (flat->blocklens[j-num] > 0) {
flat->indices[nonzeroth] =
flat->indices[nonzeroth-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] =
flat->blocklens[nonzeroth-num];
j++;
nonzeroth++;
} else {
flat->count --;
}
}
}
*curr_index = j;
/* Now repeat with strides. */
for (i=1; i<top_count; i++) {
num = *curr_index - prev_index;
prev_index = *curr_index;
for (m=0, nonzeroth=j; m<basic_num; m++) {
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset stride = ints[top_count+1+i]-ints[top_count+i];
if (flat->blocklens[j-num] > 0 ) {
flat->indices[nonzeroth] =
flat->indices[j-num] + stride* ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] = flat->blocklens[j-num];
j++;
nonzeroth++;
} else {
flat->count--;
}
}
*curr_index = j;
for (m=1; m<ints[1+i]; m++) {
for (k=0, nonzeroth=j; k<basic_num; k++) {
if (flat->blocklens[j-basic_num] > 0) {
flat->indices[nonzeroth] =
flat->indices[j-basic_num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] = flat->blocklens[j-basic_num];
j++;
nonzeroth++;
} else {
flat->count --;
}
}
}
*curr_index = j;
}
}
break;
#if defined HAVE_DECL_MPI_COMBINER_HINDEXED_BLOCK && HAVE_DECL_MPI_COMBINER_HINDEXED_BLOCK
case MPI_COMBINER_HINDEXED_BLOCK:
is_hindexed_block=1;
/* deliberate fall-through */
#endif
case MPI_COMBINER_INDEXED_BLOCK:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_INDEXED_BLOCK\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
MPI_Type_extent(types[0], &old_extent);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
{
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset stride = ints[1+1];
if (is_hindexed_block) {
ADIOI_Flatten(types[0], flat,
st_offset+adds[0], curr_index);
} else {
ADIOI_Flatten(types[0], flat,
st_offset+stride* ADIOI_AINT_CAST_TO_OFFSET old_extent, curr_index);
}
}
if (prev_index == *curr_index) {
/* simplest case, indexed type made up of basic or contiguous types */
j = *curr_index;
for (i=j; i<j+top_count; i++) {
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1];
if (is_hindexed_block) {
flat->indices[i] = st_offset + adds[i-j];
} else {
ADIO_Offset stride = ints[1+1+i-j];
flat->indices[i] = st_offset +
stride* ADIOI_AINT_CAST_TO_OFFSET old_extent;
}
flat->blocklens[i] = blocklength* ADIOI_AINT_CAST_TO_OFFSET old_extent;
}
*curr_index = i;
}
else {
/* vector of noncontiguous derived types */
j = *curr_index;
num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklens[i] times
and then strided. Replicate the first one. */
for (m=1; m<ints[1]; m++) {
for (i=0; i<num; i++) {
if (is_hindexed_block) {
/* this is the one place the hindexed case uses the
* extent of a type */
MPI_Type_extent(types[0], &old_extent);
}
flat->indices[j] = flat->indices[j-num] +
ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
/* Now repeat with strides. */
num = *curr_index - prev_index;
for (i=1; i<top_count; i++) {
for (m=0; m<num; m++) {
if (is_hindexed_block) {
flat->indices[j] = flat->indices[j-num] +
adds[i] - adds[i-1];
} else {
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset stride = ints[2+i]-ints[1+i];
flat->indices[j] = flat->indices[j-num] +
stride* ADIOI_AINT_CAST_TO_OFFSET old_extent;
}
flat->blocklens[j] = flat->blocklens[j-num];
j++;
}
}
*curr_index = j;
}
break;
case MPI_COMBINER_HINDEXED:
case MPI_COMBINER_HINDEXED_INTEGER:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_HINDEXED_INTEGER\n");
#endif
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
{
ADIOI_Flatten(types[0], flat, st_offset+adds[0], curr_index);
}
if (prev_index == *curr_index) {
/* simplest case, indexed type made up of basic or contiguous types */
j = *curr_index;
MPI_Type_size_x(types[0], &old_size);
for (i=j, nonzeroth=j; i<j+top_count; i++) {
if (ints[1+i-j] > 0) {
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
ADIO_Offset blocklength = ints[1+i-j];
flat->indices[nonzeroth] = st_offset + adds[i-j];
flat->blocklens[nonzeroth] = blocklength*old_size;
nonzeroth++;
} else {
flat->count--;
}
}
*curr_index = i;
}
else {
/* indexed type made up of noncontiguous derived types */
j = *curr_index;
num = *curr_index - prev_index;
basic_num = num;
/* The noncontiguous types have to be replicated blocklens[i] times
and then strided. Replicate the first one. */
MPI_Type_extent(types[0], &old_extent);
for (m=1; m<ints[1]; m++) {
for (i=0, nonzeroth=j; i<num; i++) {
if (flat->blocklens[j-num] > 0) {
flat->indices[nonzeroth] =
flat->indices[j-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] = flat->blocklens[j-num];
j++;
nonzeroth++;
} else {
flat->count--;
}
}
}
*curr_index = j;
/* Now repeat with strides. */
for (i=1; i<top_count; i++) {
num = *curr_index - prev_index;
prev_index = *curr_index;
for (m=0, nonzeroth=j; m<basic_num; m++) {
if (flat->blocklens[j-num] > 0) {
flat->indices[nonzeroth] =
flat->indices[j-num] + adds[i] - adds[i-1];
flat->blocklens[nonzeroth] = flat->blocklens[j-num];
j++;
nonzeroth++;
} else {
flat->count--;
}
}
*curr_index = j;
for (m=1; m<ints[1+i]; m++) {
for (k=0,nonzeroth=j; k<basic_num; k++) {
if (flat->blocklens[j-basic_num] >0) {
flat->indices[nonzeroth] =
flat->indices[j-basic_num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[nonzeroth] = flat->blocklens[j-basic_num];
j++;
nonzeroth++;
}
}
}
*curr_index = j;
}
}
break;
case MPI_COMBINER_STRUCT:
case MPI_COMBINER_STRUCT_INTEGER:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_STRUCT_INTEGER\n");
#endif
top_count = ints[0];
for (n=0; n<top_count; n++) {
MPI_Type_get_envelope(types[n], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[n], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
ADIOI_Flatten(types[n], flat, st_offset+adds[n], curr_index);
if (prev_index == *curr_index) {
/* simplest case, current type is basic or contiguous types */
/* By using ADIO_Offset we preserve +/- sign and
avoid >2G integer arithmetic problems */
if (ints[1+n] > 0 || types[n] == MPI_LB || types[n] == MPI_UB) {
ADIO_Offset blocklength = ints[1+n];
j = *curr_index;
flat->indices[j] = st_offset + adds[n];
MPI_Type_size_x(types[n], &old_size);
flat->blocklens[j] = blocklength * old_size;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple adds[%#X] "MPI_AINT_FMT_HEX_SPEC", flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",n,adds[n],j, flat->indices[j], j, flat->blocklens[j]);
#endif
(*curr_index)++;
}
}
else {
/* current type made up of noncontiguous derived types */
j = *curr_index;
num = *curr_index - prev_index;
/* The current type has to be replicated blocklens[n] times */
MPI_Type_extent(types[n], &old_extent);
for (m=1; m<ints[1+n]; m++) {
for (i=0; i<num; i++) {
flat->indices[j] =
flat->indices[j-num] + ADIOI_AINT_CAST_TO_OFFSET old_extent;
flat->blocklens[j] = flat->blocklens[j-num];
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple old_extent "MPI_AINT_FMT_HEX_SPEC", flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",old_extent,j, flat->indices[j], j, flat->blocklens[j]);
#endif
j++;
}
}
*curr_index = j;
}
}
break;
case MPI_COMBINER_RESIZED:
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: MPI_COMBINER_RESIZED\n");
#endif
/* This is done similar to a type_struct with an lb, datatype, ub */
/* handle the Lb */
j = *curr_index;
flat->indices[j] = st_offset + adds[0];
/* this zero-length blocklens[] element, unlike eleswhere in the
* flattening code, is correct and is used to indicate a lower bound
* marker */
flat->blocklens[j] = 0;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple adds[%#X] "MPI_AINT_FMT_HEX_SPEC", flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",0,adds[0],j, flat->indices[j], j, flat->blocklens[j]);
#endif
(*curr_index)++;
/* handle the datatype */
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig)) {
ADIOI_Flatten(types[0], flat, st_offset+adds[0], curr_index);
}
else {
/* current type is basic or contiguous */
j = *curr_index;
flat->indices[j] = st_offset;
MPI_Type_size_x(types[0], &old_size);
flat->blocklens[j] = old_size;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple adds[%#X] "MPI_AINT_FMT_HEX_SPEC", flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",0,adds[0],j, flat->indices[j], j, flat->blocklens[j]);
#endif
(*curr_index)++;
}
/* take care of the extent as a UB */
j = *curr_index;
flat->indices[j] = st_offset + adds[0] + adds[1];
/* again, zero-element ok: an upper-bound marker explicitly set by the
* constructor of this resized type */
flat->blocklens[j] = 0;
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: simple adds[%#X] "MPI_AINT_FMT_HEX_SPEC", flat->indices[%#llX] %#llX, flat->blocklens[%#llX] %#llX\n",1,adds[1],j, flat->indices[j], j, flat->blocklens[j]);
#endif
(*curr_index)++;
break;
default:
/* TODO: FIXME (requires changing prototypes to return errors...) */
DBG_FPRINTF(stderr, "Error: Unsupported datatype passed to ADIOI_Flatten\n");
MPI_Abort(MPI_COMM_WORLD, 1);
}
#ifndef MPISGI
/* There is a bug in SGI's impl. of MPI_Type_get_contents. It doesn't
return new datatypes. Therefore no need to free. */
for (i=0; i<ntypes; i++) {
MPI_Type_get_envelope(types[i], &old_nints, &old_nadds, &old_ntypes,
&old_combiner);
if (old_combiner != MPI_COMBINER_NAMED) MPI_Type_free(types+i);
}
#endif
ADIOI_Free(ints);
ADIOI_Free(adds);
ADIOI_Free(types);
#ifdef FLATTEN_DEBUG
DBG_FPRINTF(stderr,"ADIOI_Flatten:: return st_offset %#llX, curr_index %#llX\n",st_offset,*curr_index);
#endif
}
/* ADIOI_Count_contiguous_blocks
*
* Returns number of contiguous blocks in type, and also updates
* curr_index to reflect the space for the additional blocks.
*
* ASSUMES THAT TYPE IS NOT A BASIC!!!
*/
MPI_Count ADIOI_Count_contiguous_blocks(MPI_Datatype datatype, MPI_Count *curr_index)
{
int i, n;
MPI_Count count=0, prev_index, num, basic_num;
int top_count, combiner, old_combiner, old_is_contig;
int nints, nadds, ntypes, old_nints, old_nadds, old_ntypes;
int *ints;
MPI_Aint *adds; /* Make no assumptions about +/- sign on these */
MPI_Datatype *types;
MPI_Type_get_envelope(datatype, &nints, &nadds, &ntypes, &combiner);
ints = (int *) ADIOI_Malloc((nints+1)*sizeof(int));
adds = (MPI_Aint *) ADIOI_Malloc((nadds+1)*sizeof(MPI_Aint));
types = (MPI_Datatype *) ADIOI_Malloc((ntypes+1)*sizeof(MPI_Datatype));
MPI_Type_get_contents(datatype, nints, nadds, ntypes, ints, adds, types);
switch (combiner) {
#ifdef MPIIMPL_HAVE_MPI_COMBINER_DUP
case MPI_COMBINER_DUP:
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count = ADIOI_Count_contiguous_blocks(types[0], curr_index);
else {
count = 1;
(*curr_index)++;
}
break;
#endif
#ifdef MPIIMPL_HAVE_MPI_COMBINER_SUBARRAY
case MPI_COMBINER_SUBARRAY:
{
int dims = ints[0];
MPI_Datatype stype;
ADIO_Type_create_subarray(dims,
&ints[1], /* sizes */
&ints[dims+1], /* subsizes */
&ints[2*dims+1], /* starts */
ints[3*dims+1], /* order */
types[0], /* type */
&stype);
count = ADIOI_Count_contiguous_blocks(stype, curr_index);
/* curr_index will have already been updated; just pass
* count back up.
*/
MPI_Type_free(&stype);
}
break;
#endif
#ifdef MPIIMPL_HAVE_MPI_COMBINER_DARRAY
case MPI_COMBINER_DARRAY:
{
int dims = ints[2];
MPI_Datatype dtype;
ADIO_Type_create_darray(ints[0], /* size */
ints[1], /* rank */
dims,
&ints[3], /* gsizes */
&ints[dims+3], /* distribs */
&ints[2*dims+3], /* dargs */
&ints[3*dims+3], /* psizes */
ints[4*dims+3], /* order */
types[0],
&dtype);
count = ADIOI_Count_contiguous_blocks(dtype, curr_index);
/* curr_index will have already been updated; just pass
* count back up.
*/
MPI_Type_free(&dtype);
}
break;
#endif
case MPI_COMBINER_CONTIGUOUS:
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count = ADIOI_Count_contiguous_blocks(types[0], curr_index);
else count = 1;
if (prev_index == *curr_index)
/* simplest case, made up of basic or contiguous types */
(*curr_index)++;
else {
/* made up of noncontiguous derived types */
num = *curr_index - prev_index;
count *= top_count;
*curr_index += (top_count - 1)*num;
}
break;
case MPI_COMBINER_VECTOR:
case MPI_COMBINER_HVECTOR:
case MPI_COMBINER_HVECTOR_INTEGER:
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count = ADIOI_Count_contiguous_blocks(types[0], curr_index);
else count = 1;
if (prev_index == *curr_index) {
/* simplest case, vector of basic or contiguous types */
count = top_count;
*curr_index += count;
}
else {
/* vector of noncontiguous derived types */
num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklen times
and then strided. */
count *= ints[1] * top_count;
/* First one */
*curr_index += (ints[1] - 1)*num;
/* Now repeat with strides. */
num = *curr_index - prev_index;
*curr_index += (top_count - 1)*num;
}
break;
case MPI_COMBINER_INDEXED:
case MPI_COMBINER_HINDEXED:
case MPI_COMBINER_HINDEXED_INTEGER:
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count = ADIOI_Count_contiguous_blocks(types[0], curr_index);
else count = 1;
if (prev_index == *curr_index) {
/* simplest case, indexed type made up of basic or contiguous types */
count = top_count;
*curr_index += count;
}
else {
/* indexed type made up of noncontiguous derived types */
basic_num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklens[i] times
and then strided. */
*curr_index += (ints[1]-1) * basic_num;
count *= ints[1];
/* Now repeat with strides. */
for (i=1; i<top_count; i++) {
count += ints[1+i] * basic_num;
*curr_index += ints[1+i] * basic_num;
}
}
break;
#if defined HAVE_DECL_MPI_COMBINER_HINDEXED_BLOCK && HAVE_DECL_MPI_COMBINER_HINDEXED_BLOCK
case MPI_COMBINER_HINDEXED_BLOCK:
#endif
case MPI_COMBINER_INDEXED_BLOCK:
top_count = ints[0];
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count = ADIOI_Count_contiguous_blocks(types[0], curr_index);
else count = 1;
if (prev_index == *curr_index) {
/* simplest case, indexed type made up of basic or contiguous types */
count = top_count;
*curr_index += count;
}
else {
/* indexed type made up of noncontiguous derived types */
basic_num = *curr_index - prev_index;
/* The noncontiguous types have to be replicated blocklens[i] times
and then strided. */
*curr_index += (ints[1]-1) * basic_num;
count *= ints[1];
/* Now repeat with strides. */
*curr_index += (top_count-1) * count;
count *= top_count;
}
break;
case MPI_COMBINER_STRUCT:
case MPI_COMBINER_STRUCT_INTEGER:
top_count = ints[0];
count = 0;
for (n=0; n<top_count; n++) {
MPI_Type_get_envelope(types[n], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[n], &old_is_contig);
prev_index = *curr_index;
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig))
count += ADIOI_Count_contiguous_blocks(types[n], curr_index);
if (prev_index == *curr_index) {
/* simplest case, current type is basic or contiguous types */
count++;
(*curr_index)++;
}
else {
/* current type made up of noncontiguous derived types */
/* The current type has to be replicated blocklens[n] times */
num = *curr_index - prev_index;
count += (ints[1+n]-1)*num;
(*curr_index) += (ints[1+n]-1)*num;
}
}
break;
case MPI_COMBINER_RESIZED:
/* treat it as a struct with lb, type, ub */
/* add 2 for lb and ub */
(*curr_index) += 2;
count += 2;
/* add for datatype */
MPI_Type_get_envelope(types[0], &old_nints, &old_nadds,
&old_ntypes, &old_combiner);
ADIOI_Datatype_iscontig(types[0], &old_is_contig);
if ((old_combiner != MPI_COMBINER_NAMED) && (!old_is_contig)) {
count += ADIOI_Count_contiguous_blocks(types[0], curr_index);
}
else {
/* basic or contiguous type */
count++;
(*curr_index)++;
}
break;
default:
/* TODO: FIXME */
DBG_FPRINTF(stderr, "Error: Unsupported datatype passed to ADIOI_Count_contiguous_blocks, combiner = %d\n", combiner);
MPI_Abort(MPI_COMM_WORLD, 1);
}
#ifndef MPISGI
/* There is a bug in SGI's impl. of MPI_Type_get_contents. It doesn't
return new datatypes. Therefore no need to free. */
for (i=0; i<ntypes; i++) {
MPI_Type_get_envelope(types[i], &old_nints, &old_nadds, &old_ntypes,
&old_combiner);
if (old_combiner != MPI_COMBINER_NAMED) MPI_Type_free(types+i);
}
#endif
ADIOI_Free(ints);
ADIOI_Free(adds);
ADIOI_Free(types);
return count;
}
int convert_mpi_pvfs2_dtype(MPI_Datatype *mpi_dtype,
PVFS_Request *pvfs_dtype)
{
int num_int = -1, num_addr = -1, num_dtype = -1,
combiner = -1, i = -1, ret = -1, leaf = -1;
int *arr_int = NULL;
MPI_Aint *arr_addr = NULL;
MPI_Datatype *arr_dtype = NULL;
PVFS_Request *old_pvfs_dtype = NULL;
PVFS_Request *old_pvfs_dtype_arr = NULL;
int arr_count = -1;
PVFS_size *pvfs_arr_disp = NULL;
int *pvfs_arr_len = NULL;
MPI_Type_get_envelope(*mpi_dtype,
&num_int,
&num_addr,
&num_dtype,
&combiner);
/* Depending on type of datatype do the following
* operations */
if (combiner == MPI_COMBINER_NAMED)
{
convert_named(mpi_dtype, pvfs_dtype, combiner);
return 1;
}
/* Allocate space for the arrays necessary for
* MPI_Type_get_contents */
if ((arr_int = ADIOI_Malloc(sizeof(int)*num_int)) == NULL)
{
fprintf(stderr, "Failed to allocate array_int\n");
return -1;
}
if ((arr_addr = ADIOI_Malloc(sizeof(int)*num_addr)) == NULL)
{
ADIOI_Free(arr_int);
fprintf(stderr, "Failed to allocate array_addr\n");
return -1;
}
if ((arr_dtype = ADIOI_Malloc(sizeof(MPI_Datatype)*num_dtype)) == NULL)
{
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
fprintf(stderr, "Failed to allocate array_dtypes\n");
return -1;
}
MPI_Type_get_contents(*mpi_dtype,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
/* If it's not a predefined datatype, it is either a
* derived datatype or a structured datatype */
if (combiner != MPI_COMBINER_STRUCT)
{
if ((old_pvfs_dtype = ADIOI_Malloc(sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Request\n");
switch (combiner)
{
case MPI_COMBINER_CONTIGUOUS:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_contiguous(arr_int[0],
*old_pvfs_dtype, pvfs_dtype);
break;
case MPI_COMBINER_VECTOR:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_vector(arr_int[0], arr_int[1],
arr_int[2], *old_pvfs_dtype,
pvfs_dtype);
break;
case MPI_COMBINER_HVECTOR:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_hvector(arr_int[0], arr_int[1],
arr_addr[0], *old_pvfs_dtype,
pvfs_dtype);
break;
/* Both INDEXED and HINDEXED types require PVFS_size
* address arrays. Therefore, we need to copy and
* convert the data from MPI_get_contents() into
* a PVFS_size buffer */
case MPI_COMBINER_INDEXED:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
if ((pvfs_arr_disp =
ADIOI_Malloc(arr_int[0]*sizeof(PVFS_size))) == 0)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
for (i = 0; i < arr_int[0]; i++)
{
pvfs_arr_disp[i] =
(PVFS_size) arr_int[arr_int[0]+1+i];
}
ret = PVFS_Request_indexed(arr_int[0], &arr_int[1],
pvfs_arr_disp,
*old_pvfs_dtype, pvfs_dtype);
ADIOI_Free(pvfs_arr_disp);
break;
case MPI_COMBINER_HINDEXED:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
if ((pvfs_arr_disp =
ADIOI_Malloc(arr_int[0]*sizeof(PVFS_size))) == 0)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
for (i = 0; i < arr_int[0]; i++)
{
pvfs_arr_disp[i] =
(PVFS_size) arr_addr[i];
}
ret = PVFS_Request_hindexed(arr_int[0], &arr_int[1],
(int64_t *)&arr_addr[0],
*old_pvfs_dtype, pvfs_dtype);
ADIOI_Free(pvfs_arr_disp);
break;
case MPI_COMBINER_DUP:
leaf = convert_mpi_pvfs2_dtype(&arr_dtype[0], old_pvfs_dtype);
ret = PVFS_Request_contiguous(1,
*old_pvfs_dtype, pvfs_dtype);
break;
case MPI_COMBINER_INDEXED_BLOCK:
/* No native PVFS2 support for this operation currently */
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"INDEXED_BLOCK is unsupported\n");
break;
case MPI_COMBINER_HINDEXED_BLOCK:
/* No native PVFS2 support for this operation currently */
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"HINDEXED_BLOCK is unsupported\n");
break;
case MPI_COMBINER_HINDEXED_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"HINDEXED_INTEGER is unsupported\n");
break;
case MPI_COMBINER_STRUCT_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"STRUCT_INTEGER is unsupported\n");
break;
case MPI_COMBINER_SUBARRAY:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"SUBARRAY is unsupported\n");
break;
case MPI_COMBINER_DARRAY:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"DARRAY is unsupported\n");
break;
case MPI_COMBINER_F90_REAL:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_REAL is unsupported\n");
break;
case MPI_COMBINER_F90_COMPLEX:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_COMPLEX is unsupported\n");
break;
case MPI_COMBINER_F90_INTEGER:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"F90_INTEGER is unsupported\n");
break;
case MPI_COMBINER_RESIZED:
ADIOI_Free(old_pvfs_dtype);
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"RESIZED is unsupported\n");
break;
default:
break;
}
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_* "
"for a derived datatype\n");
#ifdef DEBUG_DTYPE
print_dtype_info(combiner,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
#endif
if (leaf != 1 && combiner != MPI_COMBINER_DUP)
MPI_Type_free(&arr_dtype[0]);
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
ADIOI_Free(arr_dtype);
PVFS_Request_free(old_pvfs_dtype);
ADIOI_Free(old_pvfs_dtype);
return ret;
}
else /* MPI_COMBINER_STRUCT */
{
MPI_Aint mpi_lb = -1, mpi_extent = -1;
PVFS_offset pvfs_lb = -1;
PVFS_size pvfs_extent = -1;
int has_lb_ub = 0;
/* When converting into a PVFS_Request_struct, we no longer
* can use MPI_LB and MPI_UB. Therfore, we have to do the
* following.
* We simply ignore all the MPI_LB and MPI_UB types and
* get the lb and extent and pass it on through a
* PVFS resized_req */
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
arr_count++;
}
}
if (arr_int[0] != arr_count)
{
MPI_Type_get_extent(*mpi_dtype, &mpi_lb, &mpi_extent);
pvfs_lb = mpi_lb;
pvfs_extent = mpi_extent;
if ((pvfs_arr_len = ADIOI_Malloc(arr_count*sizeof(int)))
== NULL)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_len\n");
}
has_lb_ub = 1;
}
if ((old_pvfs_dtype_arr
= ADIOI_Malloc(arr_count*sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Requests\n");
if ((pvfs_arr_disp = ADIOI_Malloc(arr_count*sizeof(PVFS_size)))
== NULL)
{
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate pvfs_arr_disp\n");
}
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
leaf = convert_mpi_pvfs2_dtype(
&arr_dtype[i], &old_pvfs_dtype_arr[arr_count]);
if (leaf != 1)
MPI_Type_free(&arr_dtype[i]);
pvfs_arr_disp[arr_count] =
(PVFS_size) arr_addr[i];
if (has_lb_ub)
{
pvfs_arr_len[arr_count] =
arr_int[i+1];
}
arr_count++;
}
}
/* If a MPI_UB or MPI_LB did exist, we have to
* resize the datatype */
if (has_lb_ub)
{
PVFS_Request *tmp_pvfs_dtype = NULL;
if ((tmp_pvfs_dtype = ADIOI_Malloc(sizeof(PVFS_Request))) == NULL)
fprintf(stderr, "convert_mpi_pvfs2_dtype: "
"Failed to allocate PVFS_Request\n");
ret = PVFS_Request_struct(arr_count, pvfs_arr_len,
pvfs_arr_disp,
old_pvfs_dtype_arr, tmp_pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_struct\n");
arr_count = 0;
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
{
PVFS_Request_free(&old_pvfs_dtype_arr[arr_count]);
arr_count++;
}
}
#ifdef DEBUG_DTYPE
fprintf(stderr, "STRUCT(WITHOUT %d LB or UB)(%d,[",
arr_int[0] - arr_count, arr_count);
for (i = 0; i < arr_count; i++)
fprintf(stderr, "(%d,%Ld) ",
pvfs_arr_len[i],
pvfs_arr_disp[i]);
fprintf(stderr, "]\n");
fprintf(stderr, "RESIZED(LB = %Ld, EXTENT = %Ld)\n",
pvfs_lb, pvfs_extent);
#endif
ret = PVFS_Request_resized(*tmp_pvfs_dtype,
pvfs_lb, pvfs_extent, pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_resize\n");
PVFS_Request_free(tmp_pvfs_dtype);
ADIOI_Free(tmp_pvfs_dtype);
}
else /* No MPI_LB or MPI_UB datatypes */
{
ret = PVFS_Request_struct(arr_int[0], &arr_int[1],
pvfs_arr_disp,
old_pvfs_dtype_arr, pvfs_dtype);
if (ret != 0)
fprintf(stderr, "Error in PVFS_Request_struct\n");
for (i = 0; i < arr_int[0]; i++)
{
if (arr_dtype[i] != MPI_LB &&
arr_dtype[i] != MPI_UB)
PVFS_Request_free(&old_pvfs_dtype_arr[i]);
}
#ifdef DEBUG_DTYPE
print_dtype_info(combiner,
num_int,
num_addr,
num_dtype,
arr_int,
arr_addr,
arr_dtype);
#endif
}
ADIOI_Free(arr_int);
ADIOI_Free(arr_addr);
ADIOI_Free(arr_dtype);
ADIOI_Free(old_pvfs_dtype_arr);
ADIOI_Free(pvfs_arr_disp);
ADIOI_Free(pvfs_arr_len);
return ret;
}
/* Shouldn't have gotten here */
fprintf(stderr, "convert_mpi_pvfs2_dtype: SERIOUS ERROR\n");
return -1;
}
/* vector_of_vectors_test()
*
* Builds a vector of a vector of ints. Assuming an int array of size 9
* integers, and treating the array as a 3x3 2D array, this will grab the
* corners.
*
* MPICH1 fails this test because it converts the vectors into hvectors.
*
* Returns the number of errors encountered.
*/
int vector_of_vectors_test(void)
{
MPI_Datatype inner_vector, inner_vector_copy;
MPI_Datatype outer_vector;
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(2,
1,
2,
MPI_INT,
&inner_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
err = MPI_Type_vector(2,
1,
2,
inner_vector,
&outer_vector);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
/* decode outer vector (get envelope, then contents) */
err = MPI_Type_get_envelope(outer_vector,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"outer vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"outer vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"outer vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "outer vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
/* get contents of outer vector */
err = MPI_Type_get_contents(outer_vector,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"outer vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"outer vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr, "outer vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
inner_vector_copy = types[0];
free(ints);
if (nadds) free(adds);
free(types);
/* decode inner vector */
err = MPI_Type_get_envelope(inner_vector_copy,
&nints,
&nadds,
&ntypes,
&combiner);
if (err != MPI_SUCCESS) {
if (verbose) fprintf(stderr,
"error in MPI call; aborting after %d errors\n",
errs+1);
return errs+1;
}
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr,
"inner vector nints = %d; should be 3\n",
nints);
if (nadds != 0) fprintf(stderr,
"inner vector nadds = %d; should be 0\n",
nadds);
if (ntypes != 1) fprintf(stderr,
"inner vector ntypes = %d; should be 1\n",
ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "inner vector combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes * sizeof(*types));
err = MPI_Type_get_contents(inner_vector_copy,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 2) errs++;
if (ints[1] != 1) errs++;
if (ints[2] != 2) errs++;
if (verbose) {
if (ints[0] != 2) fprintf(stderr,
"inner vector count = %d; should be 2\n",
ints[0]);
if (ints[1] != 1) fprintf(stderr,
"inner vector blocklength = %d; should be 1\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr,
"inner vector stride = %d; should be 2\n",
ints[2]);
}
if (errs) {
if (verbose) fprintf(stderr, "aborting after %d errors\n", errs);
return errs;
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &inner_vector_copy );
MPI_Type_free( &inner_vector );
MPI_Type_free( &outer_vector );
return 0;
}
/* optimizable_vector_of_basics_test()
*
* Builds a vector of ints. Count is 10, blocksize is 2, stride is 2, so this
* is equivalent to a contig of 20. But remember...we should get back our
* suboptimal values under MPI-2.
*
* Returns the number of errors encountered.
*/
int optimizable_vector_of_basics_test(void)
{
MPI_Datatype parent_type;
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_vector(10,
2,
2,
MPI_INT,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 3) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_VECTOR) errs++;
if (verbose) {
if (nints != 3) fprintf(stderr, "nints = %d; should be 3\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_VECTOR)
fprintf(stderr, "combiner = %s; should be vector\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != 10) errs++;
if (ints[1] != 2) errs++;
if (ints[2] != 2) errs++;
if (types[0] != MPI_INT) errs++;
if (verbose) {
if (ints[0] != 10) fprintf(stderr, "count = %d; should be 10\n",
ints[0]);
if (ints[1] != 2) fprintf(stderr, "blocklength = %d; should be 2\n",
ints[1]);
if (ints[2] != 2) fprintf(stderr, "stride = %d; should be 2\n",
ints[2]);
if (types[0] != MPI_INT) fprintf(stderr, "type is not MPI_INT\n");
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
/* Check the return from the routine */
static int checkType(const char str[], int p, int r, int f90kind, int err, MPI_Datatype dtype)
{
int errs = 0;
if (dtype == MPI_DATATYPE_NULL) {
printf("Unable to find a real type for (p=%d,r=%d) in %s\n", p, r, str);
errs++;
}
if (err) {
errs++;
MTestPrintError(err);
}
if (!errs) {
int nints, nadds, ndtypes, combiner;
/* Check that we got the correct type */
MPI_Type_get_envelope(dtype, &nints, &nadds, &ndtypes, &combiner);
if (combiner != f90kind) {
errs++;
printf("Wrong combiner type (got %d, should be %d) for %s\n", combiner, f90kind, str);
}
else {
int parms[2];
MPI_Datatype outtype;
parms[0] = 0;
parms[1] = 0;
if (ndtypes != 0) {
errs++;
printf
("Section 8.6 states that the array_of_datatypes entry is empty for the create_f90 types\n");
}
MPI_Type_get_contents(dtype, 2, 0, 1, parms, 0, &outtype);
switch (combiner) {
case MPI_COMBINER_F90_REAL:
case MPI_COMBINER_F90_COMPLEX:
if (nints != 2) {
errs++;
printf("Returned %d integer values, 2 expected for %s\n", nints, str);
}
if (parms[0] != p || parms[1] != r) {
errs++;
printf("Returned (p=%d,r=%d); expected (p=%d,r=%d) for %s\n",
parms[0], parms[1], p, r, str);
}
break;
case MPI_COMBINER_F90_INTEGER:
if (nints != 1) {
errs++;
printf("Returned %d integer values, 1 expected for %s\n", nints, str);
}
if (parms[0] != p) {
errs++;
printf("Returned (p=%d); expected (p=%d) for %s\n", parms[0], p, str);
}
break;
default:
errs++;
printf("Unrecognized combiner for %s\n", str);
break;
}
}
}
if (!errs) {
char buf0[64]; /* big enough to hold any single type */
char buf1[64]; /* big enough to hold any single type */
MPI_Request req[2];
int dt_size = 0;
/* check that we can actually use the type for communication,
* regression for tt#1028 */
err = MPI_Type_size(dtype, &dt_size);
check_err(MPI_Type_size);
assert(dt_size <= sizeof(buf0));
memset(buf0, 0, sizeof(buf0));
memset(buf1, 0, sizeof(buf1));
if (!errs) {
err = MPI_Isend(&buf0, 1, dtype, 0, 42, MPI_COMM_SELF, &req[0]);
check_err(MPI_Isend);
}
if (!errs) {
err = MPI_Irecv(&buf1, 1, dtype, 0, 42, MPI_COMM_SELF, &req[1]);
check_err(MPI_Irecv);
}
if (!errs) {
err = MPI_Waitall(2, req, MPI_STATUSES_IGNORE);
check_err(MPI_Waitall);
}
}
return errs;
}
/* indexed_of_basics_test(void)
*
* Simple indexed type.
*
* Returns number of errors encountered.
*/
int indexed_of_basics_test(void)
{
MPI_Datatype parent_type;
int s_count = 3, s_blocklengths[3] = { 3, 2, 1 };
int s_displacements[3] = { 10, 20, 30 };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_indexed(s_count,
s_blocklengths,
s_displacements,
MPI_INT,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 7) errs++;
if (nadds != 0) errs++;
if (ntypes != 1) errs++;
if (combiner != MPI_COMBINER_INDEXED) errs++;
if (verbose) {
if (nints != 7) fprintf(stderr, "nints = %d; should be 7\n", nints);
if (nadds != 0) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 1) fprintf(stderr, "ntypes = %d; should be 1\n", ntypes);
if (combiner != MPI_COMBINER_INDEXED)
fprintf(stderr, "combiner = %s; should be indexed\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
if (nadds) adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != s_count) errs++;
if (ints[1] != s_blocklengths[0]) errs++;
if (ints[2] != s_blocklengths[1]) errs++;
if (ints[3] != s_blocklengths[2]) errs++;
if (ints[4] != s_displacements[0]) errs++;
if (ints[5] != s_displacements[1]) errs++;
if (ints[6] != s_displacements[2]) errs++;
if (types[0] != MPI_INT) errs++;
if (verbose) {
if (ints[0] != s_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count);
if (ints[1] != s_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]);
if (ints[2] != s_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]);
if (ints[3] != s_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]);
if (ints[4] != s_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", ints[4], s_displacements[0]);
if (ints[5] != s_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", ints[5], s_displacements[1]);
if (ints[6] != s_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", ints[6], s_displacements[2]);
if (types[0] != MPI_INT) fprintf(stderr, "type[0] does not match\n");
}
free(ints);
if (nadds) free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
/*
* Synopsis
*
* This function inverts MPIX_Type_contiguous_x, i.e. it provides
* the original arguments for that call so that we know how many
* built-in types are in the user-defined datatype.
*
* This function is primary used inside of BigMPI and does not
* correspond to an MPI function, so we do avoid the use of the
* MPIX namespace.
*
* int BigMPI_Decode_contiguous_x(MPI_Datatype intype,
* MPI_Count * count,
* MPI_Datatype * basetype)
*
* Input Parameters
*
* newtype new datatype (handle)
*
* Output Parameter
*
* count replication count (nonnegative integer)
* oldtype old datatype (handle)
*
*/
int BigMPI_Decode_contiguous_x(MPI_Datatype intype, MPI_Count * count, MPI_Datatype * basetype)
{
int nint, nadd, ndts, combiner;
/* Step 1: Decode the type_create_struct call. */
MPI_Type_get_envelope(intype, &nint, &nadd, &ndts, &combiner);
assert(combiner==MPI_COMBINER_STRUCT || combiner==MPI_COMBINER_VECTOR);
#ifdef BIGMPI_AVOID_TYPE_CREATE_STRUCT
if (combiner==MPI_COMBINER_VECTOR) {
assert(nint==3);
assert(nadd==0);
assert(ndts==1);
int cbs[3]; /* {count,blocklength,stride} */
MPI_Datatype vbasetype[1];
MPI_Type_get_contents(intype, 3, 0, 1, cbs, NULL, vbasetype);
MPI_Count a = cbs[0]; /* count */
MPI_Count b = cbs[1]; /* blocklength */
assert(cbs[1]==cbs[2]); /* blocklength==stride */
*count = a*b;
*basetype = vbasetype[0];
return MPI_SUCCESS;
}
#else
assert(combiner==MPI_COMBINER_STRUCT);
#endif
assert(nint==3);
assert(nadd==2);
assert(ndts==2);
int cnbls[3]; /* {count, blocklengths[]} */
MPI_Aint displacements[2]; /* {0,remdisp} */
MPI_Datatype types[2]; /* {chunks,remainder} */;
MPI_Type_get_contents(intype, 3, 2, 2, cnbls, displacements, types);
assert(cnbls[0]==2);
assert(cnbls[1]==1);
assert(cnbls[2]==1);
assert(displacements[0]==0);
/* Step 2: Decode the type_vector call. */
MPI_Type_get_envelope(types[0], &nint, &nadd, &ndts, &combiner);
assert(combiner==MPI_COMBINER_VECTOR);
assert(nint==3);
assert(nadd==0);
assert(ndts==1);
int cbs[3]; /* {count,blocklength,stride} */
MPI_Datatype vbasetype[1];
MPI_Type_get_contents(types[0], 3, 0, 1, cbs, NULL, vbasetype);
assert(/* blocklength = */ cbs[1]==bigmpi_int_max);
assert(/* stride = */ cbs[2]==bigmpi_int_max);
/* chunk count - see above */
MPI_Count c = cbs[0];
/* Step 3: Decode the type_contiguous call. */
MPI_Type_get_envelope(types[1], &nint, &nadd, &ndts, &combiner);
assert(combiner==MPI_COMBINER_CONTIGUOUS);
assert(nint==1);
assert(nadd==0);
assert(ndts==1);
int ccc[1]; /* {count} */
MPI_Datatype cbasetype[1];
MPI_Type_get_contents(types[1], 1, 0, 1, ccc, NULL, cbasetype);
/* remainder - see above */
MPI_Count r = ccc[0];
/* The underlying type of the vector and contig types must match. */
assert(cbasetype[0]==vbasetype[0]);
*basetype = cbasetype[0];
/* This should not overflow because everything is already MPI_Count type. */
*count = c*bigmpi_int_max+r;
return MPI_SUCCESS;
}
/* struct_of_basics_test(void)
*
* There's nothing simple about structs :). Although this is an easy one.
*
* Returns number of errors encountered.
*
* NOT TESTED.
*/
int struct_of_basics_test(void)
{
MPI_Datatype parent_type;
int s_count = 3, s_blocklengths[3] = { 3, 2, 1 };
MPI_Aint s_displacements[3] = { 10, 20, 30 };
MPI_Datatype s_types[3] = { MPI_CHAR, MPI_INT, MPI_FLOAT };
int nints, nadds, ntypes, combiner, *ints;
MPI_Aint *adds = NULL;
MPI_Datatype *types;
int err, errs = 0;
/* set up type */
err = MPI_Type_create_struct(s_count,
s_blocklengths,
s_displacements,
s_types,
&parent_type);
/* decode */
err = MPI_Type_get_envelope(parent_type,
&nints,
&nadds,
&ntypes,
&combiner);
if (nints != 4) errs++;
if (nadds != 3) errs++;
if (ntypes != 3) errs++;
if (combiner != MPI_COMBINER_STRUCT) errs++;
if (verbose) {
if (nints != 4) fprintf(stderr, "nints = %d; should be 3\n", nints);
if (nadds != 3) fprintf(stderr, "nadds = %d; should be 0\n", nadds);
if (ntypes != 3) fprintf(stderr, "ntypes = %d; should be 3\n", ntypes);
if (combiner != MPI_COMBINER_STRUCT)
fprintf(stderr, "combiner = %s; should be struct\n",
combiner_to_string(combiner));
}
ints = malloc(nints * sizeof(*ints));
adds = malloc(nadds * sizeof(*adds));
types = malloc(ntypes *sizeof(*types));
err = MPI_Type_get_contents(parent_type,
nints,
nadds,
ntypes,
ints,
adds,
types);
if (ints[0] != s_count) errs++;
if (ints[1] != s_blocklengths[0]) errs++;
if (ints[2] != s_blocklengths[1]) errs++;
if (ints[3] != s_blocklengths[2]) errs++;
if (adds[0] != s_displacements[0]) errs++;
if (adds[1] != s_displacements[1]) errs++;
if (adds[2] != s_displacements[2]) errs++;
if (types[0] != s_types[0]) errs++;
if (types[1] != s_types[1]) errs++;
if (types[2] != s_types[2]) errs++;
if (verbose) {
if (ints[0] != s_count)
fprintf(stderr, "count = %d; should be %d\n", ints[0], s_count);
if (ints[1] != s_blocklengths[0])
fprintf(stderr, "blocklength[0] = %d; should be %d\n", ints[1], s_blocklengths[0]);
if (ints[2] != s_blocklengths[1])
fprintf(stderr, "blocklength[1] = %d; should be %d\n", ints[2], s_blocklengths[1]);
if (ints[3] != s_blocklengths[2])
fprintf(stderr, "blocklength[2] = %d; should be %d\n", ints[3], s_blocklengths[2]);
if (adds[0] != s_displacements[0])
fprintf(stderr, "displacement[0] = %d; should be %d\n", adds[0], s_displacements[0]);
if (adds[1] != s_displacements[1])
fprintf(stderr, "displacement[1] = %d; should be %d\n", adds[1], s_displacements[1]);
if (adds[2] != s_displacements[2])
fprintf(stderr, "displacement[2] = %d; should be %d\n", adds[2], s_displacements[2]);
if (types[0] != s_types[0])
fprintf(stderr, "type[0] does not match\n");
if (types[1] != s_types[1])
fprintf(stderr, "type[1] does not match\n");
if (types[2] != s_types[2])
fprintf(stderr, "type[2] does not match\n");
}
free(ints);
free(adds);
free(types);
MPI_Type_free( &parent_type );
return errs;
}
