pami_result_t MPIDI_Comm_destroy_external(void *comm_ext)
{
int mpi_errno = 0;
MPID_Comm* comm_ptr = (MPID_Comm*)comm_ext;
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno)
{
TRACE_ERR("Error while destroying comm_ptr in MPIDI_Comm_destroy_external\n");
return PAMI_ERROR;
}
return PAMI_SUCCESS;
}
int MPIR_Finalize_async_thread(void)
{
int mpi_errno = MPI_SUCCESS;
#if MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE
MPIR_Request *request_ptr = NULL;
MPI_Request request;
MPI_Status status;
MPIR_FUNC_TERSE_STATE_DECL(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
MPIR_FUNC_TERSE_ENTER(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
mpi_errno = MPID_Isend(NULL, 0, MPI_CHAR, 0, WAKE_TAG, progress_comm_ptr,
MPIR_CONTEXT_INTRA_PT2PT, &request_ptr);
MPIR_Assert(!mpi_errno);
request = request_ptr->handle;
mpi_errno = MPIR_Wait_impl(&request, &status);
MPIR_Assert(!mpi_errno);
/* XXX DJG why is this unlock/lock necessary? Should we just YIELD here or later? */
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_Thread_mutex_lock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
while (!progress_thread_done) {
MPID_Thread_cond_wait(&progress_cond, &progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
}
MPID_Thread_mutex_unlock(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
mpi_errno = MPIR_Comm_free_impl(progress_comm_ptr);
MPIR_Assert(!mpi_errno);
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_Thread_cond_destroy(&progress_cond, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPID_Thread_mutex_destroy(&progress_mutex, &mpi_errno);
MPIR_Assert(!mpi_errno);
MPIR_FUNC_TERSE_EXIT(MPID_STATE_MPIR_FINALIZE_ASYNC_THREAD);
#endif /* MPICH_THREAD_LEVEL == MPI_THREAD_MULTIPLE */
return mpi_errno;
}
int MPIDI_Win_free(MPID_Win **win_ptr)
{
int mpi_errno=MPI_SUCCESS;
int in_use;
MPID_Comm *comm_ptr;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_WIN_FREE);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_MPIDI_WIN_FREE);
MPIU_ERR_CHKANDJUMP((*win_ptr)->epoch_state != MPIDI_EPOCH_NONE,
mpi_errno, MPI_ERR_RMA_SYNC, "**rmasync");
mpi_errno = MPIDI_CH3I_Wait_for_pt_ops_finish(*win_ptr);
if(mpi_errno) MPIU_ERR_POP(mpi_errno);
comm_ptr = (*win_ptr)->comm_ptr;
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Free((*win_ptr)->targets);
MPIU_Free((*win_ptr)->base_addrs);
MPIU_Free((*win_ptr)->sizes);
MPIU_Free((*win_ptr)->disp_units);
MPIU_Free((*win_ptr)->all_win_handles);
MPIU_Free((*win_ptr)->pt_rma_puts_accs);
/* Free the attached buffer for windows created with MPI_Win_allocate() */
if ((*win_ptr)->create_flavor == MPI_WIN_FLAVOR_ALLOCATE || (*win_ptr)->create_flavor == MPI_WIN_FLAVOR_SHARED) {
if ((*win_ptr)->shm_allocated == FALSE && (*win_ptr)->size > 0) {
MPIU_Free((*win_ptr)->base);
}
}
MPIU_Object_release_ref(*win_ptr, &in_use);
/* MPI windows don't have reference count semantics, so this should always be true */
MPIU_Assert(!in_use);
MPIU_Handle_obj_free( &MPID_Win_mem, *win_ptr );
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_MPIDI_WIN_FREE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
static int split_type(MPIR_Comm * user_comm_ptr, int stype, int key,
MPIR_Info *info_ptr, MPIR_Comm ** newcomm_ptr)
{
MPIR_Comm *comm_ptr = NULL;
int mpi_errno = MPI_SUCCESS;
mpi_errno = MPIR_Comm_split_impl(user_comm_ptr, stype == MPI_UNDEFINED ? MPI_UNDEFINED : 0,
key, &comm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if (stype == MPI_UNDEFINED) {
*newcomm_ptr = NULL;
goto fn_exit;
}
if (stype == MPI_COMM_TYPE_SHARED) {
if (MPIDI_CH3I_Shm_supported()) {
mpi_errno = MPIR_Comm_split_type_node_topo(comm_ptr, stype, key, info_ptr, newcomm_ptr);
} else {
mpi_errno = MPIR_Comm_split_type_self(comm_ptr, stype, key, newcomm_ptr);
}
} else if (stype == MPIX_COMM_TYPE_NEIGHBORHOOD) {
mpi_errno = MPIR_Comm_split_type_neighborhood(comm_ptr, stype, key, info_ptr, newcomm_ptr);
} else {
/* we don't know how to handle other split types; hand it back
* to the upper layer */
mpi_errno = MPIR_Comm_split_type(comm_ptr, stype, key, info_ptr, newcomm_ptr);
}
if (mpi_errno) MPIR_ERR_POP(mpi_errno);
fn_exit:
if (comm_ptr)
MPIR_Comm_free_impl(comm_ptr);
return mpi_errno;
/* --BEGIN ERROR HANDLING-- */
fn_fail:
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Comm_free - Marks the communicator object for deallocation
Input Parameters:
. comm - Communicator to be destroyed (handle)
Notes:
This routine `frees` a communicator. Because the communicator may still
be in use by other MPI routines, the actual communicator storage will not
be freed until all references to this communicator are removed. For most
users, the effect of this routine is the same as if it was in fact freed
at this time of this call.
Null Handles:
The MPI 1.1 specification, in the section on opaque objects, explicitly
disallows freeing a null communicator. The text from the standard is:
.vb
A null handle argument is an erroneous IN argument in MPI calls, unless an
exception is explicitly stated in the text that defines the function. Such
exception is allowed for handles to request objects in Wait and Test calls
(sections Communication Completion and Multiple Completions ). Otherwise, a
null handle can only be passed to a function that allocates a new object and
returns a reference to it in the handle.
.ve
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_COMM
.N MPI_ERR_ARG
@*/
int MPI_Comm_free(MPI_Comm *comm)
{
int mpi_errno = MPI_SUCCESS;
MPID_Comm *comm_ptr = NULL;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_COMM_FREE);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_COMM_FREE);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_COMM(*comm, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* Get handles to MPI objects. */
MPID_Comm_get_ptr( *comm, comm_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate comm_ptr */
MPID_Comm_valid_ptr( comm_ptr, mpi_errno, TRUE );
/* If comm_ptr is not valid, it will be reset to null */
/* Cannot free the predefined communicators */
if (HANDLE_GET_KIND(*comm) == HANDLE_KIND_BUILTIN) {
mpi_errno = MPIR_Err_create_code( MPI_SUCCESS,
MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_COMM,
"**commperm", "**commperm %s",
comm_ptr->name );
}
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
*comm = MPI_COMM_NULL;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_COMM_FREE);
MPIU_THREAD_CS_EXIT(ALLFUNC,);
return mpi_errno;
fn_fail:
/* --BEGIN ERROR HANDLING-- */
# ifdef HAVE_ERROR_CHECKING
{
mpi_errno = MPIR_Err_create_code(
mpi_errno, MPIR_ERR_RECOVERABLE, FCNAME, __LINE__, MPI_ERR_OTHER, "**mpi_comm_free", "**mpi_comm_free %p", comm);
}
# endif
mpi_errno = MPIR_Err_return_comm( comm_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPID_Win_free(MPIR_Win ** win_ptr)
{
int mpi_errno = MPI_SUCCESS;
int in_use;
MPIR_Comm *comm_ptr;
MPIR_Errflag_t errflag = MPIR_ERR_NONE;
MPIR_FUNC_VERBOSE_STATE_DECL(MPID_STATE_MPID_WIN_FREE);
MPIR_FUNC_VERBOSE_RMA_ENTER(MPID_STATE_MPID_WIN_FREE);
MPIR_ERR_CHKANDJUMP(((*win_ptr)->states.access_state != MPIDI_RMA_NONE &&
(*win_ptr)->states.access_state != MPIDI_RMA_FENCE_ISSUED &&
(*win_ptr)->states.access_state != MPIDI_RMA_FENCE_GRANTED) ||
((*win_ptr)->states.exposure_state != MPIDI_RMA_NONE),
mpi_errno, MPI_ERR_RMA_SYNC, "**rmasync");
/* 1. Here we must wait until all passive locks are released on this target,
* because for some UNLOCK messages, we do not send ACK back to origin,
* we must wait until lock is released so that we can free window.
* 2. We also need to wait until AT completion counter being zero, because
* this counter is increment everytime we meet a GET-like operation, it is
* possible that when target entering Win_free, passive epoch is not finished
* yet and there are still GETs doing on this target.
* 3. We also need to wait until lock queue becomes empty. It is possible
* that some lock requests is still waiting in the queue when target is
* entering Win_free. */
while ((*win_ptr)->current_lock_type != MPID_LOCK_NONE ||
(*win_ptr)->at_completion_counter != 0 ||
(*win_ptr)->target_lock_queue_head != NULL ||
(*win_ptr)->current_target_lock_data_bytes != 0 || (*win_ptr)->sync_request_cnt != 0) {
mpi_errno = wait_progress_engine();
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
mpi_errno = MPID_Barrier((*win_ptr)->comm_ptr, &errflag);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
/* Free window resources in lower layer. */
if (MPIDI_CH3U_Win_hooks.win_free != NULL) {
mpi_errno = MPIDI_CH3U_Win_hooks.win_free(win_ptr);
if (mpi_errno != MPI_SUCCESS)
MPIR_ERR_POP(mpi_errno);
}
/* dequeue window from the global list */
MPIR_Assert((*win_ptr)->active == FALSE);
DL_DELETE(MPIDI_RMA_Win_inactive_list_head, (*win_ptr));
if (MPIDI_RMA_Win_inactive_list_head == NULL && MPIDI_RMA_Win_active_list_head == NULL) {
/* this is the last window, de-register RMA progress hook */
mpi_errno = MPID_Progress_deregister_hook(MPIDI_CH3I_RMA_Progress_hook_id);
if (mpi_errno != MPI_SUCCESS) {
MPIR_ERR_POP(mpi_errno);
}
}
comm_ptr = (*win_ptr)->comm_ptr;
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno)
MPIR_ERR_POP(mpi_errno);
if ((*win_ptr)->basic_info_table != NULL)
MPL_free((*win_ptr)->basic_info_table);
MPL_free((*win_ptr)->op_pool_start);
MPL_free((*win_ptr)->target_pool_start);
MPL_free((*win_ptr)->slots);
MPL_free((*win_ptr)->target_lock_entry_pool_start);
MPIR_Assert((*win_ptr)->current_target_lock_data_bytes == 0);
/* Free the attached buffer for windows created with MPI_Win_allocate() */
if ((*win_ptr)->create_flavor == MPI_WIN_FLAVOR_ALLOCATE ||
(*win_ptr)->create_flavor == MPI_WIN_FLAVOR_SHARED) {
if ((*win_ptr)->shm_allocated == FALSE && (*win_ptr)->size > 0) {
MPL_free((*win_ptr)->base);
}
}
MPIR_Object_release_ref(*win_ptr, &in_use);
/* MPI windows don't have reference count semantics, so this should always be true */
MPIR_Assert(!in_use);
MPIR_Handle_obj_free(&MPIR_Win_mem, *win_ptr);
fn_exit:
MPIR_FUNC_VERBOSE_RMA_EXIT(MPID_STATE_MPID_WIN_FREE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
int MPIDI_Win_free(MPID_Win **win_ptr)
{
int mpi_errno=MPI_SUCCESS, total_pt_rma_puts_accs;
int in_use;
MPID_Comm *comm_ptr;
int errflag = FALSE;
MPIDI_STATE_DECL(MPID_STATE_MPIDI_WIN_FREE);
MPIDI_RMA_FUNC_ENTER(MPID_STATE_MPIDI_WIN_FREE);
comm_ptr = (*win_ptr)->comm_ptr;
MPIU_INSTR_DURATION_START(winfree_rs);
mpi_errno = MPIR_Reduce_scatter_block_impl((*win_ptr)->pt_rma_puts_accs,
&total_pt_rma_puts_accs, 1,
MPI_INT, MPI_SUM, comm_ptr, &errflag);
if (mpi_errno) { MPIU_ERR_POP(mpi_errno); }
MPIU_ERR_CHKANDJUMP(errflag, mpi_errno, MPI_ERR_OTHER, "**coll_fail");
MPIU_INSTR_DURATION_END(winfree_rs);
if (total_pt_rma_puts_accs != (*win_ptr)->my_pt_rma_puts_accs)
{
MPID_Progress_state progress_state;
/* poke the progress engine until the two are equal */
MPIU_INSTR_DURATION_START(winfree_complete);
MPID_Progress_start(&progress_state);
while (total_pt_rma_puts_accs != (*win_ptr)->my_pt_rma_puts_accs)
{
mpi_errno = MPID_Progress_wait(&progress_state);
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno != MPI_SUCCESS)
{
MPID_Progress_end(&progress_state);
MPIU_ERR_SETANDJUMP(mpi_errno,MPI_ERR_OTHER,"**winnoprogress");
}
/* --END ERROR HANDLING-- */
}
MPID_Progress_end(&progress_state);
MPIU_INSTR_DURATION_END(winfree_complete);
}
mpi_errno = MPIR_Comm_free_impl(comm_ptr);
if (mpi_errno) MPIU_ERR_POP(mpi_errno);
MPIU_Free((*win_ptr)->base_addrs);
MPIU_Free((*win_ptr)->disp_units);
MPIU_Free((*win_ptr)->all_win_handles);
MPIU_Free((*win_ptr)->pt_rma_puts_accs);
MPIU_Object_release_ref(*win_ptr, &in_use);
/* MPI windows don't have reference count semantics, so this should always be true */
MPIU_Assert(!in_use);
MPIU_Handle_obj_free( &MPID_Win_mem, *win_ptr );
fn_exit:
MPIDI_RMA_FUNC_EXIT(MPID_STATE_MPIDI_WIN_FREE);
return mpi_errno;
fn_fail:
goto fn_exit;
}
