attribute.c

MPI stands for the Message Passing Interface. Written by the MPI Forum (a large committee comprising

/*
 * Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
 *                         University Research and Technology
 *                         Corporation.  All rights reserved.
 * Copyright (c) 2004-2006 The University of Tennessee and The University
 *                         of Tennessee Research Foundation.  All rights
 *                         reserved.
 * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart, 
 *                         University of Stuttgart.  All rights reserved.
 * Copyright (c) 2004-2005 The Regents of the University of California.
 *                         All rights reserved.
 * Copyright (c) 2006-2007 Cisco Systems, Inc.  All rights reserved.
 * $COPYRIGHT$
 * 
 * Additional copyrights may follow
 * 
 * $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 "ompi/attribute/attribute.h"
#include "opal/threads/mutex.h"
#include "ompi/constants.h"
#include "ompi/datatype/datatype.h"
#include "ompi/communicator/communicator.h"
#include "ompi/win/win.h"
#include "ompi/mpi/f77/fint_2_int.h"
#include "ompi/class/ompi_bitmap.h"

/*
 * Macros
 */

#define ATTR_TABLE_SIZE 10

/* This is done so that I can have a consistent interface to my macros
   here */

#define MPI_DATATYPE_NULL_COPY_FN MPI_TYPE_NULL_COPY_FN
#define attr_communicator_f c_f_to_c_index
#define attr_datatype_f d_f_to_c_index
#define attr_win_f w_f_to_c_index

#define CREATE_KEY(key) ompi_bitmap_find_and_set_first_unset_bit(key_bitmap, (key))

#define FREE_KEY(key) ompi_bitmap_clear_bit(key_bitmap, (key))


/* Not checking for NULL_DELETE_FN here, since according to the
   MPI-standard it should be a valid function that returns
   MPI_SUCCESS. 

   This macro exists because we have to replicate the same code for
   MPI_Comm, MPI_Datatype, and MPI_Win.  Ick.

   There are 3 possible sets of callbacks:

   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_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_MPI1 flag is
      *not* set.
   3. C-style: attribute arguments are of type (void*).  This is used
      if OMPI_KEYVAL_F77 is not set.
   
   Ick.
 */

#define DELETE_ATTR_CALLBACKS(type, attribute, keyval_obj, object) \
    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_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, &attr_val, (int*)keyval_obj->extra_state, &f_err); \
            if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
                if (need_lock) { \
                    OPAL_THREAD_UNLOCK(&alock); \
                } \
                return OMPI_FINT_2_INT(f_err); \
            } \
        } \
        /* 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, (int*)&attr_val, (int*)keyval_obj->extra_state, &f_err); \
            if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
                if (need_lock) { \
                    OPAL_THREAD_UNLOCK(&alock); \
                } \
                return OMPI_FINT_2_INT(f_err); \
            } \
        } \
    } \
    /* 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, attr_val, \
                            keyval_obj->extra_state)) != MPI_SUCCESS) {\
            if (need_lock) { \
                OPAL_THREAD_UNLOCK(&alock); \
            } \
            return err;\
        } \
    }

/* See the big, long comment above from DELETE_ATTR_CALLBACKS -- most of
   that text applies here, too. */

#define COPY_ATTR_CALLBACKS(type, old_object, keyval_obj, in_attr, new_object, 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_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), \
                 &f_key, (int*)keyval_obj->extra_state, \
                 &in, &out, &f_flag, &f_err); \
            if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
                OPAL_THREAD_UNLOCK(&alock); \
                return OMPI_FINT_2_INT(f_err); \
            } \
            out_attr->av_value = (void*) 0; \
            *out_attr->av_integer_pointer = out; \
            flag = OMPI_LOGICAL_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, &out, \
                 &f_flag, &f_err); \
            if (MPI_SUCCESS != OMPI_FINT_2_INT(f_err)) { \
                OPAL_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, &out, &flag, (ompi_##type##_t *)(new_object))) != MPI_SUCCESS) { \
            OPAL_THREAD_UNLOCK(&alock); \
            return err; \
        } \
        out_attr->av_value = out; \
    }


/* 
 * 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 {
    opal_object_t super;
    void *av_value;
    MPI_Aint *av_address_kind_pointer;
    MPI_Fint *av_integer_pointer;
    int av_set_from;
} attribute_value_t;


/* 
 * Local functions
 */
static void attribute_value_construct(attribute_value_t *item);
static void ompi_attribute_keyval_construct(ompi_attribute_keyval_t *keyval);
static void ompi_attribute_keyval_destruct(ompi_attribute_keyval_t *keyval);
static int set_value(ompi_attribute_type_t type, void *object, 
                     opal_hash_table_t **attr_hash, int key, 
                     attribute_value_t *new_attr,
                     bool predefined, bool need_lock);
static int get_value(opal_hash_table_t *attr_hash, 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,
                          opal_object_t,
                          attribute_value_construct,
                          NULL);


/*
 * ompi_attribute_entry_t classes
 */
static OBJ_CLASS_INSTANCE(ompi_attribute_keyval_t, 
                          opal_object_t,
                          ompi_attribute_keyval_construct,
                          ompi_attribute_keyval_destruct);


/* 
 * Static variables 
 */

static opal_hash_table_t *keyval_hash;
static ompi_bitmap_t *key_bitmap;
static unsigned int int_pos = 12345;

#if OMPI_HAVE_THREAD_SUPPORT
/*
 * Have one lock protect all access to any attribute stuff (keyval
 * hash, key bitmap, attribute hashes on MPI objects, etc.).
 * Arguably, we would have a finer-grained scheme (e.g., 2 locks) that
 * would allow at least *some* concurrency, but these are attributes
 * -- they're not in the performance-critical portions of the code.
 * So why bother?
 */