ompi/attribute/attribute.c

/* [<][>][^][v][top][bottom][index][help] */
This source file includes following definitions.
attribute_value_construct
ompi_attribute_keyval_construct
ompi_attribute_keyval_destruct
ompi_attr_init
ompi_attr_finalize
ompi_attr_create_keyval_impl
ompi_attr_create_keyval
ompi_attr_create_keyval_fint
ompi_attr_create_keyval_aint
ompi_attr_free_keyval
ompi_attr_set_c
ompi_attr_set_int
ompi_attr_set_fint
ompi_attr_set_aint
ompi_attr_get_c
ompi_attr_get_fint
ompi_attr_get_aint
ompi_attr_copy_all
ompi_attr_delete_impl
ompi_attr_delete
ompi_attr_delete_all
set_value
get_value
translate_to_c
translate_to_fint
translate_to_aint
compare_attr_sequence
   1 /*
   2  * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
   3  *                         University Research and Technology
   4  *                         Corporation.  All rights reserved.
   5  * Copyright (c) 2004-2014 The University of Tennessee and The University
   6  *                         of Tennessee Research Foundation.  All rights
   7  *                         reserved.
   8  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
   9  *                         University of Stuttgart.  All rights reserved.
  10  * Copyright (c) 2004-2005 The Regents of the University of California.
  11  *                         All rights reserved.
  12  * Copyright (c) 2006-2014 Cisco Systems, Inc.  All rights reserved.
  13  * Copyright (c) 2012      Los Alamos National Security, LLC.  All rights
  14  *                         reserved.
  15  * Copyright (c) 2017      Research Organization for Information Science
  16  *                         and Technology (RIST). All rights reserved.
  17  * $COPYRIGHT$
  18  *
  19  * Additional copyrights may follow
  20  *
  21  * $HEADER$
  22  */
  23 
  24 /**
  25  * @file
  26  *
  27  * Back-end MPI attribute engine.
  28  *
  29  * This is complicated enough that it deserves a lengthy discussion of
  30  * what is happening.  This is extremely complicated stuff, paired
  31  * with the fact that it is not described well in the MPI standard.
  32  * There are several places in the standard that should be read about
  33  * attributes:
  34  *
  35  * MPI-1:   Section 5.7 (pp 167-173)
  36  * MPI-1:   Section 7.1 (pp 191-192) predefined attributes in MPI-1
  37  * MPI-2:   Section 4.12.7 (pp 57-59) interlanguage attribute
  38  *          clarifications
  39  * MPI-2:   Section 6.2.2 (pp 112) window predefined attributes
  40  * MPI-2:   Section 8.8 (pp 198-208) new attribute caching functions
  41  * MPI-3.1: Section 11.2.6 (pp 414-415) window attributes
  42  *
  43  * After reading all of this, note the following:
  44  *
  45  * - C MPI-1 and MPI-2 attribute functions and functionality are
  46  *   identical except for their function names.
  47  * - Fortran MPI-1 and MPI-2 attribute functions and functionality are
  48  *   different (namely: the parameters are different sizes, both in the
  49  *   functions and the user callbacks, and the assignments to the
  50  *   different sized types occur differently [e.g., truncation and sign
  51  *   extension])
  52  * - C functions store values by reference (i.e., writing an attribute
  53  *   means writing a pointer to an instance of something; changing the
  54  *   value of that instance will make it visible to anyone who reads
  55  *   that attribute value).
  56  * - C also internally store some int attributes of a MPI_Win by value,
  57  *   and these attributes are read-only (i.e. set once for all)
  58  * - Fortran functions store values by value (i.e., writing an
  59  *   attribute value means that anyone who reads that attribute value
  60  *   will not be able to affect the value read by anyone else).
  61  * - The predefined attribute MPI_WIN_BASE seems to flaunt the rules
  62  *   designated by the rest of the standard; it is handled
  63  *   specifically in the MPI_WIN_GET_ATTR binding functions (see the
  64  *   comments in there for an explanation).
  65  * - MPI-2 4.12.7:Example 4.13 (p58) is wrong.  The C->Fortran example
  66  *   should have the Fortran "val" variable equal to &I.
  67  *
  68  * By the first two of these, there are 12 possible use cases -- 4
  69  * possibilities for writing an attribute value, each of which has 3
  70  * possibilities for reading that value back.  The following lists
  71  * each of the 12 cases, and what happens in each.
  72  *
  73  * Cases where C writes an attribute value:
  74  * ----------------------------------------
  75  *
  76  * In all of these cases, a pointer was written by C (e.g., a pointer
  77  * to an int -- but it could have been a pointer to anything, such as
  78  * a struct).  These scenarios each have 2 examples:
  79  *
  80  * Example A: int foo = 3;
  81  *            MPI_Attr_put(..., &foo);
  82  * Example B: struct foo bar;
  83  *            MPI_Attr_put(..., &bar);
  84  *
  85  * 1. C reads the attribute value.  Clearly, this is a "unity" case,
  86  * and no translation occurs.  A pointer is written, and that same
  87  * pointer is returned.
  88  *
  89  * Example A: int *ret;
  90  *            MPI_Attr_get(..., &ret);
  91  *            --> *ret will equal 3
  92  * Example B: struct foo *ret;
  93  *            MPI_Attr_get(..., &ret);
  94  *            --> *ret will point to the instance bar that was written
  95  *
  96  * 2. Fortran MPI-1 reads the attribute value.  The C pointer is cast
  97  * to a fortran INTEGER (i.e., MPI_Fint) -- potentially being
  98  * truncated if sizeof(void*) > sizeof(INTEGER).
  99  *
 100  * Example A: INTEGER ret
 101  *            CALL MPI_ATTR_GET(..., ret, ierr)
 102  *            --> ret will equal &foo, possibly truncated
 103  * Example B: INTEGER ret
 104  *            CALL MPI_ATTR_GET(..., ret, ierr)
 105  *            --> ret will equal &bar, possibly truncated
 106  *
 107  * 3. Fortran MPI-2 reads the attribute value.  The C pointer is cast
 108  * to a fortran INTEGER(KIND=MPI_ADDRESS_KIND) (i.e., a (MPI_Aint)).
 109  *
 110  * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 111  *            CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 112  *            --> ret will equal &foo
 113  * Example B: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 114  *            CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 115  *            --> ret will equal &bar
 116  *
 117  * Cases where C writes an int attribute:
 118  * ----------------------------------------------------
 119  *
 120  * In all of these cases, an int is written by C.
 121  * This is done internally when writing the attributes of a MPI_Win
 122  *
 123  * Example: int foo = 7;
 124  *          ompi_set_attr_int(..., foo, ...)
 125  *
 126  * 4. C reads the attribute value.  The value returned is a pointer
 127  *    that points to an int that has a value
 128  *    of 7.
 129  *
 130  * Example: int *ret;
 131  *          MPI_Attr_get(..., &ret);
 132  *          -> *ret will equal 7.
 133  *
 134  * 5. Fortran MPI-1 reads the attribute value.  This is the unity
 135  *    case; the same value is returned.
 136  *
 137  * Example: INTEGER ret
 138  *          CALL MPI_ATTR_GET(..., ret, ierr)
 139  *          --> ret will equal 7
 140  *
 141  * 6. Fortran MPI-2 reads the attribute value.  The same value is
 142  *    returned, but potentially sign-extended if sizeof(INTEGER) <
 143  *    sizeof(INTEGER(KIND=MPI_ADDRESS_KIND)).
 144  *
 145  * Example: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 146  *          CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 147  *          --> ret will equal 7
 148  *
 149  * Cases where Fortran MPI-1 writes an attribute value:
 150  * ----------------------------------------------------
 151  *
 152  * In all of these cases, an INTEGER is written by Fortran.
 153  *
 154  * Example: INTEGER FOO = 7
 155  *          CALL MPI_ATTR_PUT(..., foo, ierr)
 156  *
 157  * 7. C reads the attribute value.  The value returned is a pointer
 158  *    that points to an INTEGER (i.e., an MPI_Fint) that has a value
 159  *    of 7.
 160  *    --> NOTE: The external MPI interface does not distinguish between
 161  *        this case and case 7.  It is the programer's responsibility
 162  *        to code accordingly.
 163  *
 164  * Example: MPI_Fint *ret;
 165  *          MPI_Attr_get(..., &ret);
 166  *          -> *ret will equal 7.
 167  *
 168  * 8. Fortran MPI-1 reads the attribute value.  This is the unity
 169  *    case; the same value is returned.
 170  *
 171  * Example: INTEGER ret
 172  *          CALL MPI_ATTR_GET(..., ret, ierr)
 173  *          --> ret will equal 7
 174  *
 175  * 9. Fortran MPI-2 reads the attribute value.  The same value is
 176  *    returned, but potentially sign-extended if sizeof(INTEGER) <
 177  *    sizeof(INTEGER(KIND=MPI_ADDRESS_KIND)).
 178  *
 179  * Example: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 180  *          CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 181  *          --> ret will equal 7
 182  *
 183  * Cases where Fortran MPI-2 writes an attribute value:
 184  * ----------------------------------------------------
 185  *
 186  * In all of these cases, an INTEGER(KIND=MPI_ADDRESS_KIND) is written
 187  * by Fortran.
 188  *
 189  * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) FOO = 12
 190  *            CALL MPI_COMM_PUT_ATTR(..., foo, ierr)
 191  * Example B: // Assume a platform where sizeof(void*) = 8 and
 192  *            // sizeof(INTEGER) = 4.
 193  *            INTEGER(KIND=MPI_ADDRESS_KIND) FOO = pow(2, 40)
 194  *            CALL MPI_COMM_PUT_ATTR(..., foo, ierr)
 195  *
 196  * 10. C reads the attribute value.  The value returned is a pointer
 197  *    that points to an INTEGER(KIND=MPI_ADDRESS_KIND) (i.e., a void*)
 198  *    that has a value of 12.
 199  *    --> NOTE: The external MPI interface does not distinguish between
 200  *        this case and case 4.  It is the programer's responsibility
 201  *        to code accordingly.
 202  *
 203  * Example A: MPI_Aint *ret;
 204  *            MPI_Attr_get(..., &ret);
 205  *            -> *ret will equal 12
 206  * Example B: MPI_Aint *ret;
 207  *            MPI_Attr_get(..., &ret);
 208  *            -> *ret will equal 2^40
 209  *
 210  * 11. Fortran MPI-1 reads the attribute value.  The same value is
 211  *    returned, but potentially truncated if sizeof(INTEGER) <
 212  *    sizeof(INTEGER(KIND=MPI_ADDRESS_KIND)).
 213  *
 214  * Example A: INTEGER ret
 215  *            CALL MPI_ATTR_GET(..., ret, ierr)
 216  *            --> ret will equal 12
 217  * Example B: INTEGER ret
 218  *            CALL MPI_ATTR_GET(..., ret, ierr)
 219  *            --> ret will equal 0
 220  *
 221  * 12. Fortran MPI-2 reads the attribute value.  This is the unity
 222  *    case; the same value is returned.
 223  *
 224  * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 225  *            CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 226  *            --> ret will equal 7
 227  * Example B: INTEGER(KIND=MPI_ADDRESS_KIND) ret
 228  *            CALL MPI_COMM_GET_ATTR(..., ret, ierr)
 229  *            --> ret will equal 2^40
 230  */
 231 
 232 #include "ompi_config.h"
 233 
 234 #include "opal/class/opal_bitmap.h"
 235 #include "opal/threads/mutex.h"
 236 #include "opal/sys/atomic.h"
 237 
 238 #include "ompi/attribute/attribute.h"
 239 #include "ompi/constants.h"
 240 #include "ompi/datatype/ompi_datatype.h"
 241 #include "ompi/communicator/communicator.h"  /* ompi_communicator_t generated in [COPY|DELETE]_ATTR_CALLBACKS */
 242 #include "ompi/win/win.h"                    /* ompi_win_t generated in [COPY|DELETE]_ATTR_CALLBACKS */
 243 #include "ompi/mpi/fortran/base/fint_2_int.h"
 244 
 245 /*
 246  * Macros
 247  */
 248 
 249 #define ATTR_TABLE_SIZE 10
 250 
 251 /* This is done so that I can have a consistent interface to my macros
 252    here */
 253 
 254 #define MPI_DATATYPE_NULL_COPY_FN MPI_TYPE_NULL_COPY_FN
 255 #define attr_communicator_f c_f_to_c_index
 256 #define attr_datatype_f d_f_to_c_index
 257 #define attr_win_f w_f_to_c_index
 258 
 259 #define CREATE_KEY(key) opal_bitmap_find_and_set_first_unset_bit(key_bitmap, (key))
 260 
 261 #define FREE_KEY(key) opal_bitmap_clear_bit(key_bitmap, (key))
 262 
 263 
 264 /* Not checking for NULL_DELETE_FN here, since according to the
 265    MPI-standard it should be a valid function that returns
 266    MPI_SUCCESS.
 267 
 268    This macro exists because we have to replicate the same code for
 269    MPI_Comm, MPI_Datatype, and MPI_Win.  Ick.
 270 
 271    There are 3 possible sets of callbacks:
 272 
 273    1. MPI-1 Fortran-style: attribute and extra state arguments are of
 274       type (INTEGER).  This is used if both the OMPI_KEYVAL_F77 and
 275       OMPI_KEYVAL_F77_INT flags are set.
 276    2. MPI-2 Fortran-style: attribute and extra state arguments are of
 277       type (INTEGER(KIND=MPI_ADDRESS_KIND)).  This is used if the
 278       OMPI_KEYVAL_F77 flag is set and the OMPI_KEYVAL_F77_INT flag is
 279       *not* set.
 280    3. C-style: attribute arguments are of type (void*).  This is used
 281       if OMPI_KEYVAL_F77 is not set.
 282 
 283    Ick.
 284  */
 285 
 286 #define DELETE_ATTR_CALLBACKS(type, attribute, keyval_obj, object, err)     \
 287 do { \
 288     OPAL_THREAD_UNLOCK(&attribute_lock); \
 289     if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77)) { \
 290         MPI_Fint f_key = OMPI_INT_2_FINT(key); \
 291         MPI_Fint f_err; \
 292         MPI_Fint attr_##type##_f;                \
 293         attr_##type##_f = OMPI_INT_2_FINT(((ompi_##type##_t *)keyval_obj)->attr_##type##_f); \
 294         /* MPI-1 Fortran-style */ \
 295         if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_INT)) { \
 296             MPI_Fint attr_val = translate_to_fint(attribute); \
 297             (*((keyval_obj->delete_attr_fn).attr_fint_delete_fn)) \
 298                 (&attr_##type##_f,                                        \
 299                  &f_key, &attr_val, &keyval_obj->extra_state.f_integer, &f_err); \
 300             if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
 301                 err = OMPI_FINT_2_INT(f_err);           \
 302             } \
 303         } \
 304         /* MPI-2 Fortran-style */ \
 305         else { \
 306             MPI_Aint attr_val = translate_to_aint(attribute); \
 307             (*((keyval_obj->delete_attr_fn).attr_aint_delete_fn)) \
 308                 (&attr_##type##_f,                                        \
 309                  &f_key, (int*)&attr_val, &keyval_obj->extra_state.f_address, &f_err); \
 310             if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
 311                 err = OMPI_FINT_2_INT(f_err); \
 312             } \
 313         } \
 314     } \
 315     /* C style */ \
 316     else { \
 317         void *attr_val = translate_to_c(attribute); \
 318         err = (*((keyval_obj->delete_attr_fn).attr_##type##_delete_fn)) \
 319             ((ompi_##type##_t *)object,                                 \
 320              key, attr_val,                                             \
 321              keyval_obj->extra_state.c_ptr);                            \
 322     } \
 323     OPAL_THREAD_LOCK(&attribute_lock); \
 324 } while (0)
 325 
 326 /* See the big, long comment above from DELETE_ATTR_CALLBACKS -- most of
 327    that text applies here, too. */
 328 
 329 #define COPY_ATTR_CALLBACKS(type, old_object, keyval_obj, in_attr, new_object, out_attr, err) \
 330 do { \
 331     OPAL_THREAD_UNLOCK(&attribute_lock); \
 332     if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77)) { \
 333         MPI_Fint f_key = OMPI_INT_2_FINT(key); \
 334         MPI_Fint f_err; \
 335         ompi_fortran_logical_t f_flag; \
 336         /* MPI-1 Fortran-style */ \
 337         if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_INT)) { \
 338             MPI_Fint in, out;                        \
 339             MPI_Fint attr_##type##_f;                \
 340             in = translate_to_fint(in_attr); \
 341             attr_##type##_f = OMPI_INT_2_FINT(((ompi_##type##_t *)old_object)->attr_##type##_f); \
 342             (*((keyval_obj->copy_attr_fn).attr_fint_copy_fn)) \
 343                 (&attr_##type##_f, \
 344                  &f_key, &keyval_obj->extra_state.f_integer, \
 345                  &in, &out, &f_flag, &f_err); \
 346             if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
 347                 err = OMPI_FINT_2_INT(f_err);           \
 348             } else {                                    \
 349                 out_attr->av_value = (void*) 0;         \
 350                 *out_attr->av_fint_pointer = out;    \
 351                 flag = OMPI_LOGICAL_2_INT(f_flag);      \
 352             }                                           \
 353         } \
 354         /* MPI-2 Fortran-style */ \
 355         else { \
 356             MPI_Aint in, out;                        \
 357             MPI_Fint attr_##type##_f;                \
 358             in = translate_to_aint(in_attr); \
 359             attr_##type##_f = OMPI_INT_2_FINT(((ompi_##type##_t *)old_object)->attr_##type##_f); \
 360             (*((keyval_obj->copy_attr_fn).attr_aint_copy_fn)) \
 361                 (&attr_##type##_f, \
 362                  &f_key, &keyval_obj->extra_state.f_address, &in, &out, \
 363                  &f_flag, &f_err); \
 364             if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
 365                 err = OMPI_FINT_2_INT(f_err);           \
 366             } else {                                    \
 367                 out_attr->av_value = (void *) out;      \
 368                 flag = OMPI_LOGICAL_2_INT(f_flag);      \
 369             }                                           \
 370         } \
 371     } \
 372     /* C style */ \
 373     else { \
 374         void *in, *out; \
 375         in = translate_to_c(in_attr); \
 376         if ((err = (*((keyval_obj->copy_attr_fn).attr_##type##_copy_fn)) \
 377               ((ompi_##type##_t *)old_object, key, keyval_obj->extra_state.c_ptr, \
 378                in, &out, &flag, (ompi_##type##_t *)(new_object))) == MPI_SUCCESS) { \
 379             out_attr->av_value = out;                                   \
 380         }                                                               \
 381     } \
 382     OPAL_THREAD_LOCK(&attribute_lock); \
 383 } while (0)
 384 
 385 /*
 386  * Cases for attribute values
 387  */
 388 typedef enum ompi_attribute_translate_t {
 389     OMPI_ATTRIBUTE_C,
 390     OMPI_ATTRIBUTE_INT,
 391     OMPI_ATTRIBUTE_FINT,
 392     OMPI_ATTRIBUTE_AINT
 393 } ompi_attribute_translate_t;
 394 
 395 /*
 396  * struct to hold attribute values on each MPI object
 397  */
 398 typedef struct attribute_value_t {
 399     opal_object_t super;
 400     int av_key;
 401     void *av_value;
 402     int *av_int_pointer;
 403     MPI_Fint *av_fint_pointer;
 404     MPI_Aint *av_aint_pointer;
 405     int av_set_from;
 406     int av_sequence;
 407 } attribute_value_t;
 408 
 409 
 410 /*
 411  * Local functions
 412  */
 413 static void attribute_value_construct(attribute_value_t *item);
 414 static void ompi_attribute_keyval_construct(ompi_attribute_keyval_t *keyval);
 415 static void ompi_attribute_keyval_destruct(ompi_attribute_keyval_t *keyval);
 416 static int set_value(ompi_attribute_type_t type, void *object,
 417                      opal_hash_table_t **attr_hash, int key,
 418                      attribute_value_t *new_attr,
 419                      bool predefined);
 420 static int get_value(opal_hash_table_t *attr_hash, int key,
 421                      attribute_value_t **attribute, int *flag);
 422 static void *translate_to_c(attribute_value_t *val);
 423 static MPI_Fint translate_to_fint(attribute_value_t *val);
 424 static MPI_Aint translate_to_aint(attribute_value_t *val);
 425 
 426 static int compare_attr_sequence(const void *attr1, const void *attr2);
 427 
 428 
 429 /*
 430  * attribute_value_t class
 431  */
 432 static OBJ_CLASS_INSTANCE(attribute_value_t,
 433                           opal_object_t,
 434                           attribute_value_construct,
 435                           NULL);
 436 
 437 
 438 /*
 439  * ompi_attribute_entry_t classes
 440  */
 441 static OBJ_CLASS_INSTANCE(ompi_attribute_keyval_t,
 442                           opal_object_t,
 443                           ompi_attribute_keyval_construct,
 444                           ompi_attribute_keyval_destruct);
 445 
 446 
 447 /*
 448  * Static variables
 449  */
 450 
 451 static opal_hash_table_t *keyval_hash;
 452 static opal_bitmap_t *key_bitmap;
 453 static int attr_sequence;
 454 static unsigned int int_pos = 12345;
 455 static unsigned int integer_pos = 12345;
 456 
 457 /*
 458  * MPI attributes are *not* high performance, so just use a One Big Lock
 459  * approach. However, this lock is released before a user provided callback is
 460  * triggered and acquired right after, allowing for recursive behaviors.
 461  */
 462 static opal_mutex_t attribute_lock;
 463 
 464 
 465 /*
 466  * attribute_value_t constructor function
 467  */
 468 static void attribute_value_construct(attribute_value_t *item)
 469 {
 470     item->av_key = MPI_KEYVAL_INVALID;
 471     item->av_aint_pointer = (MPI_Aint*) &item->av_value;
 472     item->av_int_pointer = (int *)&item->av_value + int_pos;
 473     item->av_fint_pointer = (MPI_Fint *)&item->av_value + integer_pos;
 474     item->av_set_from = 0;
 475     item->av_sequence = -1;
 476 }
 477 
 478 
 479 /*
 480  * ompi_attribute_keyval_t constructor / destructor
 481  */
 482 static void
 483 ompi_attribute_keyval_construct(ompi_attribute_keyval_t *keyval)
 484 {
 485     keyval->attr_type = UNUSED_ATTR;
 486     keyval->attr_flag = 0;
 487     keyval->copy_attr_fn.attr_communicator_copy_fn = NULL;
 488     keyval->delete_attr_fn.attr_communicator_copy_fn = NULL;
 489     keyval->extra_state.c_ptr = NULL;
 490     keyval->bindings_extra_state = NULL;
 491 
 492     /* Set the keyval->key value to an invalid value so that we can know
 493        if it has been initialized with a proper value or not.
 494        Specifically, the destructor may get invoked if we weren't able
 495        to assign a key properly.  So we don't want to try to remove it
 496        from the table if it wasn't there. */
 497     keyval->key = -1;
 498 }
 499 
 500 
 501 static void
 502 ompi_attribute_keyval_destruct(ompi_attribute_keyval_t *keyval)
 503 {
 504     if (-1 != keyval->key) {
 505         /* If the bindings_extra_state pointer is not NULL, free it */
 506         if (NULL != keyval->bindings_extra_state) {
 507             free(keyval->bindings_extra_state);
 508         }
 509 
 510         opal_hash_table_remove_value_uint32(keyval_hash, keyval->key);
 511         FREE_KEY(keyval->key);
 512     }
 513 }
 514 
 515 
 516 /*
 517  * This will initialize the main list to store key- attribute
 518  * items. This will be called one time, during MPI_INIT().
 519  */
 520 int ompi_attr_init(void)
 521 {
 522     int ret;
 523     void *bogus = (void*) 1;
 524     int *p = (int *) &bogus;
 525 
 526     keyval_hash = OBJ_NEW(opal_hash_table_t);
 527     if (NULL == keyval_hash) {
 528         return OMPI_ERR_OUT_OF_RESOURCE;
 529     }
 530     key_bitmap = OBJ_NEW(opal_bitmap_t);
 531     /*
 532      * Set the max size to OMPI_FORTRAN_HANDLE_MAX to enforce bound
 533      */
 534     opal_bitmap_set_max_size (key_bitmap, OMPI_FORTRAN_HANDLE_MAX);
 535     if (0 != opal_bitmap_init(key_bitmap, 32)) {
 536         return OMPI_ERR_OUT_OF_RESOURCE;
 537     }
 538 
 539     for (int_pos = 0; int_pos < (sizeof(void*) / sizeof(int));
 540          ++int_pos) {
 541         if (p[int_pos] == 1) {
 542             break;
 543         }
 544     }
 545 
 546     for (integer_pos = 0; integer_pos < (sizeof(void*) / sizeof(MPI_Fint));
 547          ++integer_pos) {
 548         if (p[integer_pos] == 1) {
 549             break;
 550         }
 551     }
 552 
 553     OBJ_CONSTRUCT(&attribute_lock, opal_mutex_t);
 554 
 555     if (OMPI_SUCCESS != (ret = opal_hash_table_init(keyval_hash,
 556                                                     ATTR_TABLE_SIZE))) {
 557         return ret;
 558     }
 559     if (OMPI_SUCCESS != (ret = ompi_attr_create_predefined())) {
 560         return ret;
 561     }
 562 
 563     return OMPI_SUCCESS;
 564 }
 565 
 566 
 567 /*
 568  * Cleanup everything during MPI_Finalize().
 569  */
 570 int ompi_attr_finalize(void)
 571 {
 572     ompi_attr_free_predefined();
 573     OBJ_DESTRUCT(&attribute_lock);
 574     OBJ_RELEASE(keyval_hash);
 575     OBJ_RELEASE(key_bitmap);
 576 
 577     return OMPI_SUCCESS;
 578 }
 579 
 580 /*****************************************************************************/
 581 
 582 static int ompi_attr_create_keyval_impl(ompi_attribute_type_t type,
 583                             ompi_attribute_fn_ptr_union_t copy_attr_fn,
 584                             ompi_attribute_fn_ptr_union_t delete_attr_fn,
 585                             int *key,
 586                             ompi_attribute_fortran_ptr_t *extra_state,
 587                             int flags,
 588                             void *bindings_extra_state)
 589 {
 590     ompi_attribute_keyval_t *keyval;
 591     int ret;
 592 
 593     /* Allocate space for the list item */
 594     keyval = OBJ_NEW(ompi_attribute_keyval_t);
 595     if (NULL == keyval) {
 596         return OMPI_ERR_OUT_OF_RESOURCE;
 597     }
 598 
 599     /* Fill in the list item (must be done before we set the keyval
 600        on the keyval_hash in case some other thread immediately reads
 601        it from the keyval_hash) */
 602     keyval->copy_attr_fn = copy_attr_fn;
 603     keyval->delete_attr_fn = delete_attr_fn;
 604     keyval->extra_state = *extra_state;
 605     keyval->attr_type = type;
 606     keyval->attr_flag = flags;
 607     keyval->key = -1;
 608     keyval->bindings_extra_state = bindings_extra_state;
 609 
 610     /* Create a new unique key and fill the hash */
 611     OPAL_THREAD_LOCK(&attribute_lock);
 612     ret = CREATE_KEY(key);
 613     if (OMPI_SUCCESS == ret) {
 614         keyval->key = *key;
 615         ret = opal_hash_table_set_value_uint32(keyval_hash, *key, keyval);
 616     }
 617 
 618     if (OMPI_SUCCESS != ret) {
 619         OBJ_RELEASE(keyval);
 620     } else {
 621         ret = MPI_SUCCESS;
 622     }
 623 
 624     opal_atomic_wmb();
 625     OPAL_THREAD_UNLOCK(&attribute_lock);
 626     return ret;
 627 }
 628 
 629 int ompi_attr_create_keyval(ompi_attribute_type_t type,
 630                             ompi_attribute_fn_ptr_union_t copy_attr_fn,
 631                             ompi_attribute_fn_ptr_union_t delete_attr_fn,
 632                             int *key,
 633                             void *extra_state,
 634                             int flags,
 635                             void *bindings_extra_state)
 636 {
 637     ompi_attribute_fortran_ptr_t es_tmp;
 638 
 639     es_tmp.c_ptr = extra_state;
 640     return ompi_attr_create_keyval_impl(type, copy_attr_fn, delete_attr_fn,
 641                                         key, &es_tmp, flags,
 642                                         bindings_extra_state);
 643 }
 644 
 645 int ompi_attr_create_keyval_fint(ompi_attribute_type_t type,
 646                                  ompi_attribute_fn_ptr_union_t copy_attr_fn,
 647                                  ompi_attribute_fn_ptr_union_t delete_attr_fn,
 648                                  int *key,
 649                                  MPI_Fint extra_state,
 650                                  int flags,
 651                                  void *bindings_extra_state)
 652 {
 653     ompi_attribute_fortran_ptr_t es_tmp;
 654 
 655     es_tmp.f_integer = extra_state;
 656 #if SIZEOF_INT == OMPI_SIZEOF_FORTRAN_INTEGER
 657     flags |= OMPI_KEYVAL_F77_INT;
 658 #endif
 659     return ompi_attr_create_keyval_impl(type, copy_attr_fn, delete_attr_fn,
 660                                         key, &es_tmp, flags,
 661                                         bindings_extra_state);
 662 }
 663 
 664 int ompi_attr_create_keyval_aint(ompi_attribute_type_t type,
 665                                  ompi_attribute_fn_ptr_union_t copy_attr_fn,
 666                                  ompi_attribute_fn_ptr_union_t delete_attr_fn,
 667                                  int *key,
 668                                  MPI_Aint extra_state,
 669                                  int flags,
 670                                  void *bindings_extra_state)
 671 {
 672     ompi_attribute_fortran_ptr_t es_tmp;
 673 
 674     es_tmp.f_address = extra_state;
 675     return ompi_attr_create_keyval_impl(type, copy_attr_fn, delete_attr_fn,
 676                                         key, &es_tmp, flags,
 677                                         bindings_extra_state);
 678 }
 679 
 680 /*****************************************************************************/
 681 
 682 int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key,
 683                           bool predefined)
 684 {
 685     int ret;
 686     ompi_attribute_keyval_t *keyval;
 687 
 688     /* Find the key-value pair */
 689     OPAL_THREAD_LOCK(&attribute_lock);
 690     ret = opal_hash_table_get_value_uint32(keyval_hash, *key,
 691                                            (void **) &keyval);
 692     if ((OMPI_SUCCESS != ret) || (NULL == keyval) ||
 693         (keyval->attr_type != type) ||
 694         ((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
 695         OPAL_THREAD_UNLOCK(&attribute_lock);
 696         return OMPI_ERR_BAD_PARAM;
 697     }
 698 
 699     /* MPI says to set the returned value to MPI_KEYVAL_INVALID */
 700     *key = MPI_KEYVAL_INVALID;
 701 
 702     /* This will delete the key only when no attributes are associated
 703        with it, else it will just decrement the reference count, so that when
 704        the last attribute is deleted, this object gets deleted too */
 705     OBJ_RELEASE(keyval);
 706 
 707     opal_atomic_wmb();
 708     OPAL_THREAD_UNLOCK(&attribute_lock);
 709 
 710     return MPI_SUCCESS;
 711 }
 712 
 713 /*****************************************************************************/
 714 
 715 /*
 716  * Front-end function called by the C MPI API functions to set an
 717  * attribute.
 718  */
 719 int ompi_attr_set_c(ompi_attribute_type_t type, void *object,
 720                     opal_hash_table_t **attr_hash,
 721                     int key, void *attribute, bool predefined)
 722 {
 723     int ret;
 724     attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
 725     if (NULL == new_attr) {
 726         return OMPI_ERR_OUT_OF_RESOURCE;
 727     }
 728 
 729     OPAL_THREAD_LOCK(&attribute_lock);
 730 
 731     new_attr->av_value = attribute;
 732     new_attr->av_set_from = OMPI_ATTRIBUTE_C;
 733     ret = set_value(type, object, attr_hash, key, new_attr, predefined);
 734     if (OMPI_SUCCESS != ret) {
 735         OBJ_RELEASE(new_attr);
 736     }
 737 
 738     opal_atomic_wmb();
 739     OPAL_THREAD_UNLOCK(&attribute_lock);
 740 
 741     return ret;
 742 }
 743 
 744 
 745 /*
 746  * Front-end function internally called by the C API functions to set an
 747  * int attribute.
 748  */
 749 int ompi_attr_set_int(ompi_attribute_type_t type, void *object,
 750                       opal_hash_table_t **attr_hash,
 751                       int key, int attribute, bool predefined)
 752 {
 753     int ret;
 754     attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
 755     if (NULL == new_attr) {
 756         return OMPI_ERR_OUT_OF_RESOURCE;
 757     }
 758 
 759     OPAL_THREAD_LOCK(&attribute_lock);
 760 
 761     new_attr->av_value = (void *) 0;
 762     *new_attr->av_int_pointer = attribute;
 763     new_attr->av_set_from = OMPI_ATTRIBUTE_INT;
 764     ret = set_value(type, object, attr_hash, key, new_attr, predefined);
 765     if (OMPI_SUCCESS != ret) {
 766         OBJ_RELEASE(new_attr);
 767     }
 768 
 769     opal_atomic_wmb();
 770     OPAL_THREAD_UNLOCK(&attribute_lock);
 771 
 772     return ret;
 773 }
 774 
 775 
 776 /*
 777  * Front-end function called by the Fortran MPI-1 API functions to set
 778  * an attribute.
 779  */
 780 int ompi_attr_set_fint(ompi_attribute_type_t type, void *object,
 781                        opal_hash_table_t **attr_hash,
 782                        int key, MPI_Fint attribute,
 783                        bool predefined)
 784 {
 785     int ret;
 786     attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
 787     if (NULL == new_attr) {
 788         return OMPI_ERR_OUT_OF_RESOURCE;
 789     }
 790 
 791     OPAL_THREAD_LOCK(&attribute_lock);
 792 
 793     new_attr->av_value = (void *) 0;
 794     *new_attr->av_fint_pointer = attribute;
 795     new_attr->av_set_from = OMPI_ATTRIBUTE_FINT;
 796     ret = set_value(type, object, attr_hash, key, new_attr, predefined);
 797     if (OMPI_SUCCESS != ret) {
 798         OBJ_RELEASE(new_attr);
 799     }
 800 
 801     opal_atomic_wmb();
 802     OPAL_THREAD_UNLOCK(&attribute_lock);
 803 
 804     return ret;
 805 }
 806 
 807 
 808 /*
 809  * Front-end function called by the Fortran MPI-2 API functions to set
 810  * an attribute.
 811  */
 812 int ompi_attr_set_aint(ompi_attribute_type_t type, void *object,
 813                        opal_hash_table_t **attr_hash,
 814                        int key, MPI_Aint attribute,
 815                        bool predefined)
 816 {
 817     int ret;
 818     attribute_value_t *new_attr = OBJ_NEW(attribute_value_t);
 819     if (NULL == new_attr) {
 820         return OMPI_ERR_OUT_OF_RESOURCE;
 821     }
 822 
 823     OPAL_THREAD_LOCK(&attribute_lock);
 824 
 825     new_attr->av_value = (void *) attribute;
 826     new_attr->av_set_from = OMPI_ATTRIBUTE_AINT;
 827     ret = set_value(type, object, attr_hash, key, new_attr, predefined);
 828     if (OMPI_SUCCESS != ret) {
 829         OBJ_RELEASE(new_attr);
 830     }
 831 
 832     opal_atomic_wmb();
 833     OPAL_THREAD_UNLOCK(&attribute_lock);
 834 
 835     return ret;
 836 }
 837 
 838 /*****************************************************************************/
 839 
 840 /*
 841  * Front-end function called by the C MPI API functions to get
 842  * attributes.
 843  */
 844 int ompi_attr_get_c(opal_hash_table_t *attr_hash, int key,
 845                     void **attribute, int *flag)
 846 {
 847     attribute_value_t *val = NULL;
 848     int ret;
 849 
 850     OPAL_THREAD_LOCK(&attribute_lock);
 851 
 852     ret = get_value(attr_hash, key, &val, flag);
 853     if (MPI_SUCCESS == ret && 1 == *flag) {
 854         *attribute = translate_to_c(val);
 855     }
 856 
 857     opal_atomic_wmb();
 858     OPAL_THREAD_UNLOCK(&attribute_lock);
 859     return ret;
 860 }
 861 
 862 
 863 /*
 864  * Front-end function called by the Fortran MPI-1 API functions to get
 865  * attributes.
 866  */
 867 int ompi_attr_get_fint(opal_hash_table_t *attr_hash, int key,
 868                        MPI_Fint *attribute, int *flag)
 869 {
 870     attribute_value_t *val = NULL;
 871     int ret;
 872 
 873     OPAL_THREAD_LOCK(&attribute_lock);
 874 
 875     ret = get_value(attr_hash, key, &val, flag);
 876     if (MPI_SUCCESS == ret && 1 == *flag) {
 877         *attribute = translate_to_fint(val);
 878     }
 879 
 880     opal_atomic_wmb();
 881     OPAL_THREAD_UNLOCK(&attribute_lock);
 882     return ret;
 883 }
 884 
 885 
 886 /*
 887  * Front-end function called by the Fortran MPI-2 API functions to get
 888  * attributes.
 889  */
 890 int ompi_attr_get_aint(opal_hash_table_t *attr_hash, int key,
 891                        MPI_Aint *attribute, int *flag)
 892 {
 893     attribute_value_t *val = NULL;
 894     int ret;
 895 
 896     OPAL_THREAD_LOCK(&attribute_lock);
 897 
 898     ret = get_value(attr_hash, key, &val, flag);
 899     if (MPI_SUCCESS == ret && 1 == *flag) {
 900         *attribute = translate_to_aint(val);
 901     }
 902 
 903     opal_atomic_wmb();
 904     OPAL_THREAD_UNLOCK(&attribute_lock);
 905     return ret;
 906 }
 907 
 908 /*****************************************************************************/
 909 
 910 /*
 911  * Copy all the attributes from one MPI object to another.  Called
 912  * when MPI objects are copied (e.g., back-end actions to
 913  * MPI_COMM_DUP).
 914  */
 915 int ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object,
 916                        void *new_object, opal_hash_table_t *oldattr_hash,
 917                        opal_hash_table_t *newattr_hash)
 918 {
 919     int ret;
 920     int err;
 921     uint32_t key;
 922     int flag;
 923     void *node, *in_node;
 924     attribute_value_t *old_attr, *new_attr;
 925     ompi_attribute_keyval_t *hash_value;
 926 
 927     /* If there's nothing to do, just return */
 928     if (NULL == oldattr_hash) {
 929         return MPI_SUCCESS;
 930     }
 931 
 932     OPAL_THREAD_LOCK(&attribute_lock);
 933 
 934     /* Get the first attribute in the object's hash */
 935     ret = opal_hash_table_get_first_key_uint32(oldattr_hash, &key,
 936                                                (void **) &old_attr,
 937                                                &node);
 938 
 939     /* While we still have some attribute in the object's key hash */
 940     while (OMPI_SUCCESS == ret) {
 941         in_node = node;
 942 
 943         /* Get the keyval in the main keyval hash - so that we know
 944            what the copy_attr_fn is */
 945         err = opal_hash_table_get_value_uint32(keyval_hash, key,
 946                                                (void **) &hash_value);
 947         if (OMPI_SUCCESS != err) {
 948             /* This should not happen! */
 949             ret = MPI_ERR_INTERN;
 950             goto out;
 951         }
 952 
 953         err = 0;
 954         new_attr = OBJ_NEW(attribute_value_t);
 955         switch (type) {
 956         case COMM_ATTR:
 957             /* Now call the copy_attr_fn */
 958             COPY_ATTR_CALLBACKS(communicator, old_object, hash_value,
 959                                 old_attr, new_object, new_attr, err);
 960             break;
 961 
 962         case TYPE_ATTR:
 963             /* Now call the copy_attr_fn */
 964             COPY_ATTR_CALLBACKS(datatype, old_object, hash_value,
 965                                 old_attr, new_object, new_attr, err);
 966             break;
 967 
 968         case WIN_ATTR:
 969             /* Now call the copy_attr_fn */
 970             COPY_ATTR_CALLBACKS(win, old_object, hash_value,
 971                                 old_attr, new_object, new_attr, err);
 972             break;
 973 
 974         default:
 975             /* This should not happen */
 976             assert(0);
 977             break;
 978         }
 979         /* Did the callback return non-MPI_SUCCESS? */
 980         if (0 != err) {
 981             ret = err;
 982             goto out;
 983         }
 984 
 985         /* Hang this off the object's hash */
 986 
 987         /* The COPY_ATTR_CALLBACKS macro will have converted the
 988            _flag_ callback output value from Fortran's .TRUE. value to
 989            0/1 (if necessary).  So we only need to check for 0/1 here
 990            -- not .TRUE. */
 991         if (1 == flag) {
 992             if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77)) {
 993                 if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77_INT)) {
 994                     new_attr->av_set_from = OMPI_ATTRIBUTE_FINT;
 995                 } else {
 996                     new_attr->av_set_from = OMPI_ATTRIBUTE_AINT;
 997                 }
 998             } else {
 999                 new_attr->av_set_from = OMPI_ATTRIBUTE_C;
1000             }
1001             ret = set_value(type, new_object, &newattr_hash, key,
1002                             new_attr, true);
1003             if (MPI_SUCCESS != ret) {
1004                 goto out;
1005             }
1006         } else {
1007             OBJ_RELEASE(new_attr);
1008         }
1009 
1010         ret = opal_hash_table_get_next_key_uint32(oldattr_hash, &key,
1011                                                   (void **) &old_attr,
1012                                                   in_node, &node);
1013     }
1014     ret = MPI_SUCCESS;
1015 
1016  out:
1017     /* All done */
1018     opal_atomic_wmb();
1019     OPAL_THREAD_UNLOCK(&attribute_lock);
1020     return ret;
1021 }
1022 
1023 /*****************************************************************************/
1024 
1025 /*
1026  * Back-end function to delete a single attribute.
1027  *
1028  * Assumes that you DO already have the attribute_lock.
1029  */
1030 static int ompi_attr_delete_impl(ompi_attribute_type_t type, void *object,
1031                                  opal_hash_table_t *attr_hash, int key,
1032                                  bool predefined)
1033 {
1034     ompi_attribute_keyval_t *keyval;
1035     int ret = OMPI_SUCCESS;
1036     attribute_value_t *attr;
1037 
1038     /* Check if the key is valid in the master keyval hash */
1039     ret = opal_hash_table_get_value_uint32(keyval_hash, key,
1040                                            (void **) &keyval);
1041 
1042     if ((OMPI_SUCCESS != ret) || (NULL == keyval) ||
1043         (keyval->attr_type!= type) ||
1044         ((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
1045         ret = OMPI_ERR_BAD_PARAM;
1046         goto exit;
1047     }
1048 
1049     /* Ensure that we don't have an empty attr_hash */
1050     if (NULL == attr_hash) {
1051         ret = OMPI_ERR_BAD_PARAM;
1052         goto exit;
1053     }
1054 
1055     /* Check if the key is valid for the communicator/window/dtype. If
1056        yes, then delete the attribute and key entry from the object's
1057        hash */
1058     ret = opal_hash_table_get_value_uint32(attr_hash, key, (void**) &attr);
1059     if (OMPI_SUCCESS == ret) {
1060         switch (type) {
1061         case COMM_ATTR:
1062             DELETE_ATTR_CALLBACKS(communicator, attr, keyval, object, ret);
1063             break;
1064 
1065         case WIN_ATTR:
1066             DELETE_ATTR_CALLBACKS(win, attr, keyval, object, ret);
1067             break;
1068 
1069         case TYPE_ATTR:
1070             DELETE_ATTR_CALLBACKS(datatype, attr, keyval, object, ret);
1071             break;
1072 
1073         default:
1074             /* This should not happen */
1075             assert(0);
1076             break;
1077         }
1078         if (MPI_SUCCESS != ret) {
1079             goto exit;
1080         }
1081 
1082         /* Ignore the return value at this point; it can't help any
1083            more */
1084         (void) opal_hash_table_remove_value_uint32(attr_hash, key);
1085         OBJ_RELEASE(attr);
1086     }
1087 
1088  exit:
1089     /* Decrement the ref count for the keyval.  If ref count goes to
1090        0, destroy the keyval (the destructor deletes the key
1091        implicitly for this object).  The ref count will only go to 0
1092        here if MPI_*_FREE_KEYVAL was previously invoked and we just
1093        freed the last attribute that was using the keyval. */
1094     if (OMPI_SUCCESS == ret) {
1095         OBJ_RELEASE(keyval);
1096     }
1097 
1098     return ret;
1099 }
1100 
1101 /*
1102  * Front end function to delete a single attribute.
1103  */
1104 int ompi_attr_delete(ompi_attribute_type_t type, void *object,
1105                      opal_hash_table_t *attr_hash, int key,
1106                      bool predefined)
1107 {
1108     int ret;
1109 
1110     OPAL_THREAD_LOCK(&attribute_lock);
1111     ret = ompi_attr_delete_impl(type, object, attr_hash, key, predefined);
1112     opal_atomic_wmb();
1113     OPAL_THREAD_UNLOCK(&attribute_lock);
1114     return ret;
1115 }
1116 
1117 /*
1118  * Front-end function to delete all the attributes on an MPI object
1119  */
1120 int ompi_attr_delete_all(ompi_attribute_type_t type, void *object,
1121                          opal_hash_table_t *attr_hash)
1122 {
1123     int ret, i, num_attrs;
1124     uint32_t key;
1125     void *node, *in_node, *attr;
1126     attribute_value_t **attrs;
1127 
1128     /* Ensure that the table is not empty */
1129 
1130     if (NULL == attr_hash) {
1131         return MPI_SUCCESS;
1132     }
1133 
1134     OPAL_THREAD_LOCK(&attribute_lock);
1135 
1136     /* Make an array that contains all attributes in local object's hash */
1137     num_attrs = opal_hash_table_get_size(attr_hash);
1138     if (0 == num_attrs) {
1139         OPAL_THREAD_UNLOCK(&attribute_lock);
1140         return MPI_SUCCESS;
1141     }
1142 
1143     attrs = malloc(sizeof(attribute_value_t *) * num_attrs);
1144     if (NULL == attrs) {
1145         OPAL_THREAD_UNLOCK(&attribute_lock);
1146         return OMPI_ERR_OUT_OF_RESOURCE;
1147     }
1148 
1149     ret = opal_hash_table_get_first_key_uint32(attr_hash, &key, &attr, &node);
1150     for (i = 0; OMPI_SUCCESS == ret; i++) {
1151         attrs[i] = attr;
1152         in_node = node;
1153         ret = opal_hash_table_get_next_key_uint32(attr_hash, &key, &attr,
1154                                                   in_node, &node);
1155     }
1156 
1157     /* Sort attributes in the order that they were set */
1158     qsort(attrs, num_attrs, sizeof(attribute_value_t *), compare_attr_sequence);
1159 
1160     /* Delete attributes in the reverse order that they were set.
1161        Actually this ordering is required only for MPI_COMM_SELF, as
1162        specified in MPI-2.2: 8.7.1 Allowing User Functions at Process
1163        Termination, but we do it for everything -- what the heck.
1164        :-) */
1165     for (i = num_attrs - 1; i >= 0; i--) {
1166         ret = ompi_attr_delete_impl(type, object, attr_hash,
1167                                     attrs[i]->av_key, true);
1168         if (OMPI_SUCCESS != ret) {
1169             break;
1170         }
1171     }
1172 
1173     /* All done */
1174 
1175     free(attrs);
1176     opal_atomic_wmb();
1177     OPAL_THREAD_UNLOCK(&attribute_lock);
1178     return ret;
1179 }
1180 
1181 /*************************************************************************/
1182 
1183 /*
1184  * Back-end function to set an attribute on an MPI object.  Assumes
1185  * that you already hold the attribute_lock.
1186  */
1187 static int set_value(ompi_attribute_type_t type, void *object,
1188                      opal_hash_table_t **attr_hash, int key,
1189                      attribute_value_t *new_attr,
1190                      bool predefined)
1191 {
1192     ompi_attribute_keyval_t *keyval;
1193     int ret;
1194     attribute_value_t *old_attr;
1195     bool had_old = false;
1196 
1197     /* Note that this function can be invoked by ompi_attr_copy_all()
1198        to set attributes on the new object (in addition to the
1199        top-level MPI_* functions that set attributes). */
1200     ret = opal_hash_table_get_value_uint32(keyval_hash, key,
1201                                            (void **) &keyval);
1202 
1203     /* If key not found */
1204     if ((OMPI_SUCCESS != ret ) || (NULL == keyval) ||
1205         (keyval->attr_type != type) ||
1206         ((!predefined) && (keyval->attr_flag & OMPI_KEYVAL_PREDEFINED))) {
1207         return OMPI_ERR_BAD_PARAM;
1208     }
1209 
1210     /* Do we need to make a new attr_hash? */
1211     if (NULL == *attr_hash) {
1212         ompi_attr_hash_init(attr_hash);
1213     }
1214 
1215     /* Now see if an attribute is already present in the object's hash
1216        on the old keyval. If so, delete the old attribute value. */
1217     ret = opal_hash_table_get_value_uint32(*attr_hash, key, (void**) &old_attr);
1218     if (OMPI_SUCCESS == ret)  {
1219         switch (type) {
1220         case COMM_ATTR:
1221             DELETE_ATTR_CALLBACKS(communicator, old_attr, keyval, object, ret);
1222             break;
1223 
1224         case WIN_ATTR:
1225             DELETE_ATTR_CALLBACKS(win, old_attr, keyval, object, ret);
1226             break;
1227 
1228         case TYPE_ATTR:
1229             DELETE_ATTR_CALLBACKS(datatype, old_attr, keyval, object, ret);
1230             break;
1231 
1232         default:
1233             /* This should not happen */
1234             assert(0);
1235             break;
1236         }
1237         if (MPI_SUCCESS != ret) {
1238             return ret;
1239         }
1240         OBJ_RELEASE(old_attr);
1241         had_old = true;
1242     }
1243 
1244     ret = opal_hash_table_get_value_uint32(keyval_hash, key,
1245                                            (void **) &keyval);
1246     if ((OMPI_SUCCESS != ret ) || (NULL == keyval)) {
1247         /* Keyval has disappeared underneath us -- this shouldn't
1248            happen! */
1249         assert(0);
1250         return OMPI_ERR_BAD_PARAM;
1251     }
1252 
1253     new_attr->av_key = key;
1254     new_attr->av_sequence = attr_sequence++;
1255 
1256     ret = opal_hash_table_set_value_uint32(*attr_hash, key, new_attr);
1257 
1258     /* Increase the reference count of the object, only if there was no
1259        old atribute/no old entry in the object's key hash */
1260     if (OMPI_SUCCESS == ret && !had_old) {
1261         OBJ_RETAIN(keyval);
1262     }
1263 
1264     return ret;
1265 }
1266 
1267 /*************************************************************************/
1268 
1269 /*
1270  * Back-end function to get an attribute from the hash map and return
1271  * it to the caller.  Translation services are not provided -- they're
1272  * in small, standalone functions that are called from several
1273  * different places.
1274  *
1275  * Assumes that you do NOT already have the attribute lock.
1276  */
1277 static int get_value(opal_hash_table_t *attr_hash, int key,
1278                      attribute_value_t **attribute, int *flag)
1279 {
1280     int ret;
1281     void *attr;
1282     ompi_attribute_keyval_t *keyval;
1283 
1284     /* According to MPI specs, the call is invalid if the keyval does
1285        not exist (i.e., the key is not present in the main keyval
1286        hash).  If the keyval exists but no attribute is associated
1287        with the key, then the call is valid and returns FALSE in the
1288        flag argument */
1289     *flag = 0;
1290     ret = opal_hash_table_get_value_uint32(keyval_hash, key,
1291                                            (void**) &keyval);
1292     if (OMPI_ERR_NOT_FOUND == ret) {
1293         return MPI_KEYVAL_INVALID;
1294     }
1295 
1296     /* If we have a null attr_hash table, that means that nothing has
1297        been cached on this object yet.  So just return *flag = 0. */
1298     if (NULL == attr_hash) {
1299         return OMPI_SUCCESS;
1300     }
1301 
1302     ret = opal_hash_table_get_value_uint32(attr_hash, key, &attr);
1303     if (OMPI_SUCCESS == ret) {
1304         *attribute = (attribute_value_t*)attr;
1305         *flag = 1;
1306     }
1307 
1308     return OMPI_SUCCESS;
1309 }
1310 
1311 /*************************************************************************/
1312 
1313 /*
1314  * Take an attribute and translate it according to the cases listed in
1315  * the comments at the top of this file.
1316  *
1317  * This function does not fail -- it is only invoked in "safe"
1318  * situations.
1319  */
1320 static void *translate_to_c(attribute_value_t *val)
1321 {
1322     switch (val->av_set_from) {
1323     case OMPI_ATTRIBUTE_C:
1324         /* Case 1: wrote a C pointer, read a C pointer
1325            (unity) */
1326         return val->av_value;
1327 
1328     case OMPI_ATTRIBUTE_INT:
1329         /* Case 4: wrote an int, read a C pointer */
1330         return (void *) val->av_int_pointer;
1331 
1332     case OMPI_ATTRIBUTE_FINT:
1333         /* Case 7: wrote a MPI_Fint, read a C pointer */
1334         return (void *) val->av_fint_pointer;
1335 
1336     case OMPI_ATTRIBUTE_AINT:
1337         /* Case 10: wrote a MPI_Aint, read a C pointer */
1338         return (void *) val->av_aint_pointer;
1339 
1340     default:
1341         /* Should never reach here */
1342         return NULL;
1343     }
1344 }
1345 
1346 
1347 /*
1348  * Take an attribute and translate it according to the cases listed in
1349  * the comments at the top of this file.
1350  *
1351  * This function does not fail -- it is only invoked in "safe"
1352  * situations.
1353  */
1354 static MPI_Fint translate_to_fint(attribute_value_t *val)
1355 {
1356     switch (val->av_set_from) {
1357     case OMPI_ATTRIBUTE_C:
1358         /* Case 2: wrote a C pointer, read a MPI_Fint */
1359         return (MPI_Fint)*val->av_int_pointer;
1360 
1361     case OMPI_ATTRIBUTE_INT:
1362         /* Case 5: wrote an int, read a MPI_Fint */
1363         return (MPI_Fint)*val->av_int_pointer;
1364 
1365     case OMPI_ATTRIBUTE_FINT:
1366         /* Case 8: wrote a MPI_Fint, read a MPI_Fint
1367            (unity) */
1368         return *val->av_fint_pointer;
1369 
1370     case OMPI_ATTRIBUTE_AINT:
1371         /* Case 11: wrote a MPI_Aint, read a MPI_Fint */
1372         return (MPI_Fint)*val->av_fint_pointer;
1373 
1374     default:
1375         /* Should never reach here */
1376         return 0;
1377     }
1378 }
1379 
1380 
1381 /*
1382  * Take an attribute and translate it according to the cases listed in
1383  * the comments at the top of this file.
1384  *
1385  * This function does not fail -- it is only invoked in "safe"
1386  * situations.
1387  */
1388 static MPI_Aint translate_to_aint(attribute_value_t *val)
1389 {
1390     switch (val->av_set_from) {
1391     case OMPI_ATTRIBUTE_C:
1392        /* Case 3: wrote a C pointer, read a MPI_Aint */
1393         return (MPI_Aint) val->av_value;
1394 
1395     case OMPI_ATTRIBUTE_INT:
1396         /* Case 6: wrote an int, read a MPI_Aint */
1397         return (MPI_Aint) *val->av_int_pointer;
1398 
1399     case OMPI_ATTRIBUTE_FINT:
1400         /* Case 9: wrote a MPI_Fint, read a MPI_Aint */
1401         return (MPI_Aint) *val->av_fint_pointer;
1402 
1403     case OMPI_ATTRIBUTE_AINT:
1404         /* Case 12: wrote a MPI_Aint, read a MPI_Aint
1405            (unity) */
1406         return (MPI_Aint) val->av_value;
1407 
1408     default:
1409         /* Should never reach here */
1410         return 0;
1411     }
1412 }
1413 
1414 /*
1415  * Comparator for qsort() to sort attributes in the order that they were set.
1416  */
1417 static int compare_attr_sequence(const void *attr1, const void *attr2)
1418 {
1419     return (*(attribute_value_t **)attr1)->av_sequence -
1420            (*(attribute_value_t **)attr2)->av_sequence;
1421 }
/* [<][>][^][v][top][bottom][index][help] */
root/ompi/attribute/attribute.c

DEFINITIONS
