/* 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;
}
int MPIR_Comm_delete_attr_impl(MPIR_Comm * comm_ptr, MPII_Keyval * keyval_ptr)
{
int mpi_errno = MPI_SUCCESS;
MPIR_Attribute *p, **old_p;
/* Look for attribute. They are ordered by keyval handle */
old_p = &comm_ptr->attributes;
p = comm_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) {
int in_use;
/* Run the delete function, if any, and then free the
* attribute storage. Note that due to an ambiguity in the
* standard, if the usr function returns something other than
* MPI_SUCCESS, we should either return the user return code,
* or an mpich error code. The precedent set by the Intel
* test suite says we should return the user return code. So
* we must not ERR_POP here. */
mpi_errno = MPIR_Call_attr_delete(comm_ptr->handle, p);
if (mpi_errno)
goto fn_fail;
/* We found the attribute. Remove it from the list */
*old_p = p->next;
/* Decrement the use of the keyval */
MPII_Keyval_release_ref(p->keyval, &in_use);
if (!in_use) {
MPIR_Handle_obj_free(&MPII_Keyval_mem, p->keyval);
}
MPID_Attr_free(p);
}
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}
/*@
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-- */
}
int MPIR_WinSetAttr( MPI_Win win, int win_keyval, void *attribute_val,
MPIR_AttrType attrType )
{
static const char FCNAME[] = "MPI_Win_set_attr";
int mpi_errno = MPI_SUCCESS;
MPID_Win *win_ptr = NULL;
MPID_Keyval *keyval_ptr = NULL;
MPID_Attribute *p, **old_p;
MPID_MPI_STATE_DECL(MPID_STATE_MPIR_WIN_SET_ATTR);
MPIR_ERRTEST_INITIALIZED_ORDIE();
/* The thread lock prevents a valid attr delete on the same window
but in a different thread from causing problems */
MPIU_THREAD_CS_ENTER(ALLFUNC,);
MPID_MPI_FUNC_ENTER(MPID_STATE_MPIR_WIN_SET_ATTR);
/* Validate parameters, especially handles needing to be converted */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
MPIR_ERRTEST_WIN(win, 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_Win_get_ptr( win, win_ptr );
MPID_Keyval_get_ptr( win_keyval, keyval_ptr );
/* Validate parameters and objects (post conversion) */
# ifdef HAVE_ERROR_CHECKING
{
MPID_BEGIN_ERROR_CHECKS;
{
/* Validate win_ptr */
MPID_Win_valid_ptr( win_ptr, mpi_errno );
/* If win_ptr is not valid, it will be reset to null */
/* Validate keyval */
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 ... */
/* Look for attribute. They are ordered by keyval handle. This uses
a simple linear list algorithm because few applications use more than a
handful of attributes */
old_p = &win_ptr->attributes;
p = win_ptr->attributes;
while (p)
{
if (p->keyval->handle == keyval_ptr->handle)
{
/* If found, call the delete function before replacing the
attribute */
mpi_errno = MPIR_Call_attr_delete( win, p );
/* --BEGIN ERROR HANDLING-- */
if (mpi_errno)
{
/* FIXME : communicator of window? */
goto fn_fail;
}
/* --END ERROR HANDLING-- */
p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
p->attrType = attrType;
/* Does not change the reference count on the keyval */
break;
}
else if (p->keyval->handle > keyval_ptr->handle) {
MPID_Attribute *new_p = MPID_Attr_alloc();
MPIU_ERR_CHKANDJUMP1(!new_p,mpi_errno,MPI_ERR_OTHER,
"**nomem", "**nomem %s", "MPID_Attribute" );
new_p->keyval = keyval_ptr;
new_p->attrType = attrType;
new_p->pre_sentinal = 0;
new_p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
new_p->post_sentinal = 0;
new_p->next = p->next;
MPIR_Keyval_add_ref( keyval_ptr );
p->next = new_p;
break;
}
old_p = &p->next;
p = p->next;
}
if (!p)
{
MPID_Attribute *new_p = MPID_Attr_alloc();
MPIU_ERR_CHKANDJUMP1(!new_p,mpi_errno,MPI_ERR_OTHER,
"**nomem", "**nomem %s", "MPID_Attribute" );
/* Did not find in list. Add at end */
new_p->attrType = attrType;
new_p->keyval = keyval_ptr;
new_p->pre_sentinal = 0;
new_p->value = (MPID_AttrVal_t)(MPIR_Pint)attribute_val;
new_p->post_sentinal = 0;
new_p->next = 0;
MPIR_Keyval_add_ref( keyval_ptr );
*old_p = new_p;
}
/* Here is where we could add a hook for the device to detect attribute
value changes, using something like
MPID_Dev_win_attr_hook( win_ptr, keyval, attribute_val );
*/
/* ... end of body of routine ... */
fn_exit:
MPID_MPI_FUNC_EXIT(MPID_STATE_MPIR_WIN_SET_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_win_set_attr",
"**mpi_win_set_attr %W %d %p", win, win_keyval, attribute_val);
}
# endif
mpi_errno = MPIR_Err_return_win( win_ptr, FCNAME, mpi_errno );
goto fn_exit;
/* --END ERROR HANDLING-- */
}
int MPIR_Comm_set_attr_impl(MPIR_Comm * comm_ptr, int comm_keyval, void *attribute_val,
MPIR_Attr_type attrType)
{
int mpi_errno = MPI_SUCCESS;
MPII_Keyval *keyval_ptr = NULL;
MPIR_Attribute *p;
MPIR_ERR_CHKANDJUMP(comm_keyval == MPI_KEYVAL_INVALID, mpi_errno, MPI_ERR_KEYVAL,
"**keyvalinvalid");
/* CHANGE FOR MPI 2.2: Look for attribute. They are ordered by when they
* were added, with the most recent first. This uses
* a simple linear list algorithm because few applications use more than a
* handful of attributes */
MPII_Keyval_get_ptr(comm_keyval, keyval_ptr);
MPIR_Assert(keyval_ptr != NULL);
/* printf("Setting attr val to %x\n", attribute_val); */
p = comm_ptr->attributes;
while (p) {
if (p->keyval->handle == keyval_ptr->handle) {
/* If found, call the delete function before replacing the
* attribute */
mpi_errno = MPIR_Call_attr_delete(comm_ptr->handle, p);
if (mpi_errno) {
goto fn_fail;
}
p->attrType = attrType;
/* FIXME: This code is incorrect in some cases, particularly
* in the case where intptr_t is different from MPI_Aint,
* since in that case, the Fortran 9x interface will provide
* more bytes in the attribute_val than this allows. The
* dual casts are a sign that this is faulty. This will
* need to be fixed in the type/win set_attr routines as
* well. */
p->value = (MPII_Attr_val_t) (intptr_t) attribute_val;
/* printf("Updating attr at %x\n", &p->value); */
/* Does not change the reference count on the keyval */
break;
}
p = p->next;
}
/* CHANGE FOR MPI 2.2: If not found, add at the beginning */
if (!p) {
MPIR_Attribute *new_p = MPID_Attr_alloc();
MPIR_ERR_CHKANDJUMP(!new_p, mpi_errno, MPI_ERR_OTHER, "**nomem");
/* Did not find in list. Add at end */
new_p->keyval = keyval_ptr;
new_p->attrType = attrType;
new_p->pre_sentinal = 0;
/* FIXME: See the comment above on this dual cast. */
new_p->value = (MPII_Attr_val_t) (intptr_t) attribute_val;
new_p->post_sentinal = 0;
new_p->next = comm_ptr->attributes;
MPII_Keyval_add_ref(keyval_ptr);
comm_ptr->attributes = new_p;
/* printf("Creating attr at %x\n", &new_p->value); */
}
/* Here is where we could add a hook for the device to detect attribute
* value changes, using something like
* MPID_Comm_attr_hook(comm_ptr, keyval, attribute_val);
*/
fn_exit:
return mpi_errno;
fn_fail:
goto fn_exit;
}