Blame src/mpi/datatype/type_contiguous.c

Packit Service c5cf8c
/* -*- Mode: C; c-basic-offset:4 ; indent-tabs-mode:nil ; -*- */
Packit Service c5cf8c
/*
Packit Service c5cf8c
 *  (C) 2002 by Argonne National Laboratory.
Packit Service c5cf8c
 *      See COPYRIGHT in top-level directory.
Packit Service c5cf8c
 */
Packit Service c5cf8c
Packit Service c5cf8c
#include "mpiimpl.h"
Packit Service c5cf8c
#include "datatype.h"
Packit Service c5cf8c
Packit Service c5cf8c
/* -- Begin Profiling Symbol Block for routine MPI_Type_contigous */
Packit Service c5cf8c
#if defined(HAVE_PRAGMA_WEAK)
Packit Service c5cf8c
#pragma weak MPI_Type_contiguous = PMPI_Type_contiguous
Packit Service c5cf8c
#elif defined(HAVE_PRAGMA_HP_SEC_DEF)
Packit Service c5cf8c
#pragma _HP_SECONDARY_DEF PMPI_Type_contiguous  MPI_Type_contiguous
Packit Service c5cf8c
#elif defined(HAVE_PRAGMA_CRI_DUP)
Packit Service c5cf8c
#pragma _CRI duplicate MPI_Type_contiguous as PMPI_Type_contiguous
Packit Service c5cf8c
#elif defined(HAVE_WEAK_ATTRIBUTE)
Packit Service c5cf8c
int MPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype * newtype)
Packit Service c5cf8c
    __attribute__ ((weak, alias("PMPI_Type_contiguous")));
Packit Service c5cf8c
#endif
Packit Service c5cf8c
/* -- End Profiling Symbol Block */
Packit Service c5cf8c
Packit Service c5cf8c
/* Define MPICH_MPI_FROM_PMPI if weak symbols are not supported to build
Packit Service c5cf8c
   the MPI routines.  You can use USE_WEAK_SYMBOLS to see if MPICH is
Packit Service c5cf8c
   using weak symbols to implement the MPI routines. */
Packit Service c5cf8c
#ifndef MPICH_MPI_FROM_PMPI
Packit Service c5cf8c
#undef MPI_Type_contiguous
Packit Service c5cf8c
#define MPI_Type_contiguous PMPI_Type_contiguous
Packit Service c5cf8c
Packit Service c5cf8c
/*@
Packit Service c5cf8c
  MPIR_Type_contiguous - create a contiguous datatype
Packit Service c5cf8c
Packit Service c5cf8c
Input Parameters:
Packit Service c5cf8c
+ count - number of elements in the contiguous block
Packit Service c5cf8c
- oldtype - type (using handle) of datatype on which vector is based
Packit Service c5cf8c
Packit Service c5cf8c
Output Parameters:
Packit Service c5cf8c
. newtype - handle of new contiguous datatype
Packit Service c5cf8c
Packit Service c5cf8c
  Return Value:
Packit Service c5cf8c
  MPI_SUCCESS on success, MPI error code on failure.
Packit Service c5cf8c
@*/
Packit Service c5cf8c
int MPIR_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype * newtype)
Packit Service c5cf8c
{
Packit Service c5cf8c
    int mpi_errno = MPI_SUCCESS;
Packit Service c5cf8c
    int is_builtin;
Packit Service c5cf8c
    MPI_Aint el_sz;
Packit Service c5cf8c
    MPI_Datatype el_type;
Packit Service c5cf8c
    MPIR_Datatype *new_dtp;
Packit Service c5cf8c
Packit Service c5cf8c
    if (count == 0)
Packit Service c5cf8c
        return MPII_Type_zerolen(newtype);
Packit Service c5cf8c
Packit Service c5cf8c
    /* allocate new datatype object and handle */
Packit Service c5cf8c
    new_dtp = (MPIR_Datatype *) MPIR_Handle_obj_alloc(&MPIR_Datatype_mem);
Packit Service c5cf8c
    /* --BEGIN ERROR HANDLING-- */
Packit Service c5cf8c
    if (!new_dtp) {
Packit Service c5cf8c
        mpi_errno = MPIR_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE,
Packit Service c5cf8c
                                         "MPIR_Type_contiguous",
Packit Service c5cf8c
                                         __LINE__, MPI_ERR_OTHER, "**nomem", 0);
Packit Service c5cf8c
        return mpi_errno;
Packit Service c5cf8c
    }
