/*
* Back-end function to set an attribute on an MPI object. Assumes
* that you already hold the attribute_lock.
*/
static int set_value(ompi_attribute_type_t type, void *object,
opal_hash_table_t **attr_hash, int key,
attribute_value_t *new_attr,
bool predefined)
{
ompi_attribute_keyval_t *keyval;
int ret;
attribute_value_t *old_attr;
bool had_old = false;
/* Note that this function can be invoked by ompi_attr_copy_all()
to set attributes on the new object (in addition to the
top-level MPI_* functions that set attributes). */
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &keyval);
/* If key not found */
if ((OMPI_SUCCESS != ret ) || (NULL == keyval) ||
(keyval->attr_type != type) ||
((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
return OMPI_ERR_BAD_PARAM;
}
/* Do we need to make a new attr_hash? */
if (NULL == *attr_hash) {
ompi_attr_hash_init(attr_hash);
}
/* Now see if an attribute is already present in the object's hash
on the old keyval. If so, delete the old attribute value. */
ret = opal_hash_table_get_value_uint32(*attr_hash, key, (void**) &old_attr);
if (OMPI_SUCCESS == ret) {
switch (type) {
case COMM_ATTR:
DELETE_ATTR_CALLBACKS(communicator, old_attr, keyval, object, ret);
break;
case WIN_ATTR:
DELETE_ATTR_CALLBACKS(win, old_attr, keyval, object, ret);
break;
case TYPE_ATTR:
DELETE_ATTR_CALLBACKS(datatype, old_attr, keyval, object, ret);
break;
default:
/* This should not happen */
assert(0);
break;
}
if (MPI_SUCCESS != ret) {
return ret;
}
OBJ_RELEASE(old_attr);
had_old = true;
}
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &keyval);
if ((OMPI_SUCCESS != ret ) || (NULL == keyval)) {
/* Keyval has disappeared underneath us -- this shouldn't
happen! */
assert(0);
return OMPI_ERR_BAD_PARAM;
}
new_attr->av_key = key;
new_attr->av_sequence = attr_sequence++;
ret = opal_hash_table_set_value_uint32(*attr_hash, key, new_attr);
/* Increase the reference count of the object, only if there was no
old atribute/no old entry in the object's key hash */
if (OMPI_SUCCESS == ret && !had_old) {
OBJ_RETAIN(keyval);
}
return ret;
}
/*
* Initialize comm world/self/null/parent.
*/
int ompi_comm_init(void)
{
ompi_group_t *group;
size_t size;
/* Setup communicator array */
OBJ_CONSTRUCT(&ompi_mpi_communicators, opal_pointer_array_t);
if( OPAL_SUCCESS != opal_pointer_array_init(&ompi_mpi_communicators, 0,
OMPI_FORTRAN_HANDLE_MAX, 64) ) {
return OMPI_ERROR;
}
/* Setup MPI_COMM_WORLD */
OBJ_CONSTRUCT(&ompi_mpi_comm_world, ompi_communicator_t);
group = OBJ_NEW(ompi_group_t);
group->grp_proc_pointers = ompi_proc_world(&size);
group->grp_proc_count = (int)size;
OMPI_GROUP_SET_INTRINSIC (group);
OMPI_GROUP_SET_DENSE (group);
ompi_set_group_rank(group, ompi_proc_local());
ompi_group_increment_proc_count (group);
ompi_mpi_comm_world.comm.c_contextid = 0;
ompi_mpi_comm_world.comm.c_id_start_index = 4;
ompi_mpi_comm_world.comm.c_id_available = 4;
ompi_mpi_comm_world.comm.c_f_to_c_index = 0;
ompi_mpi_comm_world.comm.c_my_rank = group->grp_my_rank;
ompi_mpi_comm_world.comm.c_local_group = group;
ompi_mpi_comm_world.comm.c_remote_group = group;
OBJ_RETAIN(ompi_mpi_comm_world.comm.c_remote_group);
ompi_mpi_comm_world.comm.c_cube_dim = opal_cube_dim((int)size);
ompi_mpi_comm_world.comm.error_handler = &ompi_mpi_errors_are_fatal.eh;
OBJ_RETAIN( &ompi_mpi_errors_are_fatal.eh );
OMPI_COMM_SET_PML_ADDED(&ompi_mpi_comm_world.comm);
opal_pointer_array_set_item (&ompi_mpi_communicators, 0, &ompi_mpi_comm_world);
MEMCHECKER (memset (ompi_mpi_comm_world.comm.c_name, 0, MPI_MAX_OBJECT_NAME));
strncpy (ompi_mpi_comm_world.comm.c_name, "MPI_COMM_WORLD",
strlen("MPI_COMM_WORLD")+1 );
ompi_mpi_comm_world.comm.c_flags |= OMPI_COMM_NAMEISSET;
ompi_mpi_comm_world.comm.c_flags |= OMPI_COMM_INTRINSIC;
/* We have to create a hash (although it is legal to leave this
filed NULL -- the attribute accessor functions will intepret
this as "there are no attributes cached on this object")
because MPI_COMM_WORLD has some predefined attributes. */
ompi_attr_hash_init(&ompi_mpi_comm_world.comm.c_keyhash);
/* Setup MPI_COMM_SELF */
OBJ_CONSTRUCT(&ompi_mpi_comm_self, ompi_communicator_t);
group = OBJ_NEW(ompi_group_t);
group->grp_proc_pointers = ompi_proc_self(&size);
group->grp_my_rank = 0;
group->grp_proc_count = (int)size;
OMPI_GROUP_SET_INTRINSIC (group);
OMPI_GROUP_SET_DENSE (group);
ompi_mpi_comm_self.comm.c_contextid = 1;
ompi_mpi_comm_self.comm.c_f_to_c_index = 1;
ompi_mpi_comm_self.comm.c_id_start_index = 20;
ompi_mpi_comm_self.comm.c_id_available = 20;
ompi_mpi_comm_self.comm.c_my_rank = group->grp_my_rank;
ompi_mpi_comm_self.comm.c_local_group = group;
ompi_mpi_comm_self.comm.c_remote_group = group;
OBJ_RETAIN(ompi_mpi_comm_self.comm.c_remote_group);
ompi_mpi_comm_self.comm.error_handler = &ompi_mpi_errors_are_fatal.eh;
OBJ_RETAIN( &ompi_mpi_errors_are_fatal.eh );
OMPI_COMM_SET_PML_ADDED(&ompi_mpi_comm_self.comm);
opal_pointer_array_set_item (&ompi_mpi_communicators, 1, &ompi_mpi_comm_self);
MEMCHECKER (memset (ompi_mpi_comm_self.comm.c_name, 0, MPI_MAX_OBJECT_NAME));
strncpy(ompi_mpi_comm_self.comm.c_name,"MPI_COMM_SELF",strlen("MPI_COMM_SELF")+1);
ompi_mpi_comm_self.comm.c_flags |= OMPI_COMM_NAMEISSET;
ompi_mpi_comm_self.comm.c_flags |= OMPI_COMM_INTRINSIC;
/* We can set MPI_COMM_SELF's keyhash to NULL because it has no
predefined attributes. If a user defines an attribute on
MPI_COMM_SELF, the keyhash will automatically be created. */
ompi_mpi_comm_self.comm.c_keyhash = NULL;
/* Setup MPI_COMM_NULL */
OBJ_CONSTRUCT(&ompi_mpi_comm_null, ompi_communicator_t);
ompi_mpi_comm_null.comm.c_local_group = &ompi_mpi_group_null.group;
ompi_mpi_comm_null.comm.c_remote_group = &ompi_mpi_group_null.group;
OBJ_RETAIN(&ompi_mpi_group_null.group);
OBJ_RETAIN(&ompi_mpi_group_null.group);
ompi_mpi_comm_null.comm.c_contextid = 2;
ompi_mpi_comm_null.comm.c_f_to_c_index = 2;
ompi_mpi_comm_null.comm.c_my_rank = MPI_PROC_NULL;
ompi_mpi_comm_null.comm.error_handler = &ompi_mpi_errors_are_fatal.eh;
OBJ_RETAIN( &ompi_mpi_errors_are_fatal.eh );
opal_pointer_array_set_item (&ompi_mpi_communicators, 2, &ompi_mpi_comm_null);
MEMCHECKER (memset (ompi_mpi_comm_null.comm.c_name, 0, MPI_MAX_OBJECT_NAME));
strncpy(ompi_mpi_comm_null.comm.c_name,"MPI_COMM_NULL",strlen("MPI_COMM_NULL")+1);
ompi_mpi_comm_null.comm.c_flags |= OMPI_COMM_NAMEISSET;
ompi_mpi_comm_null.comm.c_flags |= OMPI_COMM_INTRINSIC;
/* Initialize the parent communicator to MPI_COMM_NULL */
ompi_mpi_comm_parent = &ompi_mpi_comm_null.comm;
OBJ_RETAIN(&ompi_mpi_comm_null);
OBJ_RETAIN(&ompi_mpi_group_null.group);
OBJ_RETAIN(&ompi_mpi_errors_are_fatal.eh);
/* initialize the comm_reg stuff for multi-threaded comm_cid
allocation */
ompi_comm_reg_init();
return OMPI_SUCCESS;
}
/*
* Back-end function to set an attribute on an MPI object
*/
static int set_value(ompi_attribute_type_t type, void *object,
opal_hash_table_t **attr_hash, int key,
attribute_value_t *new_attr,
bool predefined)
{
ompi_attribute_keyval_t *keyval;
int ret, err;
attribute_value_t *old_attr;
bool had_old = false;
/* Note that this function can be invoked by ompi_attr_copy_all()
to set attributes on the new object (in addition to the
top-level MPI_* functions that set attributes). */
OPAL_THREAD_LOCK(&keyval_hash_lock);
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &keyval);
OPAL_THREAD_UNLOCK(&keyval_hash_lock);
/* If key not found */
if ((OMPI_SUCCESS != ret ) || (NULL == keyval) ||
(keyval->attr_type != type) ||
((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
return OMPI_ERR_BAD_PARAM;
}
/* Do we need to make a new attr_hash? */
OPAL_THREAD_LOCK(&attr_hash_lock);
if (NULL == *attr_hash) {
ompi_attr_hash_init(attr_hash);
}
/* Now see if an attribute is already present in the object's hash
on the old keyval. If so, delete the old attribute value. */
ret = opal_hash_table_get_value_uint32(*attr_hash, key, (void**) &old_attr);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
if (OMPI_SUCCESS == ret) {
switch (type) {
case COMM_ATTR:
DELETE_ATTR_CALLBACKS(communicator, old_attr, keyval, object);
break;
case WIN_ATTR:
DELETE_ATTR_CALLBACKS(win, old_attr, keyval, object);
break;
case TYPE_ATTR:
DELETE_ATTR_CALLBACKS(datatype, old_attr, keyval, object);
break;
default:
return MPI_ERR_INTERN;
}
had_old = true;
OBJ_RELEASE(old_attr);
}
OPAL_THREAD_LOCK(&keyval_hash_lock);
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &keyval);
if ((OMPI_SUCCESS != ret ) || (NULL == keyval)) {
/* Keyval has disappeared underneath us. Someone must have
called ompi_attr_free_keyval since we last looked it up
in the hash. We'll behave as if we never found it in the
first place */
OPAL_THREAD_UNLOCK(&keyval_hash_lock);
return OMPI_ERR_BAD_PARAM;
}
OPAL_THREAD_LOCK(&attr_hash_lock);
ret = opal_hash_table_set_value_uint32(*attr_hash, key, new_attr);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
OPAL_THREAD_UNLOCK(&keyval_hash_lock);
/* Increase the reference count of the object, only if there was no
old atribute/no old entry in the object's key hash */
if (OMPI_SUCCESS == ret && !had_old) {
OBJ_RETAIN(keyval);
}
if (OMPI_SUCCESS != ret) {
return ret;
}
return MPI_SUCCESS;
}
