int MPIR_Comm_delete_internal(MPID_Comm * comm_ptr)
{
int in_use;
int mpi_errno = MPI_SUCCESS;
MPID_MPI_STATE_DECL(MPID_STATE_COMM_DELETE_INTERNAL);
MPID_MPI_FUNC_ENTER(MPID_STATE_COMM_DELETE_INTERNAL);
MPIU_Assert(MPIU_Object_get_ref(comm_ptr) == 0); /* sanity check */
/* Remove the attributes, executing the attribute delete routine.
* Do this only if the attribute functions are defined.
* This must be done first, because if freeing the attributes
* returns an error, the communicator is not freed */
if (MPIR_Process.attr_free && comm_ptr->attributes) {
/* Temporarily add a reference to this communicator because
* the attr_free code requires a valid communicator */
MPIU_Object_add_ref(comm_ptr);
mpi_errno = MPIR_Process.attr_free(comm_ptr->handle, &comm_ptr->attributes);
/* Release the temporary reference added before the call to
* attr_free */
MPIU_Object_release_ref(comm_ptr, &in_use);
}
/* If the attribute delete functions return failure, the
* communicator must not be freed. That is the reason for the
* test on mpi_errno here. */
if (mpi_errno == MPI_SUCCESS) {
/* If this communicator is our parent, and we're disconnecting
* from the parent, mark that fact */
if (MPIR_Process.comm_parent == comm_ptr)
MPIR_Process.comm_parent = NULL;
/* Notify the device that the communicator is about to be
* destroyed */
mpi_errno = MPID_Dev_comm_destroy_hook(comm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Free info hints */
if (comm_ptr->info != NULL) {
MPIU_Info_free(comm_ptr->info);
}
/* release our reference to the collops structure, comes after the
* destroy_hook to allow the device to manage these vtables in a custom
* fashion */
if (comm_ptr->coll_fns && --comm_ptr->coll_fns->ref_count == 0) {
MPIU_Free(comm_ptr->coll_fns);
comm_ptr->coll_fns = NULL;
}
if (comm_ptr->comm_kind == MPID_INTERCOMM && comm_ptr->local_comm)
MPIR_Comm_release(comm_ptr->local_comm);
/* Free the local and remote groups, if they exist */
if (comm_ptr->local_group)
MPIR_Group_release(comm_ptr->local_group);
if (comm_ptr->remote_group)
MPIR_Group_release(comm_ptr->remote_group);
/* free the intra/inter-node communicators, if they exist */
if (comm_ptr->node_comm)
MPIR_Comm_release(comm_ptr->node_comm);
if (comm_ptr->node_roots_comm)
MPIR_Comm_release(comm_ptr->node_roots_comm);
if (comm_ptr->intranode_table != NULL)
MPIU_Free(comm_ptr->intranode_table);
if (comm_ptr->internode_table != NULL)
MPIU_Free(comm_ptr->internode_table);
/* Free the context value. This should come after freeing the
* intra/inter-node communicators since those free calls won't
* release this context ID and releasing this before then could lead
* to races once we make threading finer grained. */
/* This must be the recvcontext_id (i.e. not the (send)context_id)
* because in the case of intercommunicators the send context ID is
* allocated out of the remote group's bit vector, not ours. */
MPIR_Free_contextid(comm_ptr->recvcontext_id);
/* We need to release the error handler */
if (comm_ptr->errhandler &&
!(HANDLE_GET_KIND(comm_ptr->errhandler->handle) == HANDLE_KIND_BUILTIN)) {
int errhInuse;
MPIR_Errhandler_release_ref(comm_ptr->errhandler, &errhInuse);
if (!errhInuse) {
MPIU_Handle_obj_free(&MPID_Errhandler_mem, comm_ptr->errhandler);
}
}
/* Remove from the list of active communicators if
* we are supporting message-queue debugging. We make this
* conditional on having debugger support since the
* operation is not constant-time */
MPIR_COMML_FORGET(comm_ptr);
/* Check for predefined communicators - these should not
* be freed */
if (!(HANDLE_GET_KIND(comm_ptr->handle) == HANDLE_KIND_BUILTIN))
MPIU_Handle_obj_free(&MPID_Comm_mem, comm_ptr);
}
else {
/* If the user attribute free function returns an error,
* then do not free the communicator */
MPIR_Comm_add_ref(comm_ptr);
}
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_COMM_DELETE_INTERNAL);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIR_Comm_copy(MPID_Comm * comm_ptr, int size, MPID_Comm ** outcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIU_Context_id_t new_context_id, new_recvcontext_id;
MPID_Comm *newcomm_ptr = NULL;
MPIR_Comm_map_t *map;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_COPY);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_COPY);
/* Get a new context first. We need this to be collective over the
* input communicator */
/* If there is a context id cache in oldcomm, use it here. Otherwise,
* use the appropriate algorithm to get a new context id. Be careful
* of intercomms here */
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
mpi_errno = MPIR_Get_intercomm_contextid(comm_ptr, &new_context_id, &new_recvcontext_id);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
}
else {
mpi_errno = MPIR_Get_contextid_sparse(comm_ptr, &new_context_id, FALSE);
new_recvcontext_id = new_context_id;
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
MPIU_Assert(new_context_id != 0);
}
/* This is the local size, not the remote size, in the case of
* an intercomm */
if (comm_ptr->rank >= size) {
*outcomm_ptr = 0;
/* always free the recvcontext ID, never the "send" ID */
MPIR_Free_contextid(new_recvcontext_id);
goto fn_exit;
}
/* We're left with the processes that will have a non-null communicator.
* Create the object, initialize the data, and return the result */
mpi_errno = MPIR_Comm_create(&newcomm_ptr);
if (mpi_errno)
goto fn_fail;
newcomm_ptr->context_id = new_context_id;
newcomm_ptr->recvcontext_id = new_recvcontext_id;
/* Save the kind of the communicator */
newcomm_ptr->comm_kind = comm_ptr->comm_kind;
newcomm_ptr->local_comm = 0;
/* There are two cases here - size is the same as the old communicator,
* or it is smaller. If the size is the same, we can just add a reference.
* Otherwise, we need to create a new network address mapping. Note that this is the
* test that matches the test on rank above. */
if (size == comm_ptr->local_size) {
/* Duplicate the network address mapping */
if (comm_ptr->comm_kind == MPID_INTRACOMM)
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
else
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_R2R);
}
else {
int i;
if (comm_ptr->comm_kind == MPID_INTRACOMM)
MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_L2L, &map);
else
MPIR_Comm_map_irregular(newcomm_ptr, comm_ptr, NULL, size, MPIR_COMM_MAP_DIR_R2R, &map);
for (i = 0; i < size; i++) {
/* For rank i in the new communicator, find the corresponding
* rank in the input communicator */
map->src_mapping[i] = i;
}
}
/* If it is an intercomm, duplicate the local network address references */
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
MPIR_Comm_map_dup(newcomm_ptr, comm_ptr, MPIR_COMM_MAP_DIR_L2L);
}
/* Set the sizes and ranks */
newcomm_ptr->rank = comm_ptr->rank;
if (comm_ptr->comm_kind == MPID_INTERCOMM) {
newcomm_ptr->local_size = comm_ptr->local_size;
newcomm_ptr->remote_size = comm_ptr->remote_size;
newcomm_ptr->is_low_group = comm_ptr->is_low_group;
}
else {
newcomm_ptr->local_size = size;
newcomm_ptr->remote_size = size;
}
/* Inherit the error handler (if any) */
MPID_THREAD_CS_ENTER(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
newcomm_ptr->errhandler = comm_ptr->errhandler;
if (comm_ptr->errhandler) {
MPIR_Errhandler_add_ref(comm_ptr->errhandler);
}
MPID_THREAD_CS_EXIT(POBJ, MPIR_THREAD_POBJ_COMM_MUTEX(comm_ptr));
/* FIXME do we want to copy coll_fns here? */
mpi_errno = MPIR_Comm_commit(newcomm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Start with no attributes on this communicator */
newcomm_ptr->attributes = 0;
/* Copy over the info hints from the original communicator. */
mpi_errno = MPIR_Info_dup_impl(comm_ptr->info, &(newcomm_ptr->info));
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_apply_hints(newcomm_ptr, newcomm_ptr->info);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
*outcomm_ptr = newcomm_ptr;
fn_fail:
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_COPY);
return mpi_errno;
}
/* comm create group impl; assumes that the standard error checking
* has already taken place in the calling function */
int MPIR_Comm_create_group(MPIR_Comm * comm_ptr, MPIR_Group * group_ptr, int tag,
MPIR_Comm ** newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
int *mapping = NULL;
int n;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_GROUP);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_CREATE_GROUP);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM);
n = group_ptr->size;
*newcomm_ptr = NULL;
/* Create a new communicator from the specified group members */
if (group_ptr->rank != MPI_UNDEFINED) {
MPIR_Comm *mapping_comm = NULL;
/* For this routine, creation of the id is collective over the input
*group*, so processes not in the group do not participate. */
mpi_errno = MPIR_Get_contextid_sparse_group( comm_ptr, group_ptr, tag, &new_context_id, 0 );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
mpi_errno = MPII_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping, &mapping_comm);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( newcomm_ptr );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
(*newcomm_ptr)->recvcontext_id = new_context_id;
(*newcomm_ptr)->rank = group_ptr->rank;
(*newcomm_ptr)->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
about the group */
(*newcomm_ptr)->local_comm = 0;
(*newcomm_ptr)->local_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->remote_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->context_id = (*newcomm_ptr)->recvcontext_id;
(*newcomm_ptr)->remote_size = (*newcomm_ptr)->local_size = n;
/* Setup the communicator's vc table. This is for the remote group,
which is the same as the local group for intracommunicators */
mpi_errno = MPII_Comm_create_map(n, 0,
mapping,
NULL,
mapping_comm,
*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_commit(*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
/* This process is not in the group */
new_context_id = 0;
}
fn_exit:
if (mapping)
MPL_free(mapping);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_CREATE_GROUP);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
if (*newcomm_ptr != NULL) {
MPIR_Comm_release(*newcomm_ptr);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0)
MPIR_Free_contextid(new_context_id);
/* --END ERROR HANDLING-- */
goto fn_exit;
}
/* comm create impl for intracommunicators, assumes that the standard error
* checking has already taken place in the calling function */
int MPIR_Comm_create_intra(MPIR_Comm *comm_ptr, MPIR_Group *group_ptr,
MPIR_Comm **newcomm_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
int *mapping = NULL;
int n;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIR_Assert(comm_ptr->comm_kind == MPIR_COMM_KIND__INTRACOMM);
n = group_ptr->size;
*newcomm_ptr = NULL;
/* Create a new communicator from the specified group members */
/* Creating the context id is collective over the *input* communicator,
so it must be created before we decide if this process is a
member of the group */
/* In the multi-threaded case, MPIR_Get_contextid_sparse assumes that the
calling routine already holds the single criticial section */
mpi_errno = MPIR_Get_contextid_sparse( comm_ptr, &new_context_id,
group_ptr->rank == MPI_UNDEFINED );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
MPIR_Assert(new_context_id != 0);
if (group_ptr->rank != MPI_UNDEFINED) {
MPIR_Comm *mapping_comm = NULL;
mpi_errno = MPII_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping, &mapping_comm);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( newcomm_ptr );
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
(*newcomm_ptr)->recvcontext_id = new_context_id;
(*newcomm_ptr)->rank = group_ptr->rank;
(*newcomm_ptr)->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
about the group */
(*newcomm_ptr)->local_comm = 0;
(*newcomm_ptr)->local_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->remote_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
(*newcomm_ptr)->context_id = (*newcomm_ptr)->recvcontext_id;
(*newcomm_ptr)->remote_size = (*newcomm_ptr)->local_size = n;
(*newcomm_ptr)->pof2 = MPL_pof2(n);
/* Setup the communicator's network address mapping. This is for the remote group,
which is the same as the local group for intracommunicators */
mpi_errno = MPII_Comm_create_map(n, 0,
mapping,
NULL,
mapping_comm,
*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
mpi_errno = MPIR_Comm_commit(*newcomm_ptr);
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
}
else {
/* This process is not in the group */
new_context_id = 0;
}
fn_exit:
if (mapping)
MPL_free(mapping);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_COMM_CREATE_INTRA);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
if (*newcomm_ptr != NULL) {
MPIR_Comm_release(*newcomm_ptr);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0 && group_ptr->rank != MPI_UNDEFINED) {
MPIR_Free_contextid(new_context_id);
}
/* --END ERROR HANDLING-- */
goto fn_exit;
}
/* comm create impl for intracommunicators, assumes that the standard error
* checking has already taken place in the calling function */
PMPI_LOCAL int MPIR_Comm_create_intra(MPID_Comm *comm_ptr, MPID_Group *group_ptr, MPI_Comm *newcomm)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Context_id_t new_context_id = 0;
MPID_Comm *newcomm_ptr = NULL;
int *mapping = NULL;
int n;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_COMM_CREATE_INTRA);
MPIU_Assert(comm_ptr->comm_kind == MPID_INTRACOMM);
n = group_ptr->size;
*newcomm = MPI_COMM_NULL;
/* Create a new communicator from the specified group members */
/* Creating the context id is collective over the *input* communicator,
so it must be created before we decide if this process is a
member of the group */
/* In the multi-threaded case, MPIR_Get_contextid assumes that the
calling routine already holds the single criticial section */
/* TODO should be converted to use MPIR_Get_contextid_sparse instead */
mpi_errno = MPIR_Get_contextid( comm_ptr, &new_context_id );
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Assert(new_context_id != 0);
if (group_ptr->rank != MPI_UNDEFINED) {
MPID_VCR *mapping_vcr = NULL;
mpi_errno = MPIR_Comm_create_calculate_mapping(group_ptr, comm_ptr,
&mapping_vcr, &mapping);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Get the new communicator structure and context id */
mpi_errno = MPIR_Comm_create( &newcomm_ptr );
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
newcomm_ptr->recvcontext_id = new_context_id;
newcomm_ptr->rank = group_ptr->rank;
newcomm_ptr->comm_kind = comm_ptr->comm_kind;
/* Since the group has been provided, let the new communicator know
about the group */
newcomm_ptr->local_comm = 0;
newcomm_ptr->local_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
newcomm_ptr->remote_group = group_ptr;
MPIR_Group_add_ref( group_ptr );
newcomm_ptr->context_id = newcomm_ptr->recvcontext_id;
newcomm_ptr->remote_size = newcomm_ptr->local_size = n;
/* Setup the communicator's vc table. This is for the remote group,
which is the same as the local group for intracommunicators */
mpi_errno = MPIR_Comm_create_create_and_map_vcrt(n,
mapping,
mapping_vcr,
&newcomm_ptr->vcrt,
&newcomm_ptr->vcr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
/* Notify the device of this new communicator */
MPID_Dev_comm_create_hook( newcomm_ptr );
mpi_errno = MPIR_Comm_commit(newcomm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_OBJ_PUBLISH_HANDLE(*newcomm, newcomm_ptr->handle);
}
else {
/* This process is not in the group */
MPIR_Free_contextid( new_context_id );
new_context_id = 0;
}
fn_exit:
if (mapping)
MPIU_Free(mapping);
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_COMM_CREATE_INTRA);
return mpi_errno;
fn_fail:
if (newcomm_ptr != NULL) {
MPIR_Comm_release(newcomm_ptr, 0/*isDisconnect*/);
new_context_id = 0; /* MPIR_Comm_release frees the new ctx id */
}
if (new_context_id != 0)
MPIR_Free_contextid(new_context_id);
*newcomm = MPI_COMM_NULL;
goto fn_exit;
}