dt_module.c

MPI stands for the Message Passing Interface. Written by the MPI Forum (a large committee comprising

            ((PDST)->opt_desc.desc != (PDST)->desc.desc) )              \
            free( (PDST)->opt_desc.desc );                              \
        (PDST)->desc     = (PSRC)->desc;                                \
        (PDST)->opt_desc = (PSRC)->opt_desc;                            \
        (PDST)->packed_description = (PSRC)->packed_description;        \
        (PSRC)->packed_description = NULL;                              \
        memcpy( (PDST)->btypes, (PSRC)->btypes,                         \
                DT_MAX_PREDEFINED * sizeof(uint32_t) );                 \
    } while(0)

#define DECLARE_MPI2_COMPOSED_STRUCT_DDT( PDATA, MPIDDT, MPIDDTNAME, type1, type2, MPIType1, MPIType2, FLAGS) \
    do {                                                                \
        struct { type1 v1; type2 v2; } s[2];                            \
        ompi_datatype_t* types[2];                                      \
        ompi_datatype_t* ptype;                                         \
        int bLength[2] = {1, 1};                                        \
        MPI_Aint base, displ[2];                                       \
                                                                        \
        types[0] = (ompi_datatype_t*)ompi_ddt_basicDatatypes[MPIType1]; \
        types[1] = (ompi_datatype_t*)ompi_ddt_basicDatatypes[MPIType2]; \
        base = (ptrdiff_t)(&(s[0]));                                    \
        displ[0] = (ptrdiff_t)(&(s[0].v1));                             \
        displ[0] -= base;                                               \
        displ[1] = (ptrdiff_t)(&(s[0].v2));                             \
        displ[1] -= base;                                               \
                                                                        \
        ompi_ddt_create_struct( 2, bLength, displ, types, &ptype );     \
        displ[0] = (ptrdiff_t)(&(s[1]));                                \
        displ[0] -= base;                                               \
        if( displ[0] != (displ[1] + (ptrdiff_t)sizeof(type2)) )         \
            ptype->ub = displ[0];  /* force a new extent for the datatype */ \
        ptype->flags |= (FLAGS);                                        \
        ptype->id = MPIDDT;                                             \
        ompi_ddt_commit( &ptype );                                      \
        COPY_DATA_DESC( PDATA, ptype );                                 \
        (PDATA)->flags |= DT_FLAG_PREDEFINED;                           \
        ptype->desc.desc = NULL;                                        \
        ptype->opt_desc.desc = NULL;                                    \
        OBJ_RELEASE( ptype );                                           \
        strncpy( (PDATA)->name, MPIDDTNAME, MPI_MAX_OBJECT_NAME );      \
    } while(0)

#define DECLARE_MPI2_COMPOSED_BLOCK_DDT( PDATA, MPIDDT, MPIDDTNAME, MPIType, FLAGS ) \
    do {                                                                             \
        ompi_datatype_t *ptype;                                                      \
        ompi_ddt_create_contiguous( 2, ompi_ddt_basicDatatypes[MPIType], &ptype );   \
        ptype->flags |= (FLAGS);                                                     \
        ptype->id = (MPIDDT);                                                        \
        ompi_ddt_commit( &ptype );                                                   \
        COPY_DATA_DESC( (PDATA), ptype );                                            \
        (PDATA)->flags |= DT_FLAG_PREDEFINED;                                        \
        ptype->desc.desc = NULL;                                                     \
        ptype->opt_desc.desc = NULL;                                                 \
        OBJ_RELEASE( ptype );                                                        \
        strncpy( (PDATA)->name, (MPIDDTNAME), MPI_MAX_OBJECT_NAME );                 \
    } while(0)

#define DECLARE_MPI_SYNONYM_DDT( PDATA, MPIDDTNAME, PORIGDDT)           \
    do {                                                                \
        /* just memcpy as it's easier this way */                       \
        memcpy( (PDATA), (PORIGDDT), sizeof(ompi_datatype_t) );         \
        strncpy( (PDATA)->name, MPIDDTNAME, MPI_MAX_OBJECT_NAME );      \
        /* forget the language flag */                                  \
        (PDATA)->flags &= ~DT_FLAG_DATA_LANGUAGE;                       \
    } while(0)

