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