errutil.c

fortran并行计算包

	    specific_err_msgs[i].sentinal2 != 0xcb0bfa11) {
	    /* Something bad has happened! Don't risk trying the
	       short_name pointer; it may have been corrupted */
	    break;
	}
	c = strcmp( specific_err_msgs[i].short_name, msg );
	if (c == 0) return i;
	if (c > 0)
	{
	    /* don't return here if the string partially matches */
	    if (strncmp(specific_err_msgs[i].short_name, msg, strlen(msg)) != 0)
		return -1;
	}
    }
    return -1;
}
/* See FindGenericMsgIndex comments for a more efficient search routine that
   could be used here as well. */
#endif


/* ------------------------------------------------------------------------ */
/* The following routines create an MPI error code, handling optional,      */
/* instance-specific error message information.  There are two key routines:*/
/*    MPIR_Err_create_code - Create the error code; this is the routine used*/
/*                           by most routines                               */
/*    MPIR_Err_create_code_valist - Create the error code; accept a valist  */
/*                           instead of a variable argument list (this is   */
/*                           used to allow this routine to be used from     */
/*                           within another varargs routine)                */
/* ------------------------------------------------------------------------ */

/* Err_create_code is just a shell that accesses the va_list and then
   calls the real routine.  */
int MPIR_Err_create_code( int lastcode, int fatal, const char fcname[], 
			  int line, int error_class, const char generic_msg[],
			  const char specific_msg[], ... )
{
    int rc;
    va_list Argp;
    va_start(Argp, specific_msg);
    rc = MPIR_Err_create_code_valist( lastcode, fatal, fcname, line,
				      error_class, generic_msg, specific_msg,
				      Argp );
    va_end(Argp);
    return rc;
}
#if MPICH_ERROR_MSG_LEVEL < MPICH_ERROR_MSG_ALL
/* In this case, the routine ignores all but (possibly) the generic message */
int MPIR_Err_create_code_valist( int lastcode, int fatal, const char fcname[], 
				 int line, int error_class, 
				 const char generic_msg[],
				 const char specific_msg[], va_list Argp )
{
#if MPICH_ERROR_MSG_LEVEL == MPICH_ERROR_MSG_GENERIC
    int generic_idx;
    int errcode;
    generic_idx = FindGenericMsgIndex(generic_msg);
    if (generic_idx >= 0) {
	errcode = (generic_idx << ERROR_GENERIC_SHIFT) | error_class;
	if (fatal)
	    errcode |= ERROR_FATAL_MASK;
    }
    return errcode;
#else
    return error_class;
#endif    
}
#endif /* msg_level < msg_all */

/*
 * Accessor routines for the predefined mqessages.  These can be
 * used by the other routines (such as MPI_Error_string) to
 * access the messages in this file, or the messages that may be
 * available through any message catalog facility 
 */
static const char *get_class_msg( int error_class )
{
#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG_NONE
    if (error_class >= 0 && error_class < MPIR_MAX_ERROR_CLASS_INDEX) {
	return generic_err_msgs[class_to_index[error_class]].long_name;
    }
    else {
	return "Unknown error class";
    }
#else 
    /* FIXME: Not internationalized */
    return "Error message texts are not available";
#endif
}

/* FIXME: This routine isn't quite right yet */
/*
 * Notes:
 * One complication is that in the instance-specific case, a 
 */