int ompi_ddt_register_params(void)
{
#if OMPI_ENABLE_DEBUG
    mca_base_param_reg_int_name( "mpi", "ddt_unpack_debug",
                                 "Whether to output debugging information in the ddt unpack functions (nonzero = enabled)",
                                 false, false,
                                 ompi_unpack_debug, &ompi_unpack_debug );
    mca_base_param_reg_int_name( "mpi", "ddt_pack_debug", 
                                 "Whether to output debugging information in the ddt pack functions (nonzero = enabled)",
                                 false, false,
                                 ompi_pack_debug, &ompi_pack_debug );
    mca_base_param_reg_int_name( "mpi", "ddt_position_debug",
                                 "Non zero lead to output generated by the datatype position functions",
                                 false, false, 0, &ompi_position_debug );

    mca_base_param_reg_int_name( "mpi", "ddt_copy_debug",
                                 "Whether to output debugging information in the ddt copy functions (nonzero = enabled)",
                                 false, false, 
                                 ompi_copy_debug, &ompi_copy_debug );
#endif  /* OMPI_ENABLE_DEBUG */
    return OMPI_SUCCESS;
}

int32_t ompi_ddt_init( void )
{
    int32_t i;

    for( i = DT_CHAR; i < DT_MAX_PREDEFINED; i++ ) {
        ompi_datatype_t* datatype = (ompi_datatype_t*)ompi_ddt_basicDatatypes[i];

        datatype->desc.desc = (dt_elem_desc_t*)malloc(2*sizeof(dt_elem_desc_t));
        datatype->desc.desc[0].elem.common.flags = DT_FLAG_PREDEFINED | DT_FLAG_DATA | DT_FLAG_CONTIGUOUS;
        datatype->desc.desc[0].elem.common.type  = i;
        datatype->desc.desc[0].elem.count        = 1;
        datatype->desc.desc[0].elem.disp         = 0;
        datatype->desc.desc[0].elem.extent       = datatype->size;

        datatype->desc.desc[1].end_loop.common.flags    = 0;
        datatype->desc.desc[1].end_loop.common.type     = DT_END_LOOP;
        datatype->desc.desc[1].end_loop.items           = 1;
        datatype->desc.desc[1].end_loop.first_elem_disp = datatype->desc.desc[0].elem.disp;
        datatype->desc.desc[1].end_loop.size            = datatype->size;

        datatype->desc.length       = 1;
        datatype->desc.used         = 1;
        /* By default the optimized descritption is the same as the default
         * description for predefined datatypes.
         */
        datatype->opt_desc          = datatype->desc;

        datatype->btypes[i]         = 1;
        /* Check if the data contain gaps */
        if( (datatype->ub - datatype->lb) == (ptrdiff_t)datatype->size ) {
            datatype->desc.desc[0].elem.common.flags |= DT_FLAG_NO_GAPS;
        }
    }

    /* Create the f2c translation table */
    ompi_datatype_f_to_c_table = OBJ_NEW(ompi_pointer_array_t);
    if (NULL == ompi_datatype_f_to_c_table) {
        return OMPI_ERROR;
    }
    /* All temporary datatypes created on the following statement will get registered
     * on the f2c table. But as they get destroyed they will (hopefully) get unregistered
     * so later when we start registering the real datatypes they will get the index
     * in mpif.h
     */

    /* the 2 complex datatypes (float and double) */
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_cplex, DT_COMPLEX_FLOAT, "MPI_COMPLEX",
				      float, float, DT_FLOAT, DT_FLOAT,
				      DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_dblcplex, DT_COMPLEX_DOUBLE, "MPI_DOUBLE_COMPLEX",
				      double, double, DT_DOUBLE, DT_DOUBLE,
				      DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );
#if HAVE_LONG_DOUBLE
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_ldblcplex, DT_COMPLEX_LONG_DOUBLE, "MPI_LONG_DOUBLE_COMPLEX",
				      long double, long double, DT_LONG_DOUBLE, DT_LONG_DOUBLE,
				      DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );
