comm.c

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

/*
 * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
 *                         University Research and Technology
 *                         Corporation.  All rights reserved.
 * Copyright (c) 2004-2006 The University of Tennessee and The University
 *                         of Tennessee Research Foundation.  All rights
 *                         reserved.
 * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, 
 *                         University of Stuttgart.  All rights reserved.
 * Copyright (c) 2004-2005 The Regents of the University of California.
 *                         All rights reserved.
 * $COPYRIGHT$
 * 
 * Additional copyrights may follow
 * 
 * $HEADER$
 */

#include "ompi_config.h"
#include <string.h>
#include <stdio.h>

#include "ompi/constants.h"
#include "orte/dss/dss.h"
#include "ompi/proc/proc.h"
#include "opal/threads/mutex.h"
#include "opal/util/bit_ops.h"
#include "opal/util/output.h"
#include "opal/util/convert.h"
#include "ompi/mca/topo/topo.h"
#include "ompi/mca/topo/base/base.h"
#include "orte/mca/ns/ns.h"

#include "ompi/attribute/attribute.h"
#include "ompi/communicator/communicator.h"
#include "ompi/mca/pml/pml.h"
#include "ompi/request/request.h"

/*
** sort-function for MPI_Comm_split 
*/
static int rankkeycompare(const void *, const void *);

/**
 * to fill the rest of the stuff for the communicator when either
 * MPI_Cart_create or MPI_Graph_create is used 
 */ 
static int ompi_comm_fill_rest (ompi_communicator_t *comm,
                                int num_procs,
                                ompi_proc_t **proc_pointers,
                                int my_rank,
                                ompi_errhandler_t *errh );
/*
** typedef for the allgather_intra required in comm_split.
** the reason for introducing this abstraction is, that
** for Comm_split for inter-coms, we do not have this
** functions, so we need to emulate it.
*/
typedef int ompi_comm_allgatherfct (void* inbuf, int incount, MPI_Datatype intype,
                                    void* outbuf, int outcount, MPI_Datatype outtype,
                                    ompi_communicator_t *comm);

static int ompi_comm_allgather_emulate_intra (void* inbuf, int incount, MPI_Datatype intype,
                                              void* outbuf, int outcount, 
                                              MPI_Datatype outtype, 
                                              ompi_communicator_t *comm);

static int ompi_comm_copy_topo (ompi_communicator_t *oldcomm, 
                                 ompi_communicator_t *newcomm);

/**********************************************************************/
/**********************************************************************/
/**********************************************************************/
/* 
 * This is the function setting all elements of a communicator.
 * All other routines are just used to determine these elements.
 */   

