openmpi/ompi/debuggers/ompi_dll.c

/* -*- Mode: C; c-basic-offset:4 ; -*- */
/**********************************************************************
 * Copyright (C) 2000-2004 by Etnus, LLC.
 * Copyright (C) 1999 by Etnus, Inc.
 * Copyright (C) 1997-1998 Dolphin Interconnect Solutions Inc.
 *
 * Permission is hereby granted to use, reproduce, prepare derivative
 * works, and to redistribute to others.
 *
 *				  DISCLAIMER
 *
 * Neither Dolphin Interconnect Solutions, Etnus LLC, nor any of their
 * employees, makes any warranty express or implied, or assumes any
 * legal liability or responsibility for the accuracy, completeness,
 * or usefulness of any information, apparatus, product, or process
 * disclosed, or represents that its use would not infringe privately
 * owned rights.
 *
 * This code was written by
 * James Cownie: Dolphin Interconnect Solutions. <jcownie@dolphinics.com>
 *               Etnus LLC <jcownie@etnus.com>
 **********************************************************************/

/* Update log
 *
 * Jul 12 2001 FNW: Add a meaningful ID to the communicator name, and switch
 *                  to using the recv_context as the unique_id field.
 * Mar  6 2001 JHC: Add mqs_get_comm_group to allow a debugger to acquire
 *                  processes less eagerly.
 * Dec 13 2000 JHC: totalview/2514: Modify image_has_queues to return
 *                  a silent FALSE if none of the expected data is
 *                  present. This way you won't get complaints when
 *                  you try this on non MPICH processes.
 * Sep  8 2000 JVD: #include <string.h> to silence Linux Alpha compiler warnings.
 * Mar 21 2000 JHC: Add the new entrypoint mqs_dll_taddr_width
 * Nov 26 1998 JHC: Fix the problem that we weren't handling
 *                  MPIR_Ignore_queues properly.
 * Oct 22 1998 JHC: Fix a zero allocation problem
 * Aug 19 1998 JHC: Fix some problems in our use of target_to_host on
 *                  big endian machines.
 * May 28 1998 JHC: Use the extra information we can return to say
 *                  explicitly that sends are only showing non-blocking ops
 * May 19 1998 JHC: Changed the names of the structs and added casts
 *                  where needed to reflect the change to the way we handle
 *                  type safety across the interface.
 * Oct 27 1997 JHC: Created by exploding db_message_state_mpich.cxx
 */

/**
 * Right now there is no MPI2 support
 */
#define FOR_MPI2  0

/* 
   The following was added by William Gropp to improve the portability 
   to systems with non-ANSI C compilers 
 */

#include "ompi_config.h"

#ifdef HAVE_NO_C_CONST
#define const
#endif
#if defined(HAVE_STRING_H)
#include <string.h>
#endif  /* defined(HAVE_STRING_H) */
#if defined(HAVE_STDLIB_H)
#include <stdlib.h>
#endif  /* defined(HAVE_STDLIB_H) */

#include "ompi/mca/pml/base/pml_base_request.h"

/* 
   End of inclusion
 */

#include "mpi_interface.h"
#include "ompi_dll_defs.h"

/* Essential macros for C */
#ifndef NULL
#define NULL ((void *)0)
#endif
#ifndef TRUE
#define TRUE (0==0)
#endif
#ifndef FALSE
#define FALSE (0==1)
#endif

#ifdef OLD_STYLE_CPP_CONCAT
#define concat(a,b) a/**/b
#define stringize(a) "a"
#else
#define concat(a,b) a##b
#define stringize(a) #a
#endif

/**********************************************************************/
/* Set up the basic callbacks into the debugger, also work out 
 * one crucial piece of info about the machine we're running on.
 */
static const mqs_basic_callbacks *mqs_basic_entrypoints;
static int host_is_big_endian;

OMPI_DECLSPEC void mqs_setup_basic_callbacks (const mqs_basic_callbacks * cb)
{
  int t = 1;

  host_is_big_endian    = (*(char *)&t) != 1;
  mqs_basic_entrypoints = cb;
} /* mqs_setup_callbacks */

/**********************************************************************/
/* Macros to make it transparent that we're calling the TV functions
 * through function pointers.
 */
#define mqs_malloc           (mqs_basic_entrypoints->mqs_malloc_fp)
#define mqs_free             (mqs_basic_entrypoints->mqs_free_fp)
#define mqs_prints           (mqs_basic_entrypoints->mqs_dprints_fp)
#define mqs_put_image_info   (mqs_basic_entrypoints->mqs_put_image_info_fp)
#define mqs_get_image_info   (mqs_basic_entrypoints->mqs_get_image_info_fp)
#define mqs_put_process_info (mqs_basic_entrypoints->mqs_put_process_info_fp)
#define mqs_get_process_info (mqs_basic_entrypoints->mqs_get_process_info_fp)

/* These macros *RELY* on the function already having set up the conventional
 * local variables i_info or p_info.
 */
#define mqs_find_type        (i_info->image_callbacks->mqs_find_type_fp)
#define mqs_field_offset     (i_info->image_callbacks->mqs_field_offset_fp)
#define mqs_sizeof           (i_info->image_callbacks->mqs_sizeof_fp)
#define mqs_get_type_sizes   (i_info->image_callbacks->mqs_get_type_sizes_fp)
#define mqs_find_function    (i_info->image_callbacks->mqs_find_function_fp)
#define mqs_find_symbol      (i_info->image_callbacks->mqs_find_symbol_fp)

#define mqs_get_image        (p_info->process_callbacks->mqs_get_image_fp)
#define mqs_get_global_rank  (p_info->process_callbacks->mqs_get_global_rank_fp)
#define mqs_fetch_data       (p_info->process_callbacks->mqs_fetch_data_fp)
#define mqs_target_to_host   (p_info->process_callbacks->mqs_target_to_host_fp)

/**********************************************************************/
/* Version handling functions.
 * This one should never be changed.
 */
OMPI_DECLSPEC int mqs_version_compatibility (void)
{
    return MQS_INTERFACE_COMPATIBILITY;
} /* mqs_version_compatibility */

/* This one can say what you like */
OMPI_DECLSPEC char *mqs_version_string (void)
{
    return "Open MPI message queue support for parallel debuggers compiled on " __DATE__;
} /* mqs_version_string */

/* So the debugger can tell what interface width the library was compiled with */
OMPI_DECLSPEC int mqs_dll_taddr_width (void)
{
    return sizeof (mqs_taddr_t);
} /* mqs_dll_taddr_width */

/**********************************************************************/
/* Additional error codes and error string conversion.
 */
enum {
    err_silent_failure  = mqs_first_user_code,

    err_no_current_communicator,
    err_bad_request,
    err_no_store,

    err_failed_qhdr,
    err_unexpected,
    err_posted,

    err_failed_queue,
    err_first,

    err_context_id,
    err_tag,
    err_tagmask,
    err_lsrc,
    err_srcmask,
    err_next,
    err_ptr,

    err_missing_type,
    err_missing_symbol,

    err_db_shandle,
    err_db_comm,
    err_db_target,
    err_db_tag,
    err_db_data,
    err_db_byte_length,
    err_db_next,

    err_failed_rhandle,
    err_is_complete,
    err_buf,
    err_len,
    err_s,

    err_failed_status,
    err_count,
    err_MPI_SOURCE,
    err_MPI_TAG,

    err_failed_commlist,
    err_sequence_number,
    err_comm_first,

