attribute.c

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

static opal_mutex_t alock;
#endif  /* OMPI_HAVE_THREAD_SUPPORT */


/*
 * attribute_value_t constructor function
 */
static void attribute_value_construct(attribute_value_t *item)
{
    item->av_address_kind_pointer = (MPI_Aint*) &item->av_value;
    item->av_integer_pointer = &(((MPI_Fint*) &item->av_value)[int_pos]);
    item->av_set_from = 0;
}


/*
 * ompi_attribute_keyval_t constructor / destructor
 */
static void
ompi_attribute_keyval_construct(ompi_attribute_keyval_t *keyval) 
{
    keyval->attr_type = UNUSED_ATTR;
    keyval->attr_flag = 0;
    keyval->copy_attr_fn.attr_communicator_copy_fn = NULL;
    keyval->delete_attr_fn.attr_communicator_copy_fn = NULL;
    keyval->extra_state = NULL;
    keyval->extra_destructor = NULL;

    /* Set the keyval->key value to an invalid value so that we can know
       if it has been initialized with a proper value or not.
       Specifically, the destructor may get invoked if we weren't able
       to assign a key properly.  So we don't want to try to remove it
       from the table if it wasn't there. */
    keyval->key = -1;
}


static void 
ompi_attribute_keyval_destruct(ompi_attribute_keyval_t *keyval) 
{
    /* THIS FUNCTION ASSUMES THAT THE CALLER ALREADY HAS OBTAINED THE
       alock MUTEX!  Remove the keyval entry from the hash and free
       the key. */

    if (-1 != keyval->key) {
        /* If the destructor function pointer is not NULL, call it */
        if (NULL != keyval->extra_destructor) {
            keyval->extra_destructor(keyval->key);
        }

        opal_hash_table_remove_value_uint32(keyval_hash, keyval->key);
        FREE_KEY(keyval->key);
    }
}


/* 
 * This will initialize the main list to store key- attribute
 * items. This will be called one time, mostly during MPI_INIT()
 */

int ompi_attr_init(void)
{
    int ret;
    void *bogus = (void*) 1;
    MPI_Fint *p = (MPI_Fint*) &bogus;

    keyval_hash = OBJ_NEW(opal_hash_table_t);
    if (NULL == keyval_hash) {
        return MPI_ERR_SYSRESOURCE;
    }
    key_bitmap = OBJ_NEW(ompi_bitmap_t);
    if (0 != ompi_bitmap_init(key_bitmap, 32)) {
        return MPI_ERR_SYSRESOURCE;
    }

    for (int_pos = 0; int_pos < (sizeof(void*) / sizeof(MPI_Fint)); 
         ++int_pos) {
        if (p[int_pos] == 1) {
            break;
        }
    }

#if OMPI_HAVE_THREAD_SUPPORT
    OBJ_CONSTRUCT(&alock, opal_mutex_t);
#endif

    if (OMPI_SUCCESS != (ret = opal_hash_table_init(keyval_hash,
                                                    ATTR_TABLE_SIZE))) {
        return ret;
    }
    if (OMPI_SUCCESS != (ret = ompi_attr_create_predefined())) {
        return ret;
    }
  
    return OMPI_SUCCESS;
}


/* 
 * This will destroy the list, mostly during MPI_Finalize()
 */

int ompi_attr_finalize(void)
{
    int ret;

    ret = ompi_attr_free_predefined();
    OBJ_RELEASE(keyval_hash);
    OBJ_RELEASE(key_bitmap);

    return ret;
}


int ompi_attr_create_keyval(ompi_attribute_type_t type,
                            ompi_attribute_fn_ptr_union_t copy_attr_fn,
                            ompi_attribute_fn_ptr_union_t delete_attr_fn,
                            int *key, void *extra_state, int flags,
                            ompi_attribute_keyval_destructor_fn_t *destructor_fn)
{
    ompi_attribute_keyval_t *keyval;
    int ret;

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

    /* Allocate space for the list item */

    keyval = OBJ_NEW(ompi_attribute_keyval_t);
    if (NULL == keyval) {
        return MPI_ERR_SYSRESOURCE;
    }

    /* Fill in the list item (must be done before we set the keyval
       on the keyval_hash in case some other thread immediately reads
       it from the keyval_hash) */
  
    keyval->copy_attr_fn = copy_attr_fn;
    keyval->delete_attr_fn = delete_attr_fn;
    keyval->extra_state = extra_state;
    keyval->attr_type = type;
    keyval->attr_flag = flags;
    keyval->key = -1;
    keyval->extra_destructor = destructor_fn;

    /* Create a new unique key and fill the hash */
  
    OPAL_THREAD_LOCK(&alock);
    ret = CREATE_KEY(key);
    if (OMPI_SUCCESS == ret) {
        keyval->key = *key;
        ret = opal_hash_table_set_value_uint32(keyval_hash, *key, keyval);
    }
    if (OMPI_SUCCESS != ret) {
        OBJ_RELEASE(keyval);
        OPAL_THREAD_UNLOCK(&alock);
        return ret;
    }

    OPAL_THREAD_UNLOCK(&alock);
    return MPI_SUCCESS;
}