int ompi_comm_set ( ompi_communicator_t *newcomm, 
                    ompi_communicator_t* oldcomm,
                    int local_size, 
                    ompi_proc_t **local_procs,
                    int remote_size,
                    ompi_proc_t **remote_procs,
                    opal_hash_table_t *attr,
                    ompi_errhandler_t *errh,
                    mca_base_component_t *topocomponent )
{
    ompi_proc_t *my_gpointer;
    int my_grank;
    int ret;

    /* Set local_group information */
    memcpy ( newcomm->c_local_group->grp_proc_pointers, 
             local_procs, local_size * sizeof(ompi_proc_t *));
    ompi_group_increment_proc_count(newcomm->c_local_group);
        
    /* determine my rank */
    my_grank    = oldcomm->c_local_group->grp_my_rank;             
    my_gpointer = oldcomm->c_local_group->grp_proc_pointers[my_grank];
    ompi_set_group_rank(newcomm->c_local_group, my_gpointer);
    newcomm->c_my_rank = newcomm->c_local_group->grp_my_rank;

    /* Set remote group, if applicable */
    if ( 0 < remote_size) {        
        memcpy ( newcomm->c_remote_group->grp_proc_pointers, 
                 remote_procs, remote_size * sizeof(ompi_proc_t *));
        ompi_group_increment_proc_count(newcomm->c_remote_group);
        newcomm->c_flags |= OMPI_COMM_INTER;
    }

    /* Check how many different jobids are represented in this communicator.
       Necessary for the disconnect of dynamic communicators. */
    ompi_comm_mark_dyncomm (newcomm);

    /* Set error handler */
    newcomm->error_handler = errh;
    OBJ_RETAIN ( newcomm->error_handler );

    /* Set Topology, if required */
    
    if ( NULL != topocomponent ) {
        /*
         * This functions is never used to determine the topology
         * component. The topology component is determined only by the
         * ompi_cart_create and ompi_comm_create functions. Have to
         * see what ahppens during MPI_Comm_dup though. During this
         * the topology information has to be copied into the new
         * communicator which includes selecting a new topology
         * component and setting the information which is on that
         * communicator into this communicator. This probably is
         * another function in this file.
         */ 
        
        if (OMPI_COMM_IS_CART ( oldcomm ) )
            newcomm->c_flags |= OMPI_COMM_CART;
        if (OMPI_COMM_IS_GRAPH ( oldcomm ) ) 
            newcomm->c_flags |= OMPI_COMM_GRAPH;

        /*
         * Now I have to set the information on the topology from the previous
         * communicator
         */ 

        /* allocate the data for the common good */
        newcomm->c_topo_comm = (mca_topo_base_comm_t *)malloc(sizeof(mca_topo_base_comm_t));

        if (NULL == newcomm->c_topo_comm) {
            OBJ_RELEASE(newcomm);
            return OMPI_ERROR;
        }

        if (OMPI_SUCCESS != (ret = mca_topo_base_comm_select (newcomm, 
                                   oldcomm->c_topo_component))) {
            free(newcomm->c_topo_comm); 
            OBJ_RELEASE(newcomm);
            return ret;
        }

        /*
         * Should copy over the information from the previous communicator
         */
         if (OMPI_SUCCESS != (ret = ompi_comm_copy_topo (oldcomm, newcomm))) {
             OBJ_RELEASE(newcomm);
             return ret;
         }
    }

    /* Copy attributes and call according copy functions, if
       required */

    if (NULL != oldcomm->c_keyhash) {
        if (NULL != attr) {
            ompi_attr_hash_init(&newcomm->c_keyhash);
            if (OMPI_SUCCESS != (ret = ompi_attr_copy_all (COMM_ATTR, oldcomm,
                                                           newcomm, attr, 
                                                           newcomm->c_keyhash))) {
                OBJ_RELEASE(newcomm);
                return ret;
            }                                    
        }
    }

    /* Initialize the PML stuff in the newcomm  */
    if ( OMPI_ERROR == MCA_PML_CALL(add_comm(newcomm)) ) {
        OBJ_RELEASE(newcomm);
        return OMPI_ERROR;
    }
    OMPI_COMM_SET_PML_ADDED(newcomm);
    return (OMPI_SUCCESS);
}


/**********************************************************************/
/**********************************************************************/
/**********************************************************************/
/*
** Counterpart to MPI_Comm_group. To be used within OMPI functions.
*/
int ompi_comm_group ( ompi_communicator_t* comm, ompi_group_t **group )
{
    /* increment reference counters for the group */
    OBJ_RETAIN(comm->c_local_group);

    /* increase also the reference counter for the procs */
    ompi_group_increment_proc_count(comm->c_local_group);

    *group = comm->c_local_group;
    return OMPI_SUCCESS;
}