    err_failed_communicator,
    err_lrank_to_grank,
    err_send_context,
    err_recv_context,
    err_comm_next,
    err_comm_name,

    err_all_communicators,
    err_mpid_sends,
    err_mpid_recvs,
    err_group_corrupt
};

/**********************************************************************/
/* Forward declarations 
 */
static mqs_taddr_t fetch_pointer (mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info);
static mqs_tword_t fetch_int (mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info);
static mqs_tword_t fetch_bool(mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info);

/* Internal structure we hold for each communicator */
typedef struct communicator_t
{
    struct communicator_t * next;
    group_t *               group;		/* Translations */
    int                     recv_context;	/* Unique ID for the communicator */
    mqs_taddr_t             comm_ptr;
    int                     present;
    mqs_communicator        comm_info;		/* Info needed at the higher level */
} communicator_t;

#if defined(CODE_NOT_USED)
/**********************************************************************/
/* Functions to handle translation groups.
 * We have a list of these on the process info, so that we can
 * share the group between multiple communicators.
 */
/**********************************************************************/
/* Translate a process number */
static int translate (group_t *this, int index) 
{ 	
    if (index == MQS_INVALID_PROCESS ||
        ((unsigned int)index) >= ((unsigned int) this->entries))
        return MQS_INVALID_PROCESS;
    else
        return this->local_to_global[index]; 
} /* translate */

/**********************************************************************/
/* Reverse translate a process number i.e. global to local*/
static int reverse_translate (group_t * this, int index) 
{ 	
    int i;
    for ( i = 0; i < this->entries; i++ )
        if( this->local_to_global[i] == index )
            return i;

    return MQS_INVALID_PROCESS;
} /* reverse_translate */
#endif  /* CODE_NOT_USED */

/**********************************************************************/
/* Search the group list for this group, if not found create it.
 */
static group_t * find_or_create_group (mqs_process *proc,
				       mqs_taddr_t table)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    int intsize = p_info->sizes.int_size;
    communicator_t *comm  = p_info->communicator_list;
    int *tr;
    char *trbuffer;
    int i;
    group_t *g;
    int np;

    np = fetch_int( proc,
                    table + i_info->ompi_group_t.offset.grp_proc_count,
                    p_info );
    if( np < 0 ) {
        printf( "Get a size for the communicator = %d\n", np );
        return NULL;  /* Makes no sense ! */
    }
    /* Iterate over each communicator seeing if we can find this group */
    for (;comm; comm = comm->next) {
        g = comm->group;
        if (g && g->table_base == table) {
            g->ref_count++;			/* Someone else is interested */
            return g;
        }
    }

    /* Hmm, couldn't find one, so fetch it */	
    g = (group_t *)mqs_malloc (sizeof (group_t));
    tr = (int *)mqs_malloc (np*sizeof(int));
    trbuffer = (char *)mqs_malloc (np*intsize);
    g->local_to_global = tr;

    if (mqs_ok != mqs_fetch_data (proc, table, np*intsize, trbuffer) ) {
        mqs_free (g);
        mqs_free (tr);
        mqs_free (trbuffer);
        return NULL;
    }

    /* This code is assuming that sizeof(int) is the same on target and host...
     * that's a bit flaky, but probably actually OK.
     */
    for( i = 0; i < np; i++ )
        mqs_target_to_host( proc, trbuffer+intsize*i, &tr[i], intsize );

    mqs_free(trbuffer);

    g->entries = np;
    g->ref_count = 1;
    return g;
} /* find_or_create_group */

/***********************************************************************/
static void group_decref (group_t * group)
{
    if (--(group->ref_count) == 0) {
        mqs_free (group->local_to_global);
        mqs_free (group);
    }
} /* group_decref */

/***********************************************************************
 * Perform basic setup for the image, we just allocate and clear
 * our info.
 */
OMPI_DECLSPEC int mqs_setup_image (mqs_image *image, const mqs_image_callbacks *icb)
{
    mpi_image_info *i_info = (mpi_image_info *)mqs_malloc (sizeof (mpi_image_info));

    if (!i_info)
        return err_no_store;

    memset ((void *)i_info, 0, sizeof (mpi_image_info));
    i_info->image_callbacks = icb;		/* Before we do *ANYTHING* */

    mqs_put_image_info (image, (mqs_image_info *)i_info);
  
    return mqs_ok;
} /* mqs_setup_image */


/***********************************************************************
 * Check for all the information we require to access the Open MPI message queues.
 * Stash it into our structure on the image if we're succesful.
 */