void MPIR_Err_get_string( int errorcode, char * msg, int length, 
			  MPIR_Err_get_class_string_func_t fn )
{
    int error_class;
    int len, num_remaining = length;
    
    if (num_remaining == 0)
	num_remaining = MPI_MAX_ERROR_STRING;

    /* Convert the code to a string.  The cases are:
       simple class.  Find the corresponding string.
       <not done>
       if (user code) { go to code that extracts user error messages }
       else {
           is specific message code set and available?  if so, use it
	   else use generic code (lookup index in table of messages)
       }
     */
    if (errorcode & ERROR_DYN_MASK) {
	/* This is a dynamically created error code (e.g., with 
	   MPI_Err_add_class) */
	/* If a dynamic error code was created, the function to convert
	   them into strings has been set.  Check to see that it was; this 
	   is a safeguard against a bogus error code */
	if (!MPIR_Process.errcode_to_string) {
	    /* FIXME: not internationalized */
	    /* --BEGIN ERROR HANDLING-- */
	    if (MPIU_Strncpy(msg, "Undefined dynamic error code", 
			     num_remaining))
	    {
		msg[num_remaining - 1] = '\0';
	    }
	    /* --END ERROR HANDLING-- */
	}
	else
	{
	    if (MPIU_Strncpy(msg, MPIR_Process.errcode_to_string( errorcode ), 
			     num_remaining))
	    {
		msg[num_remaining - 1] = '\0';
	    }
	}
    }
    else if ( (errorcode & ERROR_CLASS_MASK) == errorcode) {
	error_class = MPIR_ERR_GET_CLASS(errorcode);

	if (fn != NULL && error_class > MPICH_ERR_LAST_CLASS /*&& error_class < MPICH_ERR_MAX_EXT_CLASS*/)
	{
	    fn(errorcode, msg, length);
	}
	else
	{
	    if (MPIU_Strncpy(msg, get_class_msg( errorcode ), num_remaining))
	    {
		msg[num_remaining - 1] = '\0';
	    }
	}
    }
    else
    {
	/* print the class message first */
	error_class = MPIR_ERR_GET_CLASS(errorcode);

	if (fn != NULL && error_class > MPICH_ERR_LAST_CLASS /*&& error_class < MPICH_ERR_MAX_EXT_CLASS*/)
	{
	    fn(errorcode, msg, num_remaining);
	}
	else
	{
	    MPIU_Strncpy(msg, get_class_msg(ERROR_GET_CLASS(errorcode)), num_remaining);
	}
	msg[num_remaining - 1] = '\0';
	len = (int)strlen(msg);
	msg += len;
	num_remaining -= len;

	/* then print the stack or the last specific error message */

#       if MPICH_ERROR_MSG_LEVEL >= MPICH_ERROR_MSG_ALL
	if (ErrGetInstanceString( errorcode, msg, num_remaining, fn )) 
	    goto fn_exit;
#elif MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG_NONE
	{
	    int generic_idx;
	    
	    generic_idx = ((errorcode & ERROR_GENERIC_MASK) >> ERROR_GENERIC_SHIFT) - 1;
	    
	    if (generic_idx >= 0) {
		MPIU_Snprintf(msg, num_remaining, ", %s", generic_err_msgs[generic_idx].long_name);
		msg[num_remaining - 1] = '\0';
		goto fn_exit;
	    }
	}
#           endif
    }
    
fn_exit:
    return;
}


/* ------------------------------------------------------------------------- */
/* Routines to convert instance-specific messages into a string              */
/* This is the only case that supports instance-specific messages            */
/* ------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------ */
/* This block of code is used to convert various MPI values into descriptive*/
/* strings.  The routines are                                               */
/*     GetAssertString - handle MPI_MODE_xxx (RMA asserts)                  */
/*     GetDTypeString  - handle MPI_Datatypes                               */
/*     GetMPIOpString  - handle MPI_Op                                      */
/* These routines are used in vsnprintf_mpi                                 */
/* FIXME: These functions are not thread safe                               */
/* ------------------------------------------------------------------------ */
#define ASSERT_STR_MAXLEN 256