/**********************************************************************/
/**********************************************************************/
/**********************************************************************/
/*
** Counterpart to MPI_Comm_create. To be used within OMPI.
*/
int ompi_comm_create ( ompi_communicator_t *comm, ompi_group_t *group, 
                      ompi_communicator_t **newcomm )
{
    ompi_communicator_t *newcomp;
    int rsize;
    int mode;
    int *allranks=NULL;
    ompi_proc_t **rprocs=NULL;
    int rc = OMPI_SUCCESS;
    
    if ( OMPI_COMM_IS_INTER(comm) ) {
        int tsize, i, j;

        tsize = ompi_comm_remote_size(comm);
        allranks = (int *) malloc ( tsize * sizeof(int));
        if ( NULL == allranks ) {
            rc = OMPI_ERR_OUT_OF_RESOURCE;
            goto exit;
        }
        
        rc = comm->c_coll.coll_allgather ( &(group->grp_my_rank), 
                                           1, MPI_INT, allranks, 
                                           1, MPI_INT, comm );
        if ( OMPI_SUCCESS != rc ) {
            goto exit;
        }

        /* Count number of procs in future remote group */
        for (rsize=0, i = 0; i < tsize; i++) {
            if ( MPI_UNDEFINED != allranks[i] ) {
                rsize++;
            }
        }

        /* If any of those groups is empty, we have to return
           MPI_COMM_NULL */
        if ( 0 == rsize || 0 == group->grp_proc_count ) {
            newcomp = MPI_COMM_NULL;
            rc = OMPI_SUCCESS;
            goto exit;
        }

        /* Set proc-pointers for remote group */
        rprocs = (ompi_proc_t **) calloc ( rsize, sizeof(ompi_proc_t *));
        if ( NULL == rprocs ) {
            rc = OMPI_ERR_OUT_OF_RESOURCE;
            goto exit;
        }

        for ( j = 0, i = 0; i < tsize; i++ ) {
            if ( MPI_UNDEFINED != allranks[i] ) {
                rprocs[j] = comm->c_remote_group->grp_proc_pointers[i];
                j++;
            }
        }                                           
        mode = OMPI_COMM_CID_INTER;

    }
    else {
        rsize  = 0;
        rprocs = NULL;
        mode   = OMPI_COMM_CID_INTRA;
    }
    
    newcomp = ompi_comm_allocate (group->grp_proc_count, rsize );
    if ( NULL == newcomp ) {
        rc = MPI_ERR_INTERN;
        goto exit;
    }

    /* Determine context id. It is identical to f_2_c_handle */
    rc = ompi_comm_nextcid ( newcomp,  /* new communicator */ 
                             comm,     /* old comm */
                             NULL,     /* bridge comm */
                             NULL,     /* local leader */
                             NULL,     /* remote_leader */
                             mode,     /* mode */
                             -1 );     /* send first */
    if ( OMPI_SUCCESS != rc ) {
        goto exit;
    }

    rc = ompi_comm_set ( newcomp,                  /* new comm */
                         comm,                     /* old comm */
                         group->grp_proc_count,    /* local_size */
                         group->grp_proc_pointers, /* local_procs*/
                         rsize,                    /* remote_size */
                         rprocs,                   /* remote_procs */
                         NULL,                     /* attrs */
                         comm->error_handler,      /* error handler */
                         NULL                      /* topo component */
                         );
    if ( OMPI_SUCCESS != rc ) {
        goto exit;
    }

    /* Set name for debugging purposes */
    snprintf(newcomp->c_name, MPI_MAX_OBJECT_NAME, "MPI COMMUNICATOR %d CREATE FROM %d", 
             newcomp->c_contextid, comm->c_contextid );

    /* Activate the communicator and init coll-component */
    rc = ompi_comm_activate ( newcomp,  /* new communicator */ 
                              comm,     /* old comm */
                              NULL,     /* bridge comm */
                              NULL,     /* local leader */
                              NULL,     /* remote_leader */
                              mode,     /* mode */
                              -1,       /* send first */
                              NULL );   /* coll component */
                             
    if ( OMPI_SUCCESS != rc ) {
        goto exit;
    }


    /* Check whether we are part of the new comm.
       If not, we have to free the structure again.
       However, we could not avoid the comm_nextcid step, since
       all processes of the original comm have to participate in
       that function call. Additionally, all errhandler stuff etc.
       has to be set to make ompi_comm_free happy */
    if ( MPI_UNDEFINED == newcomp->c_local_group->grp_my_rank ) {
        ompi_comm_free ( &newcomp );
    }

 exit:
    if ( NULL != allranks ) {
        free ( allranks );
    }
    if ( NULL != rprocs ) {
        free ( rprocs );
    }

    *newcomm = newcomp;
    return ( rc );
}


/**********************************************************************/
/**********************************************************************/
/**********************************************************************/
/*
** Counterpart to MPI_Comm_split. To be used within OMPI (e.g. MPI_Cart_sub).
*/
int ompi_comm_split ( ompi_communicator_t* comm, int color, int key, 
                     ompi_communicator_t **newcomm, bool pass_on_topo )
{
    int myinfo[2];
    int size, my_size;