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);
}