#endif  /* HAVE_LONG_DOUBLE */

    /* Now the predefined MPI2 datatypes (they should last forever!) */
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_float_int, DT_FLOAT_INT, "MPI_FLOAT_INT",
				      float, int, DT_FLOAT, DT_INT, DT_FLAG_DATA_C );
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_double_int, DT_DOUBLE_INT, "MPI_DOUBLE_INT",
				      double, int, DT_DOUBLE, DT_INT, DT_FLAG_DATA_C );
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_long_int, DT_LONG_INT, "MPI_LONG_INT",
				      long, int, DT_LONG, DT_INT, DT_FLAG_DATA_C | DT_FLAG_DATA_INT );
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_short_int, DT_SHORT_INT, "MPI_SHORT_INT",
				      short, int, DT_SHORT, DT_INT, DT_FLAG_DATA_C | DT_FLAG_DATA_INT );
    DECLARE_MPI2_COMPOSED_STRUCT_DDT( &ompi_mpi_longdbl_int, DT_LONG_DOUBLE_INT, "MPI_LONG_DOUBLE_INT",
				      long double, int, DT_LONG_DOUBLE, DT_INT, DT_FLAG_DATA_C );

    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2int, DT_2INT, "MPI_2INT", DT_INT,
				     DT_FLAG_DATA_C | DT_FLAG_DATA_INT );
    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2integer, DT_2INTEGER, "MPI_2INTEGER", DT_INT,
				     DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT);
    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2real, DT_2REAL, "MPI_2REAL", DT_FLOAT,
				     DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );
    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2dblprec, DT_2DBLPREC, "MPI_2DOUBLE_PRECISION", DT_DOUBLE,
				     DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );
    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2cplex, DT_2COMPLEX, "MPI_2COMPLEX", DT_COMPLEX_FLOAT,
				     DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT);
    DECLARE_MPI2_COMPOSED_BLOCK_DDT( &ompi_mpi_2dblcplex, DT_2DOUBLE_COMPLEX, "MPI_2DOUBLE_COMPLEX",
                                     DT_COMPLEX_DOUBLE, DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT );

    for( i = 0; i < DT_MAX_PREDEFINED; ++i ) {
        ompi_ddt_local_sizes[i] = ompi_ddt_basicDatatypes[i]->size;
    }

    /* Copy the desc pointer from the <DT_MAX_PREDEFINED datatypes to
       the synonym types */

    /* C++ complex types */
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_cxx_cplex, "MPI_CXX_COMPLEX", &ompi_mpi_cplex );
    ompi_mpi_cxx_cplex.flags |= DT_FLAG_DATA_CPP | DT_FLAG_DATA_COMPLEX;
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_cxx_dblcplex, "MPI_CXX_DOUBLE_COMPLEX", &ompi_mpi_dblcplex );
    ompi_mpi_cxx_dblcplex.flags |= DT_FLAG_DATA_CPP | DT_FLAG_DATA_COMPLEX;
#if HAVE_LONG_DOUBLE
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_cxx_ldblcplex, "MPI_CXX_LONG_DOUBLE_COMPLEX", &ompi_mpi_ldblcplex );
    ompi_mpi_cxx_ldblcplex.flags |= DT_FLAG_DATA_CPP | DT_FLAG_DATA_COMPLEX;
#endif  /* HAVE_LONG_DOUBLE */

    /* Optional Fortran REAL types */

#if OMPI_HAVE_FORTRAN_REAL4
#if (OMPI_SIZEOF_FORTRAN_REAL4 == SIZEOF_FLOAT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real4, "MPI_REAL4", &ompi_mpi_float );
#else
#   warning "No proper C type found for REAL4"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real4, "MPI_REAL4", &ompi_mpi_unavailable );
#endif
    ompi_mpi_real4.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT;
#endif /* OMPI_HAVE_FORTRAN_REAL4 */

#if OMPI_HAVE_FORTRAN_REAL8
#if (OMPI_SIZEOF_FORTRAN_REAL8 == SIZEOF_FLOAT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real8, "MPI_REAL8", &ompi_mpi_float );
#elif (OMPI_SIZEOF_FORTRAN_REAL8 == SIZEOF_DOUBLE)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real8, "MPI_REAL8", &ompi_mpi_double );
#elif (OMPI_SIZEOF_FORTRAN_REAL8 == SIZEOF_LONG_DOUBLE)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real8, "MPI_REAL8", &ompi_mpi_long_double );
#else
#   warning "No proper C type found for REAL8"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real8, "MPI_REAL8", &ompi_mpi_unavailable );
#endif
    ompi_mpi_real8.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT;
#endif /* OMPI_HAVE_FORTRAN_REAL8 */

#if OMPI_HAVE_FORTRAN_REAL16
#if (OMPI_SIZEOF_FORTRAN_REAL16 == SIZEOF_LONG_DOUBLE)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real16, "MPI_REAL16", &ompi_mpi_long_double );
#else
#   warning "No proper C type found for REAL16"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_real16, "MPI_REAL16", &ompi_mpi_unavailable );
#endif
    ompi_mpi_real16.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_FLOAT;
#endif /* OMPI_HAVE_FORTRAN_REAL16 */

    /* Optional Fortran INTEGER types */