OMPI_DECLSPEC int mqs_image_has_queues (mqs_image *image, char **message)
{
    mpi_image_info * i_info = (mpi_image_info *)mqs_get_image_info (image);
    char* missing_in_action;

    /* Default failure message ! */
    *message = "The symbols and types in the Open MPI library used by TotalView\n"
        "to extract the message queues are not as expected in\n"
        "the image '%s'\n"
        "No message queue display is possible.\n"
        "This is probably an Open MPI version or configuration problem.";

    /* Force in the file containing our breakpoint function, to ensure that 
     * types have been read from there before we try to look them up.
     */
    mqs_find_function (image, "MPIR_Breakpoint", mqs_lang_c, NULL);

    /* Are we supposed to ignore this ? (e.g. it's really an HPF runtime using the
     * Open MPI process acquisition, but not wanting queue display) 
     */
    if (mqs_find_symbol (image, "MPIR_Ignore_queues", NULL) == mqs_ok) {
        *message = NULL;				/* Fail silently */
        return err_silent_failure;
    }

    /**
     * Open MPI use a bunch of lists in order to kep track of the internal
     * objects. We have to make sure we're able to find all of them in the image
     * and compute their ofset in order to be able to parse them later.
     * We need to find the opal_list_item_t, the opal_list_t, the ompi_free_list_item_t,
     * and the ompi_free_list_t.
     *
     * Once we have these offsets, we should make sure that we have access to all
     * requests lists and types. We're looking here only at the basic type for the
     * requests as they hold all the information we need to export to the debugger.
     */
    {
        mqs_type* qh_type = mqs_find_type( image, "opal_list_item_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "opal_list_item_t";
            goto type_missing;
        }
        i_info->opal_list_item_t.size = mqs_sizeof(qh_type);
        i_info->opal_list_item_t.offset.opal_list_next = mqs_field_offset(qh_type, "opal_list_next");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "opal_list_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "opal_list_t";
            goto type_missing;
        }
        i_info->opal_list_t.size = mqs_sizeof(qh_type);
        i_info->opal_list_t.offset.opal_list_sentinel = mqs_field_offset(qh_type, "opal_list_sentinel");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_free_list_item_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_free_list_item_t";
            goto type_missing;
        }
        /* This is just an overloaded opal_list_item_t */
        i_info->ompi_free_list_item_t.size = mqs_sizeof(qh_type);
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_free_list_memory_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_free_list_memory_t";
            goto type_missing;
        }
        /* This is just an overloaded opal_list_item_t */
        i_info->ompi_free_list_memory_t.size = mqs_sizeof(qh_type);
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_free_list_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_free_list_t";
            goto type_missing;
        }
        i_info->ompi_free_list_t.size = mqs_sizeof(qh_type);
        i_info->ompi_free_list_t.offset.fl_elem_size = mqs_field_offset(qh_type, "fl_elem_size");
        i_info->ompi_free_list_t.offset.fl_header_space = mqs_field_offset(qh_type, "fl_header_space");
        i_info->ompi_free_list_t.offset.fl_alignment = mqs_field_offset(qh_type, "fl_alignment");
        i_info->ompi_free_list_t.offset.fl_allocations = mqs_field_offset(qh_type, "fl_allocations");
        i_info->ompi_free_list_t.offset.fl_max_to_alloc = mqs_field_offset(qh_type, "fl_max_to_alloc");
        i_info->ompi_free_list_t.offset.fl_num_per_alloc = mqs_field_offset(qh_type, "fl_num_per_alloc");
        i_info->ompi_free_list_t.offset.fl_num_allocated = mqs_field_offset(qh_type, "fl_num_allocated");
    }
    /**
     * Now let's look for all types required for reading the requests.
     */
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_request_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_request_t";
            goto type_missing;
        }
        i_info->ompi_request_t.size = mqs_sizeof(qh_type);
        i_info->ompi_request_t.offset.req_type = mqs_field_offset(qh_type, "req_type");
        i_info->ompi_request_t.offset.req_status = mqs_field_offset(qh_type, "req_status");
        i_info->ompi_request_t.offset.req_complete = mqs_field_offset(qh_type, "req_complete");
        i_info->ompi_request_t.offset.req_state = mqs_field_offset(qh_type, "req_state");
        i_info->ompi_request_t.offset.req_f_to_c_index = mqs_field_offset(qh_type, "req_f_to_c_index");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_base_request_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_base_request_t";
            goto type_missing;
        }
        i_info->mca_pml_base_request_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_base_request_t.offset.req_addr = mqs_field_offset(qh_type, "req_addr");
        i_info->mca_pml_base_request_t.offset.req_count = mqs_field_offset(qh_type, "req_count");
        i_info->mca_pml_base_request_t.offset.req_peer = mqs_field_offset(qh_type, "req_peer");
        i_info->mca_pml_base_request_t.offset.req_tag = mqs_field_offset(qh_type, "req_tag");
        i_info->mca_pml_base_request_t.offset.req_comm = mqs_field_offset(qh_type, "req_comm");
        i_info->mca_pml_base_request_t.offset.req_proc = mqs_field_offset(qh_type, "req_proc");
        i_info->mca_pml_base_request_t.offset.req_sequence = mqs_field_offset(qh_type, "req_sequence");
        i_info->mca_pml_base_request_t.offset.req_type = mqs_field_offset(qh_type, "req_type");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_base_send_request_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_base_send_request_t";
            goto type_missing;
        }
        i_info->mca_pml_base_send_request_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_base_send_request_t.offset.req_addr = mqs_field_offset(qh_type, "req_addr");
        i_info->mca_pml_base_send_request_t.offset.req_bytes_packed = mqs_field_offset(qh_type, "req_bytes_packed");
        i_info->mca_pml_base_send_request_t.offset.req_send_mode = mqs_field_offset(qh_type, "req_send_mode");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_base_recv_request_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_base_recv_request_t";
            goto type_missing;
        }
        i_info->mca_pml_base_recv_request_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_base_recv_request_t.offset.req_bytes_packed = mqs_field_offset(qh_type, "req_bytes_packed");
    }
    /**
     * Gather information about the received fragments and theirs headers.
     */
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_ob1_common_hdr_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_ob1_common_hdr_t";
            goto type_missing;
        }
        i_info->mca_pml_ob1_common_hdr_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_ob1_common_hdr_t.offset.hdr_type = mqs_field_offset(qh_type, "hdr_type");
        i_info->mca_pml_ob1_common_hdr_t.offset.hdr_flags = mqs_field_offset(qh_type, "hdr_flags");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_ob1_match_hdr_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_ob1_match_hdr_t";
            goto type_missing;
        }
        i_info->mca_pml_ob1_match_hdr_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_ob1_match_hdr_t.offset.hdr_common = mqs_field_offset(qh_type, "hdr_common");
        i_info->mca_pml_ob1_match_hdr_t.offset.hdr_ctx    = mqs_field_offset(qh_type, "hdr_ctx");
        i_info->mca_pml_ob1_match_hdr_t.offset.hdr_src    = mqs_field_offset(qh_type, "hdr_src");
        i_info->mca_pml_ob1_match_hdr_t.offset.hdr_tag    = mqs_field_offset(qh_type, "hdr_tag");
        i_info->mca_pml_ob1_match_hdr_t.offset.hdr_seq    = mqs_field_offset(qh_type, "hdr_seq");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "mca_pml_ob1_recv_frag_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "mca_pml_ob1_recv_frag_t";
            goto type_missing;
        }
        i_info->mca_pml_ob1_recv_frag_t.size = mqs_sizeof(qh_type);
        i_info->mca_pml_ob1_recv_frag_t.offset.hdr = mqs_field_offset(qh_type, "hdr");
        i_info->mca_pml_ob1_recv_frag_t.offset.request = mqs_field_offset(qh_type, "request");
    }

    /**
     * And now let's look at the communicator and group structures.
     */
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_pointer_array_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_pointer_array_t";
            goto type_missing;
        }
        i_info->ompi_pointer_array_t.size = mqs_sizeof(qh_type);
        i_info->ompi_pointer_array_t.offset.lowest_free = mqs_field_offset(qh_type, "lowest_free");
        i_info->ompi_pointer_array_t.offset.size = mqs_field_offset(qh_type, "size");
        i_info->ompi_pointer_array_t.offset.addr = mqs_field_offset(qh_type, "addr");
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_communicator_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_communicator_t";
            goto type_missing;
        }
        i_info->ompi_communicator_t.size = mqs_sizeof(qh_type);
        i_info->ompi_communicator_t.offset.c_name = mqs_field_offset(qh_type, "c_name");
        i_info->ompi_communicator_t.offset.c_contextid = mqs_field_offset(qh_type, "c_contextid");
        i_info->ompi_communicator_t.offset.c_my_rank = mqs_field_offset(qh_type, "c_my_rank" );
        i_info->ompi_communicator_t.offset.c_local_group = mqs_field_offset(qh_type, "c_local_group" );
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_group_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_group_t";
            goto type_missing;
        }
        i_info->ompi_group_t.size = mqs_sizeof(qh_type);
        i_info->ompi_group_t.offset.grp_proc_count = mqs_field_offset(qh_type, "grp_proc_count");
        i_info->ompi_group_t.offset.grp_my_rank = mqs_field_offset(qh_type, "grp_my_rank");
        i_info->ompi_group_t.offset.grp_flags = mqs_field_offset(qh_type, "grp_flags" );
    }
    {
        mqs_type* qh_type = mqs_find_type( image, "ompi_status_public_t", mqs_lang_c );
        if( !qh_type ) {
            missing_in_action = "ompi_status_public_t";
            goto type_missing;
        }
        i_info->ompi_status_public_t.size = mqs_sizeof(qh_type);
        i_info->ompi_status_public_t.offset.MPI_SOURCE = mqs_field_offset(qh_type, "MPI_SOURCE");
        i_info->ompi_status_public_t.offset.MPI_TAG = mqs_field_offset(qh_type, "MPI_TAG");
        i_info->ompi_status_public_t.offset.MPI_ERROR = mqs_field_offset(qh_type, "MPI_ERROR" );
        i_info->ompi_status_public_t.offset._count = mqs_field_offset(qh_type, "_count" );
        i_info->ompi_status_public_t.offset._cancelled = mqs_field_offset(qh_type, "_cancelled" );
    }

    /* All the types are here. Let's succesfully return. */
    return mqs_ok;

 type_missing:
    /**
     * One of the required types is missing in the image. We are unable to extract
     * the information we need from the pointers. We did our best but here
     * we're at our limit. Give up!
     */
    *message = missing_in_action;
    return err_missing_type;
} /* mqs_image_has_queues */

