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  */
attribute_value_construct(attribute_value_t * item)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
ompi_attribute_keyval_construct(ompi_attribute_keyval_t * keyval)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
ompi_attribute_keyval_destruct(ompi_attribute_keyval_t * keyval)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  */
ompi_attr_init(void)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  */
ompi_attr_finalize(void)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 
ompi_attr_create_keyval_impl(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,ompi_attribute_fortran_ptr_t * extra_state,int flags,void * bindings_extra_state)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 
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,void * bindings_extra_state)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 
ompi_attr_create_keyval_fint(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,MPI_Fint extra_state,int flags,void * bindings_extra_state)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 
ompi_attr_create_keyval_aint(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,MPI_Aint extra_state,int flags,void * bindings_extra_state)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 
ompi_attr_free_keyval(ompi_attribute_type_t type,int * key,bool predefined)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  */
ompi_attr_set_c(ompi_attribute_type_t type,void * object,opal_hash_table_t ** attr_hash,int key,void * attribute,bool predefined)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  */
ompi_attr_set_int(ompi_attribute_type_t type,void * object,opal_hash_table_t ** attr_hash,int key,int attribute,bool predefined)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  */
ompi_attr_set_fint(ompi_attribute_type_t type,void * object,opal_hash_table_t ** attr_hash,int key,MPI_Fint attribute,bool predefined)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  */
ompi_attr_set_aint(ompi_attribute_type_t type,void * object,opal_hash_table_t ** attr_hash,int key,MPI_Aint attribute,bool predefined)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  */
ompi_attr_get_c(opal_hash_table_t * attr_hash,int key,void ** attribute,int * flag)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  */
ompi_attr_get_fint(opal_hash_table_t * attr_hash,int key,MPI_Fint * attribute,int * flag)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  */
ompi_attr_get_aint(opal_hash_table_t * attr_hash,int key,MPI_Aint * attribute,int * flag)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  */
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)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  */
ompi_attr_delete_impl(ompi_attribute_type_t type,void * object,opal_hash_table_t * attr_hash,int key,bool predefined)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  */
ompi_attr_delete(ompi_attribute_type_t type,void * object,opal_hash_table_t * attr_hash,int key,bool predefined)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  */
ompi_attr_delete_all(ompi_attribute_type_t type,void * object,opal_hash_table_t * attr_hash)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  */
set_value(ompi_attribute_type_t type,void * object,opal_hash_table_t ** attr_hash,int key,attribute_value_t * new_attr,bool predefined)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  */
get_value(opal_hash_table_t * attr_hash,int key,attribute_value_t ** attribute,int * flag)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  */
translate_to_c(attribute_value_t * val)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  */
translate_to_fint(attribute_value_t * val)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  */
translate_to_aint(attribute_value_t * val)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  */
compare_attr_sequence(const void * attr1,const void * attr2)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 }
1422