int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, 
                          bool predefined)
{
    int ret;
    ompi_attribute_keyval_t *keyval;

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

    /* Find the key-value pair */

    OPAL_THREAD_LOCK(&alock);
    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(&alock);
        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_THREAD_UNLOCK(&alock);

    return MPI_SUCCESS;
}


int ompi_attr_delete(ompi_attribute_type_t type, void *object, 
                     opal_hash_table_t *attr_hash, int key,
                     bool predefined, bool need_lock) 
{
    ompi_attribute_keyval_t *keyval;
    int ret = OMPI_SUCCESS, err;
    attribute_value_t *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;
    }

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

    if (need_lock) {
        OPAL_THREAD_LOCK(&alock);
    }

    /* 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);
            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);
    
        ret = opal_hash_table_remove_value_uint32(attr_hash, key);
        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) {
        OBJ_RELEASE(keyval);
    }

    if (need_lock) {
        OPAL_THREAD_UNLOCK(&alock);
    }        

    return ret;
}


/*
 * Front-end function called by the C MPI API functions to set an
 * attribute.
 */
int ompi_attr_set_c(ompi_attribute_type_t type, void *object, 
                    opal_hash_table_t **attr_hash,
                    int key, void *attribute, bool predefined, bool need_lock)
{
    attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
    if (NULL == new_attr) {
        return MPI_ERR_SYSRESOURCE;
    }

    new_attr->av_value = attribute;
    new_attr->av_set_from = OMPI_ATTRIBUTE_C;
    return set_value(type, object, attr_hash, key, new_attr,
                     predefined, need_lock);
}


/*
 * Front-end function called by the Fortran MPI-2 API functions to set
 * an attribute.
 */
int ompi_attr_set_fortran_mpi1(ompi_attribute_type_t type, void *object, 
                               opal_hash_table_t **attr_hash,
                               int key, MPI_Fint attribute, 
                               bool predefined, bool need_lock)
{
    attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
    if (NULL == new_attr) {
        return MPI_ERR_SYSRESOURCE;
    }

    new_attr->av_value = (void *) 0;
    *new_attr->av_integer_pointer = attribute;
    new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI1;
    return set_value(type, object, attr_hash, key, new_attr,
                     predefined, need_lock);
}


/*
 * Front-end function called by the Fortran MPI-2 API functions to set
 * an attribute.
 */
int ompi_attr_set_fortran_mpi2(ompi_attribute_type_t type, void *object, 
                               opal_hash_table_t **attr_hash,
                               int key, MPI_Aint attribute, 
                               bool predefined, bool need_lock)
{
    attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
    if (NULL == new_attr) {
        return MPI_ERR_SYSRESOURCE;
    }

    new_attr->av_value = (void *) attribute;
    new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI2;
    return set_value(type, object, attr_hash, key, new_attr,
                     predefined, need_lock);
}


/*
 * Front-end function called by the C MPI API functions to get
 * attributes.
 */
int ompi_attr_get_c(opal_hash_table_t *attr_hash, int key, 
                    void **attribute, int *flag)
{
    attribute_value_t *val = NULL;
    int ret;

    ret = get_value(attr_hash, key, &val, flag);
    if (MPI_SUCCESS == ret && 1 == *flag) {
        *attribute = translate_to_c(val);
    }

    return ret;
}


/*
 * Front-end function called by the Fortran MPI-1 API functions to get
 * attributes.
 */
int ompi_attr_get_fortran_mpi1(opal_hash_table_t *attr_hash, int key, 
                               MPI_Fint *attribute, int *flag)
{
    attribute_value_t *val = NULL;
    int ret;

    ret = get_value(attr_hash, key, &val, flag);
    if (MPI_SUCCESS == ret && 1 == *flag) {
        *attribute = translate_to_fortran_mpi1(val);
    }

    return ret;
}


/*
 * Front-end function called by the Fortran MPI-2 API functions to get
 * attributes.
 */
int ompi_attr_get_fortran_mpi2(opal_hash_table_t *attr_hash, int key, 
                               MPI_Aint *attribute, int *flag)
{
    attribute_value_t *val = NULL;
    int ret;

    ret = get_value(attr_hash, key, &val, flag);
    if (MPI_SUCCESS == ret && 1 == *flag) {
        *attribute = translate_to_fortran_mpi2(val);
    }