/***********************************************************************
 * Setup information needed for a specific process.
 * TV assumes that this will hang something onto the process,
 * if nothing is attached to it, then TV will believe that this process
 * has no message queue information.
 */
OMPI_DECLSPEC int mqs_setup_process (mqs_process *process, const mqs_process_callbacks *pcb)
{ 
    /* Extract the addresses of the global variables we need and save them away */
    mpi_process_info *p_info = (mpi_process_info *)mqs_malloc (sizeof (mpi_process_info));

    if (p_info) {
        mqs_image        *image;
        mpi_image_info *i_info;

        p_info->process_callbacks = pcb;

        /* Now we can get the rest of the info ! */
        image  = mqs_get_image (process);
        i_info = (mpi_image_info *)mqs_get_image_info (image);

        /* Library starts at zero, so this ensures we go look to start with */
        p_info->communicator_sequence = -1;
        /* We have no communicators yet */
        p_info->communicator_list     = NULL;
        mqs_get_type_sizes (process, &p_info->sizes);

        mqs_put_process_info (process, (mqs_process_info *)p_info);
      
        return mqs_ok;
    }
    return err_no_store;
} /* mqs_setup_process */

/***********************************************************************
 * Check the process for message queues.
 */
OMPI_DECLSPEC int mqs_process_has_queues (mqs_process *proc, char **msg)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);

    /* Don't bother with a pop up here, it's unlikely to be helpful */
    *msg = 0;

    if (mqs_find_symbol (image, "ompi_mpi_communicators", &p_info->commlist_base) != mqs_ok)
        return err_all_communicators;
  
    if (mqs_find_symbol (image, "mca_pml_base_send_requests", &p_info->send_queue_base) != mqs_ok)
        return err_mpid_sends;
  
    if (mqs_find_symbol (image, "mca_pml_base_recv_requests", &p_info->recv_queue_base) != mqs_ok)
        return err_mpid_recvs;
  
    return mqs_ok;
} /* mqs_setup_process_info */

/***********************************************************************
 * Check if the communicators have changed by looking at the 
 * sequence number.
 */
static int communicators_changed (mqs_process *proc)
{
#if 0  /* TODO: how do we figure out which communicators have changed ? */
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    mqs_tword_t new_seq = fetch_int (proc, 
                                     p_info->commlist_base+i_info->sequence_number_offs,
                                     p_info);
    int  res = (new_seq != p_info->communicator_sequence);
      
    /* Save the sequence number for next time */
    p_info->communicator_sequence = new_seq;

    return res;
#endif
    return 1;
} /* mqs_communicators_changed */

/***********************************************************************
 * Find a matching communicator on our list. We check the recv context
 * as well as the address since the communicator structures may be
 * being re-allocated from a free list, in which case the same
 * address will be re-used a lot, which could confuse us.
 */
static communicator_t * find_communicator (mpi_process_info *p_info,
					   int recv_ctx)
{
    communicator_t * comm = p_info->communicator_list;

    for (; comm; comm=comm->next) {
        if (comm->recv_context == recv_ctx)
            return comm;
    }

    return NULL;
} /* find_communicator */

/***********************************************************************
 * Comparison function for sorting communicators.
 */
static int compare_comms (const void *a, const void *b)
{
    communicator_t * ca = *(communicator_t **)a;
    communicator_t * cb = *(communicator_t **)b;

    return cb->recv_context - ca->recv_context;
} /* compare_comms */

/***********************************************************************
 * Rebuild our list of communicators because something has changed 
 */
static int rebuild_communicator_list (mqs_process *proc)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    communicator_t **commp, *old;
    int commcount = 0;
    int i;
    mqs_tword_t comm_size;
    mqs_taddr_t comm_addr_base = p_info->commlist_base + i_info->ompi_pointer_array_t.offset.addr;
    mqs_taddr_t comm_ptr;
    mqs_communicator remote_comm;

    /**
     * Start by getting the number of registered communicators in the
     * global communicator array.
     */
    comm_size = fetch_int( proc,
                           p_info->commlist_base + i_info->ompi_pointer_array_t.offset.size,
                           p_info );
    /* Now get the pointer to the first communicator pointer */
    comm_addr_base = fetch_pointer( proc, comm_addr_base, p_info );

    for( i = 0; i < comm_size; i++ ) {
        /* Get the communicator pointer */
        comm_ptr = 
            fetch_pointer( proc,
                           comm_addr_base + i * p_info->sizes.pointer_size,
                           p_info );
        if( 0 == comm_ptr ) continue;

        /* Now let's grab the data we want from inside */
        remote_comm.unique_id = fetch_int( proc,
                                           comm_ptr + i_info->ompi_communicator_t.offset.c_contextid,
                                           p_info );
        remote_comm.local_rank = fetch_int( proc,
                                            comm_ptr + i_info->ompi_communicator_t.offset.c_my_rank,
                                            p_info );
        mqs_fetch_data( proc, comm_ptr + i_info->ompi_communicator_t.offset.c_name,
                        64, remote_comm.name );

        /* Do we already have this communicator ? */
        old = find_communicator(p_info, remote_comm.unique_id);
        if( NULL == old ) {
            mqs_taddr_t group_base;

            old = (communicator_t *)mqs_malloc (sizeof (communicator_t));
            /* Save the results */
            old->next = p_info->communicator_list;
            p_info->communicator_list = old;
            old->comm_ptr  = comm_ptr;
            old->recv_context = remote_comm.unique_id;

            /* Now get the information about the group */
            group_base =
                fetch_pointer( proc, comm_ptr + i_info->ompi_communicator_t.offset.c_local_group,
                               p_info );
            old->group = find_or_create_group( proc, group_base );
            
        }
        strncpy(old->comm_info.name, remote_comm.name, 64);
        old->comm_info.unique_id = remote_comm.unique_id;
        old->comm_info.local_rank = remote_comm.local_rank;
        if( NULL != old->group ) {
            old->comm_info.size = old->group->entries;
        }
        old->present = TRUE;
    }

    /* Now iterate over the list tidying up any communicators which
     * no longer exist, and cleaning the flags on any which do.
     */
    commp = &p_info->communicator_list;

    for (; *commp; commp = &(*commp)->next) {
        communicator_t *comm = *commp;
        if (comm->present) {
            comm->present = FALSE;
            commcount++;
        } else { /* It needs to be deleted */
            *commp = comm->next;			/* Remove from the list */
            group_decref (comm->group);		/* Group is no longer referenced from here */
            mqs_free (comm);
            if( *commp == NULL ) break;
        }
    }

    if (commcount) {
        /* Sort the list so that it is displayed in some semi-sane order. */
        communicator_t ** comm_array =
            (communicator_t **) mqs_malloc(commcount * sizeof (communicator_t *));
        communicator_t *comm = p_info->communicator_list;

        for (i=0; i<commcount; i++, comm=comm->next)
            comm_array [i] = comm;

        /* Do the sort */
        qsort (comm_array, commcount, sizeof (communicator_t *), compare_comms);

        /* Rebuild the list */
        p_info->communicator_list = NULL;
        for (i=0; i<commcount; i++) {
            comm = comm_array[i];
            comm->next = p_info->communicator_list;
            p_info->communicator_list = comm;
        }

        mqs_free (comm_array);
    }

    return mqs_ok;
} /* rebuild_communicator_list */