#if OMPI_HAVE_FORTRAN_INTEGER1
#if (OMPI_SIZEOF_FORTRAN_INTEGER1 == SIZEOF_CHAR)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer1, "MPI_INTEGER1", &ompi_mpi_char );
#elif (OMPI_SIZEOF_FORTRAN_INTEGER1 == SIZEOF_SHORT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer1, "MPI_INTEGER1", &ompi_mpi_short );
#elif (OMPI_SIZEOF_FORTRAN_INTEGER1 == SIZEOF_INT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer1, "MPI_INTEGER1", &ompi_mpi_int );
#else
#   warning "No proper C type found for INTEGER1"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer1, "MPI_INTEGER1", &ompi_mpi_unavailable );
#endif
    ompi_mpi_integer1.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT;
#endif /* OMPI_HAVE_FORTRAN_INTEGER1 */

#if OMPI_HAVE_FORTRAN_INTEGER2
#if (OMPI_SIZEOF_FORTRAN_INTEGER2 == SIZEOF_SHORT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer2, "MPI_INTEGER2", &ompi_mpi_short );
#elif (OMPI_SIZEOF_FORTRAN_INTEGER2 == SIZEOF_INT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer2, "MPI_INTEGER2", &ompi_mpi_int );
#else
#   warning "No proper C type found for INTEGER2"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer2, "MPI_INTEGER2", &ompi_mpi_unavailable );
#endif
    ompi_mpi_integer2.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT;
#endif /* OMPI_HAVE_FORTRAN_INTEGER2 */

#if OMPI_HAVE_FORTRAN_INTEGER4
#if (OMPI_SIZEOF_FORTRAN_INTEGER4 == SIZEOF_INT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer4, "MPI_INTEGER4", &ompi_mpi_int );
#elif (OMPI_SIZEOF_FORTRAN_INTEGER4 == SIZEOF_LONG)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer4, "MPI_INTEGER4", &ompi_mpi_long );
#else
#   warning "No proper C type found for INTEGER4"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer4, "MPI_INTEGER4", &ompi_mpi_unavailable );
#endif
    ompi_mpi_integer4.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT;
#endif /* OMPI_HAVE_FORTRAN_INTEGER4 */

#if OMPI_HAVE_FORTRAN_INTEGER8
#if (OMPI_SIZEOF_FORTRAN_INTEGER8 == SIZEOF_LONG)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer8, "MPI_INTEGER8", &ompi_mpi_long );
#elif (OMPI_SIZEOF_FORTRAN_INTEGER8 == SIZEOF_LONG_LONG)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer8, "MPI_INTEGER8", &ompi_mpi_long_long_int );
#else
#   warning "No proper C type found for INTEGER8"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer8, "MPI_INTEGER8", &ompi_mpi_unavailable );
#endif
    ompi_mpi_integer8.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT;
#endif /* OMPI_HAVE_FORTRAN_INTEGER8 */

#if OMPI_HAVE_FORTRAN_INTEGER16
#if (OMPI_SIZEOF_FORTRAN_INTEGER16 == SIZEOF_LONG_LONG)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer16, "MPI_INTEGER16", &ompi_mpi_long_long_int );
#else
#   warning "No proper C type found for INTEGER16"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_integer16, "MPI_INTEGER16", &ompi_mpi_unavailable );
#endif
    ompi_mpi_integer16.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_INT;
#endif /* OMPI_HAVE_FORTRAN_INTEGER16 */

    /* Optional Fortran COMPLEX types */

#if OMPI_HAVE_FORTRAN_COMPLEX8
#if (OMPI_SIZEOF_FORTRAN_COMPLEX8 == 2*SIZEOF_FLOAT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_complex8, "MPI_COMPLEX8", &ompi_mpi_cplex );
#else
#   warning "No proper C type found for COMPLEX8"
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_complex8, "MPI_COMPLEX8", &ompi_mpi_unavailable );
#endif
    ompi_mpi_complex8.flags |= DT_FLAG_DATA_FORTRAN | DT_FLAG_DATA_COMPLEX;
#endif /* OMPI_HAVE_FORTRAN_COMPLEX8 */

#if OMPI_HAVE_FORTRAN_COMPLEX16
#if (OMPI_SIZEOF_FORTRAN_COMPLEX16 == 2*SIZEOF_FLOAT)
    DECLARE_MPI_SYNONYM_DDT( &ompi_mpi_complex16, "MPI_COMPLEX16", &ompi_mpi_cplex );