static const char * GetAssertString(int d)
{
    static char str[ASSERT_STR_MAXLEN] = "";
    char *cur;
    size_t len = ASSERT_STR_MAXLEN;
    size_t n;

    if (d == 0)
    {
	MPIU_Strncpy(str, "assert=0", ASSERT_STR_MAXLEN);
	return str;
    }
    cur = str;
    if (d & MPI_MODE_NOSTORE)
    {
	MPIU_Strncpy(cur, "MPI_MODE_NOSTORE", len);
	n = strlen(cur);
	cur += n;
	len -= n;
	d ^= MPI_MODE_NOSTORE;
    }
    if (d & MPI_MODE_NOCHECK)
    {
	if (len < ASSERT_STR_MAXLEN)
	    MPIU_Strncpy(cur, " | MPI_MODE_NOCHECK", len);
	else
	    MPIU_Strncpy(cur, "MPI_MODE_NOCHECK", len);
	n = strlen(cur);
	cur += n;
	len -= n;
	d ^= MPI_MODE_NOCHECK;
    }
    if (d & MPI_MODE_NOPUT)
    {
	if (len < ASSERT_STR_MAXLEN)
	    MPIU_Strncpy(cur, " | MPI_MODE_NOPUT", len);
	else
	    MPIU_Strncpy(cur, "MPI_MODE_NOPUT", len);
	n = strlen(cur);
	cur += n;
	len -= n;
	d ^= MPI_MODE_NOPUT;
    }
    if (d & MPI_MODE_NOPRECEDE)
    {
	if (len < ASSERT_STR_MAXLEN)
	    MPIU_Strncpy(cur, " | MPI_MODE_NOPRECEDE", len);
	else
	    MPIU_Strncpy(cur, "MPI_MODE_NOPRECEDE", len);
	n = strlen(cur);
	cur += n;
	len -= n;
	d ^= MPI_MODE_NOPRECEDE;
    }
    if (d & MPI_MODE_NOSUCCEED)
    {
	if (len < ASSERT_STR_MAXLEN)
	    MPIU_Strncpy(cur, " | MPI_MODE_NOSUCCEED", len);
	else
	    MPIU_Strncpy(cur, "MPI_MODE_NOSUCCEED", len);
	n = strlen(cur);
	cur += n;
	len -= n;
	d ^= MPI_MODE_NOSUCCEED;
    }
    if (d)
    {
	if (len < ASSERT_STR_MAXLEN)
	    MPIU_Snprintf(cur, len, " | 0x%x", d);
	else
	    MPIU_Snprintf(cur, len, "assert=0x%x", d);
    }
    return str;
}

static const char * GetDTypeString(MPI_Datatype d)
{
    static char default_str[64];
    int num_integers, num_addresses, num_datatypes, combiner = 0;
    char *str;

    if (HANDLE_GET_MPI_KIND(d) != MPID_DATATYPE ||      \
	(HANDLE_GET_KIND(d) == HANDLE_KIND_INVALID &&   \
	d != MPI_DATATYPE_NULL))
        return "INVALID DATATYPE";
    

    if (d == MPI_DATATYPE_NULL)
	return "MPI_DATATYPE_NULL";

    if (d == 0)
    {
	MPIU_Strncpy(default_str, "dtype=0x0", 64);
	return default_str;
    }

    MPID_Type_get_envelope(d, &num_integers, &num_addresses, &num_datatypes, 
			   &combiner);
    if (combiner == MPI_COMBINER_NAMED)
    {
	str = MPIDU_Datatype_builtin_to_string(d);
	if (str == NULL)
	{
	    MPIU_Snprintf(default_str, 64, "dtype=0x%08x", d);
	    return default_str;
	}
	return str;
    }
    
    /* default is not thread safe */
    str = MPIDU_Datatype_combiner_to_string(combiner);
    if (str == NULL)
    {
	MPIU_Snprintf(default_str, 64, "dtype=USER<0x%08x>", d);
	return default_str;
    }
    MPIU_Snprintf(default_str, 64, "dtype=USER<%s>", str);
    return default_str;
}

static const char * GetMPIOpString(MPI_Op o)
{
    static char default_str[64];

    switch (o)
    {
    case MPI_OP_NULL:
	return "MPI_OP_NULL";
    case MPI_MAX:
	return "MPI_MAX";
    case MPI_MIN:
	return "MPI_MIN";
    case MPI_SUM:
	return "MPI_SUM";
    case MPI_PROD:
	return "MPI_PROD";
    case MPI_LAND:
	return "MPI_LAND";
    case MPI_BAND:
	return "MPI_BAND";
    case MPI_LOR:
	return "MPI_LOR";
    case MPI_BOR:
	return "MPI_BOR";
    case MPI_LXOR:
	return "MPI_LXOR";
    case MPI_BXOR:
	return "MPI_BXOR";
    case MPI_MINLOC:
	return "MPI_MINLOC";
    case MPI_MAXLOC:
	return "MPI_MAXLOC";
    case MPI_REPLACE:
	return "MPI_REPLACE";
    }
    /* FIXME: default is not thread safe */
    MPIU_Snprintf(default_str, 64, "op=0x%x", o);
    return default_str;
}

/* ------------------------------------------------------------------------ */
/* This routine takes an instance-specific string with format specifiers    */
/* This routine makes use of the above routines, along with some inlined    */
/* code, to process the format specifiers for the MPI objects               */
/* The current set of format specifiers is undocumented except for their
   use in this routine.  In addition, these choices do not permit the 
   use of GNU extensions to check the validity of these arguments.  
   At some point, a documented set that can exploit those GNU extensions
   will replace these. */
