dll_mpich2.c

fortran并行计算包

/* -*- Mode: C; c-basic-offset:4 ; -*- */
/*  
 *  (C) 2005 by Argonne National Laboratory.
 *      See COPYRIGHT in top-level directory.
 */

/* Fixme: include the mpichconf.h file? */

#include <stdlib.h>
#include <stdint.h>
#include <string.h>
#include "mpi.h"

/* MPIR_dll_name is defined in dbg_init.c; it must be part of the target image,
   not the debugger interface */

/* mpi_interface.h defines the interface to the debugger.  This interface
   is the same for any MPI implementation, for a given debugger 
   (a more precise name might be mpi_tv_interface.h) */
#include "mpi_interface.h"
/* mpich2_dll_defs.h defines the structures for a particular MPI 
   implementation (MPICH2 in this case) */
#include "mpich2_dll_defs.h"

/* style: allow:strncpy:1 sig:0 */

/* ------------------------------------------------------------------------ */
/* Local variables for this package */

static const mqs_basic_callbacks *mqs_basic_entrypoints = 0;
static int host_is_big_endian = -1;

/* ------------------------------------------------------------------------ */
/* Error values. */
enum {
    err_silent_failure = mqs_first_user_code, 

    err_no_current_communicator,
    err_bad_request,
    err_no_store, 
    err_all_communicators, 
    err_group_corrupt,

  err_failed_qhdr,
    err_unexpected,
    err_posted,

  err_failed_queue,
    err_first,

};

/* Internal functions used only by routines in this package */
static void mqs_free_communicator_list( struct communicator_t *comm );

static int communicators_changed (mqs_process *proc);
static int rebuild_communicator_list (mqs_process *proc);
static int compare_comms (const void *a, const void *b);


/* ------------------------------------------------------------------------ */
/* 
 * Many of the services used by this file are performed by calling 
 * functions executed by the debugger.  In other words, these are routines
 * that the debugger must export to this package.  To make it easy to 
 * identify these functions as well as to make their use simple,
 * we use macros that start with dbgr_xxx (for debugger).  These 
 * function pointers are set early in the initialization phase.
 *
 * Note: to avoid any changes to the mpi_interface.h file, the fields in
 * the structures that contain the function pointers have not been 
 * renamed dbgr_xxx and continue to use their original mqs_ prefix.  
 * Using the dbgr_ prefix for the debugger-provided callbacks was done to
 * make it more obvious whether the debugger or the MPI interface DLL is
 * responsible for providing the function.
 */
#define dbgr_malloc           (mqs_basic_entrypoints->mqs_malloc_fp)
#define dbgr_free             (mqs_basic_entrypoints->mqs_free_fp)
#define dbgr_prints           (mqs_basic_entrypoints->mqs_eprints_fp)
#define dbgr_put_image_info   (mqs_basic_entrypoints->mqs_put_image_info_fp)
#define dbgr_get_image_info   (mqs_basic_entrypoints->mqs_get_image_info_fp)
#define dbgr_put_process_info (mqs_basic_entrypoints->mqs_put_process_info_fp)
#define dbgr_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 dbgr_find_type        (i_info->image_callbacks->mqs_find_type_fp)
#define dbgr_field_offset     (i_info->image_callbacks->mqs_field_offset_fp)
#define dbgr_get_type_sizes   (i_info->image_callbacks->mqs_get_type_sizes_fp)
#define dbgr_find_function    (i_info->image_callbacks->mqs_find_function_fp)
#define dbgr_find_symbol      (i_info->image_callbacks->mqs_find_symbol_fp)

#define dbgr_get_image        (p_info->process_callbacks->mqs_get_image_fp)
#define dbgr_get_global_rank  (p_info->process_callbacks->mqs_get_global_rank_fp)
#define dbgr_fetch_data       (p_info->process_callbacks->mqs_fetch_data_fp)
#define dbgr_target_to_host   (p_info->process_callbacks->mqs_target_to_host_fp)

/* Routines to access data within the process */
static mqs_taddr_t fetch_pointer (mqs_process * proc, mqs_taddr_t addr, 
				  mpich_process_info *p_info);
static mqs_tword_t fetch_int (mqs_process * proc, mqs_taddr_t addr, 
			      mpich_process_info *p_info);
static mqs_tword_t fetch_int16 (mqs_process * proc, mqs_taddr_t addr, 
				mpich_process_info *p_info);