Packit Service c5cf8c
    /* --END ERROR HANDLING-- */
Packit Service c5cf8c
Packit Service c5cf8c
    /* handle is filled in by MPIR_Handle_obj_alloc() */
Packit Service c5cf8c
    MPIR_Object_set_ref(new_dtp, 1);
Packit Service c5cf8c
    new_dtp->is_permanent = 0;
Packit Service c5cf8c
    new_dtp->is_committed = 0;
Packit Service c5cf8c
    new_dtp->attributes = NULL;
Packit Service c5cf8c
    new_dtp->cache_id = 0;
Packit Service c5cf8c
    new_dtp->name[0] = 0;
Packit Service c5cf8c
    new_dtp->contents = NULL;
Packit Service c5cf8c
Packit Service c5cf8c
    new_dtp->dataloop = NULL;
Packit Service c5cf8c
    new_dtp->dataloop_size = -1;
Packit Service c5cf8c
    new_dtp->dataloop_depth = -1;
Packit Service c5cf8c
Packit Service c5cf8c
    is_builtin = (HANDLE_GET_KIND(oldtype) == HANDLE_KIND_BUILTIN);
Packit Service c5cf8c
Packit Service c5cf8c
    if (is_builtin) {
Packit Service c5cf8c
        el_sz = MPIR_Datatype_get_basic_size(oldtype);
Packit Service c5cf8c
        el_type = oldtype;
Packit Service c5cf8c
Packit Service c5cf8c
        new_dtp->size = count * el_sz;
Packit Service c5cf8c
        new_dtp->has_sticky_ub = 0;
Packit Service c5cf8c
        new_dtp->has_sticky_lb = 0;
Packit Service c5cf8c
        new_dtp->true_lb = 0;
Packit Service c5cf8c
        new_dtp->lb = 0;
Packit Service c5cf8c
        new_dtp->true_ub = count * el_sz;
Packit Service c5cf8c
        new_dtp->ub = new_dtp->true_ub;
Packit Service c5cf8c
        new_dtp->extent = new_dtp->ub - new_dtp->lb;
Packit Service c5cf8c
Packit Service c5cf8c
        new_dtp->alignsize = el_sz;
Packit Service c5cf8c
        new_dtp->n_builtin_elements = count;
Packit Service c5cf8c
        new_dtp->builtin_element_size = el_sz;
Packit Service c5cf8c
        new_dtp->basic_type = el_type;
Packit Service c5cf8c
        new_dtp->is_contig = 1;
Packit Service c5cf8c
        new_dtp->max_contig_blocks = 1;
Packit Service c5cf8c
Packit Service c5cf8c
    } else {
Packit Service c5cf8c
        /* user-defined base type (oldtype) */
Packit Service c5cf8c
        MPIR_Datatype *old_dtp;
Packit Service c5cf8c
Packit Service c5cf8c
        MPIR_Datatype_get_ptr(oldtype, old_dtp);
Packit Service c5cf8c
        el_sz = old_dtp->builtin_element_size;
Packit Service c5cf8c
        el_type = old_dtp->basic_type;
Packit Service c5cf8c
Packit Service c5cf8c
        new_dtp->size = count * old_dtp->size;
Packit Service c5cf8c
        new_dtp->has_sticky_ub = old_dtp->has_sticky_ub;
Packit Service c5cf8c
        new_dtp->has_sticky_lb = old_dtp->has_sticky_lb;
Packit Service c5cf8c
Packit Service c5cf8c
        MPII_DATATYPE_CONTIG_LB_UB((MPI_Aint) count,
Packit Service c5cf8c
                                   old_dtp->lb,
Packit Service c5cf8c
                                   old_dtp->ub, old_dtp->extent, new_dtp->lb, new_dtp->ub);
Packit Service c5cf8c
Packit Service c5cf8c
        /* easiest to calc true lb/ub relative to lb/ub; doesn't matter
Packit Service c5cf8c
         * if there are sticky lb/ubs or not when doing this.
Packit Service c5cf8c
         */
Packit Service c5cf8c
        new_dtp->true_lb = new_dtp->lb + (old_dtp->true_lb - old_dtp->lb);
Packit Service c5cf8c
        new_dtp->true_ub = new_dtp->ub + (old_dtp->true_ub - old_dtp->ub);
Packit Service c5cf8c
        new_dtp->extent = new_dtp->ub - new_dtp->lb;
Packit Service c5cf8c
Packit Service c5cf8c
        new_dtp->alignsize = old_dtp->alignsize;
Packit Service c5cf8c
        new_dtp->n_builtin_elements = count * old_dtp->n_builtin_elements;
Packit Service c5cf8c
        new_dtp->builtin_element_size = old_dtp->builtin_element_size;
Packit Service c5cf8c
        new_dtp->basic_type = el_type;
Packit Service c5cf8c
Packit Service c5cf8c
        MPIR_Datatype_is_contig(oldtype, &new_dtp->is_contig);
Packit Service c5cf8c
        if (new_dtp->is_contig)
Packit Service c5cf8c
            new_dtp->max_contig_blocks = 1;
Packit Service c5cf8c
        else
Packit Service c5cf8c
            new_dtp->max_contig_blocks = count * old_dtp->max_contig_blocks;
Packit Service c5cf8c
    }