/***********************************************************************
 * Update the list of communicators in the process if it has changed.
 */
OMPI_DECLSPEC int mqs_update_communicator_list (mqs_process *proc)
{
    if (communicators_changed (proc))
        return rebuild_communicator_list (proc);
    else
        return mqs_ok;
} /* mqs_update_communicator_list */

/***********************************************************************
 * Setup to iterate over communicators.
 * This is where we check whether our internal communicator list needs
 * updating and if so do it.
 */
OMPI_DECLSPEC int mqs_setup_communicator_iterator (mqs_process *proc)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);

    /* Start at the front of the list again */
    p_info->current_communicator = p_info->communicator_list;
    /* Reset the operation iterator too */
    p_info->next_msg.free_list            = 0;
    p_info->next_msg.current_item         = 0;
    p_info->next_msg.opal_list_t_pos.list = 0;

    return p_info->current_communicator == NULL ? mqs_end_of_list : mqs_ok;
} /* mqs_setup_communicator_iterator */

/***********************************************************************
 * Fetch information about the current communicator.
 */
OMPI_DECLSPEC int mqs_get_communicator (mqs_process *proc, mqs_communicator *comm)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);

    if (p_info->current_communicator) {
        *comm = p_info->current_communicator->comm_info;
  
        return mqs_ok;
    }
    return err_no_current_communicator;
} /* mqs_get_communicator */

/***********************************************************************
 * Get the group information about the current communicator.
 */
OMPI_DECLSPEC int mqs_get_comm_group (mqs_process *proc, int *group_members)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);
    communicator_t     *comm   = p_info->current_communicator;

    if (comm && comm->group) {
        group_t * g = comm->group;
        int i;

        for (i=0; i<g->entries; i++)
            group_members[i] = g->local_to_global[i];

        return mqs_ok;
    }
    return err_no_current_communicator;
} /* mqs_get_comm_group */

/***********************************************************************
 * Step to the next communicator.
 */
OMPI_DECLSPEC int mqs_next_communicator (mqs_process *proc)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);

    p_info->current_communicator = p_info->current_communicator->next;
  
    return (p_info->current_communicator != NULL) ? mqs_ok : mqs_end_of_list;
} /* mqs_next_communicator */

/**
 * Parsing the opal_list_t.
 */
static int opal_list_t_init_parser( mqs_process *proc, mpi_process_info *p_info,
                                    mqs_opal_list_t_pos* position, mqs_taddr_t list )
{
    mqs_image * image        = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);

    position->list = list;
    position->sentinel = position->list + i_info->opal_list_t.offset.opal_list_sentinel;
    position->current_item =
        fetch_pointer( proc, position->sentinel + i_info->opal_list_item_t.offset.opal_list_next,
                       p_info );
    if( position->current_item == position->sentinel )
        position->current_item = 0;
    return mqs_ok;
}

static int next_item_opal_list_t( mqs_process *proc, mpi_process_info *p_info,
                                  mqs_opal_list_t_pos* position, mqs_taddr_t* active_item )
{
    mqs_image * image        = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);

    *active_item = position->current_item;
    if( 0 == position->current_item )
        return mqs_end_of_list;

    position->current_item =
        fetch_pointer( proc,
                       position->current_item + i_info->opal_list_item_t.offset.opal_list_next,
                       p_info );
    if( position->current_item == position->sentinel )
        position->current_item = 0;
    return mqs_ok;
}

#if defined(CODE_NOT_USED)
/**
 * Parsing the ompi_free_list lists.
 *
 *
 *
 *
 */
static void ompi_free_list_t_dump_position( mqs_ompi_free_list_t_pos* position )
{
    printf( "position->opal_list_t_pos.current_item = 0x%llx\n", (long long)position->opal_list_t_pos.current_item );
    printf( "position->opal_list_t_pos.list         = 0x%llx\n", (long long)position->opal_list_t_pos.list );
    printf( "position->opal_list_t_pos.sentinel     = 0x%llx\n", (long long)position->opal_list_t_pos.sentinel );
    printf( "position->current_item                 = 0x%llx\n", (long long)position->current_item );
    printf( "position->upper_bound                  = 0x%llx\n", (long long)position->upper_bound );
    printf( "position->free_list                    = 0x%llx\n", (long long)position->free_list );
    printf( "position->fl_elem_size                 = %ld\n", (long)position->fl_elem_size );
    printf( "position->fl_header_space              = %ld\n", (long)position->fl_header_space );
    printf( "position->fl_alignment                 = %ld\n", (long)position->fl_alignment );
    printf( "position->fl_num_per_alloc             = %ld\n", (long)position->fl_num_per_alloc );
    printf( "position->fl_num_allocated             = %ld\n", (long)position->fl_num_allocated );
    printf( "position->fl_num_initial_alloc         = %ld\n", (long)position->fl_num_initial_alloc );
}
#endif  /* CODE_NOT_USED */

static int ompi_free_list_t_init_parser( mqs_process *proc, mpi_process_info *p_info,
                                         mqs_ompi_free_list_t_pos* position, mqs_taddr_t free_list )
{
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    mqs_taddr_t active_allocation;

    position->free_list = free_list;

    position->fl_elem_size =
        fetch_int( proc, position->free_list + i_info->ompi_free_list_t.offset.fl_elem_size,
                   p_info );
    position->fl_header_space =
        fetch_int( proc, position->free_list + i_info->ompi_free_list_t.offset.fl_header_space,
                   p_info );
    position->fl_alignment =
        fetch_int( proc, position->free_list + i_info->ompi_free_list_t.offset.fl_alignment,
                   p_info );
    position->fl_num_per_alloc =
        fetch_int( proc, position->free_list + i_info->ompi_free_list_t.offset.fl_num_per_alloc,
                   p_info );
    position->fl_num_allocated =
        fetch_int( proc, position->free_list + i_info->ompi_free_list_t.offset.fl_num_allocated,
                   p_info );
    /**
     * Work around the strange ompi_free_list_t way to allocate elements. The first chunk is
     * not required to have the same size as the others.
     * A similar work around should be set for the last chunk of allocations too !!! But how
     * can we solve ONE equation with 2 unknowns ?
     */
    if( position->fl_num_allocated <= position->fl_num_per_alloc ) {
        position->fl_num_initial_alloc = position->fl_num_allocated;
    } else {
        position->fl_num_initial_alloc = position->fl_num_allocated % position->fl_num_per_alloc;
        if( 0 == position->fl_num_initial_alloc )
            position->fl_num_initial_alloc = position->fl_num_per_alloc;
    }

    /**
     * Initialize the pointer to the opal_list_t.
     */
    opal_list_t_init_parser( proc, p_info, &position->opal_list_t_pos,
                             position->free_list + i_info->ompi_free_list_t.offset.fl_allocations );
    next_item_opal_list_t( proc, p_info, &position->opal_list_t_pos, &active_allocation );

    if( 0 == active_allocation ) {  /* the end of the list */
        position->upper_bound = 0;
    } else {
        /**
         * Handle alignment issues...
         */
        active_allocation += i_info->ompi_free_list_memory_t.size;
        if( 0 != position->fl_alignment ) {
            mqs_tword_t modulo;
            
            active_allocation += position->fl_header_space;
            modulo = active_allocation % position->fl_alignment;
            active_allocation += (position->fl_alignment - modulo);
            active_allocation -= position->fl_header_space;
        }
        /**
         * Now let's try to compute the upper bound ...
         */
        position->upper_bound =
            position->fl_num_initial_alloc * position->fl_elem_size + active_allocation;
    }
    position->current_item = active_allocation;
    
    /*ompi_free_list_t_dump_position( position );*/
    return mqs_ok;
}

