From 225c20162e19aef0616b993ce5a5e9f47eb0daf3 Mon Sep 17 00:00:00 2001 From: Jeff Squyres Date: Mon, 27 Jun 2005 19:17:11 +0000 Subject: [PATCH] Submitted by: Jeff "I love MPI attributes" Squyres Reviewed by: Brian "MPI attributes ROCK" Barrett Bunches of changes to the attribute engine: - After many hours of discussion about MPI attributes, we came to the conclusion that MPI-2 Example 4.13 (the C->Fortran example) is just wrong. If you accept that, the rest of the text makes much more sense. - There are 9 inter-language cases: all combinations of (read, write) with C, Fortran MPI-1, and Fortran MPI-2 for each value. Each of the 9 cases have specific code for what is supposed to happen (and is labeled in the code with comments). There is a *lengthy* comment at the top of src/attribute/attribute.c that describes all of this. - All predefined attributes are now treated as if they were put from MPI-1 Fortran calls, with the exception of the window predefined attributes (which are irrelevant on the beta, because there is no one-sided support; preliminary fixes included in this patch, but will be fully addressed on the trunk) - MPI API calls (particularly the Fortran wrappers) are now fundamentally simpler -- they do *not* call the back-end MPI C API calls; instead, they call directly back into the attribute engine. - The MPI_LASTUSEDCODE attribute only exists on MPI_COMM_WORLD and is updated appropriately when user error classes are added. --> Note: Edgar made a suggestion that for communicator attributes, we ignore the communicator argument when retrieving attributes and simply return the value. This will likely only happen on the trunk, and will alleviate (from the user's perspective) the restriction that LASTUSEDCODE is only on MPI_COMM_WORLD. - The predefined attributes are now "better". We create keyvals separately than assigning values, and correctly distinguish between comm, type, and win attributes. Initial values are now set as if they were called from MPI-1 fortran. - Added a comment to the top of src/attribute/attribute_predefined.c explaining what each of the predefined attributes were and what OMPI sets them to be. This commit was SVN r6193. --- src/attribute/attribute.c | 908 ++++++++++++++++++++------- src/attribute/attribute.h | 181 +++++- src/attribute/attribute_predefined.c | 256 +++++--- src/errhandler/errclass.c | 5 + src/mpi/c/attr_get.c | 6 +- src/mpi/c/attr_put.c | 4 +- src/mpi/c/comm_get_attr.c | 7 +- src/mpi/c/comm_set_attr.c | 4 +- src/mpi/c/type_get_attr.c | 8 +- src/mpi/c/type_set_attr.c | 4 +- src/mpi/c/win_get_attr.c | 8 +- src/mpi/f77/attr_get_f.c | 40 +- src/mpi/f77/attr_put_f.c | 39 +- src/mpi/f77/comm_get_attr_f.c | 39 +- src/mpi/f77/comm_set_attr_f.c | 20 +- src/mpi/f77/keyval_create_f.c | 2 +- src/mpi/f77/type_get_attr_f.c | 39 +- src/mpi/f77/type_set_attr_f.c | 24 +- src/mpi/f77/win_get_attr_f.c | 36 +- src/mpi/f77/win_set_attr_f.c | 20 +- 20 files changed, 1159 insertions(+), 491 deletions(-) diff --git a/src/attribute/attribute.c b/src/attribute/attribute.c index 3c2ba6f4b0..ed923e5fe5 100644 --- a/src/attribute/attribute.c +++ b/src/attribute/attribute.c @@ -14,6 +14,179 @@ * $HEADER$ */ +/** + * @file + * + * Back-end MPI attribute engine. + * + * This is complicated enough that it deserves a lengthy discussion of + * what is happening. This is extremely complicated stuff, paired + * with the fact that it is not described well in the MPI standard. + * There are several places in the standard that should be read about + * attributes: + * + * MPI-1: Section 5.7 (pp 167-173) + * MPI-1: Section 7.1 (pp 191-192) predefined attributes in MPI-1 + * MPI-2: Section 4.12.7 (pp 57-59) interlanguage attribute + * clarifications + * MPI-2: Section 6.2.2 (pp 112) window predefined attributes + * MPI-2: Section 8.8 (pp 198-208) new attribute caching functions + * + * After reading all of this, note the following: + * + * - C MPI-1 and MPI-2 attribute functions and functionality are + * identical except for their function names. + * - Fortran MPI-1 and MPI-2 attribute functions and functionality are + * different (namely: the parameters are different sizes, both in the + * functions and the user callbacks, and the assignments to the + * different sized types occur differently [e.g., truncation and sign + * extension]) + * - C functions store values by reference (i.e., writing an attribute + * means writing a pointer to an instance of something; changing the + * value of that instance will make it visible to anyone who reads + * that attribute value). + * - Fortran functions store values by value (i.e., writing an + * attribute value means that anyone who reads that attribute value + * will not be able to affect the value read by anyone else). + * - The predefined attribute MPI_WIN_BASE seems to flaunt the rules + * designated by the rest of the standard; it is handled + * specifically in the MPI_WIN_GET_ATTR binding functions (see the + * comments in there for an explanation). + * - MPI-2 4.12.7:Example 4.13 (p58) is wrong. The C->Fortran example + * should have the Fortran "val" variable equal to &I. + * + * By the first two of these, there are 9 possible use cases -- 3 + * possibilities for writing an attribute value, each of which has 3 + * possibilities for reading that value back. The following lists + * each of the 9 cases, and what happens in each. + * + * Cases where C writes an attribute value: + * ---------------------------------------- + * + * In all of these cases, a pointer was written by C (e.g., a pointer + * to an int -- but it could have been a pointer to anything, such as + * a struct). These scenarios each have 2 examples: + * + * Example A: int foo = 3; + * MPI_Attr_put(..., &foo); + * Example B: struct foo bar; + * MPI_Attr_put(..., &bar); + * + * 1. C reads the attribute value. Clearly, this is a "unity" case, + * and no translation occurs. A pointer is written, and that same + * pointer is returned. + * + * Example A: int *ret; + * MPI_Attr_get(..., &ret); + * --> *ret will equal 3 + * Example B: struct foo *ret; + * MPI_Attr_get(..., &ret); + * --> *ret will point to the instance bar that was written + * + * 2. Fortran MPI-1 reads the attribute value. The C pointer is cast + * to a fortran INTEGER (i.e., MPI_Fint) -- potentially being + * truncated if sizeof(void*) > sizeof(INTEGER). + * + * Example A: INTEGER ret + * CALL MPI_ATTR_GET(..., ret, ierr) + * --> ret will equal &foo, possibly truncaed + * Example B: INTEGER ret + * CALL MPI_ATTR_GET(..., ret, ierr) + * --> ret will equal &bar, possibly truncaed + * + * 3. Fortran MPI-2 reads the attribute value. The C pointer is cast + * to a fortran INTEGER(KIND=MPI_ADDRESS_KIND) (i.e., a (MPI_Aint)). + * + * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) ret + * CALL MPI_COMM_GET_ATTR(..., ret, ierr) + * --> ret will equal &foo + * Example B: INTEGER(KIND=MPI_ADDRESS_KIND) ret + * CALL MPI_COMM_GET_ATTR(..., ret, ierr) + * --> ret will equal &bar + * + * Cases where Fortran MPI-1 writes an attribute value: + * ---------------------------------------------------- + * + * In all of these cases, an INTEGER is written by Fortran. + * + * Example: INTEGER FOO = 7 + * CALL MPI_ATTR_PUT(..., foo, ierr) + * + * 4. C reads the attribute value. The value returned is a pointer + * that points to an INTEGER (i.e., an MPI_Fint) that has a value + * of 7. + * --> NOTE: The external MPI interface does not distinguish between + * this case and case 7. It is the programer's responsibility + * to code accordingly. + * + * Example: MPI_Fint *ret; + * MPI_Attr_get(..., &ret); + * -> *ret will equal 7. + * + * 5. Fortran MPI-1 reads the attribute value. This is the unity + * case; the same value is returned. + * + * Example: INTEGER ret + * CALL MPI_ATTR_GET(..., ret, ierr) + * --> ret will equal 7 + * + * 6. Fortran MPI-2 reads the attribute value. The same value is + * returned, but potentially sign-extended if sizeof(INTEGER) < + * sizeof(INTEGER(KIND=MPI_ADDRESS_KIND)). + * + * Example: INTEGER(KIND=MPI_ADDRESS_KIND) ret + * CALL MPI_COMM_GET_ATTR(..., ret, ierr) + * --> ret will equal 7 + * + * Cases where Fortran MPI-2 writes an attribute value: + * ---------------------------------------------------- + * + * In all of these cases, an INTEGER(KIND=MPI_ADDRESS_KIND) is written + * by Fortran. + * + * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) FOO = 12 + * CALL MPI_COMM_PUT_ATTR(..., foo, ierr) + * Example B: // Assume a platform where sizeof(void*) = 8 and + * // sizeof(INTEGER) = 4. + * INTEGER(KIND=MPI_ADDRESS_KIND) FOO = pow(2, 40) + * CALL MPI_COMM_PUT_ATTR(..., foo, ierr) + * + * 7. C reads the attribute value. The value returned is a pointer + * that points to an INTEGER(KIND=MPI_ADDRESS_KIND) (i.e., a void*) + * that has a value of 12. + * --> NOTE: The external MPI interface does not distinguish between + * this case and case 4. It is the programer's responsibility + * to code accordingly. + * + * Example A: MPI_Aint *ret; + * MPI_Attr_get(..., &ret); + * -> *ret will equal 12 + * Example B: MPI_Aint *ret; + * MPI_Attr_get(..., &ret); + * -> *ret will equal 2^40 + * + * 8. Fortran MPI-1 reads the attribute value. The same value is + * returned, but potentially truncated if sizeof(INTEGER) < + * sizeof(INTEGER(KIND=MPI_ADDRESS_KIND)). + * + * Example A: INTEGER ret + * CALL MPI_ATTR_GET(..., ret, ierr) + * --> ret will equal 12 + * Example B: INTEGER ret + * CALL MPI_ATTR_GET(..., ret, ierr) + * --> ret will equal 0 + * + * 9. Fortran MPI-2 reads the attribute value. This is the unity + * case; the same value is returned. + * + * Example A: INTEGER(KIND=MPI_ADDRESS_KIND) ret + * CALL MPI_COMM_GET_ATTR(..., ret, ierr) + * --> ret will equal 7 + * Example B: INTEGER(KIND=MPI_ADDRESS_KIND) ret + * CALL MPI_COMM_GET_ATTR(..., ret, ierr) + * --> ret will equal 2^40 + */ + #include "ompi_config.h" #include "attribute/attribute.h" @@ -54,10 +227,10 @@ 1. MPI-1 Fortran-style: attribute and extra state arguments are of type (INTEGER). This is used if both the OMPI_KEYVAL_F77 and - OMPI_KEYVAL_F77_OLD flags are set. + OMPI_KEYVAL_F77_MPI1 flags are set. 2. MPI-2 Fortran-style: attribute and extra state arguments are of type (INTEGER(KIND=MPI_ADDRESS_KIND)). This is used if the - OMPI_KEYVAL_F77 flag is set and the OMPI_KEYVAL_F77_OLD flag is + OMPI_KEYVAL_F77 flag is set and the OMPI_KEYVAL_F77_MPI1 flag is *not* set. 3. C-style: attribute arguments are of type (void*). This is used if OMPI_KEYVAL_F77 is not set. @@ -65,17 +238,16 @@ Ick. */ -#define DELETE_ATTR_OBJECT(type, attribute, keyval_obj) \ +#define DELETE_ATTR_CALLBACKS(type, attribute, keyval_obj) \ if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77)) { \ MPI_Fint f_key = OMPI_INT_2_FINT(key); \ MPI_Fint f_err; \ /* MPI-1 Fortran-style */ \ - if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_OLD)) { \ - ompi_attribute_fortran_ptr_t value; \ - value.c_ptr = attribute; \ + if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_MPI1)) { \ + MPI_Fint attr_val = translate_to_fortran_mpi1(attribute); \ (*((keyval_obj->delete_attr_fn).attr_mpi1_fortran_delete_fn)) \ (&(((ompi_##type##_t *)object)->attr_##type##_f), \ - &f_key, &value.f_integer, keyval_obj->extra_state, &f_err); \ + &f_key, &attr_val, keyval_obj->extra_state, &f_err); \ if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \ if (need_lock) { \ OMPI_THREAD_UNLOCK(&alock); \ @@ -85,9 +257,10 @@ } \ /* MPI-2 Fortran-style */ \ else { \ + MPI_Aint attr_val = translate_to_fortran_mpi2(attribute); \ (*((keyval_obj->delete_attr_fn).attr_mpi2_fortran_delete_fn)) \ (&(((ompi_##type##_t *)object)->attr_##type##_f), \ - &f_key, &attribute, keyval_obj->extra_state, &f_err); \ + &f_key, &attr_val, keyval_obj->extra_state, &f_err); \ if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \ if (need_lock) { \ OMPI_THREAD_UNLOCK(&alock); \ @@ -98,9 +271,10 @@ } \ /* C style */ \ else { \ + void *attr_val = translate_to_c(attribute); \ if ((err = (*((keyval_obj->delete_attr_fn).attr_##type##_delete_fn)) \ ((ompi_##type##_t *)object, \ - key, attribute, \ + key, attr_val, \ keyval_obj->extra_state)) != MPI_SUCCESS) {\ if (need_lock) { \ OMPI_THREAD_UNLOCK(&alock); \ @@ -109,73 +283,110 @@ } \ } -/* See the big, long comment above from DELETE_ATTR_OBJECT -- most of +/* See the big, long comment above from DELETE_ATTR_CALLBACKS -- most of that text applies here, too. */ -#define COPY_ATTR_OBJECT(type, old_object, keyval_obj, in_attr, out_attr) \ +#define COPY_ATTR_CALLBACKS(type, old_object, keyval_obj, in_attr, out_attr) \ if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77)) { \ MPI_Fint f_key = OMPI_INT_2_FINT(key); \ MPI_Fint f_err; \ ompi_fortran_logical_t f_flag; \ /* MPI-1 Fortran-style */ \ - if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_OLD)) { \ - ompi_attribute_fortran_ptr_t in, out; \ - MPI_Fint tmp = 0; \ - in.c_ptr = in_attr; \ + if (0 != (keyval_obj->attr_flag & OMPI_KEYVAL_F77_MPI1)) { \ + MPI_Fint in, out; \ + in = translate_to_fortran_mpi1(in_attr); \ (*((keyval_obj->copy_attr_fn).attr_mpi1_fortran_copy_fn)) \ - (&(((ompi_##type##_t *)old_object)->attr_##type##_f),\ + (&(((ompi_##type##_t *)old_object)->attr_##type##_f), \ &f_key, keyval_obj->extra_state, \ - &in.f_integer, &tmp, &f_flag, &f_err); \ + &in, &out, &f_flag, &f_err); \ if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \ OMPI_THREAD_UNLOCK(&alock); \ return OMPI_FINT_2_INT(f_err); \ } \ - /* Must do weird sign extension -- see src/mpi/f77/attr_put_f.c for details */ \ - if (tmp < 0) { \ - out.c_ptr = (void *) -1; \ - } else { \ - out.c_ptr = (void *) 0; \ - } \ - out.f_integer = tmp; \ - out_attr = out.c_ptr; \ + out_attr->av_value = (void *) out; \ flag = OMPI_FINT_2_INT(f_flag); \ } \ /* MPI-2 Fortran-style */ \ else { \ + MPI_Aint in, out; \ + in = translate_to_fortran_mpi2(in_attr); \ (*((keyval_obj->copy_attr_fn).attr_mpi2_fortran_copy_fn)) \ (&(((ompi_##type##_t *)old_object)->attr_##type##_f), \ - &f_key, keyval_obj->extra_state, &in_attr, &out_attr, \ + &f_key, keyval_obj->extra_state, &in, &out, \ &f_flag, &f_err); \ if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \ OMPI_THREAD_UNLOCK(&alock); \ return OMPI_FINT_2_INT(f_err); \ } \ + out_attr->av_value = (void *) out; \ flag = OMPI_FINT_2_INT(f_flag); \ } \ } \ /* C style */ \ else { \ + void *in, *out; \ + in = translate_to_c(in_attr); \ if ((err = (*((keyval_obj->copy_attr_fn).attr_##type##_copy_fn)) \ ((ompi_##type##_t *)old_object, key, keyval_obj->extra_state, \ - in_attr, &out_attr, &flag)) != MPI_SUCCESS) { \ + in, &out, &flag)) != MPI_SUCCESS) { \ OMPI_THREAD_UNLOCK(&alock); \ return err; \ } \ + out_attr->av_value = out; \ } /* - * Static + * Cases for attribute values */ +typedef enum ompi_attribute_translate_t { + OMPI_ATTRIBUTE_C, + OMPI_ATTRIBUTE_FORTRAN_MPI1, + OMPI_ATTRIBUTE_FORTRAN_MPI2 +} ompi_attribute_translate_t; + + +/* + * struct to hold attribute values on each MPI object + */ +typedef struct attribute_value_t { + ompi_object_t super; + void *av_value; + void *av_address_kind_pointer; + void *av_integer_pointer; + int av_set_from; +} attribute_value_t; + + +/* + * Local functions + */ +static void attribute_value_construct(attribute_value_t *item); static void ompi_attrkey_item_construct(ompi_attrkey_item_t *item); static void ompi_attrkey_item_destruct(ompi_attrkey_item_t *item); +static int set_value(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, int key, + attribute_value_t *new_attr, + bool predefined, bool need_lock); +static int get_value(ompi_hash_table_t *keyhash, int key, + attribute_value_t **attribute, int *flag); +static void *translate_to_c(attribute_value_t *val); +static MPI_Fint translate_to_fortran_mpi1(attribute_value_t *val); +static MPI_Aint translate_to_fortran_mpi2(attribute_value_t *val); + + +/* + * attribute_value_t class + */ +static OBJ_CLASS_INSTANCE(attribute_value_t, + ompi_object_t, + attribute_value_construct, + NULL); /* * ompi_attribute_entry_t classes */ - -struct ompi_attrkey_item_t_class; static OBJ_CLASS_INSTANCE(ompi_attrkey_item_t, ompi_object_t, ompi_attrkey_item_construct, @@ -188,6 +399,7 @@ static OBJ_CLASS_INSTANCE(ompi_attrkey_item_t, static ompi_hash_table_t *keyval_hash; static ompi_bitmap_t *key_bitmap; +static unsigned int int_pos = 12345; #if OMPI_HAVE_THREAD_SUPPORT /* @@ -201,10 +413,21 @@ static ompi_bitmap_t *key_bitmap; static ompi_mutex_t alock; #endif /* OMPI_HAVE_THREAD_SUPPORT */ -/* - * ompi_attrkey_item_t interface functions - */ +/* + * attribute_value_t constructor function + */ +static void attribute_value_construct(attribute_value_t *item) +{ + item->av_address_kind_pointer = &item->av_value; + item->av_integer_pointer = &(((MPI_Fint*) &item->av_value)[int_pos]); + item->av_set_from = 0; +} + + +/* + * ompi_attrkey_item_t constructor / destructor + */ static void ompi_attrkey_item_construct(ompi_attrkey_item_t *item) { @@ -230,20 +453,28 @@ ompi_attrkey_item_destruct(ompi_attrkey_item_t *item) * items. This will be called one time, mostly during MPI_INIT() */ -int -ompi_attr_init(void) +int ompi_attr_init(void) { int ret; + void *bogus = (void*) 1; + MPI_Fint *p = (MPI_Fint*) &bogus; keyval_hash = OBJ_NEW(ompi_hash_table_t); if (NULL == keyval_hash) { - /* show_help */ return MPI_ERR_SYSRESOURCE; } key_bitmap = OBJ_NEW(ompi_bitmap_t); if (0 != ompi_bitmap_init(key_bitmap, 10)) { return MPI_ERR_SYSRESOURCE; } + + for (int_pos = 0; int_pos < (sizeof(void*) / sizeof(MPI_Fint)); + ++int_pos) { + if (p[int_pos] == 1) { + break; + } + } + if (OMPI_SUCCESS != (ret = ompi_hash_table_init(keyval_hash, ATTR_TABLE_SIZE))) { return ret; @@ -260,8 +491,7 @@ ompi_attr_init(void) * This will destroy the list, mostly during MPI_Finalize() */ -int -ompi_attr_finalize(void) +int ompi_attr_finalize(void) { OBJ_RELEASE(keyval_hash); OBJ_RELEASE(key_bitmap); @@ -270,11 +500,10 @@ ompi_attr_finalize(void) } -int -ompi_attr_create_keyval(ompi_attribute_type_t type, - ompi_attribute_fn_ptr_union_t copy_attr_fn, - ompi_attribute_fn_ptr_union_t delete_attr_fn, - int *key, void *extra_state, int flags) +int ompi_attr_create_keyval(ompi_attribute_type_t type, + ompi_attribute_fn_ptr_union_t copy_attr_fn, + ompi_attribute_fn_ptr_union_t delete_attr_fn, + int *key, void *extra_state, int flags) { ompi_attrkey_item_t *attr; int ret; @@ -319,8 +548,8 @@ ompi_attr_create_keyval(ompi_attribute_type_t type, } -int -ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, bool predefined) +int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, + bool predefined) { int ret; ompi_attrkey_item_t *key_item; @@ -338,7 +567,8 @@ ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, bool predefined) (void **) &key_item); OMPI_THREAD_UNLOCK(&alock); - if ((OMPI_SUCCESS != ret) || (NULL == key_item) || (key_item->attr_type != type) || + if ((OMPI_SUCCESS != ret) || (NULL == key_item) || + (key_item->attr_type != type) || ((!predefined) && (key_item->attr_flag & OMPI_KEYVAL_PREDEFINED))) { return OMPI_ERR_BAD_PARAM; } @@ -357,14 +587,13 @@ ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, bool predefined) } -int -ompi_attr_delete(ompi_attribute_type_t type, void *object, - ompi_hash_table_t *keyhash, int key, - bool predefined, bool need_lock) +int ompi_attr_delete(ompi_attribute_type_t type, void *object, + ompi_hash_table_t *keyhash, int key, + bool predefined, bool need_lock) { ompi_attrkey_item_t *key_item; int ret = OMPI_SUCCESS, err; - void *attr; + attribute_value_t *attr; /* Protect against the user calling ompi_attr_destroy and then calling any of the functions which use it */ @@ -382,12 +611,13 @@ ompi_attr_delete(ompi_attribute_type_t type, void *object, OMPI_THREAD_LOCK(&alock); } - /* Check if the key is valid in the key-attribute hash */ + /* Check if the key is valid in the master keyval hash */ ret = ompi_hash_table_get_value_uint32(keyval_hash, key, (void **) &key_item); - if ( (OMPI_SUCCESS != ret)||(NULL == key_item)||(key_item->attr_type!= type)|| + if ((OMPI_SUCCESS != ret) || (NULL == key_item) || + (key_item->attr_type!= type) || ((!predefined) && (key_item->attr_flag & OMPI_KEYVAL_PREDEFINED))) { ret = OMPI_ERR_BAD_PARAM; goto exit; @@ -401,31 +631,31 @@ ompi_attr_delete(ompi_attribute_type_t type, void *object, } /* Check if the key is valid for the communicator/window/dtype. If - yes, then delete the attribute and key entry from the CWD hash */ + yes, then delete the attribute and key entry from the object's key + hash */ - ret = ompi_hash_table_get_value_uint32(keyhash, key, &attr); - - if ( OMPI_SUCCESS == ret ) { - switch(type) { - case COMM_ATTR: - DELETE_ATTR_OBJECT(communicator, attr, key_item); - break; + ret = ompi_hash_table_get_value_uint32(keyhash, key, (void**) &attr); + if (OMPI_SUCCESS == ret) { + switch (type) { + case COMM_ATTR: + DELETE_ATTR_CALLBACKS(communicator, attr, key_item); + break; #if OMPI_WANT_MPI2_ONE_SIDED - case WIN_ATTR: - DELETE_ATTR_OBJECT(win, attr, key_item); - break; + case WIN_ATTR: + DELETE_ATTR_CALLBACKS(win, attre, key_item); + break; #endif - case TYPE_ATTR: - DELETE_ATTR_OBJECT(datatype, attr, key_item); - break; + case TYPE_ATTR: + DELETE_ATTR_CALLBACKS(datatype, attr, key_item); + break; - default: - /* show_help */ - ret = MPI_ERR_INTERN; - goto exit; + default: + ret = MPI_ERR_INTERN; + goto exit; } + OBJ_RELEASE(attr); ret = ompi_hash_table_remove_value_uint32(keyhash, key); if (OMPI_SUCCESS != ret) { @@ -448,151 +678,138 @@ ompi_attr_delete(ompi_attribute_type_t type, void *object, } -int -ompi_attr_set(ompi_attribute_type_t type, void *object, - ompi_hash_table_t **keyhash, int key, void *attribute, - bool predefined, bool need_lock) +/* + * Front-end function called by the C MPI API functions to set an + * attribute. + */ +int ompi_attr_set_c(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, void *attribute, bool predefined, bool need_lock) { - ompi_attrkey_item_t *key_item; - int ret, err; - void *oldattr; - bool had_old = false; - - /* Protect against the user calling ompi_attr_destroy and then - calling any of the functions which use it */ - if (NULL == keyval_hash) { - return MPI_ERR_INTERN; - } - if (NULL == keyhash) { - return MPI_ERR_INTERN; + attribute_value_t *new_attr = OBJ_NEW(attribute_value_t); + if (NULL == new_attr) { + return MPI_ERR_SYSRESOURCE; } - /* Note that this function can be invoked by ompi_attr_copy_all() - to set attributes on the new object (in addition to the - top-level MPI_* functions that set attributes). In these - cases, ompi_attr_copy_all() has already locked the keyval_lock, - so we should not try to lock it again. */ - - if (need_lock) { - OMPI_THREAD_LOCK(&alock); - } - ret = ompi_hash_table_get_value_uint32(keyval_hash, key, - (void **) &key_item); - - /* If key not found */ - - if ( (OMPI_SUCCESS != ret )||(NULL == key_item) || (key_item->attr_type != type) || - ((!predefined) && (key_item->attr_flag & OMPI_KEYVAL_PREDEFINED))) { - if (need_lock) { - OMPI_THREAD_UNLOCK(&alock); - } - return OMPI_ERR_BAD_PARAM; - } - - /* Do we need to make a new keyhash? */ - - if (NULL == *keyhash) { - ompi_attr_hash_init(keyhash); - } - - /* Now see if the key is present in the CWD object. If so, delete - the old attribute in the key */ - - ret = ompi_hash_table_get_value_uint32(*keyhash, key, &oldattr); - if ( OMPI_SUCCESS == ret ) { - switch(type) { - case COMM_ATTR: - DELETE_ATTR_OBJECT(communicator, oldattr, key_item); - break; - -#if OMPI_WANT_MPI2_ONE_SIDED - case WIN_ATTR: - DELETE_ATTR_OBJECT(win, oldattr, key_item); - break; -#endif - - case TYPE_ATTR: - DELETE_ATTR_OBJECT(datatype, oldattr, key_item); - break; - - default: - /* show_help */ - return MPI_ERR_INTERN; - } - had_old = true; - } - - ret = ompi_hash_table_set_value_uint32(*keyhash, key, attribute); - if (need_lock) { - OMPI_THREAD_UNLOCK(&alock); - } - if (OMPI_SUCCESS != ret) { - return ret; - } - - /* Increase the reference count of the object, only if there was no - old atribute/no old entry in the CWD */ - - if (!had_old) { - OBJ_RETAIN(key_item); - } - return MPI_SUCCESS; + new_attr->av_value = attribute; + new_attr->av_set_from = OMPI_ATTRIBUTE_C; + return set_value(type, object, keyhash, key, new_attr, + predefined, need_lock); } -int -ompi_attr_get(ompi_hash_table_t *keyhash, int key, void *attribute, - int *flag) +/* + * Front-end function called by the Fortran MPI-2 API functions to set + * an attribute. + */ +int ompi_attr_set_fortran_mpi1(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, MPI_Fint attribute, + bool predefined, bool need_lock) { + attribute_value_t *new_attr = OBJ_NEW(attribute_value_t); + if (NULL == new_attr) { + return MPI_ERR_SYSRESOURCE; + } + + new_attr->av_value = (void *) attribute; + new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI1; + return set_value(type, object, keyhash, key, new_attr, + predefined, need_lock); +} + + +/* + * Front-end function called by the Fortran MPI-2 API functions to set + * an attribute. + */ +int ompi_attr_set_fortran_mpi2(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, MPI_Aint attribute, + bool predefined, bool need_lock) +{ + attribute_value_t *new_attr = OBJ_NEW(attribute_value_t); + if (NULL == new_attr) { + return MPI_ERR_SYSRESOURCE; + } + + new_attr->av_value = (void *) attribute; + new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI2; + return set_value(type, object, keyhash, key, new_attr, + predefined, need_lock); +} + + +/* + * Front-end function called by the C MPI API functions to get + * attributes. + */ +int ompi_attr_get_c(ompi_hash_table_t *keyhash, int key, + void **attribute, int *flag) +{ + attribute_value_t *val; int ret; - void *attr; - ompi_attrkey_item_t *key_item; - /* According to MPI specs, the call is invalid if key is not - present in the main hash at all. If no attribute is associated - with the key, then the call is valid and returns FALSE in the - flag argument */ - - *flag = 0; - OMPI_THREAD_LOCK(&alock); - ret = ompi_hash_table_get_value_uint32(keyval_hash, key, - (void**) &key_item); - - if ( OMPI_ERR_NOT_FOUND == ret ) { - OMPI_THREAD_UNLOCK(&alock); - return MPI_KEYVAL_INVALID; + ret = get_value(keyhash, key, &val, flag); + if (MPI_SUCCESS == ret && 1 == *flag) { + *attribute = translate_to_c(val); } - /* If we have a null keyhash table, that means that nothing has - been cached on this object yet. So just return *flag = 0. */ - - if (NULL == keyhash) { - OMPI_THREAD_UNLOCK(&alock); - return MPI_SUCCESS; - } - - ret = ompi_hash_table_get_value_uint32(keyhash, key, &attr); - OMPI_THREAD_UNLOCK(&alock); - if ( OMPI_SUCCESS == ret ) { - *((void **) attribute) = attr; - *flag = 1; - } - return MPI_SUCCESS; + return ret; } -/* There is too much of code copy/paste in here, see if some other - logic could work here */ -int -ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object, - void *new_object, ompi_hash_table_t *oldkeyhash, - ompi_hash_table_t *newkeyhash) +/* + * Front-end function called by the Fortran MPI-1 API functions to get + * attributes. + */ +int ompi_attr_get_fortran_mpi1(ompi_hash_table_t *keyhash, int key, + MPI_Fint *attribute, int *flag) +{ + attribute_value_t *val; + int ret; + + ret = get_value(keyhash, key, &val, flag); + if (MPI_SUCCESS == ret && 1 == *flag) { + *attribute = translate_to_fortran_mpi1(val); + } + + return ret; +} + + +/* + * Front-end function called by the Fortran MPI-2 API functions to get + * attributes. + */ +int ompi_attr_get_fortran_mpi2(ompi_hash_table_t *keyhash, int key, + MPI_Aint *attribute, int *flag) +{ + attribute_value_t *val; + int ret; + + ret = get_value(keyhash, key, &val, flag); + if (MPI_SUCCESS == ret && 1 == *flag) { + *attribute = translate_to_fortran_mpi2(val); + } + + return ret; +} + + +/* + * Copy all the attributes from one MPI object to another + */ +int ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object, + void *new_object, ompi_hash_table_t *oldkeyhash, + ompi_hash_table_t *newkeyhash) { int ret; int err; uint32_t key; int flag; - void *node, *in_node, *old_attr, *new_attr; + void *node, *in_node; + attribute_value_t *old_attr, *new_attr; ompi_attrkey_item_t *hash_value; /* Protect against the user calling ompi_attr_destroy and then @@ -613,55 +830,70 @@ ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object, OMPI_THREAD_LOCK(&alock); - /* Get the first key-attr in the CWD hash */ - ret = ompi_hash_table_get_first_key_uint32(oldkeyhash, &key, &old_attr, + /* Get the first key-attr in the object's key hash */ + ret = ompi_hash_table_get_first_key_uint32(oldkeyhash, &key, + (void **) &old_attr, &node); - /* While we still have some key-attr pair in the CWD hash */ + /* While we still have some key-attr pair in the object's key + hash */ while (OMPI_SUCCESS == ret) { in_node = node; - /* Get the attr_item in the main hash - so that we know what - the copy_attr_fn is */ + /* Get the attr_item in the main keyval hash - so that we know + what the copy_attr_fn is */ err = ompi_hash_table_get_value_uint32(keyval_hash, key, (void **) &hash_value); - /* assert (err == OMPI_SUCCESS); */ - + new_attr = OBJ_NEW(attribute_value_t); switch (type) { case COMM_ATTR: /* Now call the copy_attr_fn */ - COPY_ATTR_OBJECT(communicator, old_object, hash_value, old_attr, new_attr); + COPY_ATTR_CALLBACKS(communicator, old_object, hash_value, + old_attr, new_attr); break; case TYPE_ATTR: /* Now call the copy_attr_fn */ - COPY_ATTR_OBJECT(datatype, old_object, hash_value, old_attr, new_attr); + COPY_ATTR_CALLBACKS(datatype, old_object, hash_value, + old_attr, new_attr); break; #if OMPI_WANT_MPI2_ONE_SIDED case WIN_ATTR: /* Now call the copy_attr_fn */ - COPY_ATTR_OBJECT(win, old_object, hash_value, old_attr, new_attr); + COPY_ATTR_CALLBACKS(win, old_object, hash_value, + old_attr, new_attr); break; #endif } - /* Hang this off the new CWD object */ + /* Hang this off the object's key hash */ /* The "predefined" parameter to ompi_attr_set() is set to 1, so that no comparison is done for prdefined at all and it just falls off the error checking loop in attr_set */ if (1 == flag) { - ompi_attr_set(type, new_object, &newkeyhash, key, - new_attr, true, false); + if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77)) { + if (0 != (hash_value->attr_flag & OMPI_KEYVAL_F77_MPI1)) { + new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI1; + } else { + new_attr->av_set_from = OMPI_ATTRIBUTE_FORTRAN_MPI2; + } + } else { + new_attr->av_set_from = OMPI_ATTRIBUTE_C; + } + set_value(type, new_object, &newkeyhash, key, + new_attr, true, false); + } else { + OBJ_RELEASE(new_attr); } ret = ompi_hash_table_get_next_key_uint32(oldkeyhash, &key, - &old_attr, in_node, - &node); + (void **) &old_attr, + in_node, &node); } /* All done */ @@ -671,9 +903,11 @@ ompi_attr_copy_all(ompi_attribute_type_t type, void *old_object, } -int -ompi_attr_delete_all(ompi_attribute_type_t type, void *object, - ompi_hash_table_t *keyhash) +/* + * Delete all the attributes on an MPI object + */ +int ompi_attr_delete_all(ompi_attribute_type_t type, void *object, + ompi_hash_table_t *keyhash) { int key_ret, del_ret; uint32_t key, oldkey; @@ -697,7 +931,7 @@ ompi_attr_delete_all(ompi_attribute_type_t type, void *object, OMPI_THREAD_LOCK(&alock); - /* Get the first key in local CWD hash */ + /* Get the first key in local object's key hash */ key_ret = ompi_hash_table_get_first_key_uint32(keyhash, &key, &old_attr, &node); @@ -725,3 +959,245 @@ ompi_attr_delete_all(ompi_attribute_type_t type, void *object, OMPI_THREAD_UNLOCK(&alock); return del_ret; } + +/*************************************************************************/ + +/* + * Back-end function to set an attribute on an MPI object + */ +static int set_value(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, int key, + attribute_value_t *new_attr, + bool predefined, bool need_lock) +{ + ompi_attrkey_item_t *key_item; + int ret, err; + attribute_value_t *old_attr; + bool had_old = false; + + /* Protect against the user calling ompi_attr_destroy and then + calling any of the functions which use it */ + if (NULL == keyval_hash) { + return MPI_ERR_INTERN; + } + if (NULL == keyhash) { + return MPI_ERR_INTERN; + } + + /* Note that this function can be invoked by ompi_attr_copy_all() + to set attributes on the new object (in addition to the + top-level MPI_* functions that set attributes). In these + cases, ompi_attr_copy_all() has already locked the keyval_lock, + so we should not try to lock it again. */ + + if (need_lock) { + OMPI_THREAD_LOCK(&alock); + } + ret = ompi_hash_table_get_value_uint32(keyval_hash, key, + (void **) &key_item); + + /* If key not found */ + + if ((OMPI_SUCCESS != ret ) || (NULL == key_item) || + (key_item->attr_type != type) || + ((!predefined) && (key_item->attr_flag & OMPI_KEYVAL_PREDEFINED))) { + if (need_lock) { + OMPI_THREAD_UNLOCK(&alock); + } + return OMPI_ERR_BAD_PARAM; + } + + /* Do we need to make a new keyhash? */ + + if (NULL == *keyhash) { + ompi_attr_hash_init(keyhash); + } + + /* Now see if the key is present in the object's key hash. If so, + delete the old attribute value. */ + + ret = ompi_hash_table_get_value_uint32(*keyhash, key, (void**) &old_attr); + if (OMPI_SUCCESS == ret) { + switch (type) { + case COMM_ATTR: + DELETE_ATTR_CALLBACKS(communicator, old_attr, key_item); + break; + +#if OMPI_WANT_MPI2_ONE_SIDED + case WIN_ATTR: + DELETE_ATTR_CALLBACKS(win, old_attr, key_item); + break; +#endif + + case TYPE_ATTR: + DELETE_ATTR_CALLBACKS(datatype, old_attr, key_item); + break; + + default: + return MPI_ERR_INTERN; + } + had_old = true; + OBJ_RELEASE(old_attr); + } + + ret = ompi_hash_table_set_value_uint32(*keyhash, key, new_attr); + + if (need_lock) { + OMPI_THREAD_UNLOCK(&alock); + } + if (OMPI_SUCCESS != ret) { + return ret; + } + + /* Increase the reference count of the object, only if there was no + old atribute/no old entry in the object's key hash */ + + if (!had_old) { + OBJ_RETAIN(key_item); + } + return MPI_SUCCESS; +} + + +/* + * Back-end function to get an attribute from the hash map and return + * it to the caller. Translation services are not provided -- they're + * in small, standalone functions that are called from several + * different places. + */ +static int get_value(ompi_hash_table_t *keyhash, int key, + attribute_value_t **attribute, int *flag) +{ + int ret; + void *attr; + ompi_attrkey_item_t *key_item; + + /* According to MPI specs, the call is invalid if key is not + present in the main keyval hash at all. If no attribute is + associated with the key, then the call is valid and returns + FALSE in the flag argument */ + + *flag = 0; + OMPI_THREAD_LOCK(&alock); + ret = ompi_hash_table_get_value_uint32(keyval_hash, key, + (void**) &key_item); + + if (OMPI_ERR_NOT_FOUND == ret) { + OMPI_THREAD_UNLOCK(&alock); + return MPI_KEYVAL_INVALID; + } + + /* If we have a null keyhash table, that means that nothing has + been cached on this object yet. So just return *flag = 0. */ + + if (NULL == keyhash) { + OMPI_THREAD_UNLOCK(&alock); + return OMPI_SUCCESS; + } + + ret = ompi_hash_table_get_value_uint32(keyhash, key, &attr); + OMPI_THREAD_UNLOCK(&alock); + if (OMPI_SUCCESS == ret) { + *attribute = attr; + *flag = 1; + } + return OMPI_SUCCESS; +} + + +/* + * Take an attribute and translate it according to the cases listed in + * the comments at the top of this file. + * + * This function does not fail -- it is only invoked in "safe" + * situations. + */ +static void *translate_to_c(attribute_value_t *val) +{ + switch (val->av_set_from) { + case OMPI_ATTRIBUTE_C: + /* Case 1: written in C, read in C (unity) */ + return val->av_value; + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI1: + /* Case 4: written in Fortran MPI-1, read in C */ + return val->av_integer_pointer; + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI2: + /* Case 7: written in Fortran MPI-2, read in C */ + return val->av_address_kind_pointer; + break; + + default: + /* Should never reach here */ + return NULL; + } +} + + +/* + * Take an attribute and translate it according to the cases listed in + * the comments at the top of this file. + * + * This function does not fail -- it is only invoked in "safe" + * situations. + */ +static MPI_Fint translate_to_fortran_mpi1(attribute_value_t *val) +{ + switch (val->av_set_from) { + case OMPI_ATTRIBUTE_C: + /* Case 2: written in C, read in Fortran MPI-1 */ + return ((MPI_Fint *) &val->av_value)[int_pos]; + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI1: + /* Case 5: written in Fortran MPI-1, read in Fortran MPI-1 + (unity) */ + return *((MPI_Fint *) val->av_integer_pointer); + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI2: + /* Case 8: written in Fortran MPI-2, read in Fortran MPI-1 */ + return *((MPI_Fint *) val->av_integer_pointer); + break; + + default: + /* Should never reach here */ + return 0; + } +} + + +/* + * Take an attribute and translate it according to the cases listed in + * the comments at the top of this file. + * + * This function does not fail -- it is only invoked in "safe" + * situations. + */ +static MPI_Aint translate_to_fortran_mpi2(attribute_value_t *val) +{ + switch (val->av_set_from) { + case OMPI_ATTRIBUTE_C: + /* Case 3: written in C, read in Fortran MPI-2 */ + return (MPI_Aint) val->av_value; + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI1: + /* Case 6: written in Fortran MPI-1, read in Fortran MPI-2 */ + return (MPI_Aint) *((MPI_Fint *) val->av_integer_pointer); + break; + + case OMPI_ATTRIBUTE_FORTRAN_MPI2: + /* Case 9: written in Fortran MPI-2, read in Fortran MPI-2 + (unity) */ + return (MPI_Aint) val->av_value; + break; + + default: + /* Should never reach here */ + return 0; + } +} diff --git a/src/attribute/attribute.h b/src/attribute/attribute.h index 6424331260..92a5dc967e 100644 --- a/src/attribute/attribute.h +++ b/src/attribute/attribute.h @@ -35,16 +35,19 @@ #define ATTR_HASH_SIZE 10 -/* Flags for attribute will contain these */ -#define OMPI_KEYVAL_PREDEFINED 1 -#define OMPI_KEYVAL_F77 2 -#define OMPI_KEYVAL_F77_OLD 4 +/* + * Flags for keyvals + */ +#define OMPI_KEYVAL_PREDEFINED 0x0001 +#define OMPI_KEYVAL_F77 0x0002 +#define OMPI_KEYVAL_F77_MPI1 0x0004 + #if defined(c_plusplus) || defined(__cplusplus) extern "C" { #endif -enum ompi_attribute_type_t{ +enum ompi_attribute_type_t { COMM_ATTR = 1, /**< The attribute belongs to a comm object. Starts with 1 so that we can have it initialized to 0 using memset in the constructor */ @@ -239,7 +242,8 @@ int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, bool predefined); /** - * Set an attribute on the comm/win/datatype + * Set an attribute on the comm/win/datatype in a form valid for C. + * * @param type Type of attribute (COMM/WIN/DTYPE) (IN) * @param object The actual Comm/Win/Datatype object (IN) * @param keyhash The attribute hash table hanging on the object(IN/OUT) @@ -257,14 +261,101 @@ int ompi_attr_free_keyval(ompi_attribute_type_t type, int *key, * function is invoked internally (i.e., when we already hold the * relevant locks, and we don't want to try to lock them again, * recursively). + * + * All three of these functions (ompi_attr_set_c(), + * ompi_attr_set_fortran_mpi1(), and ompi_attr_set_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. */ - -int ompi_attr_set(ompi_attribute_type_t type, void *object, - ompi_hash_table_t **keyhash, - int key, void *attribute, bool predefined, bool need_lock); +int ompi_attr_set_c(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, void *attribute, bool predefined, bool need_lock); /** - * Get an attribute on the comm/win/datatype + * Set an attribute on the comm/win/datatype in a form valid for + * Fortran MPI-1. + * + * @param type Type of attribute (COMM/WIN/DTYPE) (IN) + * @param object The actual Comm/Win/Datatype object (IN) + * @param keyhash The attribute hash table hanging on the object(IN/OUT) + * @param key Key val for the attribute (IN) + * @param attribute The actual attribute pointer (IN) + * @param predefined Whether the key is predefined or not 0/1 (IN) + * @param need_lock Whether we need to need to lock the keyval_lock or not + * @return OMPI error code + * + * If (*keyhash) == NULL, a new keyhash will be created and + * initialized. + * + * Note that need_lock should *always* be true when this function is + * invoked from an top-level MPI function. It is only false when this + * function is invoked internally (i.e., when we already hold the + * relevant locks, and we don't want to try to lock them again, + * recursively). + * + * All three of these functions (ompi_attr_set_c(), + * ompi_attr_set_fortran_mpi1(), and ompi_attr_set_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. + */ +int ompi_attr_set_fortran_mpi1(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, MPI_Fint attribute, + bool predefined, bool need_lock); + +/** + * Set an attribute on the comm/win/datatype in a form valid for + * Fortran MPI-2. + * + * @param type Type of attribute (COMM/WIN/DTYPE) (IN) + * @param object The actual Comm/Win/Datatype object (IN) + * @param keyhash The attribute hash table hanging on the object(IN/OUT) + * @param key Key val for the attribute (IN) + * @param attribute The actual attribute pointer (IN) + * @param predefined Whether the key is predefined or not 0/1 (IN) + * @param need_lock Whether we need to need to lock the keyval_lock or not + * @return OMPI error code + * + * If (*keyhash) == NULL, a new keyhash will be created and + * initialized. + * + * Note that need_lock should *always* be true when this function is + * invoked from an top-level MPI function. It is only false when this + * function is invoked internally (i.e., when we already hold the + * relevant locks, and we don't want to try to lock them again, + * recursively). + * + * All three of these functions (ompi_attr_set_c(), + * ompi_attr_set_fortran_mpi1(), and ompi_attr_set_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. + */ +int ompi_attr_set_fortran_mpi2(ompi_attribute_type_t type, void *object, + ompi_hash_table_t **keyhash, + int key, MPI_Aint attribute, + bool predefined, bool need_lock); + +/** + * Get an attribute on the comm/win/datatype in a form valid for C. + * * @param keyhash The attribute hash table hanging on the object(IN) * @param key Key val for the attribute (IN) * @param attribute The actual attribute pointer (OUT) @@ -272,10 +363,74 @@ int ompi_attr_set(ompi_attribute_type_t type, void *object, * with the key (OUT) * @return OMPI error code * + * All three of these functions (ompi_attr_get_c(), + * ompi_attr_get_fortran_mpi1(), and ompi_attr_get_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. */ -int ompi_attr_get(ompi_hash_table_t *keyhash, int key, - void *attribute, int *flag); +int ompi_attr_get_c(ompi_hash_table_t *keyhash, int key, + void **attribute, int *flag); + + +/** + * Get an attribute on the comm/win/datatype in a form valid for + * Fortran MPI-1. + * + * @param keyhash The attribute hash table hanging on the object(IN) + * @param key Key val for the attribute (IN) + * @param attribute The actual attribute pointer (OUT) + * @param flag Flag whether an attribute is associated + * with the key (OUT) + * @return OMPI error code + * + * All three of these functions (ompi_attr_get_c(), + * ompi_attr_get_fortran_mpi1(), and ompi_attr_get_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. + */ + +int ompi_attr_get_fortran_mpi1(ompi_hash_table_t *keyhash, int key, + MPI_Fint *attribute, int *flag); + + +/** + * Get an attribute on the comm/win/datatype in a form valid for + * Fortran MPI-2. + * + * @param keyhash The attribute hash table hanging on the object(IN) + * @param key Key val for the attribute (IN) + * @param attribute The actual attribute pointer (OUT) + * @param flag Flag whether an attribute is associated + * with the key (OUT) + * @return OMPI error code + * + * All three of these functions (ompi_attr_get_c(), + * ompi_attr_get_fortran_mpi1(), and ompi_attr_get_fortran_mpi2()) + * could have been combined into one function that took some kind of + * (void*) and an enum to indicate which way to translate the final + * representation, but that just seemed to make an already complicated + * situation more complicated through yet another layer of + * indirection. + * + * So yes, this is more code, but it's clearer and less error-prone + * (read: better) this way. + */ + +int ompi_attr_get_fortran_mpi2(ompi_hash_table_t *keyhash, int key, + MPI_Aint *attribute, int *flag); /** diff --git a/src/attribute/attribute_predefined.c b/src/attribute/attribute_predefined.c index 14d60780b8..d3aac7381a 100644 --- a/src/attribute/attribute_predefined.c +++ b/src/attribute/attribute_predefined.c @@ -14,6 +14,66 @@ * $HEADER$ */ +/** + * @file + * + * Setup the predefined attributes in MPI. + * + * A number of pre-defined attributes are created here, most of which + * are exactly what one would expect, but there are a few exceptions + * -- so they're documented here. + * + * Predefined attributes are integer-valued or address-valued (per + * MPI-2; see section 4.12.7, keeping in mind that Example 4.13 is + * totally wrong -- see src/attribute/attribute.h for a lengthy + * explanation of this). + * + * The only address-valued attribute is MPI_WIN_BASE. We treat it as + * if it were set from C. All other attributes are integer-valued. + * We treat them as if they were set from Fortran MPI-1 (i.e., + * MPI_ATTR_PUT) or Fortran MPI-2 (i.e., MPI_xxx_ATTR_SET). Most + * attributes are MPI-1 integer-valued, meaning that they are the size + * of MPI_Fint (INTEGER). But MPI_WIN_SIZE and MPI_WIN_DISP_UNIT are + * MPI-2 integer-valued, meaning that they are the size of MPI_Aint + * (INTEGER(KIND=MPI_ADDRESS_KIND)). + * + * MPI_TAG_UB is set to a fixed upper limit. + * + * MPI_HOST is set to MPI_PROC_NULL (per MPI-1, see 7.1.1, p192). + * + * MPI_IO is set to 1 because OMPI provides IO forwarding. + * + * MPI_WTIME_IS_GLOBAL is set to 0 (a conservative answer). + * + * MPI_APPNUM is set as the result of a GPR subscription. + * + * MPI_LASTUSEDCODE is set to an initial value and is reset every time + * MPI_ADD_ERROR_CLASS is invoked. Its copy function is set to + * MPI_COMM_NULL_COPY_FN, meaning that *only* MPI_COMM_WORLD will have + * this attribute value. As such, we only have to update + * MPI_COMM_WORLD when this value changes (i.e., since this is an + * integer-valued attribute, we have to update this attribute on every + * communicator -- using NULL_COPY_FN ensures that only MPI_COMM_WORLD + * has this attribute value set). + * + * MPI_UNIVERSE_SIZE is set as the result of a GPR subscription. + * + * MPI_WIN_BASE is an address-valued attribute, and is set directly + * from MPI_WIN_CREATE. MPI_WIN_SIZE and MPI_WIN_DISP_UNIT are both + * integer-valued attributes, *BUT* at least the MPI_WIN_SIZE is an + * MPI_Aint, so in terms of consistency, both should be the same -- + * hence, we treat them as MPI-2 Fortran integer-valued attributes. + * All three of these atrributes have NULL_COPY_FN copy functions; it + * doesn't make sense to copy them to new windows (because they're + * values specific and unique to each window) -- especially when + * WIN_CREATE will explicitly set them on new windows anyway. + * + * These are not supported yet, but are included here for consistency: + * + * MPI_IMPI_CLIENT_SIZE, MPI_IMPI_CLIENT_COLOR, MPI_IMPI_HOST_SIZE, + * and MPI_IMPI_HOST_COLOR are integer-valued attributes. + */ + #include "ompi_config.h" #include "mpi.h" @@ -23,6 +83,7 @@ #include "errhandler/errclass.h" #include "communicator/communicator.h" #include "util/proc_info.h" +#include "util/sys_info.h" #include "mca/ns/ns.h" #include "mca/gpr/gpr.h" #include "mca/errmgr/errmgr.h" @@ -32,46 +93,80 @@ /* * Private functions */ -static int set(int keyval, void *value); - - -/* - * Back-end for attribute values - */ -static int attr_tag_ub = MPI_TAG_UB_VALUE; -static char *attr_host = NULL; -static int attr_io = 1; -static int attr_wtime_is_global = 0; - -/* Filled in at run-time, below */ -static int attr_appnum = -1; -/* Filled in at run-time, below */ -static int attr_universe_size = -1; - -#if 0 +static int create_comm(int target_keyval, bool want_inherit); +#if OMPI_WANT_MPI2_ONE_SIDED /* JMS for when we implement windows */ -static int attr_win_base = 0; -static int attr_win_size = 0; -static int attr_win_disp_unit = 0; -#endif - -#if 0 -/* JMS for when we implement IMPI */ -static int attr_impi_client_size = 0; -static int attr_impi_client_color = 0; -static int attr_impi_host_size = 0; -static int attr_impi_host_color = 0; +static int create_win(int target_keyval); #endif +static int set_f(int keyval, MPI_Fint value); int ompi_attr_create_predefined(void) { - int rc; + int rc, ret; orte_gpr_trigger_t trig, *trig1; orte_gpr_value_t value, *values; orte_gpr_subscription_t sub, *sub1; orte_jobid_t job; + /* Create all the keyvals */ + + /* DO NOT CHANGE THE ORDER OF CREATING THESE KEYVALS! This order + strictly adheres to the order in mpi.h. If you change the + order here, you must change the order in mpi.h as well! */ + + if (OMPI_SUCCESS != (ret = create_comm(MPI_TAG_UB, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_HOST, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_IO, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_WTIME_IS_GLOBAL, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_APPNUM, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_LASTUSEDCODE, false)) || + OMPI_SUCCESS != (ret = create_comm(MPI_UNIVERSE_SIZE, true)) || +#if OMPI_WANT_MPI2_ONE_SIDED + /* JMS for when we implement windows */ + OMPI_SUCCESS != (ret = create_win(MPI_WIN_BASE)) || + OMPI_SUCCESS != (ret = create_win(MPI_WIN_SIZE)) || + OMPI_SUCCESS != (ret = create_win(MPI_WIN_DISP_UNIT)) || +#endif +#if 0 + /* JMS For when we implement IMPI */ + OMPI_SUCCESS != (ret = create_comm(MPI_IMPI_CLIENT_SIZE, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_IMPI_CLIENT_COLOR, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_IMPI_HOST_SIZE, true)) || + OMPI_SUCCESS != (ret = create_comm(MPI_IMPI_HOST_COLOR, true)) || +#endif + 0) { + return ret; + } + + /* Set default values for everything except UNIVERSE_SIZE and + APPNUM. */ + + if (OMPI_SUCCESS != (ret = set_f(MPI_TAG_UB, MPI_TAG_UB_VALUE)) || + OMPI_SUCCESS != (ret = set_f(MPI_HOST, MPI_PROC_NULL)) || + OMPI_SUCCESS != (ret = set_f(MPI_IO, 1)) || + OMPI_SUCCESS != (ret = set_f(MPI_WTIME_IS_GLOBAL, 0)) || + OMPI_SUCCESS != (ret = set_f(MPI_LASTUSEDCODE, + ompi_errclass_lastused)) || +#if 0 + /* JMS For when we implement IMPI */ + OMPI_SUCCESS != (ret = set(MPI_IMPI_CLIENT_SIZE, + &attr_impi_client_size)) || + OMPI_SUCCESS != (ret = set(MPI_IMPI_CLIENT_COLOR, + &attr_impi_client_color)) || + OMPI_SUCCESS != (ret = set(MPI_IMPI_HOST_SIZE, + &attr_impi_host_size)) || + OMPI_SUCCESS != (ret = set(MPI_IMPI_HOST_COLOR, + &attr_impi_host_color)) || +#endif + 0) { + return ret; + } + + /* Now that those are all created, setup the trigger to get the + UNIVERSE_SIZE and APPNUM values once everyone has passed + stg1. */ + if (ORTE_SUCCESS != (rc = orte_ns.get_jobid(&job, orte_process_info.my_name))) { ORTE_ERROR_LOG(rc); return rc; @@ -177,11 +272,11 @@ void ompi_attr_create_predefined_callback( orte_gpr_notify_data_t *data, void *cbdata) { - int err; size_t i, j; orte_gpr_keyval_t **keyval; orte_gpr_value_t **value; orte_jobid_t job; + unsigned int universe_size = 0; /* Set some default values */ @@ -189,11 +284,13 @@ void ompi_attr_create_predefined_callback( return; } - /* Per conversation between Jeff, Edgar, and Ralph - this needs - * to be fixed to properly determine the appnum + /* Per conversation between Jeff, Edgar, and Ralph - this needs to + * be fixed to properly determine the appnum. Ignore errors here; + * there's no way to propagate the error up, so just try to keep + * going. */ - attr_appnum = (int)job; - + set_f(MPI_APPNUM, (MPI_Fint) job); + /* Query the gpr to find out how many CPUs there will be. This will only return a non-empty list in a persistent universe. If we don't have a persistent universe, then just @@ -215,9 +312,8 @@ void ompi_attr_create_predefined_callback( * happens in-between anyway, so this shouldn't cause a problem. */ - attr_universe_size = 0; if (0 == data->cnt) { /* no data returned */ - attr_universe_size = ompi_comm_size(MPI_COMM_WORLD); + universe_size = ompi_comm_size(MPI_COMM_WORLD); } else { value = data->values; for (i=0; i < data->cnt; i++) { @@ -229,54 +325,22 @@ void ompi_attr_create_predefined_callback( */ if (ORTE_SIZE == keyval[j]->type) { /* Process slot count */ - attr_universe_size += keyval[j]->value.size; + universe_size += keyval[j]->value.size; } } } } } - /* DO NOT CHANGE THE ORDER OF CREATING THESE KEYVALS! This order - strictly adheres to the order in mpi.h. If you change the - order here, you must change the order in mpi.h as well! */ - - if (OMPI_SUCCESS != (err = set(MPI_TAG_UB, &attr_tag_ub)) || - OMPI_SUCCESS != (err = set(MPI_HOST, &attr_host)) || - OMPI_SUCCESS != (err = set(MPI_IO, &attr_io)) || - OMPI_SUCCESS != (err = set(MPI_WTIME_IS_GLOBAL, - &attr_wtime_is_global)) || - OMPI_SUCCESS != (err = set(MPI_APPNUM, &attr_appnum)) || - OMPI_SUCCESS != (err = set(MPI_LASTUSEDCODE, - &ompi_errclass_lastused)) || - OMPI_SUCCESS != (err = set(MPI_UNIVERSE_SIZE, &attr_universe_size)) || -#if 0 - /* JMS for when we implement windows */ - /* JMS BE SURE TO READ ALL OF MPI-2 4.12.7 BEFORE IMPLEMENTING - THESE ADDRESS-VALUED ATTRIBUTES! */ - OMPI_SUCCESS != (err = set(MPI_WIN_BASE, &attr_win_base)) || - OMPI_SUCCESS != (err = set(MPI_WIN_SIZE, &attr_win_size)) || - OMPI_SUCCESS != (err = set(MPI_WIN_DISP_UNIT, &attr_win_disp_unit)) || -#endif -#if 0 - /* JMS For when we implement IMPI */ - OMPI_SUCCESS != (err = set(MPI_IMPI_CLIENT_SIZE, - &attr_impi_client_size)) || - OMPI_SUCCESS != (err = set(MPI_IMPI_CLIENT_COLOR, - &attr_impi_client_color)) || - OMPI_SUCCESS != (err = set(MPI_IMPI_HOST_SIZE, - &attr_impi_host_size)) || - OMPI_SUCCESS != (err = set(MPI_IMPI_HOST_COLOR, - &attr_impi_host_color)) || -#endif - 0) { - return; - } + /* Same as above -- ignore errors here because there's nothing we + can do if there's any error anyway */ + set_f(MPI_UNIVERSE_SIZE, universe_size); return; } -static int set(int target_keyval, void *value) +static int create_comm(int target_keyval, bool want_inherit) { int err; int keyval; @@ -284,18 +348,50 @@ static int set(int target_keyval, void *value) ompi_attribute_fn_ptr_union_t del; keyval = -1; - copy.attr_communicator_copy_fn = MPI_COMM_DUP_FN; + copy.attr_communicator_copy_fn = + want_inherit ? MPI_COMM_DUP_FN : MPI_COMM_NULL_COPY_FN; del.attr_communicator_delete_fn = MPI_COMM_NULL_DELETE_FN; err = ompi_attr_create_keyval(COMM_ATTR, copy, del, &keyval, NULL, OMPI_KEYVAL_PREDEFINED); - if (keyval != target_keyval || OMPI_SUCCESS != err) { + if (MPI_SUCCESS != err) { return err; } - err = ompi_attr_set(COMM_ATTR, MPI_COMM_WORLD, - &MPI_COMM_WORLD->c_keyhash, keyval, value, true, true); - if (OMPI_SUCCESS != err) { - return err; + if (target_keyval != keyval) { + return OMPI_ERR_BAD_PARAM; } - return OMPI_SUCCESS; } + + +#if OMPI_WANT_MPI2_ONE_SIDED +/* JMS for when we implement windows */ +static int create_win(int target_keyval) +{ + int err; + int keyval; + ompi_attribute_fn_ptr_union_t copy; + ompi_attribute_fn_ptr_union_t del; + + keyval = -1; + copy.attr_win_copy_fn = MPI_WIN_NULL_COPY_FN; + del.attr_win_delete_fn = MPI_WIN_NULL_DELETE_FN; + err = ompi_attr_create_keyval(WIN_ATTR, copy, del, + &keyval, NULL, OMPI_KEYVAL_PREDEFINED); + if (MPI_SUCCESS != err) { + return err; + } + if (target_keyval != keyval) { + return OMPI_ERR_BAD_PARAM; + } + return OMPI_SUCCESS; +} +#endif + + +static int set_f(int keyval, MPI_Fint value) +{ + return ompi_attr_set_fortran_mpi1(COMM_ATTR, MPI_COMM_WORLD, + &MPI_COMM_WORLD->c_keyhash, + keyval, value, + true, true); +} diff --git a/src/errhandler/errclass.c b/src/errhandler/errclass.c index fd358c5f32..d074055b54 100644 --- a/src/errhandler/errclass.c +++ b/src/errhandler/errclass.c @@ -402,6 +402,11 @@ int ompi_errclass_add(void) newerrclass = OBJ_NEW(ompi_errclass_t); newerrclass->cls = ompi_errclass_lastused; ompi_errclass_lastused++; + + /* Now need to reset the MPI_LASTUSEDCODE attribute on + MPI_COMM_WORLD */ + + ompi_pointer_array_set_item(&ompi_errclasses, newerrclass->cls, newerrclass); return OMPI_SUCCESS; diff --git a/src/mpi/c/attr_get.c b/src/mpi/c/attr_get.c index 32ebd952f7..92d1244af4 100644 --- a/src/mpi/c/attr_get.c +++ b/src/mpi/c/attr_get.c @@ -44,9 +44,11 @@ int MPI_Attr_get(MPI_Comm comm, int keyval, void *attribute_val, int *flag) } } - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ - ret = ompi_attr_get(comm->c_keyhash, keyval, attribute_val, flag); + ret = ompi_attr_get_c(comm->c_keyhash, keyval, attribute_val, flag); OMPI_ERRHANDLER_RETURN(ret, comm, ret, FUNC_NAME); } diff --git a/src/mpi/c/attr_put.c b/src/mpi/c/attr_put.c index a16688c025..aa4b3046f5 100644 --- a/src/mpi/c/attr_put.c +++ b/src/mpi/c/attr_put.c @@ -44,8 +44,8 @@ int MPI_Attr_put(MPI_Comm comm, int keyval, void *attribute_val) } } - ret = ompi_attr_set(COMM_ATTR, comm, &comm->c_keyhash, - keyval, attribute_val, false, true); + ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, + keyval, attribute_val, false, true); OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); } diff --git a/src/mpi/c/comm_get_attr.c b/src/mpi/c/comm_get_attr.c index b0b3b0448f..004b3df7f7 100644 --- a/src/mpi/c/comm_get_attr.c +++ b/src/mpi/c/comm_get_attr.c @@ -44,8 +44,11 @@ int MPI_Comm_get_attr(MPI_Comm comm, int comm_keyval, } } - ret = ompi_attr_get(comm->c_keyhash, comm_keyval, - attribute_val, flag); + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + ret = ompi_attr_get_c(comm->c_keyhash, comm_keyval, + attribute_val, flag); OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); } diff --git a/src/mpi/c/comm_set_attr.c b/src/mpi/c/comm_set_attr.c index 2fec8616f7..d023641de0 100644 --- a/src/mpi/c/comm_set_attr.c +++ b/src/mpi/c/comm_set_attr.c @@ -44,7 +44,7 @@ int MPI_Comm_set_attr(MPI_Comm comm, int comm_keyval, void *attribute_val) } } - ret = ompi_attr_set(COMM_ATTR, comm, &comm->c_keyhash, - comm_keyval, attribute_val, false, true); + ret = ompi_attr_set_c(COMM_ATTR, comm, &comm->c_keyhash, + comm_keyval, attribute_val, false, true); OMPI_ERRHANDLER_RETURN(ret, comm, MPI_ERR_OTHER, FUNC_NAME); } diff --git a/src/mpi/c/type_get_attr.c b/src/mpi/c/type_get_attr.c index 3e4a08e66c..ee8e34f907 100644 --- a/src/mpi/c/type_get_attr.c +++ b/src/mpi/c/type_get_attr.c @@ -52,8 +52,12 @@ int MPI_Type_get_attr (MPI_Datatype type, } } - ret = ompi_attr_get(type->d_keyhash, type_keyval, - attribute_val, flag); + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(type->d_keyhash, type_keyval, + attribute_val, flag); OMPI_ERRHANDLER_RETURN(ret, MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME); } diff --git a/src/mpi/c/type_set_attr.c b/src/mpi/c/type_set_attr.c index 91db7d7b66..7e3bf35c89 100644 --- a/src/mpi/c/type_set_attr.c +++ b/src/mpi/c/type_set_attr.c @@ -48,8 +48,8 @@ int MPI_Type_set_attr (MPI_Datatype type, } } - ret = ompi_attr_set(TYPE_ATTR, type, &type->d_keyhash, - type_keyval, attribute_val, false, true); + ret = ompi_attr_set_c(TYPE_ATTR, type, &type->d_keyhash, + type_keyval, attribute_val, false, true); OMPI_ERRHANDLER_RETURN(ret, MPI_COMM_WORLD, MPI_ERR_OTHER, FUNC_NAME); diff --git a/src/mpi/c/win_get_attr.c b/src/mpi/c/win_get_attr.c index 6605fe622e..92c25f2942 100644 --- a/src/mpi/c/win_get_attr.c +++ b/src/mpi/c/win_get_attr.c @@ -45,7 +45,11 @@ int MPI_Win_get_attr(MPI_Win win, int win_keyval, } } - ret = ompi_attr_get(win->w_keyhash, win_keyval, - attribute_val, flag); + /* This stuff is very confusing. Be sure to see + src/attribute/attribute.c for a lengthy comment explaining Open + MPI attribute behavior. */ + + ret = ompi_attr_get_c(win->w_keyhash, win_keyval, + attribute_val, flag); OMPI_ERRHANDLER_RETURN(ret, win, MPI_ERR_OTHER, FUNC_NAME); } diff --git a/src/mpi/f77/attr_get_f.c b/src/mpi/f77/attr_get_f.c index a85257813a..d0d822d45a 100644 --- a/src/mpi/f77/attr_get_f.c +++ b/src/mpi/f77/attr_get_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "communicator/communicator.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_ATTR_GET = mpi_attr_get_f @@ -59,39 +61,15 @@ void mpi_attr_get_f(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr) { int c_err, c_flag; - MPI_Comm c_comm; - ompi_attribute_fortran_ptr_t value; - - c_comm = MPI_Comm_f2c(*comm); + MPI_Comm c_comm = MPI_Comm_f2c(*comm); - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - /* Didn't use all the FINT macros that could have prevented a few - extra variables in this function, but I figured that the - clarity of code, and the fact that this is not expected to be a - high-performance function, was worth it */ - - /* Note that this function deals with attribute values that are - the size of Fortran INTEGERS; the C function MPI_Attr_get deals - with attribute values that are the size of address integers. - Hence, it is possible that you'll lose some precision upon the - cast. Per MPI-2 4.12.7, use MPI_xxx_GET/SET_ATTR when you need - lossless conversion. */ - - c_err = MPI_Attr_get(c_comm, OMPI_FINT_2_INT(*keyval), - &value.c_ptr, &c_flag); + c_err = ompi_attr_get_fortran_mpi1(c_comm->c_keyhash, + OMPI_FINT_2_INT(*keyval), + attribute_val, + &c_flag); *ierr = OMPI_INT_2_FINT(c_err); *flag = OMPI_INT_2_FINT(c_flag); - - /* Note that MPI-2 4.12.7 specifically says that Fortran's - ATTR_GET function will take the address returned from C and - "convert it to an integer". This compliments ATTR_PUT, who, - since we need to save Fortran attributes by value, saves only - the MPI_Fint (regardless of the size of the back-end attribute - storeage). So here we simply extract that MPI_Fint and get the - value back. */ - - if (MPI_SUCCESS == c_err && 1 == c_flag) { - *attribute_val = value.f_integer; - } } diff --git a/src/mpi/f77/attr_put_f.c b/src/mpi/f77/attr_put_f.c index d3fdbe1b7d..0f469dbc6c 100644 --- a/src/mpi/f77/attr_put_f.c +++ b/src/mpi/f77/attr_put_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "communicator/communicator.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_ATTR_PUT = mpi_attr_put_f @@ -58,32 +60,17 @@ OMPI_GENERATE_F77_BINDINGS (MPI_ATTR_PUT, void mpi_attr_put_f(MPI_Fint *comm, MPI_Fint *keyval, MPI_Fint *attribute_val, MPI_Fint *ierr) { - MPI_Comm c_comm; - ompi_attribute_fortran_ptr_t convert; + int c_err; + MPI_Comm c_comm = MPI_Comm_f2c(*comm); - c_comm = MPI_Comm_f2c(*comm); + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ - - /* Note that this function deals with attribute values that are - the size of Fortran INTEGERS; the C function MPI_Attr_put deals - with attribute values that are the size of address integers. - Hence, it is possible that the C value is larger than the - Fortran value. MPI says that we sign-extend in this case. */ - - /* Fortran attributes are integers. So we need to save those by - value -- not by reference. Hence, we don't save the pointer to - the fortran parameter that came in, but rather its dereferenced - value. Assign to the c_ptr member first, filling out the sign - extension. */ - - if (OMPI_FINT_2_INT(*attribute_val) >= 0) { - convert.c_ptr = (void*) 0; - } else { - convert.c_ptr = (void*) -1; - } - convert.f_integer = *attribute_val; - *ierr = OMPI_INT_2_FINT(MPI_Attr_put(c_comm, - OMPI_FINT_2_INT(*keyval), - convert.c_ptr)); + c_err = ompi_attr_set_fortran_mpi1(COMM_ATTR, + c_comm, + &c_comm->c_keyhash, + OMPI_FINT_2_INT(*keyval), + *attribute_val, + false, true); + *ierr = OMPI_INT_2_FINT(c_err); } diff --git a/src/mpi/f77/comm_get_attr_f.c b/src/mpi/f77/comm_get_attr_f.c index d2f1014140..3efd83349c 100644 --- a/src/mpi/f77/comm_get_attr_f.c +++ b/src/mpi/f77/comm_get_attr_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "communicator/communicator.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_COMM_GET_ATTR = mpi_comm_get_attr_f @@ -56,38 +58,19 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_GET_ATTR, #endif void mpi_comm_get_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval, - MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr) + MPI_Aint *attribute_val, MPI_Fint *flag, + MPI_Fint *ierr) { int c_err, c_flag; - MPI_Comm c_comm; - int *c_value; + MPI_Comm c_comm = MPI_Comm_f2c(*comm); - c_comm = MPI_Comm_f2c(*comm); + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ - - /* Didn't use all the FINT macros that could have prevented a few - extra variables in this function, but I figured that the - clarity of code, and the fact that this is not expected to be a - high-performance function, was worth it */ - - /* Note that there is no conversion on attribute_val -- MPI-2 says - that it is supposed to be the right size already */ - - c_err = MPI_Comm_get_attr(c_comm, OMPI_FINT_2_INT(*comm_keyval), - &c_value, &c_flag); + c_err = ompi_attr_get_fortran_mpi2(c_comm->c_keyhash, + OMPI_FINT_2_INT(*comm_keyval), + attribute_val, + &c_flag); *ierr = OMPI_INT_2_FINT(c_err); *flag = OMPI_INT_2_FINT(c_flag); - - /* Note that MPI-2 4.12.7 specifically says that Fortran's - xxx_GET_ATTR functions will take the address returned from C - and "convert it to an integer". Since we stored the *value* of - the attribute in the corresponding xxx_SET_ATTR function, we - simply cast here to get the value back (remember, MPI - guarantess that xxx_SET_ATTR fortran parameters are the right - size). */ - - if (MPI_SUCCESS == c_err && 1 == c_flag) { - *attribute_val = (MPI_Aint) c_value; - } } diff --git a/src/mpi/f77/comm_set_attr_f.c b/src/mpi/f77/comm_set_attr_f.c index 2c11a64626..1a258d4337 100644 --- a/src/mpi/f77/comm_set_attr_f.c +++ b/src/mpi/f77/comm_set_attr_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "communicator/communicator.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_COMM_SET_ATTR = mpi_comm_set_attr_f @@ -58,15 +60,17 @@ OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SET_ATTR, void mpi_comm_set_attr_f(MPI_Fint *comm, MPI_Fint *comm_keyval, MPI_Aint *attribute_val, MPI_Fint *ierr) { + int c_err; MPI_Comm c_comm = MPI_Comm_f2c(*comm); - /* We save fortran attributes by value, so dereference - attribute_val. MPI-2 guarantees that xxx_SET_ATTR will be - called in fortran with an address-sized integer parameter for - the attribute, so there's no need to do any size conversions - before calling the back-end C function. */ + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - *ierr = OMPI_INT_2_FINT(MPI_Comm_set_attr(c_comm, - OMPI_FINT_2_INT(*comm_keyval), - (void*) *attribute_val)); + c_err = ompi_attr_set_fortran_mpi2(COMM_ATTR, + c_comm, + &c_comm->c_keyhash, + OMPI_FINT_2_INT(*comm_keyval), + *attribute_val, + false, true); + *ierr = OMPI_INT_2_FINT(c_err); } diff --git a/src/mpi/f77/keyval_create_f.c b/src/mpi/f77/keyval_create_f.c index d669243d5f..d7f699ce90 100644 --- a/src/mpi/f77/keyval_create_f.c +++ b/src/mpi/f77/keyval_create_f.c @@ -77,7 +77,7 @@ void mpi_keyval_create_f(ompi_mpi1_fortran_copy_attr_function* copy_attr_fn, ret = ompi_attr_create_keyval(COMM_ATTR, copy_fn, del_fn, keyval, extra_state, - OMPI_KEYVAL_F77 | OMPI_KEYVAL_F77_OLD); + OMPI_KEYVAL_F77 | OMPI_KEYVAL_F77_MPI1); if (MPI_SUCCESS != ret) { c_err = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, diff --git a/src/mpi/f77/type_get_attr_f.c b/src/mpi/f77/type_get_attr_f.c index 00c097c975..b93c0eb5fe 100644 --- a/src/mpi/f77/type_get_attr_f.c +++ b/src/mpi/f77/type_get_attr_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "datatype/datatype.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_TYPE_GET_ATTR = mpi_type_get_attr_f @@ -56,38 +58,19 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_GET_ATTR, #endif void mpi_type_get_attr_f(MPI_Fint *type, MPI_Fint *type_keyval, - MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr) + MPI_Aint *attribute_val, MPI_Fint *flag, + MPI_Fint *ierr) { int c_err, c_flag; - MPI_Datatype c_type; - int *c_value; + MPI_Datatype c_type = MPI_Type_f2c(*type); - c_type = MPI_Type_f2c(*type); + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ - - /* Didn't use all the FINT macros that could have prevented a few - extra variables in this function, but I figured that the - clarity of code, and the fact that this is not expected to be a - high-performance function, was worth it */ - - /* Note that there is no conversion on attribute_val -- MPI-2 says - that it is supposed to be the right size already */ - - c_err = MPI_Type_get_attr(c_type, OMPI_FINT_2_INT(*type_keyval), - &c_value, &c_flag); + c_err = ompi_attr_get_fortran_mpi2(c_type->d_keyhash, + OMPI_FINT_2_INT(*type_keyval), + attribute_val, + &c_flag); *ierr = OMPI_INT_2_FINT(c_err); *flag = OMPI_INT_2_FINT(c_flag); - - /* Note that MPI-2 4.12.7 specifically says that Fortran's - xxx_GET_ATTR functions will take the address returned from C - and "convert it to an integer". Since we stored the *value* of - the attribute in the corresponding xxx_SET_ATTR function, we - simply cast here to get the value back (remember, MPI - guarantess that xxx_SET_ATTR fortran parameters are the right - size). */ - - if (MPI_SUCCESS == c_err && 1 == c_flag) { - *attribute_val = (MPI_Aint) c_value; - } } diff --git a/src/mpi/f77/type_set_attr_f.c b/src/mpi/f77/type_set_attr_f.c index d8844305db..50ce9d195b 100644 --- a/src/mpi/f77/type_set_attr_f.c +++ b/src/mpi/f77/type_set_attr_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "datatype/datatype.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_TYPE_SET_ATTR = mpi_type_set_attr_f @@ -55,17 +57,19 @@ OMPI_GENERATE_F77_BINDINGS (MPI_TYPE_SET_ATTR, #include "mpi/f77/profile/defines.h" #endif -void mpi_type_set_attr_f(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attr_val, MPI_Fint *ierr) +void mpi_type_set_attr_f(MPI_Fint *type, MPI_Fint *type_keyval, MPI_Aint *attribute_val, MPI_Fint *ierr) { - MPI_Datatype c_type = MPI_Type_f2c( *type ); + int c_err; + MPI_Datatype c_type = MPI_Type_f2c(*type); - /* We save fortran attributes by value, so dereference - attribute_val. MPI-2 guarantees that xxx_SET_ATTR will be - called in fortran with an address-sized integer parameter for - the attribute, so there's no need to do any size conversions - before calling the back-end C function. */ + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - *ierr = OMPI_INT_2_FINT(MPI_Type_set_attr( c_type, - OMPI_FINT_2_INT(*type_keyval), - (void*) *attr_val )); + c_err = ompi_attr_set_fortran_mpi2(TYPE_ATTR, + c_type, + &c_type->d_keyhash, + OMPI_FINT_2_INT(*type_keyval), + *attribute_val, + false, true); + *ierr = OMPI_INT_2_FINT(c_err); } diff --git a/src/mpi/f77/win_get_attr_f.c b/src/mpi/f77/win_get_attr_f.c index 451033c652..8ab8b32db7 100644 --- a/src/mpi/f77/win_get_attr_f.c +++ b/src/mpi/f77/win_get_attr_f.c @@ -17,6 +17,8 @@ #include "ompi_config.h" #include "mpi/f77/bindings.h" +#include "attribute/attribute.h" +#include "win/win.h" #if OMPI_HAVE_WEAK_SYMBOLS && OMPI_PROFILE_LAYER #pragma weak PMPI_WIN_GET_ATTR = mpi_win_get_attr_f @@ -59,35 +61,15 @@ void mpi_win_get_attr_f(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Fint *flag, MPI_Fint *ierr) { int c_err, c_flag; - MPI_Win c_win; - int *c_value; + MPI_Win c_win = MPI_Win_f2c(*win); - c_win = MPI_Win_f2c(*win); + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - /* This stuff is very confusing. Be sure to see MPI-2 4.12.7. */ - - /* Didn't use all the FINT macros that could have prevented a few - extra variables in this function, but I figured that the - clarity of code, and the fact that this is not expected to be a - high-performance function, was worth it */ - - /* Note that there is no conversion on attribute_val -- MPI-2 says - that it is supposed to be the right size already */ - - c_err = MPI_Win_get_attr(c_win, OMPI_FINT_2_INT(*win_keyval), - &c_value, &c_flag); + c_err = ompi_attr_get_fortran_mpi2(c_win->w_keyhash, + OMPI_FINT_2_INT(*keyhash), + attribute_val, + &c_flag) *ierr = OMPI_INT_2_FINT(c_err); *flag = OMPI_INT_2_FINT(c_flag); - - /* Note that MPI-2 4.12.7 specifically says that Fortran's - xxx_GET_ATTR functions will take the address returned from C - and "convert it to an integer" Since we stored the *value* of - the attribute in the corresponding xxx_SET_ATTR function, we - simply cast here to get the value back (remember, MPI - guarantess that xxx_SET_ATTR fortran parameters are the right - size). */ - - if (MPI_SUCCESS == c_err && 1 == c_flag) { - *attribute_val = (MPI_Aint) c_value; - } } diff --git a/src/mpi/f77/win_set_attr_f.c b/src/mpi/f77/win_set_attr_f.c index f327a30741..38e181e255 100644 --- a/src/mpi/f77/win_set_attr_f.c +++ b/src/mpi/f77/win_set_attr_f.c @@ -58,15 +58,17 @@ OMPI_GENERATE_F77_BINDINGS (MPI_WIN_SET_ATTR, void mpi_win_set_attr_f(MPI_Fint *win, MPI_Fint *win_keyval, MPI_Aint *attribute_val, MPI_Fint *ierr) { - MPI_Win c_win = MPI_Win_f2c( *win ); + int c_err; + MPI_Win c_win = MPI_Win_f2c(*win); - /* We save fortran attributes by value, so dereference - attribute_val. MPI-2 guarantees that xxx_SET_ATTR will be - called in fortran with an address-sized integer parameter for - the attribute, so there's no need to do any size conversions - before calling the back-end C function. */ + /* This stuff is very confusing. Be sure to see the comment at + the top of src/attributes/attributes.c. */ - *ierr = OMPI_INT_2_FINT(MPI_Win_set_attr( c_win, - OMPI_FINT_2_INT(*win_keyval), - (void*) *attribute_val )); + c_err = ompi_attr_set_fortran_mpi2(WIN_ATTR, + c_win, + &c_win->w_keyhash, + OMPI_FINT_2_INT(*win_keyval), + *attribute_val, + false, true); + *ierr = OMPI_INT_2_FINT(c_err); }