Packit Service c5cf8c
Packit Service c5cf8c
    *newtype = new_dtp->handle;
Packit Service c5cf8c
Packit Service c5cf8c
    MPL_DBG_MSG_P(MPIR_DBG_DATATYPE, VERBOSE, "contig type %x created.", new_dtp->handle);
Packit Service c5cf8c
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
}
Packit Service c5cf8c
Packit Service c5cf8c
#undef FUNCNAME
Packit Service c5cf8c
#define FUNCNAME MPIR_Type_contiguous_impl
Packit Service c5cf8c
#undef FCNAME
Packit Service c5cf8c
#define FCNAME MPL_QUOTE(FUNCNAME)
Packit Service c5cf8c
int MPIR_Type_contiguous_impl(int count, MPI_Datatype oldtype, MPI_Datatype * newtype)
Packit Service c5cf8c
{
Packit Service c5cf8c
    int mpi_errno = MPI_SUCCESS;
Packit Service c5cf8c
    MPIR_Datatype *new_dtp;
Packit Service c5cf8c
    MPI_Datatype new_handle;
Packit Service c5cf8c
Packit Service c5cf8c
    mpi_errno = MPIR_Type_contiguous(count, oldtype, &new_handle);
Packit Service c5cf8c
Packit Service c5cf8c
    if (mpi_errno != MPI_SUCCESS)
Packit Service c5cf8c
        goto fn_fail;
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_Datatype_get_ptr(new_handle, new_dtp);
Packit Service c5cf8c
    mpi_errno = MPIR_Datatype_set_contents(new_dtp, MPI_COMBINER_CONTIGUOUS, 1, /* ints (count) */
Packit Service c5cf8c
                                           0, 1, &count, NULL, &oldtype);
Packit Service c5cf8c
Packit Service c5cf8c
    if (mpi_errno != MPI_SUCCESS)
Packit Service c5cf8c
        goto fn_fail;
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_OBJ_PUBLISH_HANDLE(*newtype, new_handle);
Packit Service c5cf8c
Packit Service c5cf8c
  fn_exit:
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
  fn_fail:
Packit Service c5cf8c
Packit Service c5cf8c
    goto fn_exit;
Packit Service c5cf8c
}
Packit Service c5cf8c
Packit Service c5cf8c
#undef FUNCNAME
Packit Service c5cf8c
#define FUNCNAME MPIR_Type_contiguous_x_impl
Packit Service c5cf8c
#undef FCNAME
Packit Service c5cf8c
#define FCNAME MPL_QUOTE(FUNCNAME)
Packit Service c5cf8c
int MPIR_Type_contiguous_x_impl(MPI_Count count, MPI_Datatype oldtype, MPI_Datatype * newtype)
Packit Service c5cf8c
{
Packit Service c5cf8c
    /* to make 'count' fit MPI-3 type processing routines (which take integer
Packit Service c5cf8c
     * counts), we construct a type consisting of N INT_MAX chunks followed by
Packit Service c5cf8c
     * a remainder.  e.g for a count of 4000000000 bytes you would end up with
Packit Service c5cf8c
     * one 2147483647-byte chunk followed immediately by a 1852516353-byte
Packit Service c5cf8c
     * chunk */
Packit Service c5cf8c
    MPI_Datatype chunks, remainder;
Packit Service c5cf8c
    MPI_Aint lb, extent, disps[2];
Packit Service c5cf8c
    int blocklens[2];
Packit Service c5cf8c
    MPI_Datatype types[2];
Packit Service c5cf8c
    int mpi_errno;
Packit Service c5cf8c
Packit Service c5cf8c
    /* truly stupendously large counts will overflow an integer with this math,
Packit Service c5cf8c
     * but that is a problem for a few decades from now.  Sorry, few decades
Packit Service c5cf8c
     * from now! */
Packit Service c5cf8c
    MPIR_Assert(count / INT_MAX == (int) (count / INT_MAX));
Packit Service c5cf8c
    int c = (int) (count / INT_MAX);    /* OK to cast until 'count' is 256 bits */
Packit Service c5cf8c
    int r = count % INT_MAX;
Packit Service c5cf8c
Packit Service c5cf8c
    mpi_errno = MPIR_Type_vector_impl(c, INT_MAX, INT_MAX, oldtype, &chunks);
Packit Service c5cf8c
    if (mpi_errno != MPI_SUCCESS)
Packit Service c5cf8c
        goto fn_fail;
Packit Service c5cf8c
    mpi_errno = MPIR_Type_contiguous_impl(r, oldtype, &remainder);
Packit Service c5cf8c
    if (mpi_errno != MPI_SUCCESS)
Packit Service c5cf8c
        goto fn_fail;
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_Type_get_extent_impl(oldtype, &lb, &extent);
Packit Service c5cf8c
Packit Service c5cf8c
    blocklens[0] = 1;
Packit Service c5cf8c
    blocklens[1] = 1;
Packit Service c5cf8c
    disps[0] = 0;
Packit Service c5cf8c
    disps[1] = c * extent * INT_MAX;
Packit Service c5cf8c
    types[0] = chunks;
Packit Service c5cf8c
    types[1] = remainder;
Packit Service c5cf8c
Packit Service c5cf8c
    mpi_errno = MPIR_Type_create_struct_impl(2, blocklens, disps, types, newtype);
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_Type_free_impl(&chunks);
Packit Service c5cf8c
    MPIR_Type_free_impl(&remainder);
Packit Service c5cf8c
Packit Service c5cf8c
  fn_exit:
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
  fn_fail:
Packit Service c5cf8c
    goto fn_exit;
Packit Service c5cf8c
}
Packit Service c5cf8c
#endif
Packit Service c5cf8c
Packit Service c5cf8c
Packit Service c5cf8c
#undef FUNCNAME
Packit Service c5cf8c
#define FUNCNAME MPI_Type_contiguous
Packit Service c5cf8c
#undef FCNAME
Packit Service c5cf8c
#define FCNAME MPL_QUOTE(FUNCNAME)
Packit Service c5cf8c
/*@
Packit Service c5cf8c
    MPI_Type_contiguous - Creates a contiguous datatype
Packit Service c5cf8c
Packit Service c5cf8c
Input Parameters:
Packit Service c5cf8c
+ count - replication count (nonnegative integer)
Packit Service c5cf8c
- oldtype - old datatype (handle)
Packit Service c5cf8c
Packit Service c5cf8c
Output Parameters:
Packit Service c5cf8c
. newtype - new datatype (handle)
Packit Service c5cf8c
Packit Service c5cf8c
.N ThreadSafe
Packit Service c5cf8c
Packit Service c5cf8c
.N Fortran
Packit Service c5cf8c
Packit Service c5cf8c
.N Errors
Packit Service c5cf8c
.N MPI_SUCCESS
Packit Service c5cf8c
.N MPI_ERR_TYPE
Packit Service c5cf8c
.N MPI_ERR_COUNT
Packit Service c5cf8c
.N MPI_ERR_EXHAUSTED
Packit Service c5cf8c
@*/
Packit Service c5cf8c
int MPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype * newtype)
Packit Service c5cf8c
{
Packit Service c5cf8c
    int mpi_errno = MPI_SUCCESS;
Packit Service c5cf8c
    MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPI_TYPE_CONTIGUOUS);