/**
 * Return the current position and move the internal counter to the next element.
 */
static int ompi_free_list_t_next_item( mqs_process *proc, mpi_process_info *p_info,
                                       mqs_ompi_free_list_t_pos* position, mqs_taddr_t* active_item )
{
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    mqs_taddr_t active_allocation;

    *active_item = position->current_item;
    if( 0 == position->current_item )  /* the end ... */
        return mqs_ok;

    position->current_item += position->fl_elem_size;
    if( position->current_item >= position->upper_bound ) {
        /*printf( "Reach the end of one of the ompi_free_list_t allocations. Go to the next one\n" );*/
        /* we should go to the next allocation */
        next_item_opal_list_t( proc, p_info,
                               &position->opal_list_t_pos, &active_allocation );
        if( 0 == active_allocation ) { /* we're at the end */
            position->current_item = 0;
            return mqs_ok;
        }
        /**
         * Handle alignment issues...
         */
        active_allocation += i_info->ompi_free_list_memory_t.size;
        if( 0 != position->fl_alignment ) {
            mqs_tword_t modulo;

            active_allocation += position->fl_header_space;
            modulo = active_allocation % position->fl_alignment;
            active_allocation += (position->fl_alignment - modulo);
            active_allocation -= position->fl_header_space;
        }
        /**
         * Now let's try to compute the upper bound ...
         */
        position->upper_bound =
            position->fl_num_per_alloc * position->fl_elem_size + active_allocation;
        position->current_item = active_allocation;
        /*ompi_free_list_t_dump_position( position );*/
    }
    /*printf( "Free list actual position %p next element at %p\n", (void*)*active_item,
      (void*)position->current_item );*/
    return mqs_ok;
}

#if defined(CODE_NOT_USED)
static void dump_request( mqs_taddr_t current_item, mqs_pending_operation *res )
{
    printf( "\n+===============================================+\n" );
    printf(   "|Request 0x%llx contain \n", (long long)current_item );
    printf(   "|    res->status              = %d\n", res->status );
    printf(   "|    res->desired_local_rank  = %ld\n", (long)res->desired_local_rank );
    printf(   "|    res->desired_global_rank = %ld\n", (long)res->desired_global_rank );
    printf(   "|    res->tag_wild            = %ld\n", (long)res->tag_wild );
    printf(   "|    res->desired_tag         = %ld\n", (long)res->desired_tag );
    printf(   "|    res->system_buffer       = %s\n", (TRUE == res->system_buffer ? "TRUE" : "FALSE") );
    printf(   "|    res->buffer              = 0x%llx\n", (long long)res->buffer );
    printf(   "|    res->desired_length      = %ld\n", (long)res->desired_length );
    if( res->status != mqs_st_pending ) {
        printf(   "|    res->actual_length       = %ld\n", (long)res->actual_length );
        printf(   "|    res->actual_tag          = %ld\n", (long)res->actual_tag );
        printf(   "|    res->actual_local_rank   = %ld\n", (long)res->actual_local_rank );
        printf(   "|    res->actual_global_rank  = %ld\n", (long)res->actual_global_rank );
    }
    printf(   "+===============================================+\n\n" );
}
#endif  /* CODE_NOT_USED */

/**
 * TODO: ompi_request_completed can be used to detect any changes in the request handles.
 */

/**
 * Handle the send queue as well as the receive queue. The unexpected queue
 * is a whole different story ...
 */
static int fetch_request( mqs_process *proc, mpi_process_info *p_info,
			  mqs_pending_operation *res, int look_for_user_buffer )
{
    mqs_image * image        = mqs_get_image (proc);
    mpi_image_info *i_info   = (mpi_image_info *)mqs_get_image_info (image);
    mqs_taddr_t current_item;
    mqs_tword_t req_complete, req_valid, req_type;
    mqs_taddr_t req_buffer, req_comm;

    while( 1 ) {
        ompi_free_list_t_next_item( proc, p_info,
                                    &p_info->next_msg, &current_item );
        if( 0 == current_item )
            return mqs_end_of_list;
        req_valid = fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_state, p_info );
        if( OMPI_REQUEST_INVALID == req_valid ) continue;
        req_comm = fetch_pointer( proc, current_item + i_info->mca_pml_base_request_t.offset.req_comm, p_info );
        if( p_info->current_communicator->comm_ptr == req_comm ) break;
    }

    res->extra_text[0][0] = 0; res->extra_text[1][0] = 0; res->extra_text[2][0] = 0;
    res->extra_text[3][0] = 0; res->extra_text[4][0] = 0;

    req_type = fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_type, p_info );
    if( OMPI_REQUEST_PML == req_type ) {
        req_type =
            fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_type,
                       p_info);
        req_complete = fetch_bool( proc, current_item + i_info->ompi_request_t.offset.req_complete, p_info );
        res->status = (req_complete == 0 ? mqs_st_pending : mqs_st_complete);

        res->desired_local_rank  =
            fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_peer, p_info );
        res->desired_global_rank = res->desired_local_rank;
        res->desired_tag         =
            fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_tag, p_info );
        res->tag_wild            = (MPI_ANY_TAG == res->desired_tag ? TRUE : FALSE);
        
        res->buffer = fetch_pointer( proc, current_item + i_info->mca_pml_base_request_t.offset.req_addr,
                                    p_info );
        res->system_buffer = FALSE;
        if( MCA_PML_REQUEST_SEND == req_type ) {
            snprintf( (char *)res->extra_text[0], 64, "Non-blocking send 0x%llx", (long long)current_item );
            req_buffer =
                fetch_pointer( proc, current_item + i_info->mca_pml_base_send_request_t.offset.req_addr,
                               p_info );
            res->system_buffer = ( req_buffer == res->buffer ? FALSE : TRUE );
            res->desired_length      =
                fetch_int( proc,
                           current_item + i_info->mca_pml_base_send_request_t.offset.req_bytes_packed, p_info );
        } else if( MCA_PML_REQUEST_RECV == req_type ) {
            snprintf( (char *)res->extra_text[0], 64, "Non-blocking recv 0x%llx", (long long)current_item );
        } else {
            snprintf( (char *)res->extra_text[0], 64, "Unknown type of request 0x%llx", (long long)current_item );
        }
        res->desired_length      =
            fetch_int( proc, current_item + i_info->mca_pml_base_request_t.offset.req_count, p_info );
        
        if( mqs_st_pending != res->status ) {  /* The real data from the status */
            res->actual_length       =
                fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
                           i_info->ompi_status_public_t.offset._count, p_info );
            res->actual_tag          =
                fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
                           i_info->ompi_status_public_t.offset.MPI_TAG, p_info );
            res->actual_local_rank   =
                fetch_int( proc, current_item + i_info->ompi_request_t.offset.req_status +
                           i_info->ompi_status_public_t.offset.MPI_SOURCE, p_info );
            res->actual_global_rank  = res->actual_local_rank;  /* TODO: what's the global rank ? */
        }
        /*dump_request( current_item, res );*/
    }
    return mqs_ok;
}

