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;
}
/*@
MPI_Info_free - Frees an info object
Input Parameters:
. info - info object to be freed (handle)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_INFO
.N MPI_ERR_OTHER
@*/
int MPI_Info_free( MPI_Info *info )
{
#ifdef HAVE_ERROR_CHECKING
static const char FCNAME[] = "MPI_Info_free";
#endif
int mpi_errno = MPI_SUCCESS;
MPID_Info *info_ptr=0;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_INFO_FREE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_INFO_FREE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_INFO(*info, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Convert MPI object handles to object pointers */
MPID_Info_get_ptr( *info, info_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate info_ptr */
MPID_Info_valid_ptr( info_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
MPIU_Info_free( info_ptr );
*info = MPI_INFO_NULL;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_INFO_FREE);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
fn_fail:
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER,
"**mpi_info_free",
"**mpi_info_free %p", info);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