Packit Service c5cf8c
Packit Service c5cf8c
    MPIR_ERRTEST_INITIALIZED_ORDIE();
Packit Service c5cf8c
Packit Service c5cf8c
    MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
Packit Service c5cf8c
    MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPI_TYPE_CONTIGUOUS);
Packit Service c5cf8c
Packit Service c5cf8c
#ifdef HAVE_ERROR_CHECKING
Packit Service c5cf8c
    {
Packit Service c5cf8c
        MPID_BEGIN_ERROR_CHECKS;
Packit Service c5cf8c
        {
Packit Service c5cf8c
            MPIR_Datatype *datatype_ptr = NULL;
Packit Service c5cf8c
Packit Service c5cf8c
            MPIR_ERRTEST_COUNT(count, mpi_errno);
Packit Service c5cf8c
            MPIR_ERRTEST_DATATYPE(oldtype, "datatype", mpi_errno);
Packit Service c5cf8c
Packit Service c5cf8c
            if (HANDLE_GET_KIND(oldtype) != HANDLE_KIND_BUILTIN) {
Packit Service c5cf8c
                MPIR_Datatype_get_ptr(oldtype, datatype_ptr);
Packit Service c5cf8c
                MPIR_Datatype_valid_ptr(datatype_ptr, mpi_errno);
Packit Service c5cf8c
                if (mpi_errno != MPI_SUCCESS)
Packit Service c5cf8c
                    goto fn_fail;
Packit Service c5cf8c
            }
Packit Service c5cf8c
            MPIR_ERRTEST_ARGNULL(newtype, "newtype", mpi_errno);
Packit Service c5cf8c
        }
Packit Service c5cf8c
        MPID_END_ERROR_CHECKS;
Packit Service c5cf8c
    }