#if 0
/***********************************************************************
 * Handle the unexpected queue and the pending receive queue.
 * They're very similar.
 */
static int fetch_receive (mqs_process *proc, mpi_process_info *p_info,
			  mqs_pending_operation *res, int look_for_user_buffer)
{
    mqs_image * image          = mqs_get_image (proc);
    mpi_image_info *i_info     = (mpi_image_info *)mqs_get_image_info (image);
    communicator_t   *comm     = p_info->current_communicator;
    mqs_tword_t wanted_context = comm->recv_context;
    mqs_taddr_t base           = fetch_pointer (proc, p_info->next_msg, p_info);

    while (base != 0) { /* Well, there's a queue, at least ! */
        mqs_tword_t actual_context = fetch_int (proc, base + i_info->context_id_offs, p_info);
      
        if (actual_context == wanted_context) { /* Found a good one */
            mqs_tword_t tag     = fetch_int (proc, base + i_info->tag_offs, p_info);
            mqs_tword_t tagmask = fetch_int (proc, base + i_info->tagmask_offs, p_info);
            mqs_tword_t lsrc    = fetch_int (proc, base + i_info->lsrc_offs, p_info);
            mqs_tword_t srcmask = fetch_int (proc, base + i_info->srcmask_offs, p_info);
            mqs_taddr_t ptr     = fetch_pointer (proc, base + i_info->ptr_offs, p_info);
	  
            /* Fetch the fields from the MPIR_RHANDLE */
            int is_complete = fetch_int (proc, ptr + i_info->is_complete_offs, p_info);
            mqs_taddr_t buf     = fetch_pointer (proc, ptr + i_info->buf_offs, p_info);
            mqs_tword_t len     = fetch_int (proc, ptr + i_info->len_offs, p_info);
            mqs_tword_t count   = fetch_int (proc, ptr + i_info->count_offs, p_info);

            /* If we don't have start, then use buf instead... */
            mqs_taddr_t start;
            if (i_info->start_offs < 0)
                start = buf;
            else
                start = fetch_pointer (proc, ptr + i_info->start_offs, p_info);

            /* Hurrah, we should now be able to fill in all the necessary fields in the
             * result !
             */
            res->status = is_complete ? mqs_st_complete : mqs_st_pending; /* We can't discern matched */
            if (srcmask == 0) {
                res->desired_local_rank  = -1;
                res->desired_global_rank = -1;
            } else {
                res->desired_local_rank  = lsrc;
                res->desired_global_rank = translate (comm->group, lsrc);
	      
            }
            res->tag_wild       = (tagmask == 0);
            res->desired_tag    = tag;
	  
            if (look_for_user_buffer) {
                res->system_buffer  = FALSE;
                res->buffer         = buf;
                res->desired_length = len;
            } else {
                res->system_buffer  = TRUE;
                /* Correct an oddity. If the buffer length is zero then no buffer
                 * is allocated, but the descriptor is left with random data.
                 */
                if (count == 0)
                    start = 0;
	      
                res->buffer         = start;
                res->desired_length = count;
            }

            if (is_complete) { /* Fill in the actual results, rather than what we were looking for */
                mqs_tword_t mpi_source  = fetch_int (proc, ptr + i_info->MPI_SOURCE_offs, p_info);
                mqs_tword_t mpi_tag  = fetch_int (proc, ptr + i_info->MPI_TAG_offs, p_info);

                res->actual_length     = count;
                res->actual_tag        = mpi_tag;
                res->actual_local_rank = mpi_source;
                res->actual_global_rank= translate (comm->group, mpi_source);
            }

            /* Don't forget to step the queue ! */
            p_info->next_msg = base + i_info->next_offs;
            return mqs_ok;
        } else { /* Try the next one */
            base = fetch_pointer (proc, base + i_info->next_offs, p_info);
        }
    }
  
    p_info->next_msg = 0;
    return mqs_end_of_list;
}  /* fetch_receive */

/***********************************************************************
 * Handle the send queue, somewhat different.
 */
static int fetch_send (mqs_process *proc, mpi_process_info *p_info,
		       mqs_pending_operation *res)
{
    mqs_image * image        = mqs_get_image (proc);
    mpi_image_info *i_info = (mpi_image_info *)mqs_get_image_info (image);
    communicator_t   *comm   = p_info->current_communicator;
    mqs_taddr_t base         = fetch_pointer (proc, p_info->next_msg, p_info);

    /**
     * Mark all send requests as non blocking. In Open MPI we are able to make
     * a difference between blocking and non blocking by looking into the
     * type field, but I'll keep this for later.
     */
    strcpy( (char *)res->extra_text[0], "Non-blocking send" );
    res->extra_text[1][0] = 0;

    while (base != 0) { /* Well, there's a queue, at least ! */
        /* Check if it's one we're interested in ? */
        mqs_taddr_t commp = fetch_pointer (proc, base+i_info->db_comm_offs, p_info);
        int recv_ctx = fetch_int (proc, commp+i_info->recv_context_offs, p_info);

        mqs_taddr_t next  = base+i_info->db_next_offs;

        if (recv_ctx == comm->recv_context) { /* Found one */
            mqs_tword_t target = fetch_int (proc, base+i_info->db_target_offs,      p_info);
            mqs_tword_t tag    = fetch_int (proc, base+i_info->db_tag_offs,         p_info);
            mqs_tword_t length = fetch_int (proc, base+i_info->db_byte_length_offs, p_info);
            mqs_taddr_t data   = fetch_pointer (proc, base+i_info->db_data_offs,    p_info);
            mqs_taddr_t shandle= fetch_pointer (proc, base+i_info->db_shandle_offs, p_info);
            mqs_tword_t complete=fetch_int (proc, shandle+i_info->is_complete_offs, p_info);

            /* Ok, fill in the results */
            res->status = complete ? mqs_st_complete : mqs_st_pending; /* We can't discern matched */
            res->actual_local_rank = res->desired_local_rank = target;
            res->actual_global_rank= res->desired_global_rank= translate (comm->group, target);
            res->tag_wild   = FALSE;
            res->actual_tag = res->desired_tag = tag;
            res->desired_length = res->actual_length = length;
            res->system_buffer  = FALSE;
            res->buffer = data;

            p_info->next_msg = next;
            return mqs_ok;
        }
      
        base = fetch_pointer (proc, next, p_info);
    }

    p_info->next_msg = 0;
    return mqs_end_of_list;
} /* fetch_send */
#endif

/***********************************************************************
 * Setup to iterate over pending operations 
 */
OMPI_DECLSPEC int mqs_setup_operation_iterator (mqs_process *proc, int op)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);

    p_info->what = (mqs_op_class)op;

    switch (op) {
    case mqs_pending_sends:
        ompi_free_list_t_init_parser( proc, p_info, &p_info->next_msg, p_info->send_queue_base );
        return mqs_ok;

    case mqs_pending_receives:
        ompi_free_list_t_init_parser( proc, p_info, &p_info->next_msg, p_info->recv_queue_base );
        return mqs_ok;

    case mqs_unexpected_messages:  /* TODO */
        return mqs_no_information;

    default:
        return err_bad_request;
    }
} /* mqs_setup_operation_iterator */

/***********************************************************************
 * Fetch the next valid operation. 
 * Since Open MPI only maintains a single queue of each type of operation,
 * we have to run over it and filter out the operations which
 * match the active communicator.
 */
