/* Routine to delete an attribute list */
int MPIR_Attr_delete_list( int handle, MPID_Attribute **attr )
{
MPID_Attribute *p, *new_p;
int mpi_errno = MPI_SUCCESS;
p = *attr;
while (p) {
/* delete the attribute by first executing the delete routine, if any,
determine the the next attribute, and recover the attributes
storage */
new_p = p->next;
/* Check the sentinals first */
/* --BEGIN ERROR HANDLING-- */
if (p->pre_sentinal != 0 || p->post_sentinal != 0) {
MPIR_ERR_SET(mpi_errno,MPI_ERR_OTHER,"**attrsentinal");
/* We could keep trying to free the attributes, but for now
we'll just bag it */
return mpi_errno;
}
/* --END ERROR HANDLING-- */
/* For this attribute, find the delete function for the
corresponding keyval */
/* Still to do: capture any error returns but continue to
process attributes */
mpi_errno = MPIR_Call_attr_delete( handle, p );
/* We must also remove the keyval reference. If the keyval
was freed earlier (reducing the refcount), the actual
release and free will happen here. We must free the keyval
even if the attr delete failed, as we then remove the
attribute.
*/
{
int in_use;
/* Decrement the use of the keyval */
MPIR_Keyval_release_ref( p->keyval, &in_use);
if (!in_use) {
MPIU_Handle_obj_free( &MPID_Keyval_mem, p->keyval );
}
}
MPIU_Handle_obj_free( &MPID_Attr_mem, p );
p = new_p;
}
/* We must zero out the attribute list pointer or we could attempt to use it
later. This normally can't happen because the communicator usually
disappears after a call to MPI_Comm_free. But if the attribute keyval
has an associated delete function that returns an error then we don't
actually free the communicator despite having freed all the attributes
associated with the communicator.
This function is also used for Win and Type objects, but the idea is the
same in those cases as well. */
*attr = NULL;
return mpi_errno;
}
void MPIR_Comm_free_keyval_impl(int keyval)
{
int in_use;
MPID_Keyval *keyval_ptr;
MPID_Keyval_get_ptr(keyval, keyval_ptr);
if (!keyval_ptr->was_freed) {
keyval_ptr->was_freed = 1;
MPIR_Keyval_release_ref( keyval_ptr, &in_use);
if (!in_use) {
MPIU_Handle_obj_free( &MPID_Keyval_mem, keyval_ptr );
}
}
return;
}
/*@
MPI_Type_delete_attr - Deletes an attribute value associated with a key on
a datatype
Input Parameters:
+ datatype - MPI datatype to which attribute is attached (handle)
- type_keyval - The key value of the deleted attribute (integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_OTHER
.N MPI_ERR_KEYVAL
@*/
int MPI_Type_delete_attr(MPI_Datatype datatype, int type_keyval)
{
static const char FCNAME[] = "MPI_Type_delete_attr";
int mpi_errno = MPI_SUCCESS;
MPID_Datatype *type_ptr = NULL;
MPID_Attribute *p, **old_p;
MPID_Keyval *keyval_ptr = 0;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_TYPE_DELETE_ATTR);
MPIR_ERRTEST_INITIALIZED_ORDIE();
/* The thread lock prevents a valid attr delete on the same datatype
but in a different thread from causing problems */
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_TYPE_DELETE_ATTR);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_DATATYPE(datatype, "datatype", mpi_errno);
MPIR_ERRTEST_KEYVAL(type_keyval, MPID_DATATYPE, "datatype", mpi_errno);
MPIR_ERRTEST_KEYVAL_PERM(type_keyval, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Validate parameters and objects (post conversion) */
MPID_Datatype_get_ptr( datatype, type_ptr );
MPID_Keyval_get_ptr( type_keyval, keyval_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate type_ptr */
MPID_Datatype_valid_ptr( type_ptr, mpi_errno );
/* If type_ptr is not valid, it will be reset to null */
/* Validate keyval_ptr */
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
/* Look for attribute. They are ordered by keyval handle */
old_p = &type_ptr->attributes;
p = type_ptr->attributes;
while (p)
{
if (p->keyval->handle == keyval_ptr->handle)
{
break;
}
old_p = &p->next;
p = p->next;
}
/* We can't unlock yet, because we must not free the attribute until
we know whether the delete function has returned with a 0 status
code */
if (p)
{
/* Run the delete function, if any, and then free the attribute
storage */
mpi_errno = MPIR_Call_attr_delete( datatype, p );
/* --BEGIN ERROR HANDLING-- */
if (!mpi_errno)
{
int in_use;
/* We found the attribute. Remove it from the list */
*old_p = p->next;
/* Decrement the use of the keyval */
MPIR_Keyval_release_ref( p->keyval, &in_use);
if (!in_use)
{
MPIU_Handle_obj_free( &MPID_Keyval_mem, p->keyval );
}
MPID_Attr_free(p);
}
/* --END ERROR HANDLING-- */
}
if (mpi_errno != MPI_SUCCESS) goto fn_fail;
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_TYPE_DELETE_ATTR);
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_type_delete_attr",
"**mpi_type_delete_attr %D %d", datatype, type_keyval);
}
# endif
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
/*@
MPI_Win_free_keyval - Frees an attribute key for MPI RMA windows
Input Parameters:
. win_keyval - key value (integer)
.N ThreadSafe
.N Fortran
.N Errors
.N MPI_SUCCESS
.N MPI_ERR_WIN
.N MPI_ERR_OTHER
.N MPI_ERR_KEYVAL
@*/
int MPI_Win_free_keyval(int *win_keyval)
{
#ifdef HAVE_ERROR_CHECKING
static const char FCNAME[] = "MPI_Win_free_keyval";
#endif
int mpi_errno = MPI_SUCCESS;
MPID_Keyval *keyval_ptr = NULL;
int in_use;
MPID_MPI_STATE_DECL(MPID_STATE_MPI_WIN_FREE_KEYVAL);
MPIR_ERRTEST_INITIALIZED_ORDIE();
MPID_THREAD_CS_ENTER(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPI_WIN_FREE_KEYVAL);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_ARGNULL(*win_keyval, "win_keyval", mpi_errno);
MPIR_ERRTEST_KEYVAL(*win_keyval, MPID_WIN, "window", mpi_errno);
MPIR_ERRTEST_KEYVAL_PERM(*win_keyval, mpi_errno);
}
MPID_END_ERROR_CHECKS;
}
# endif
/* Convert MPI object handles to object pointers */
MPID_Keyval_get_ptr( *win_keyval, keyval_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPID_Keyval_valid_ptr( keyval_ptr, mpi_errno );
if (mpi_errno) goto fn_fail;
}
MPID_END_ERROR_CHECKS;
}
# endif /* HAVE_ERROR_CHECKING */
/* ... body of routine ... */
if (!keyval_ptr->was_freed) {
keyval_ptr->was_freed = 1;
MPIR_Keyval_release_ref( keyval_ptr, &in_use);
if (!in_use) {
MPIU_Handle_obj_free( &MPID_Keyval_mem, keyval_ptr );
}
}
*win_keyval = MPI_KEYVAL_INVALID;
/* ... end of body of routine ... */
#ifdef HAVE_ERROR_CHECKING
fn_exit:
#endif
MPID_MPI_FUNC_EXIT(MPID_STATE_MPI_WIN_FREE_KEYVAL);
MPID_THREAD_CS_EXIT(GLOBAL, MPIR_THREAD_GLOBAL_ALLFUNC_MUTEX);
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_win_free_keyval",
"**mpi_win_free_keyval %p", win_keyval);
}
mpi_errno = MPIR_Err_return_comm( NULL, FCNAME, mpi_errno );
goto fn_exit;
# endif
/* --END ERROR HANDLING-- */
}