/* ------------------------------------------------------------------------ */

static int vsnprintf_mpi(char *str, size_t maxlen, const char *fmt_orig, 
			 va_list list)
{
    char *begin, *end, *fmt;
    size_t len;
    MPI_Comm C;
    MPI_Info I;
    MPI_Datatype D;
    MPI_Win W;
    MPI_Group G;
    MPI_Op O;
    MPI_Request R;
    MPI_Errhandler E;
    char *s;
    int t, i, d, mpi_errno=MPI_SUCCESS;
    void *p;

    fmt = MPIU_Strdup(fmt_orig);
    if (fmt == NULL)
    {
	if (maxlen > 0 && str != NULL)
	    *str = '\0';
	return 0;
    }

    begin = fmt;
    end = strchr(fmt, '%');
    while (end)
    {
	len = maxlen;
	if (len > (size_t)(end - begin)) {
	    len = (size_t)(end - begin);
	}
	if (len)
	{
	    memcpy(str, begin, len);
	    str += len;
	    maxlen -= len;
	}
	end++;
	begin = end+1;
	switch ((int)(*end))
	{
	case (int)'s':
	    s = va_arg(list, char *);
	    if (s) 
	        MPIU_Strncpy(str, s, maxlen);
            else {
		MPIU_Strncpy(str, "<NULL>", maxlen );
	    }
	    break;
	case (int)'d':
	    d = va_arg(list, int);
	    MPIU_Snprintf(str, maxlen, "%d", d);
	    break;
	case (int)'i':
	    i = va_arg(list, int);
	    switch (i)
	    {
	    case MPI_ANY_SOURCE:
		MPIU_Strncpy(str, "MPI_ANY_SOURCE", maxlen);
		break;
	    case MPI_PROC_NULL:
		MPIU_Strncpy(str, "MPI_PROC_NULL", maxlen);
		break;
	    case MPI_ROOT:
		MPIU_Strncpy(str, "MPI_ROOT", maxlen);
		break;
	    case MPI_UNDEFINED_RANK:
		MPIU_Strncpy(str, "MPI_UNDEFINED_RANK", maxlen);
		break;
	    default:
		MPIU_Snprintf(str, maxlen, "%d", i);
		break;
	    }
	    break;
	case (int)'t':
	    t = va_arg(list, int);
	    switch (t)
	    {
	    case MPI_ANY_TAG:
		MPIU_Strncpy(str, "MPI_ANY_TAG", maxlen);
		break;
	    case MPI_UNDEFINED:
		MPIU_Strncpy(str, "MPI_UNDEFINED", maxlen);
		break;
	    default:
		MPIU_Snprintf(str, maxlen, "%d", t);
		break;
	    }
	    break;
	case (int)'p':
	    p = va_arg(list, void *);
	    /* FIXME: A check for MPI_IN_PLACE should only be used 
	       where that is valid */
	    if (p == MPI_IN_PLACE)
	    {
		MPIU_Strncpy(str, "MPI_IN_PLACE", maxlen);
	    }
	    else
	    {
		/* FIXME: We may want to use 0x%p for systems that 
		   (including Windows) that don't prefix %p with 0x. 
		   This must be done with a capability, not a test on
		   particular OS or header files */
		MPIU_Snprintf(str, maxlen, "%p", p);
	    }
	    break;
	case (int)'C':
	    C = va_arg(list, MPI_Comm);
	    switch (C)
	    {
	    case MPI_COMM_WORLD:
		MPIU_Strncpy(str, "MPI_COMM_WORLD", maxlen);
		break;
	    case MPI_COMM_SELF:
		MPIU_Strncpy(str, "MPI_COMM_SELF", maxlen);
		break;
	    case MPI_COMM_NULL:
		MPIU_Strncpy(str, "MPI_COMM_NULL", maxlen);
		break;
	    default:
		MPIU_Snprintf(str, maxlen, "comm=0x%x", C);
		break;
	    }
	    break;
	case (int)'I':
	    I = va_arg(list, MPI_Info);
	    if (I == MPI_INFO_NULL)
	    {
		MPIU_Strncpy(str, "MPI_INFO_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "info=0x%x", I);