OMPI_DECLSPEC int mqs_next_operation (mqs_process *proc, mqs_pending_operation *op)
{
    mpi_process_info *p_info = (mpi_process_info *)mqs_get_process_info (proc);

    switch (p_info->what) {
    case mqs_pending_receives:
        return fetch_request( proc, p_info, op, TRUE );
    case mqs_unexpected_messages:
        /* TODO: not handled yet */
        return err_bad_request;
    case mqs_pending_sends:
        return fetch_request( proc, p_info, op, FALSE );
    default: return err_bad_request;
    }
} /* mqs_next_operation */

/***********************************************************************
 * Destroy the info.
 */
OMPI_DECLSPEC void mqs_destroy_process_info (mqs_process_info *mp_info)
{
    mpi_process_info *p_info = (mpi_process_info *)mp_info;
    /* Need to handle the communicators and groups too */
    communicator_t *comm = p_info->communicator_list;

    while (comm) {
        communicator_t *next = comm->next;

        if( NULL != comm->group )
            group_decref (comm->group);  /* Group is no longer referenced from here */
        mqs_free (comm);
      
        comm = next;
    }
    mqs_free (p_info);
} /* mqs_destroy_process_info */

/***********************************************************************
 * Free off the data we associated with an image. Since we malloced it
 * we just free it.
 */
OMPI_DECLSPEC void mqs_destroy_image_info (mqs_image_info *info)
{
    mqs_free (info);
} /* mqs_destroy_image_info */

/***********************************************************************/
static mqs_taddr_t fetch_pointer (mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info)
{
    int asize = p_info->sizes.pointer_size;
    char data [8];				/* ASSUME a pointer fits in 8 bytes */
    mqs_taddr_t res = 0;

    if (mqs_ok == mqs_fetch_data (proc, addr, asize, data))
        mqs_target_to_host (proc, data, 
                            ((char *)&res) + (host_is_big_endian ? sizeof(mqs_taddr_t)-asize : 0), 
                            asize);

    return res;
} /* fetch_pointer */

/***********************************************************************/
static mqs_tword_t fetch_int (mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info)
{
    int isize = p_info->sizes.int_size;
    char buffer[8];				/* ASSUME an integer fits in 8 bytes */
    mqs_tword_t res = 0;

    if (mqs_ok == mqs_fetch_data (proc, addr, isize, buffer))
        mqs_target_to_host (proc, buffer, 
                            ((char *)&res) + (host_is_big_endian ? sizeof(mqs_tword_t)-isize : 0), 
                            isize);
  
    return res;
} /* fetch_int */

/***********************************************************************/
static mqs_tword_t fetch_bool(mqs_process * proc, mqs_taddr_t addr, mpi_process_info *p_info)
{
    int isize = 1;
    char buffer;				/* ASSUME an integer fits in 8 bytes */
    mqs_tword_t res = 0;

    if (mqs_ok == mqs_fetch_data (proc, addr, isize, &buffer))
        res = (mqs_tword_t)buffer;
  
    return res;
} /* fetch_bool */

/***********************************************************************/
/* Convert an error code into a printable string */
OMPI_DECLSPEC char * mqs_dll_error_string (int errcode)
{
    switch (errcode) {
    case err_silent_failure:
        return "";
    case err_no_current_communicator: 
        return "No current communicator in the communicator iterator";
    case err_bad_request:    
        return "Attempting to setup to iterate over an unknown queue of operations";
    case err_no_store: 
        return "Unable to allocate store";
    case err_failed_qhdr: 
        return "Failed to find type MPID_QHDR";
    case err_unexpected: 
        return "Failed to find field 'unexpected' in MPID_QHDR";
    case err_posted: 
        return "Failed to find field 'posted' in MPID_QHDR";
    case err_failed_queue: 
        return "Failed to find type MPID_QUEUE";
    case err_first: 
        return "Failed to find field 'first' in MPID_QUEUE";
    case err_context_id: 
        return "Failed to find field 'context_id' in MPID_QEL";
    case err_tag: 
        return "Failed to find field 'tag' in MPID_QEL";
    case err_tagmask: 
        return "Failed to find field 'tagmask' in MPID_QEL";
    case err_lsrc: 
        return "Failed to find field 'lsrc' in MPID_QEL";
    case err_srcmask: 
        return "Failed to find field 'srcmask' in MPID_QEL";
    case err_next: 
        return "Failed to find field 'next' in MPID_QEL";
    case err_ptr: 
        return "Failed to find field 'ptr' in MPID_QEL";
    case err_missing_type: 
        return "Failed to find some type";
    case err_missing_symbol: 
        return "Failed to find field the global symbol";
    case err_db_shandle: 
        return "Failed to find field 'db_shandle' in MPIR_SQEL";
    case err_db_comm: 
        return "Failed to find field 'db_comm' in MPIR_SQEL";
    case err_db_target: 
        return "Failed to find field 'db_target' in MPIR_SQEL";
    case err_db_tag: 
        return "Failed to find field 'db_tag' in MPIR_SQEL";
    case err_db_data: 
        return "Failed to find field 'db_data' in MPIR_SQEL";
    case err_db_byte_length: 
        return "Failed to find field 'db_byte_length' in MPIR_SQEL";
    case err_db_next: 
        return "Failed to find field 'db_next' in MPIR_SQEL";
    case err_failed_rhandle: 
        return "Failed to find type MPIR_RHANDLE";
    case err_is_complete: 
        return "Failed to find field 'is_complete' in MPIR_RHANDLE";
    case err_buf: 
        return "Failed to find field 'buf' in MPIR_RHANDLE";
    case err_len: 
        return "Failed to find field 'len' in MPIR_RHANDLE";
    case err_s: 
        return "Failed to find field 's' in MPIR_RHANDLE";
    case err_failed_status: 
        return "Failed to find type MPI_Status";
    case err_count: 
        return "Failed to find field 'count' in MPIR_Status";
    case err_MPI_SOURCE: 
        return "Failed to find field 'MPI_SOURCE' in MPIR_Status";
    case err_MPI_TAG: 
        return "Failed to find field 'MPI_TAG' in MPIR_Status";
    case err_failed_commlist: 
        return "Failed to find type MPIR_Comm_list";
    case err_sequence_number: 
        return "Failed to find field 'sequence_number' in MPIR_Comm_list";
    case err_comm_first: 
        return "Failed to find field 'comm_first' in MPIR_Comm_list";
    case err_failed_communicator: 
        return "Failed to find type MPIR_Communicator";
    case err_lrank_to_grank: 
        return "Failed to find field 'lrank_to_grank' in MPIR_Communicator";
    case err_send_context: 
        return "Failed to find field 'send_context' in MPIR_Communicator";
    case err_recv_context: 
        return "Failed to find field 'recv_context' in MPIR_Communicator";
    case err_comm_next: 
        return "Failed to find field 'comm_next' in MPIR_Communicator";
    case err_comm_name: 
        return "Failed to find field 'comm_name' in MPIR_Communicator";
    case err_all_communicators: 
        return "Failed to find the global symbol MPIR_All_communicators";
    case err_mpid_sends: 
        return "Failed to access the global send requests list";
    case err_mpid_recvs: 
        return "Failed to access the global receive requests list";
    case err_group_corrupt:
        return "Could not read a communicator's group from the process (probably a store corruption)";

    default: return "Unknown error code";
    }
} /* mqs_dll_error_string */