attribute.c

MPI stands for the Message Passing Interface. Written by the MPI Forum (a large committee comprising

    return ret;
}


/*
 * 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;

    /* Protect against the user calling ompi_attr_destroy and then
       calling any of the functions which use it  */
    if (NULL == keyval_hash) {
        return MPI_ERR_INTERN;
    }

    /* 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 keyval hash or bitmap while
       we're traversing it */

    OPAL_THREAD_LOCK(&alock);

    /* 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);

        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, false);
        } else {
            OBJ_RELEASE(new_attr);
        }

        ret = opal_hash_table_get_next_key_uint32(oldattr_hash, &key, 
                                                  (void **) &old_attr, 
                                                  in_node, &node);
    }

    /* All done */

    OPAL_THREAD_UNLOCK(&alock);
    return MPI_SUCCESS;
}


/*
 * Delete all the attributes on an MPI object
 */
int ompi_attr_delete_all(ompi_attribute_type_t type, void *object, 
                         opal_hash_table_t *attr_hash)
{
    int key_ret, del_ret;
    uint32_t key, oldkey;
    void *node, *in_node, *old_attr;

    /* Protect against the user calling ompi_attr_destroy and then
       calling any of the functions which use it  */
    if (NULL == keyval_hash) {
        return MPI_ERR_INTERN;
    }

    /* Ensure that the table is not empty */

    if (NULL == attr_hash) {
        return MPI_SUCCESS;
    }
        
    /* Lock this whole sequence of events -- don't let any other
       thread modify the structure of the keyval hash or bitmap while
       we're traversing it */

    OPAL_THREAD_LOCK(&alock);

    /* Get the first key in local object's hash  */
    key_ret = opal_hash_table_get_first_key_uint32(attr_hash,
                                               &key, &old_attr,
                                               &node);
    del_ret = OMPI_SUCCESS;
    while (OMPI_SUCCESS == key_ret && OMPI_SUCCESS == del_ret) {

        /* Save this node info for deletion, before we move onto the
           next node */

        in_node = node;
        oldkey = key;
        
        /* Move to the next node */

        key_ret = opal_hash_table_get_next_key_uint32(attr_hash,
                                                      &key, &old_attr, 
                                                      in_node, &node);
        /* Now delete this attribute */

        del_ret = ompi_attr_delete(type, object, attr_hash, oldkey, true, false);
    }

    /* All done */

    OPAL_THREAD_UNLOCK(&alock);
    return del_ret;
}

/*************************************************************************/

/*
 * 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, bool need_lock)
{
    ompi_attribute_keyval_t *keyval;
    int ret, err;
    attribute_value_t *old_attr;
    bool had_old = false;

    /* Protect against the user calling ompi_attr_destroy and then
       calling any of the functions which use it  */
    if (NULL == keyval_hash) {
        return MPI_ERR_INTERN;
    }
    if (NULL == attr_hash) {
        return MPI_ERR_INTERN;
    }

    /* 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).  In these
       cases, ompi_attr_copy_all() has already locked the keyval_lock,
       so we should not try to lock it again. */

    if (need_lock) {
        OPAL_THREAD_LOCK(&alock);
    }
    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))) {
        if (need_lock) {
            OPAL_THREAD_UNLOCK(&alock);
        }
        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);
            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:
            if (need_lock) {
                OPAL_THREAD_UNLOCK(&alock);
            }
            return MPI_ERR_INTERN;
        }
        had_old = true;
        OBJ_RELEASE(old_attr);
    }

    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);
    }

    /* Release the lock if we grabbed it */

    if (need_lock) {
        OPAL_THREAD_UNLOCK(&alock);
    }
    if (OMPI_SUCCESS != ret) {
        return ret;
    }

    return MPI_SUCCESS;
}


/*
 * 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.
 */
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;
    OPAL_THREAD_LOCK(&alock);
    ret = opal_hash_table_get_value_uint32(keyval_hash, key, 
                                           (void**) &keyval);

    if (OMPI_ERR_NOT_FOUND == ret) {
        OPAL_THREAD_UNLOCK(&alock);
        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) {
        OPAL_THREAD_UNLOCK(&alock);
        return OMPI_SUCCESS;
    }

    ret = opal_hash_table_get_value_uint32(attr_hash, key, &attr);
    OPAL_THREAD_UNLOCK(&alock);
    if (OMPI_SUCCESS == ret) {
        *attribute = (attribute_value_t*)attr;
        *flag = 1;
    }
    return OMPI_SUCCESS;
}


/*
 * Take an attribute and translate it according to the cases listed in
 * the comments at the top of this file.
 *
 * This function does not fail -- it is only invoked in "safe"
 * situations.
 */
static void *translate_to_c(attribute_value_t *val)
{
    switch (val->av_set_from) {
    case OMPI_ATTRIBUTE_C:
        /* Case 1: written in C, read in C (unity) */
        return val->av_value;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI1:
        /* Case 4: written in Fortran MPI-1, read in C */
        return (void *) val->av_integer_pointer;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI2:
        /* Case 7: written in Fortran MPI-2, read in C */
        return (void *) val->av_address_kind_pointer;
        break;

    default:
        /* Should never reach here */
        return NULL;
    }
}


/*
 * Take an attribute and translate it according to the cases listed in
 * the comments at the top of this file.
 *
 * This function does not fail -- it is only invoked in "safe"
 * situations.
 */
static MPI_Fint translate_to_fortran_mpi1(attribute_value_t *val)
{
    switch (val->av_set_from) {
    case OMPI_ATTRIBUTE_C:
        /* Case 2: written in C, read in Fortran MPI-1 */
        return *val->av_integer_pointer;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI1:
        /* Case 5: written in Fortran MPI-1, read in Fortran MPI-1
           (unity) */
        return *val->av_integer_pointer;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI2:
        /* Case 8: written in Fortran MPI-2, read in Fortran MPI-1 */
        return *val->av_integer_pointer;
        break;

    default:
        /* Should never reach here */
        return 0;
    }
}


/*
 * Take an attribute and translate it according to the cases listed in
 * the comments at the top of this file.
 *
 * This function does not fail -- it is only invoked in "safe"
 * situations.
 */
static MPI_Aint translate_to_fortran_mpi2(attribute_value_t *val)
{
    switch (val->av_set_from) {
    case OMPI_ATTRIBUTE_C:
        /* Case 3: written in C, read in Fortran MPI-2 */
        return (MPI_Aint) val->av_value;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI1:
        /* Case 6: written in Fortran MPI-1, read in Fortran MPI-2 */
        return (MPI_Aint) *val->av_integer_pointer;
        break;

    case OMPI_ATTRIBUTE_FORTRAN_MPI2:
        /* Case 9: written in Fortran MPI-2, read in Fortran MPI-2
           (unity) */
        return (MPI_Aint) val->av_value;
        break;

    default:
        /* Should never reach here */
        return 0;
    }
}