/* ------------------------------------------------------------------------ */
/* Startup calls 
   These three routines are the first ones invoked by the debugger; they
   are used to ensure that the debug interface library is a known version.
*/
int mqs_version_compatibility ( void )
{
  return MQS_INTERFACE_COMPATIBILITY;
} 

char *mqs_version_string ( void )
{
  return "ETNUS MPICH message queue support for MPICH2 1.0 compiled on " __DATE__;
} 

/* Allow the debugger to discover the size of an address type */
int mqs_dll_taddr_width (void)
{
  return sizeof (mqs_taddr_t);
} 

/* ------------------------------------------------------------------------ */
/* Initialization 
   
   The function mqs_setup_basic_callbacks is used by the debugger to 
   inform the routines in this file of the addresses of functions that 
   it may call in the debugger.

   The function mqs_setup_image creates the image structure (local to this
   file) and tell the debugger about it

   The function mqs_image_has_queues initializes the image structure.  
   Much of the information that is saved in the image structure is information
   about the relative offset to data within an MPICH2 data structure.
   These offsets allow the debugger to retrieve information about the
   MPICH2 structures.  The debugger routine dbgr_find_type is used to 
   find information on an named type, and dbgr_field_offset is used 
   to get the offset of a named field within a type.

   The function mqs_setup_process(process, callbacks) creates a private 
   process information structure and stores a pointer to it in process 
   (using dbgr_put_process_info).  The use of a routine to store this 
   value rather than passing an address to the process structure is 
   done to give the debugger control over any operation that might store
   into the debuggers memory (instead, we'll use put_xxx_info).

   The function mqs_process_has_queues ??
 */
