/*
* Back-end function to get an attribute from the hash map and return
* it to the caller. Translation services are not provided -- they're
* in small, standalone functions that are called from several
* different places.
*
* Assumes that you do NOT already have the attribute lock.
*/
static int get_value(opal_hash_table_t *attr_hash, int key,
attribute_value_t **attribute, int *flag)
{
int ret;
void *attr;
ompi_attribute_keyval_t *keyval;
/* According to MPI specs, the call is invalid if the keyval does
not exist (i.e., the key is not present in the main keyval
hash). If the keyval exists but no attribute is associated
with the key, then the call is valid and returns FALSE in the
flag argument */
*flag = 0;
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void**) &keyval);
if (OMPI_ERR_NOT_FOUND == ret) {
return MPI_KEYVAL_INVALID;
}
/* If we have a null attr_hash table, that means that nothing has
been cached on this object yet. So just return *flag = 0. */
if (NULL == attr_hash) {
return OMPI_SUCCESS;
}
ret = opal_hash_table_get_value_uint32(attr_hash, key, &attr);
if (OMPI_SUCCESS == ret) {
*attribute = (attribute_value_t*)attr;
*flag = 1;
}
return OMPI_SUCCESS;
}
/**
* int mca_btl_sctp_proc_check
* ----------------------------
* This function simply consults a table of procs and checks if the table at
* position 'id' is valid or not.
*
* TODO - change this to use a hash for constant time performance
*/
static int mca_btl_sctp_proc_check(int is_vpid, sctp_assoc_t id, ompi_vpid_t vpid, struct mca_btl_sctp_proc_table_node *table) {
#if MCA_BTL_SCTP_DONT_USE_HASH
int i;
for(i = 0; i < MCA_BTL_SCTP_PROC_TABLE_SIZE; i++) {
/* sender_proc_table uses ompi_vpid_t.
* recvr_proc_table uses sctp_assoc_id.
* Calls using this function use one or the other.
*/
if((0 == is_vpid && table[i].valid && table[i].sctp_assoc_id == id) ||
(1 == is_vpid && table[i].valid && table[i].vpid == vpid))
{
return VALID_ENTRY;
} else if(table[i].valid == 0) {
/* once invalid is found, can return INVALID_ENTRY (added incrementally) */
break;
}
}
return INVALID_ENTRY;
#else
mca_btl_sctp_proc_t *val;
/* TODO fix if sctp_assoc_t is 64 bit (once we change to hash) */
int rc = opal_hash_table_get_value_uint32(&mca_btl_sctp_component.sctp_assocID_hash, id, &val);
if(OPAL_SUCCESS == rc) {
return VALID_ENTRY;
} else {
return INVALID_ENTRY;
}
#endif
}
int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key,
bool predefined)
{
int ret;
ompi_attribute_keyval_t *keyval;
/* Find the key-value pair */
OPAL_THREAD_LOCK(&attribute_lock);
ret = opal_hash_table_get_value_uint32(keyval_hash, *key,
(void **) &keyval);
if ((OMPI_SUCCESS != ret) || (NULL == keyval) ||
(keyval->attr_type != type) ||
((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
OPAL_THREAD_UNLOCK(&attribute_lock);
return OMPI_ERR_BAD_PARAM;
}
/* MPI says to set the returned value to MPI_KEYVAL_INVALID */
*key = MPI_KEYVAL_INVALID;
/* This will delete the key only when no attributes are associated
with it, else it will just decrement the reference count, so that when
the last attribute is deleted, this object gets deleted too */
OBJ_RELEASE(keyval);
opal_atomic_wmb();
OPAL_THREAD_UNLOCK(&attribute_lock);
return MPI_SUCCESS;
}
orte_job_t* orte_get_job_data_object(orte_jobid_t job)
{
orte_job_t *jdata;
/* if the job data wasn't setup, we cannot provide the data */
if (NULL == orte_job_data) {
return NULL;
}
jdata = NULL;
opal_hash_table_get_value_uint32(orte_job_data, job, (void**)&jdata);
return jdata;
}
int ompi_osc_ucx_lock(int lock_type, int target, int assert, struct ompi_win_t *win) {
ompi_osc_ucx_module_t *module = (ompi_osc_ucx_module_t *)win->w_osc_module;
ompi_osc_ucx_lock_t *lock = NULL;
ompi_osc_ucx_epoch_t original_epoch = module->epoch_type.access;
int ret = OMPI_SUCCESS;
if (module->lock_count == 0) {
if (module->epoch_type.access != NONE_EPOCH &&
module->epoch_type.access != FENCE_EPOCH) {
return OMPI_ERR_RMA_SYNC;
}
} else {
ompi_osc_ucx_lock_t *item = NULL;
assert(module->epoch_type.access == PASSIVE_EPOCH);
opal_hash_table_get_value_uint32(&module->outstanding_locks, (uint32_t) target, (void **) &item);
if (item != NULL) {
return OMPI_ERR_RMA_SYNC;
}
}
module->epoch_type.access = PASSIVE_EPOCH;
module->lock_count++;
assert(module->lock_count <= ompi_comm_size(module->comm));
lock = OBJ_NEW(ompi_osc_ucx_lock_t);
lock->target_rank = target;
if ((assert & MPI_MODE_NOCHECK) == 0) {
lock->is_nocheck = false;
if (lock_type == MPI_LOCK_EXCLUSIVE) {
ret = start_exclusive(module, target);
lock->type = LOCK_EXCLUSIVE;
} else {
ret = start_shared(module, target);
lock->type = LOCK_SHARED;
}
} else {
lock->is_nocheck = true;
}
if (ret == OMPI_SUCCESS) {
opal_hash_table_set_value_uint32(&module->outstanding_locks, (uint32_t)target, (void *)lock);
} else {
OBJ_RELEASE(lock);
module->epoch_type.access = original_epoch;
}
return ret;
}
static inline int check_sync_state(ompi_osc_ucx_module_t *module, int target,
bool is_req_ops) {
if (is_req_ops == false) {
if (module->epoch_type.access == NONE_EPOCH) {
return OMPI_ERR_RMA_SYNC;
} else if (module->epoch_type.access == START_COMPLETE_EPOCH) {
int i, size = ompi_group_size(module->start_group);
for (i = 0; i < size; i++) {
if (module->start_grp_ranks[i] == target) {
break;
}
}
if (i == size) {
return OMPI_ERR_RMA_SYNC;
}
} else if (module->epoch_type.access == PASSIVE_EPOCH) {
ompi_osc_ucx_lock_t *item = NULL;
opal_hash_table_get_value_uint32(&module->outstanding_locks, (uint32_t) target, (void **) &item);
if (item == NULL) {
return OMPI_ERR_RMA_SYNC;
}
}
} else {
if (module->epoch_type.access != PASSIVE_EPOCH &&
module->epoch_type.access != PASSIVE_ALL_EPOCH) {
return OMPI_ERR_RMA_SYNC;
} else if (module->epoch_type.access == PASSIVE_EPOCH) {
ompi_osc_ucx_lock_t *item = NULL;
opal_hash_table_get_value_uint32(&module->outstanding_locks, (uint32_t) target, (void **) &item);
if (item == NULL) {
return OMPI_ERR_RMA_SYNC;
}
}
}
return OMPI_SUCCESS;
}
/**
* Find proc_data_t container associated with given
* orte_process_name_t.
*/
static proc_data_t* lookup_orte_proc(opal_hash_table_t *jtable, orte_vpid_t vpid)
{
proc_data_t *proc_data = NULL;
opal_hash_table_get_value_uint32(jtable, orte_util_hash_vpid(vpid), (void**)&proc_data);
if (NULL == proc_data) {
/* The proc clearly exists, so create a data structure for it */
proc_data = OBJ_NEW(proc_data_t);
if (NULL == proc_data) {
opal_output(0, "db:hash:lookup_orte_proc: unable to allocate proc_data_t\n");
return NULL;
}
opal_hash_table_set_value_uint32(jtable, orte_util_hash_vpid(vpid), proc_data);
}
return proc_data;
}
int ompi_osc_ucx_unlock(int target, struct ompi_win_t *win) {
ompi_osc_ucx_module_t *module = (ompi_osc_ucx_module_t *)win->w_osc_module;
ompi_osc_ucx_lock_t *lock = NULL;
int ret = OMPI_SUCCESS;
ucp_ep_h ep;
if (module->epoch_type.access != PASSIVE_EPOCH) {
return OMPI_ERR_RMA_SYNC;
}
opal_hash_table_get_value_uint32(&module->outstanding_locks, (uint32_t) target, (void **) &lock);
if (lock == NULL) {
return OMPI_ERR_RMA_SYNC;
}
opal_hash_table_remove_value_uint32(&module->outstanding_locks,
(uint32_t)target);
ep = OSC_UCX_GET_EP(module->comm, target);
ret = opal_common_ucx_ep_flush(ep, mca_osc_ucx_component.ucp_worker);
if (ret != OMPI_SUCCESS) {
return ret;
}
module->global_ops_num -= module->per_target_ops_nums[target];
module->per_target_ops_nums[target] = 0;
if (lock->is_nocheck == false) {
if (lock->type == LOCK_EXCLUSIVE) {
ret = end_exclusive(module, target);
} else {
ret = end_shared(module, target);
}
}
OBJ_RELEASE(lock);
module->lock_count--;
assert(module->lock_count >= 0);
if (module->lock_count == 0) {
module->epoch_type.access = NONE_EPOCH;
assert(module->global_ops_num == 0);
}
return ret;
}
static int ompi_osc_pt2pt_dt_send_complete (ompi_request_t *request)
{
ompi_datatype_t *datatype = (ompi_datatype_t *) request->req_complete_cb_data;
ompi_osc_pt2pt_module_t *module = NULL;
OMPI_DATATYPE_RELEASE(datatype);
OPAL_THREAD_LOCK(&mca_osc_pt2pt_component.lock);
(void) opal_hash_table_get_value_uint32(&mca_osc_pt2pt_component.modules,
ompi_comm_get_cid(request->req_mpi_object.comm),
(void **) &module);
OPAL_THREAD_UNLOCK(&mca_osc_pt2pt_component.lock);
assert (NULL != module);
ompi_request_free (&request);
return 1;
}
static int ompi_osc_pt2pt_dt_send_complete (ompi_request_t *request)
{
ompi_datatype_t *datatype = (ompi_datatype_t *) request->req_complete_cb_data;
ompi_osc_pt2pt_module_t *module = NULL;
OBJ_RELEASE(datatype);
OPAL_THREAD_LOCK(&mca_osc_pt2pt_component.lock);
(void) opal_hash_table_get_value_uint32(&mca_osc_pt2pt_component.modules,
ompi_comm_get_cid(request->req_mpi_object.comm),
(void **) &module);
OPAL_THREAD_UNLOCK(&mca_osc_pt2pt_component.lock);
assert (NULL != module);
/* put this request on the garbage colletion list */
osc_pt2pt_gc_add_request (module, request);
return OMPI_SUCCESS;
}
/**
* mca_btl_sctp_proc_t* mca_btl_sctp_proc_get
* ------------------------------------------
* Returns pointer to a proc that is indexed by the association id.
*/
mca_btl_sctp_proc_t *mca_btl_sctp_proc_get(sctp_assoc_t id, struct mca_btl_sctp_proc_table_node *table) {
#if MCA_BTL_SCTP_DONT_USE_HASH
int i;
for(i = 0; i < MCA_BTL_SCTP_PROC_TABLE_SIZE; i++){
if(table[i].sctp_assoc_id == id) {
return table[i].proc;
}
}
return NULL;
#else
mca_btl_sctp_proc_t *val;
/* TODO fix if sctp_assoc_t is 64 bit (once we change to hash) */
int rc = opal_hash_table_get_value_uint32(&mca_btl_sctp_component.sctp_assocID_hash, id, &val);
if(OPAL_SUCCESS == rc) {
return val;
} else {
return NULL;
}
#endif
}
/*
* Copy all the attributes from one MPI object to another
*/
int ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object,
void *new_object, opal_hash_table_t *oldattr_hash,
opal_hash_table_t *newattr_hash)
{
int ret;
int err;
uint32_t key;
int flag;
void *node, *in_node;
attribute_value_t *old_attr, *new_attr;
ompi_attribute_keyval_t *hash_value;
/* If there's nothing to do, just return */
if (NULL == oldattr_hash) {
return MPI_SUCCESS;
}
/* Lock this whole sequence of events -- don't let any other
thread modify the structure of the attrbitue hash or bitmap
while we're traversing it */
OPAL_THREAD_LOCK(&attr_hash_lock);
/* Get the first attribute in the object's hash */
ret = opal_hash_table_get_first_key_uint32(oldattr_hash, &key,
(void **) &old_attr,
&node);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
/* While we still have some attribute in the object's key hash */
while (OMPI_SUCCESS == ret) {
in_node = node;
/* Get the keyval in the main keyval hash - so that we know
what the copy_attr_fn is */
OPAL_THREAD_LOCK(&keyval_hash_lock);
err = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &hash_value);
OPAL_THREAD_UNLOCK(&keyval_hash_lock);
new_attr = OBJ_NEW(attribute_value_t);
switch (type) {
case UNUSED_ATTR: /* keep the compiler happy */
assert(0);
break;
case COMM_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(communicator, old_object, hash_value,
old_attr, new_object, new_attr);
break;
case TYPE_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(datatype, old_object, hash_value,
old_attr, new_object, new_attr);
break;
case WIN_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(win, old_object, hash_value,
old_attr, new_object, new_attr);
break;
}
/* Hang this off the object's hash */
/* The "predefined" parameter to ompi_attr_set() is set to 1,
so that no comparison is done for prdefined at all and it
just falls off the error checking loop in attr_set */
if (1 == flag) {
if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77)) {
if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77_MPI1)) {
new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI1;
} else {
new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI2;
}
} else {
new_attr->av_set_from = OMPI_ATTRIBUTE_C;
}
set_value(type, new_object, &newattr_hash, key,
new_attr, true);
} else {
OBJ_RELEASE(new_attr);
}
OPAL_THREAD_LOCK(&attr_hash_lock);
ret = opal_hash_table_get_next_key_uint32(oldattr_hash, &key,
(void **) &old_attr,
in_node, &node);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
}
/* All done */
return MPI_SUCCESS;
}
/*
* Back-end function to delete a single attribute.
*
* Assumes that you DO already have the attribute_lock.
*/
static int ompi_attr_delete_impl(ompi_attribute_type_t type, void *object,
opal_hash_table_t *attr_hash, int key,
bool predefined)
{
ompi_attribute_keyval_t *keyval;
int ret = OMPI_SUCCESS;
attribute_value_t *attr;
/* Check if the key is valid in the master keyval hash */
ret = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &keyval);
if ((OMPI_SUCCESS != ret) || (NULL == keyval) ||
(keyval->attr_type!= type) ||
((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
ret = OMPI_ERR_BAD_PARAM;
goto exit;
}
/* Ensure that we don't have an empty attr_hash */
if (NULL == attr_hash) {
ret = OMPI_ERR_BAD_PARAM;
goto exit;
}
/* Check if the key is valid for the communicator/window/dtype. If
yes, then delete the attribute and key entry from the object's
hash */
ret = opal_hash_table_get_value_uint32(attr_hash, key, (void**) &attr);
if (OMPI_SUCCESS == ret) {
switch (type) {
case COMM_ATTR:
DELETE_ATTR_CALLBACKS(communicator, attr, keyval, object, ret);
break;
case WIN_ATTR:
DELETE_ATTR_CALLBACKS(win, attr, keyval, object, ret);
break;
case TYPE_ATTR:
DELETE_ATTR_CALLBACKS(datatype, attr, keyval, object, ret);
break;
default:
/* This should not happen */
assert(0);
break;
}
if (MPI_SUCCESS != ret) {
goto exit;
}
/* Ignore the return value at this point; it can't help any
more */
(void) opal_hash_table_remove_value_uint32(attr_hash, key);
OBJ_RELEASE(attr);
}
exit:
/* Decrement the ref count for the keyval. If ref count goes to
0, destroy the keyval (the destructor deletes the key
implicitly for this object). The ref count will only go to 0
here if MPI_*_FREE_KEYVAL was previously invoked and we just
freed the last attribute that was using the keyval. */
if (OMPI_SUCCESS == ret) {
OBJ_RELEASE(keyval);
}
return ret;
}
int ompi_attr_delete(ompi_attribute_type_t type, void *object,
opal_hash_table_t *attr_hash, int key,
bool predefined)
{
ompi_attribute_keyval_t *keyval;
int ret = OMPI_SUCCESS, err;
attribute_value_t *attr;
/* Check if the key is valid in the master keyval hash */
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 ((OMPI_SUCCESS != ret) || (NULL == keyval) ||
(keyval->attr_type!= type) ||
((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
ret = OMPI_ERR_BAD_PARAM;
return ret;
}
OPAL_THREAD_LOCK(&attr_hash_lock);
/* Ensure that we don't have an empty attr_hash */
if (NULL == attr_hash) {
ret = OMPI_ERR_BAD_PARAM;
OPAL_THREAD_UNLOCK(&attr_hash_lock);
return ret;
}
/* Check if the key is valid for the communicator/window/dtype. If
yes, then delete the attribute and key entry from the object's
hash */
/* Note that this function can be invoked by
ompi_attr_delete_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(attr_hash, key, (void**) &attr);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
if (OMPI_SUCCESS == ret) {
switch (type) {
case COMM_ATTR:
DELETE_ATTR_CALLBACKS(communicator, attr, keyval, object);
break;
case WIN_ATTR:
DELETE_ATTR_CALLBACKS(win, attr, keyval, object);
break;
case TYPE_ATTR:
DELETE_ATTR_CALLBACKS(datatype, attr, keyval, object);
break;
default:
ret = MPI_ERR_INTERN;
goto exit;
}
OBJ_RELEASE(attr);
OPAL_THREAD_LOCK(&attr_hash_lock);
ret = opal_hash_table_remove_value_uint32(attr_hash, key);
OPAL_THREAD_UNLOCK(&attr_hash_lock);
if (OMPI_SUCCESS != ret) {
goto exit;
}
}
exit:
/* Decrement the ref count for the keyval. If ref count goes to
0, destroy the keyval (the destructor deletes the key
implicitly for this object). The ref count will only go to 0
here if MPI_*_FREE_KEYVAL was previously invoked and we just
freed the last attribute that was using the keyval. */
if (OMPI_SUCCESS == ret) {
OPAL_THREAD_LOCK(&keyval_hash_lock);
OBJ_RELEASE(keyval);
OPAL_THREAD_UNLOCK(&keyval_hash_lock);
}
return ret;
}
static orte_process_name_t get_route(orte_process_name_t *target)
{
orte_process_name_t *ret, daemon;
int rc;
/* if it is me, then the route is just direct */
if (OPAL_EQUAL == opal_dss.compare(ORTE_PROC_MY_NAME, target, ORTE_NAME)) {
ret = target;
goto found;
}
/* if I am an application process, always route via my local daemon */
if (ORTE_PROC_IS_APP) {
ret = ORTE_PROC_MY_DAEMON;
goto found;
}
/****** HNP AND DAEMONS ONLY ******/
/* if the job family is zero, then this is going to a local slave,
* so the path is direct
*/
if (0 == ORTE_JOB_FAMILY(target->jobid)) {
ret = target;
goto found;
}
/* IF THIS IS FOR A DIFFERENT JOB FAMILY... */
if (ORTE_JOB_FAMILY(target->jobid) != ORTE_JOB_FAMILY(ORTE_PROC_MY_NAME->jobid)) {
/* if I am a daemon, route this via the HNP */
if (ORTE_PROC_IS_DAEMON) {
ret = ORTE_PROC_MY_HNP;
goto found;
}
/* if I am the HNP or a tool, then I stored a route to
* this job family, so look it up
*/
rc = opal_hash_table_get_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(target->jobid), (void**)&ret);
if (ORTE_SUCCESS == rc) {
/* got a good result - return it */
goto found;
}
/* not found - so we have no route */
ret = ORTE_NAME_INVALID;
goto found;
}
/* THIS CAME FROM OUR OWN JOB FAMILY... */
/* if we are not using static ports and this is going to the HNP, send direct */
if (!orte_static_ports &&
ORTE_PROC_MY_HNP->jobid == target->jobid &&
ORTE_PROC_MY_HNP->vpid == target->vpid) {
OPAL_OUTPUT_VERBOSE((2, orte_routed_base_output,
"%s routing not enabled - going direct",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME)));
ret = target;
goto found;
}
daemon.jobid = ORTE_PROC_MY_NAME->jobid;
/* find out what daemon hosts this proc */
if (ORTE_VPID_INVALID == (daemon.vpid = orte_ess.proc_get_daemon(target))) {
ORTE_ERROR_LOG(ORTE_ERR_NOT_FOUND);
ret = ORTE_NAME_INVALID;
goto found;
}
/* if the daemon is me, then send direct to the target! */
if (ORTE_PROC_MY_NAME->vpid == daemon.vpid) {
ret = target;
} else {
/* the linear routing tree is trivial - if the vpid is
* lower than mine, route through my parent, which is
* at my_vpid-1. If the vpid is higher than mine, then
* route to my_vpid+1, wrapping around to 0
*/
if (daemon.vpid < ORTE_PROC_MY_NAME->vpid) {
daemon.vpid = ORTE_PROC_MY_NAME->vpid - 1;
ret = &daemon;
} else {
if (ORTE_PROC_MY_NAME->vpid < orte_process_info.num_procs-1) {
daemon.vpid = ORTE_PROC_MY_NAME->vpid + 1;
} else {
/* we are at end of chain - wrap around */
daemon.vpid = 0;
}
ret = &daemon;
}
}
found:
OPAL_OUTPUT_VERBOSE((1, orte_routed_base_output,
"%s routed_linear_get(%s) --> %s",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME),
ORTE_NAME_PRINT(target),
ORTE_NAME_PRINT(ret)));
return *ret;
}
static int delete_route(orte_process_name_t *proc)
{
int rc;
orte_process_name_t *route_copy;
if (proc->jobid == ORTE_JOBID_INVALID ||
proc->vpid == ORTE_VPID_INVALID) {
return ORTE_ERR_BAD_PARAM;
}
/* if I am an application process, I don't have any routes
* so there is nothing for me to do
*/
if (!ORTE_PROC_IS_HNP && !ORTE_PROC_IS_DAEMON &&
!ORTE_PROC_IS_TOOL) {
return ORTE_SUCCESS;
}
OPAL_OUTPUT_VERBOSE((1, orte_routed_base_output,
"%s routed_binomial_delete_route for %s",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME),
ORTE_NAME_PRINT(proc)));
/* if this is from a different job family, then I need to
* look it up appropriately
*/
if (ORTE_JOB_FAMILY(proc->jobid) != ORTE_JOB_FAMILY(ORTE_PROC_MY_NAME->jobid)) {
/* if I am a daemon, then I will automatically route
* anything to this job family via my HNP - so I have nothing
* in my routing table and thus have nothing to do
* here, just return
*/
if (ORTE_PROC_IS_DAEMON) {
return ORTE_SUCCESS;
}
/* see if this proc is present - it will have a wildcard vpid,
* so we have to look for it with that condition
*/
rc = opal_hash_table_get_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(proc->jobid),
(void**)&route_copy);
if (ORTE_SUCCESS == rc && NULL != route_copy) {
/* proc is present - remove the data */
free(route_copy);
rc = opal_hash_table_remove_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(proc->jobid));
if (ORTE_SUCCESS != rc) {
ORTE_ERROR_LOG(rc);
}
return rc;
}
/* not present - nothing to do */
return ORTE_SUCCESS;
}
/* THIS CAME FROM OUR OWN JOB FAMILY...there is nothing
* to do here. The routes will be redefined when we update
* the routing tree
*/
return ORTE_SUCCESS;
}
/*
* 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;
}
/*
* Copy all the attributes from one MPI object to another. Called
* when MPI objects are copied (e.g., back-end actions to
* MPI_COMM_DUP).
*/
int ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object,
void *new_object, opal_hash_table_t *oldattr_hash,
opal_hash_table_t *newattr_hash)
{
int ret;
int err;
uint32_t key;
int flag;
void *node, *in_node;
attribute_value_t *old_attr, *new_attr;
ompi_attribute_keyval_t *hash_value;
/* If there's nothing to do, just return */
if (NULL == oldattr_hash) {
return MPI_SUCCESS;
}
OPAL_THREAD_LOCK(&attribute_lock);
/* Get the first attribute in the object's hash */
ret = opal_hash_table_get_first_key_uint32(oldattr_hash, &key,
(void **) &old_attr,
&node);
/* While we still have some attribute in the object's key hash */
while (OMPI_SUCCESS == ret) {
in_node = node;
/* Get the keyval in the main keyval hash - so that we know
what the copy_attr_fn is */
err = opal_hash_table_get_value_uint32(keyval_hash, key,
(void **) &hash_value);
if (OMPI_SUCCESS != err) {
/* This should not happen! */
ret = MPI_ERR_INTERN;
goto out;
}
err = 0;
new_attr = OBJ_NEW(attribute_value_t);
switch (type) {
case COMM_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(communicator, old_object, hash_value,
old_attr, new_object, new_attr, err);
break;
case TYPE_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(datatype, old_object, hash_value,
old_attr, new_object, new_attr, err);
break;
case WIN_ATTR:
/* Now call the copy_attr_fn */
COPY_ATTR_CALLBACKS(win, old_object, hash_value,
old_attr, new_object, new_attr, err);
break;
default:
/* This should not happen */
assert(0);
break;
}
/* Did the callback return non-MPI_SUCCESS? */
if (0 != err) {
ret = err;
goto out;
}
/* Hang this off the object's hash */
/* The COPY_ATTR_CALLBACKS macro will have converted the
_flag_ callback output value from Fortran's .TRUE. value to
0/1 (if necessary). So we only need to check for 0/1 here
-- not .TRUE. */
if (1 == flag) {
if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77)) {
if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77_INT)) {
new_attr->av_set_from = OMPI_ATTRIBUTE_FINT;
} else {
new_attr->av_set_from = OMPI_ATTRIBUTE_AINT;
}
} else {
new_attr->av_set_from = OMPI_ATTRIBUTE_C;
}
ret = set_value(type, new_object, &newattr_hash, key,
new_attr, true);
if (MPI_SUCCESS != ret) {
goto out;
}
} else {
OBJ_RELEASE(new_attr);
}
ret = opal_hash_table_get_next_key_uint32(oldattr_hash, &key,
(void **) &old_attr,
in_node, &node);
}
ret = MPI_SUCCESS;
out:
/* All done */
opal_atomic_wmb();
OPAL_THREAD_UNLOCK(&attribute_lock);
return ret;
}
static int update_route(orte_process_name_t *target,
orte_process_name_t *route)
{
int rc;
orte_process_name_t * route_copy;
if (target->jobid == ORTE_JOBID_INVALID ||
target->vpid == ORTE_VPID_INVALID) {
return ORTE_ERR_BAD_PARAM;
}
/* if I am an application process, we don't update the route since
* we automatically route everything through the local daemon
*/
if (ORTE_PROC_IS_APP) {
return ORTE_SUCCESS;
}
/* if the job family is zero, then this is going to a local slave,
* so the path is direct and there is nothing to do here
*/
if (0 == ORTE_JOB_FAMILY(target->jobid)) {
return ORTE_SUCCESS;
}
OPAL_OUTPUT_VERBOSE((1, orte_routed_base_output,
"%s routed_linear_update: %s --> %s",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME),
ORTE_NAME_PRINT(target),
ORTE_NAME_PRINT(route)));
/* if this is from a different job family, then I need to
* track how to send messages to it
*/
if (ORTE_JOB_FAMILY(target->jobid) != ORTE_JOB_FAMILY(ORTE_PROC_MY_NAME->jobid)) {
/* if I am a daemon, then I will automatically route
* anything to this job family via my HNP - so nothing to do
* here, just return
*/
if (ORTE_PROC_IS_DAEMON) {
return ORTE_SUCCESS;
}
OPAL_OUTPUT_VERBOSE((1, orte_routed_base_output,
"%s routed_linear_update: diff job family routing job %s --> %s",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME),
ORTE_JOBID_PRINT(target->jobid),
ORTE_NAME_PRINT(route)));
/* see if this target is already present - it will have a wildcard vpid,
* so we have to look for it with that condition
*/
rc = opal_hash_table_get_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(target->jobid),
(void**)&route_copy);
if (ORTE_SUCCESS == rc && NULL != route_copy) {
/* target already present - update the route info
* in case it has changed
*/
*route_copy = *route;
rc = opal_hash_table_set_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(target->jobid), route_copy);
if (ORTE_SUCCESS != rc) {
ORTE_ERROR_LOG(rc);
}
return rc;
}
/* not there, so add the route FOR THE JOB FAMILY*/
route_copy = (orte_process_name_t *) malloc(sizeof(orte_process_name_t));
*route_copy = *route;
rc = opal_hash_table_set_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(target->jobid), route_copy);
if (ORTE_SUCCESS != rc) {
ORTE_ERROR_LOG(rc);
}
return rc;
}
/* THIS CAME FROM OUR OWN JOB FAMILY... */
opal_output(0, "%s CALL TO UPDATE ROUTE FOR OWN JOB FAMILY", ORTE_NAME_PRINT(ORTE_PROC_MY_NAME));
return ORTE_ERR_NOT_SUPPORTED;
}
static orte_process_name_t get_route(orte_process_name_t *target)
{
orte_process_name_t *ret, daemon;
opal_list_item_t *item;
orte_routed_tree_t *child;
int rc;
if (target->jobid == ORTE_JOBID_INVALID ||
target->vpid == ORTE_VPID_INVALID) {
ret = ORTE_NAME_INVALID;
goto found;
}
/* if it is me, then the route is just direct */
if (OPAL_EQUAL == opal_dss.compare(ORTE_PROC_MY_NAME, target, ORTE_NAME)) {
ret = target;
goto found;
}
/* if I am an application process, always route via my local daemon */
if (ORTE_PROC_IS_APP) {
ret = ORTE_PROC_MY_DAEMON;
goto found;
}
/****** HNP AND DAEMONS ONLY ******/
/* if the job family is zero, then this is going to a local slave,
* so the path is direct
*/
if (0 == ORTE_JOB_FAMILY(target->jobid)) {
ret = target;
goto found;
}
/* IF THIS IS FOR A DIFFERENT JOB FAMILY... */
if (ORTE_JOB_FAMILY(target->jobid) != ORTE_JOB_FAMILY(ORTE_PROC_MY_NAME->jobid)) {
/* if I am a daemon, route this via the HNP */
if (ORTE_PROC_IS_DAEMON) {
ret = ORTE_PROC_MY_HNP;
goto found;
}
/* if I am the HNP or a tool, then I stored a route to
* this job family, so look it up
*/
rc = opal_hash_table_get_value_uint32(&jobfam_list,
ORTE_JOB_FAMILY(target->jobid), (void**)&ret);
if (ORTE_SUCCESS == rc) {
/* got a good result - return it */
goto found;
}
/* not found - so we have no route */
ret = ORTE_NAME_INVALID;
goto found;
}
/* THIS CAME FROM OUR OWN JOB FAMILY... */
/* if we are not using static ports and this is going to the HNP, send direct */
if (!orte_static_ports &&
ORTE_PROC_MY_HNP->jobid == target->jobid &&
ORTE_PROC_MY_HNP->vpid == target->vpid) {
OPAL_OUTPUT_VERBOSE((2, orte_routed_base_output,
"%s routing not enabled - going direct",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME)));
ret = target;
goto found;
}
daemon.jobid = ORTE_PROC_MY_NAME->jobid;
/* find out what daemon hosts this proc */
if (ORTE_VPID_INVALID == (daemon.vpid = orte_ess.proc_get_daemon(target))) {
ORTE_ERROR_LOG(ORTE_ERR_NOT_FOUND);
ret = ORTE_NAME_INVALID;
goto found;
}
/* if the daemon is me, then send direct to the target! */
if (ORTE_PROC_MY_NAME->vpid == daemon.vpid) {
ret = target;
goto found;
} else {
/* search routing tree for next step to that daemon */
for (item = opal_list_get_first(&my_children);
item != opal_list_get_end(&my_children);
item = opal_list_get_next(item)) {
child = (orte_routed_tree_t*)item;
if (child->vpid == daemon.vpid) {
/* the child is hosting the proc - just send it there */
ret = &daemon;
goto found;
}
/* otherwise, see if the daemon we need is below the child */
if (opal_bitmap_is_set_bit(&child->relatives, daemon.vpid)) {
/* yep - we need to step through this child */
daemon.vpid = child->vpid;
ret = &daemon;
goto found;
}
}
}
/* if we get here, then the target daemon is not beneath
* any of our children, so we have to step up through our parent
*/
daemon.vpid = my_parent.vpid;
ret = &daemon;
found:
OPAL_OUTPUT_VERBOSE((1, orte_routed_base_output,
"%s routed_radix_get(%s) --> %s",
ORTE_NAME_PRINT(ORTE_PROC_MY_NAME),
ORTE_NAME_PRINT(target),
ORTE_NAME_PRINT(ret)));
return *ret;
}
int MPI_Type_create_f90_integer(int r, MPI_Datatype *newtype)
{
OPAL_CR_NOOP_PROGRESS();
if (MPI_PARAM_CHECK) {
OMPI_ERR_INIT_FINALIZE(FUNC_NAME);
/* Note: These functions accept negative integers for the p and r
* arguments. This is because for the SELECTED_INTEGER_KIND,
* negative numbers are equivalent to zero values. See section
* 13.14.95 of the Fortran 95 standard. */
}
/**
* With respect to the MPI standard, MPI-2.0 Sect. 10.2.5, MPI_TYPE_CREATE_F90_xxxx,
* page 295, line 47 we handle this nicely by caching the values in a hash table.
* However, as the value of might not always make sense, a little bit of optimization
* might be a good idea. Therefore, first we try to see if we can handle the value
* with some kind of default value, and if it's the case then we look into the
* cache.
*/
if (r > 38) *newtype = &ompi_mpi_datatype_null.dt;
#if OMPI_HAVE_F90_INTEGER16
else if (r > 18) *newtype = &ompi_mpi_long_long_int.dt;
#else
else if (r > 18) *newtype = &ompi_mpi_datatype_null.dt;
#endif /* OMPI_HAVE_F90_INTEGER16 */
#if SIZEOF_LONG > SIZEOF_INT
else if (r > 9) *newtype = &ompi_mpi_long.dt;
#else
#if SIZEOF_LONG_LONG > SIZEOF_INT
else if (r > 9) *newtype = &ompi_mpi_long_long_int.dt;
#else
else if (r > 9) *newtype = &ompi_mpi_datatype_null.dt;
#endif /* SIZEOF_LONG_LONG > SIZEOF_INT */
#endif /* SIZEOF_LONG > SIZEOF_INT */
else if (r > 4) *newtype = &ompi_mpi_int.dt;
else if (r > 2) *newtype = &ompi_mpi_short.dt;
else *newtype = &ompi_mpi_byte.dt;
if( *newtype != &ompi_mpi_datatype_null.dt ) {
ompi_datatype_t* datatype;
int* a_i[1];
int rc;
if( OPAL_SUCCESS == opal_hash_table_get_value_uint32( &ompi_mpi_f90_integer_hashtable,
r, (void**)newtype ) ) {
return MPI_SUCCESS;
}
/* Create the duplicate type corresponding to selected type, then
* set the argument to be a COMBINER with the correct value of r
* and add it to the hash table. */
if (OMPI_SUCCESS != ompi_datatype_duplicate( *newtype, &datatype)) {
OMPI_ERRHANDLER_RETURN (MPI_ERR_INTERN, MPI_COMM_WORLD,
MPI_ERR_INTERN, FUNC_NAME );
}
/* Make sure the user is not allowed to free this datatype as specified
* in the MPI standard.
*/
datatype->super.flags |= OMPI_DATATYPE_FLAG_PREDEFINED;
/* Mark the datatype as a special F90 convenience type */
snprintf(datatype->name, MPI_MAX_OBJECT_NAME, "COMBINER %s",
(*newtype)->name);
a_i[0] = &r;
ompi_datatype_set_args( datatype, 1, a_i, 0, NULL, 0, NULL, MPI_COMBINER_F90_INTEGER );
rc = opal_hash_table_set_value_uint32( &ompi_mpi_f90_integer_hashtable, r, datatype );
if (OMPI_SUCCESS != rc) {
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, rc, FUNC_NAME);
}
*newtype = datatype;
return MPI_SUCCESS;
}
return OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, MPI_ERR_ARG, FUNC_NAME);
}
/*
* 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;
}
