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; }