void mqs_setup_basic_callbacks (const mqs_basic_callbacks * cb)
{
  int t = 1;

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

/* 
   Allocate and setup the basic image data structure.  Also 
   save the callbacks provided by the debugger; these will be used
   to access information about the image.  This memory may be recovered
   with mqs_destroy_image_info.
 */
int mqs_setup_image (mqs_image *image, const mqs_image_callbacks *icb)
{
    mpich_image_info *i_info = 
      (mpich_image_info *)dbgr_malloc (sizeof (mpich_image_info));
    
    if (!i_info)
	return err_no_store;

    memset ((void *)i_info, 0, sizeof (mpich_image_info));
    i_info->image_callbacks = icb;		/* Before we do *ANYTHING* */
   
    /* Tell the debugger to associate i_info with image */
    dbgr_put_image_info (image, (mqs_image_info *)i_info);
    
    return mqs_ok;
} 

/*
 * Setup information needed to access the queues.  If successful, return
 * mqs_ok.  If not, return an erro rcode.  Also set the message pointer
 * with an explanatory message if there is a problem; otherwise, set it
 * to NULL.
 *
 * This routine is where much of the information specific to an MPI 
 * implementation is used.  In particular, the names of the structures
 * internal to an implementation and their fields are used here.  
 *
 * FIXME: some of this information is specific to particular devices.
 * For example, the message queues are defined by the device.  How do
 * we export this information?  Should the queue code itself be responsible
 * for this (either by calling a routine in the image, using 
 * dbgr_find_function (?) or by having the queue implementation provide a
 * separate file that can be included here to get the necessary information.
 */
int mqs_image_has_queues (mqs_image *image, char **message)
{
    mpich_image_info * i_info = 
	(mpich_image_info *)dbgr_get_image_info (image);
    int have_co = 0, have_cl = 0, have_req = 0, have_dreq = 0;

    /* Default failure message ! */
    *message = "The symbols and types in the MPICH 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 MPICH 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.
     */
    dbgr_find_function (image, "MPIR_Breakpoint", mqs_lang_c, NULL);

    /* Find the various global variables and structure definitions 
       that describe the communicator and message queue structures for
       the MPICH2 implementation */

    /* First, the communicator information.  This is in two parts:
       MPIR_All_Communicators - a structure containing the head of the
       list of all active communicators.  The type is MPIR_Comm_list.
       The communicators themselves are of type MPID_Comm.
    */
    {
	mqs_type *cl_type = dbgr_find_type( image, "MPIR_Comm_list", 
					    mqs_lang_c );
	if (cl_type) {
	    have_cl = 1;
	    i_info->sequence_number_offs = 
		dbgr_field_offset( cl_type, "sequence_number" );
	    i_info->comm_head_offs = dbgr_field_offset( cl_type, "head" );
	}
    }
    {
	mqs_type *co_type = dbgr_find_type( image, "MPID_Comm", mqs_lang_c );
	if (co_type) {
	    have_co = 1;
	    i_info->comm_name_offs = dbgr_field_offset( co_type, "name" );
	    i_info->comm_next_offs = dbgr_field_offset( co_type, "comm_next" );
	    i_info->comm_rsize_offs = dbgr_field_offset( co_type, "remote_size" );
	    i_info->comm_rank_offs = dbgr_field_offset( co_type, "rank" );
	    i_info->comm_context_id_offs = dbgr_field_offset( co_type, "context_id" );
	    i_info->comm_recvcontext_id_offs = dbgr_field_offset( co_type, "recvcontext_id" );
	}
    }

    /* Now the receive queues.  The receive queues contain MPID_Request
       objects, and the various fields are within types in that object.
       To simplify the eventual access, we compute all offsets relative to the
       request.  This means diving into the types that make of the 
       request definition */
    {
	mqs_type *req_type = dbgr_find_type( image, "MPID_Request", mqs_lang_c );
	if (req_type) {
	    have_req = 1;
	    int dev_offs;
	    dev_offs = dbgr_field_offset( req_type, "dev" );
	    i_info->req_status_offs = dbgr_field_offset( req_type, "status" );
	    i_info->req_cc_offs     = dbgr_field_offset( req_type, "cc" );
	    if (dev_offs >= 0) {
		mqs_type *dreq_type = dbgr_find_type( image, "MPIDI_Request", 
						      mqs_lang_c );
		i_info->req_dev_offs = dev_offs;
		if (dreq_type) {
		    int loff, match_offs;
		    have_dreq = 1;
		    loff = dbgr_field_offset( dreq_type, "next" );
		    i_info->req_next_offs = dev_offs + loff;
		    match_offs = dbgr_field_offset( dreq_type, "match" );
		    if (match_offs >= 0) {
			mqs_type *match_type = dbgr_find_type( image, "MPIDI_Message_match", mqs_lang_c );
			if (match_type) {
			    int moff;
			    moff = dbgr_field_offset( match_type, "tag" );
			    i_info->req_tag_offs = dev_offs + match_offs + moff;
			    moff = dbgr_field_offset( match_type, "rank" );
			    i_info->req_rank_offs = dev_offs + match_offs + moff;
			    moff = dbgr_field_offset( match_type, "context_id" );
			    i_info->req_context_id_offs = dev_offs + match_offs + moff;
			}
		    }
		}
	    }
	}
    }

    /* Send queues use a separate system */
    {
	mqs_type *sreq_type = dbgr_find_type( image, "MPIR_Sendq", mqs_lang_c );
	if (sreq_type) {
	    i_info->sendq_next_offs = dbgr_field_offset( sreq_type, "next" );
	    i_info->sendq_tag_offs  = dbgr_field_offset( sreq_type, "tag" );
	    i_info->sendq_rank_offs  = dbgr_field_offset( sreq_type, "rank" );
	    i_info->sendq_context_id_offs  = dbgr_field_offset( sreq_type, "context_id" );
	}
    }

    return mqs_ok;
    /* FIXME: This function is not yet implemented */
    return err_silent_failure;
}
/* mqs_setup_process initializes the process structure.  
 * The memory allocated by this routine (and routines that modify this
 * structure) is freed with mqs_destroy_process_info 
 */
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 */
    mpich_process_info *p_info = 
	(mpich_process_info *)dbgr_malloc (sizeof (mpich_process_info));

    if (p_info) {
	mqs_image        *image;
	mpich_image_info *i_info;
	
	p_info->process_callbacks = pcb;
	
	/* Now we can get the rest of the info ! */
	image  = dbgr_get_image (process);
	i_info = (mpich_image_info *)dbgr_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;
	/* Ask the debugger to initialize the structure that contains
	   the sizes of basic items (short, int, long, long long, and 
	   void *) */
	dbgr_get_type_sizes (process, &p_info->sizes);
	
	/* Tell the debugger to associate p_info with process */
	dbgr_put_process_info (process, (mqs_process_info *)p_info);
	
	return mqs_ok;
    }
    else
	return err_no_store;
}
int mqs_process_has_queues (mqs_process *proc, char **msg)
{