/* Fill in a field value, making sure the index is safe */
static void
fill_in_field_value(RefIndex list, FieldInfo *fields, jvalue *fvalues,
int n_fields, jint index, jvalue value,
jvmtiPrimitiveType primType)
{
HPROF_ASSERT(fvalues != NULL);
HPROF_ASSERT(n_fields > 0);
HPROF_ASSERT(index < n_fields);
HPROF_ASSERT(index >= 0 );
HPROF_ASSERT(fvalues[index].j==(jlong)0);
verify_field(list, fields, fvalues, n_fields, index, value, primType);
if (index >= 0 && index < n_fields) {
fvalues[index] = value;
}
}
int flatcc_verify_union_field(flatcc_table_verifier_descriptor_t *td,
voffset_t id, int required, flatcc_union_verifier_f *uvf)
{
voffset_t vte_type, vte_table;
const uint8_t *type;
if (0 == (vte_type = read_vt_entry(td, id - 1))) {
vte_table = read_vt_entry(td, id);
verify(vte_table == 0, flatcc_verify_error_union_cannot_have_a_table_without_a_type);
verify(!required, flatcc_verify_error_type_field_absent_from_required_union_field);
return flatcc_verify_ok;
}
/* No need to check required here. */
check_result(verify_field(td, id - 1, 0, 1, 1));
/* Only now is it safe to read the type. */
vte_table = read_vt_entry(td, id);
type = (const uint8_t *)td->buf + td->table + vte_type;
verify(*type || vte_table == 0, flatcc_verify_error_union_type_NONE_cannot_have_a_table);
return uvf(td, id, *type);
}
FC_FUNC( mpi_init_fort , MPI_INIT_FORT)
(int *f_MPI_COMM_WORLD,
int *f_MPI_ANY_SOURCE, int *f_MPI_ANY_TAG,
int *f_MPI_PROC_NULL, int *f_MPI_ROOT,
int *f_MPI_COMM_NULL, int *f_MPI_REQUEST_NULL,
int *f_MPI_GROUP_NULL, int *f_MPI_GROUP_EMPTY,
int *f_MPI_UNDEFINED,
int *f_MPI_MAX_ERROR_STRING,
int *f_MPI_MAX_PROCESSOR_NAME,
int *f_MPI_STATUS_SIZE,
int *f_MPI_SOURCE, int *f_MPI_TAG, int *f_MPI_ERROR,
int *f_status,
int *fsource, int *ftag, int *ferror,
int *f_MPI_INTEGER, void *fint1, void *fint2,
int *f_MPI_LOGICAL, void *flog1, void *flog2,
int *f_MPI_REAL, void *freal1, void *freal2,
int *f_MPI_DOUBLE_PRECISION,
void *fdub1, void *fdub2,
int *f_MPI_COMPLEX, void *fcomp1, void *fcomp2,
int *ierror)
{
int err;
int size;
int offset;
*ierror=MPI_Init(NULL,NULL);
err=0;
/*
* These 3 macros compare things from mpif.h (as passed in by the f_
* arguments) to the values in C (from #including mpi.h).
*
* Unfortunately, this kind of thing is done most easily in a nasty
* looking macto.
*
*/
/*
* verify_eq
* compare value of constants in C and fortran
* i.e. compare *f_<name> to <name>
*/
#define verify_eq(name) \
if (*f_##name != name) \
{ fprintf(stderr,"mpi-serial: mpi_init_fort: %s not consistant " \
"between mpif.h (%d) and mpi.h (%d)\n",\
#name,*f_##name,name); \
err=1; }
#define verify_eq_warn(name) \
if (*f_##name != name) \
{ fprintf(stderr,"mpi-serial: mpi_init_fort: warning: %s not consistant " \
"between mpif.h (%d) and mpi.h (%d)\n",\
#name,*f_##name,name); \
}
/*
* verify_size
* verify that the type name in fortran has the correct
* value (i.e. the size of that data type).
* Determine size by subtracting the pointer values of two
* consecutive array locations.
*/
#define verify_size(name,p1,p2) \
if ( (size=((char *)(p2) - (char *)(p1))) != *f_##name ) \
{ fprintf(stderr,"mpi-serial: mpi_init_fort: mpif.h %s (%d) " \
"does not match actual fortran size (%d)\n", \
#name,*f_##name,size); \
err=1; }
/*
* verify_field
* check the struct member offsets for MPI_Status vs. the
* fortan integer array offsets. E.g. the location of
* status->MPI_SOURCE should be the same as STATUS(MPI_SOURCE)
*/
#define verify_field(name) \
{ offset= (char *)&((MPI_Status *)f_status)->name - (char *)f_status; \
if ( offset != (*f_##name-1)*sizeof(int) ) \
{ fprintf(stderr,"mpi-serial: mpi_init_fort: mpif.h %s (%d) (%d bytes) " \
"is inconsistant w/offset in MPI_Status (%d bytes)\n", \
#name,*f_##name,(*f_##name-1)*sizeof(int),offset); \
err=1; }}
verify_eq(MPI_COMM_WORLD);
verify_eq(MPI_ANY_SOURCE);
verify_eq(MPI_ANY_TAG);
verify_eq(MPI_PROC_NULL);
verify_eq(MPI_ROOT);
verify_eq(MPI_COMM_NULL);
verify_eq(MPI_REQUEST_NULL);
verify_eq(MPI_GROUP_NULL);
verify_eq(MPI_GROUP_EMPTY);
verify_eq(MPI_UNDEFINED);
verify_eq(MPI_MAX_ERROR_STRING);
verify_eq(MPI_MAX_PROCESSOR_NAME);
verify_eq(MPI_STATUS_SIZE);
verify_field(MPI_SOURCE);
verify_field(MPI_TAG);
verify_field(MPI_ERROR);
verify_eq(MPI_INTEGER);
verify_size(MPI_INTEGER,fint1,fint2);
verify_size(MPI_LOGICAL,flog1,flog2);
verify_eq_warn(MPI_REAL);
verify_size(MPI_REAL,freal1,freal2);
verify_eq(MPI_DOUBLE_PRECISION);
verify_size(MPI_DOUBLE_PRECISION,fdub1,fdub2);
verify_size(MPI_COMPLEX,fcomp1,fcomp2);
if (err)
abort();
}
int flatcc_verify_field(flatcc_table_verifier_descriptor_t *td,
voffset_t id, uint16_t align, size_t size)
{
check_result(verify_field(td, id, 0, align, (uoffset_t)size));
return flatcc_verify_ok;
}