Packit Service c5cf8c
#endif /* HAVE_ERROR_CHECKING */
Packit Service c5cf8c
Packit Service c5cf8c
    /* ... body of routine ... */
Packit Service c5cf8c
Packit Service c5cf8c
    mpi_errno = MPIR_Type_contiguous_impl(count, oldtype, newtype);
Packit Service c5cf8c
    if (mpi_errno)
Packit Service c5cf8c
        MPIR_ERR_POP(mpi_errno);
Packit Service c5cf8c
Packit Service c5cf8c
    /* ... end of body of routine ... */
Packit Service c5cf8c
Packit Service c5cf8c
  fn_exit:
Packit Service c5cf8c
    MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPI_TYPE_CONTIGUOUS);
Packit Service c5cf8c
    MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
Packit Service c5cf8c
    return mpi_errno;
Packit Service c5cf8c
Packit Service c5cf8c
  fn_fail:
Packit Service c5cf8c
    /* --BEGIN ERROR HANDLING-- */
Packit Service c5cf8c
#ifdef HAVE_ERROR_CHECKING
Packit Service c5cf8c
    {
Packit Service c5cf8c
        mpi_errno =
Packit Service c5cf8c
            MPIR_Err_create_code(mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
Packit Service c5cf8c
                                 "**mpi_type_contiguous", "**mpi_type_contiguous %d %D %p", count,
Packit Service c5cf8c
                                 oldtype, newtype);
Packit Service c5cf8c
    }
Packit Service c5cf8c
#endif
Packit Service c5cf8c
    mpi_errno = MPIR_Err_return_comm(NULL, FCNAME, mpi_errno);
Packit Service c5cf8c
    goto fn_exit;
Packit Service c5cf8c
    /* --END ERROR HANDLING-- */
Packit Service c5cf8c
}