errutil.c

fortran并行计算包

	    }
	    break;
	case (int)'D':
	    D = va_arg(list, MPI_Datatype);
	    MPIU_Snprintf(str, maxlen, "%s", GetDTypeString(D));
	    break;
	    /* Include support for %F only if MPI-IO is enabled */
#ifdef MPI_MODE_RDWR
	case (int)'F':
	    {
	    MPI_File F;
	    F = va_arg(list, MPI_File);
	    if (F == MPI_FILE_NULL)
	    {
		MPIU_Strncpy(str, "MPI_FILE_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "file=0x%lx", (unsigned long)F);
	    }
	    }
	    break;
#endif
	case (int)'W':
	    W = va_arg(list, MPI_Win);
	    if (W == MPI_WIN_NULL)
	    {
		MPIU_Strncpy(str, "MPI_WIN_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "win=0x%x", W);
	    }
	    break;
	case (int)'A':
	    d = va_arg(list, int);
	    MPIU_Snprintf(str, maxlen, "%s", GetAssertString(d));
	    break;
	case (int)'G':
	    G = va_arg(list, MPI_Group);
	    if (G == MPI_GROUP_NULL)
	    {
		MPIU_Strncpy(str, "MPI_GROUP_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "group=0x%x", G);
	    }
	    break;
	case (int)'O':
	    O = va_arg(list, MPI_Op);
	    MPIU_Snprintf(str, maxlen, "%s", GetMPIOpString(O));
	    break;
	case (int)'R':
	    R = va_arg(list, MPI_Request);
	    if (R == MPI_REQUEST_NULL)
	    {
		MPIU_Strncpy(str, "MPI_REQUEST_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "req=0x%x", R);
	    }
	    break;
	case (int)'E':
	    E = va_arg(list, MPI_Errhandler);
	    if (E == MPI_ERRHANDLER_NULL)
	    {
		MPIU_Strncpy(str, "MPI_ERRHANDLER_NULL", maxlen);
	    }
	    else
	    {
		MPIU_Snprintf(str, maxlen, "errh=0x%x", E);
	    }
	    break;
	default:
	    /* Error: unhandled output type */
	    return 0;
	    /*
	    if (maxlen > 0 && str != NULL)
		*str = '\0';
	    break;
	    */
	}
	len = strlen(str);
	maxlen -= len;
	str += len;
	end = strchr(begin, '%');
    }
    if (*begin != '\0')
    {
	MPIU_Strncpy(str, begin, maxlen);
    }
    /* Free the dup'ed format string */
    MPIU_Free( fmt );

    return mpi_errno;
}

/* ------------------------------------------------------------------------- */
/* ------------------------------------------------------------------------- */
/*
 * Instance-specific error messages are stored in a ring.  The elements of this
 * ring are MPIR_Err_msg_t structures, which contain the following fields:
 *    id - this is used to check that the entry is valid; it is computed from
 *         the error code and location in the ring.  The routine
 *           ErrcodeToId( errcode, &id ) is used to extract the id from an 
 *         error code and
 *           ErrcodeCreateID( class, generic, msg, &id, &seq ) is used to 
 *         create the id from an error class, generic index, and message 
 *         string.  The "seq" field is inserted into the error code as a 
 *         check.
 *
 *    prev_error - The full MPI error code of the previous error attached 
 *         to this list of errors, or MPI_SUCCESSS (which has value 0).
 *         This is the last error code, not the index in the ring of the last 
 *         error code.  That's the right choice, because we want to ensure 
 *         that the value is valid if the ring overflows.  In addition,
 *         we allow this to be an error CLASS (one of the predefined MPI
 *         error classes).  This is particularly important for 
 *         MPI_ERR_IN_STATUS, which may be returned as a valid error code.
 *         (classes are valid error codes).
 *         
 *    use_user_error_code and user_error_code - Used to handle a few cases 
 *         in MPI where a user-provided routine returns an error code; 
 *         this allows us to provide information about the chain of 
 *         routines that were involved, while returning the users prefered
 *         error value to the users environment.  See the note below
 *         on user error codes.
 *
 *    location - A string that indicates what function and line number
 *         where the error code was set.
 *
 *    msg - A message about the error.  This may be instance-specific (e.g.,
 *         it may have been created at the time the error was detected with
 *         information about the parameters that caused the error).
 *
 * Note that both location and msg are defined as length MAX_xxx+1.  This 
 * isn't really necessary (at least for msg), since the MPI standard 
 * requires that MAX_MPI_ERROR_STRING include the space for the trailing null,
 * but using the extra byte makes the code a little simpler.
 *
 * The "id" value is used to keep a sort of "checkvalue" to ensure that the
 * error code that points at this message is in fact for this particular 
 * message.  This is used to handle the unlikely but possible situation where 
 * so many error messages are generated that the ring is overlapped.
 *
 * The message arrays are preallocated to ensure that there is space for these
 * messages when an error occurs.  One variation would be to allow these
 * to be dynamically allocated, but it is probably better to either preallocate
 * these or turn off all error message generation (which will eliminate these
 * arrays).
 *
 * One possible alternative is to use the message ring *only* for instance
 * messages and use the predefined messages in-place for the generic
 * messages.  The approach used here provides uniform handling of all 
 * error messages.
 *
 * Note on user error codes
 *
 * The "user error codes" is used to handle an ambiguity in the MPI-1 
 * standard about the return value from the attribute callbacks.  The 
 * standard does not specify what values, other than 'MPI_SUCCESS', are
 * valid.  Because the Intel MPI-1 test suite expected 'MPI_Comm_dup' to
 * return the same non-zero value returned by the attribute callback routine,
 * this is the behavior that many (if not all) MPI implementations provide.
 * As a result, the return from those routines is 
 * 
 */
#if MPICH_ERROR_MSG_LEVEL == MPICH_ERROR_MSG_ALL

/* FIXME: Where is the documentation for this function?  What is it for?  */
static void MPIR_Err_print_stack_string(int errcode, char *str, int maxlen);

#define MAX_ERROR_RING ERROR_SPECIFIC_INDEX_SIZE
#define MAX_LOCATION_LEN 63

/* The maximum error string in this case may be a multi-line message,
   constructed from multiple entries in the error message ring.  The 
   individual ring messages should be shorter than MPI_MAX_ERROR_STRING,
   perhaps as small a 256. We define a separate value for the error lines. 
 */
#define MPIR_MAX_ERROR_LINE 256

/* See the description above for the fields in this structure */
typedef struct MPIR_Err_msg
{
    int  id;
    int  prev_error;
    int  use_user_error_code;
    int  user_error_code;

    char location[MAX_LOCATION_LEN+1];
    char msg[MPIR_MAX_ERROR_LINE+1];
}
MPIR_Err_msg_t;

static MPIR_Err_msg_t ErrorRing[MAX_ERROR_RING];
static volatile unsigned int error_ring_loc     = 0;
static volatile unsigned int max_error_ring_loc = 0;

#if defined(MPID_REQUIRES_THREAD_SAFETY)
/* if the device requires internal MPICH routines to be thread safe, the
   MPIU_THREAD_CHECK macros are not appropriate */
static MPID_Thread_mutex_t error_ring_mutex;
#define error_ring_mutex_create(_mpi_errno_p_)			\
    MPID_Thread_mutex_create(&error_ring_mutex, _mpi_errno_p_)
#define error_ring_mutex_destroy(_mpi_errno_p)				\
    MPID_Thread_mutex_destroy(&error_ring_mutex, _mpi_errno_p_)
#define error_ring_mutex_lock()			\
    MPID_Thread_mutex_lock(&error_ring_mutex)
#define error_ring_mutex_unlock()		\
    MPID_Thread_mutex_unlock(&error_ring_mutex)
#elif defined(MPICH_IS_THREADED)
static MPID_Thread_mutex_t error_ring_mutex;
#define error_ring_mutex_create(_mpi_errno_p) MPID_Thread_mutex_create(&error_ring_mutex,_mpi_errno_p)
#define error_ring_mutex_destroy(_mpi_errno_p) MPID_Thread_mutex_destroy(&error_ring_mutex,_mpi_errno_p)
#define error_ring_mutex_lock() \
    MPIU_THREAD_CHECK_BEGIN \
     MPID_Thread_mutex_lock(&error_ring_mutex) \
    MPIU_THREAD_CHECK_END
#define error_ring_mutex_unlock() \
    MPIU_THREAD_CHECK_BEGIN \
     MPID_Thread_mutex_unlock(&error_ring_mutex) \
    MPIU_THREAD_CHECK_END
#else
#define error_ring_mutex_create(_a)
#define error_ring_mutex_destroy(_a)
#define error_ring_mutex_lock()
#define error_ring_mutex_unlock()
#endif

/* Create the ring id from information about the message */
static void ErrcodeCreateID( int error_class, int generic_idx, 
			     const char *msg, int *id, int *seq )
{
    int i;
    int ring_seq = 0, ring_id;

    /* Create a simple hash function of the message to serve as the 
       sequence number */
    ring_seq = 0;
    for (i=0; msg[i]; i++)
	ring_seq += (unsigned int) msg[i];

    ring_seq %= ERROR_SPECIFIC_SEQ_SIZE;

    ring_id = (error_class & ERROR_CLASS_MASK) |
	((generic_idx + 1) << ERROR_GENERIC_SHIFT) |
	(ring_seq << ERROR_SPECIFIC_SEQ_SHIFT);

    *id  = ring_id;
    *seq = ring_seq;
}

/* Convert an error code into ring_idx, ring_id, and generic_idx.
   Return non-zero if there is a problem with the decode values
   (e.g., out of range for the ring index) */
static int convertErrcodeToIndexes( int errcode, int *ring_idx, int *ring_id,
				    int *generic_idx )
{
    *ring_idx = (errcode & ERROR_SPECIFIC_INDEX_MASK) >> 
	ERROR_SPECIFIC_INDEX_SHIFT;
    *ring_id = errcode & (ERROR_CLASS_MASK | 
			  ERROR_GENERIC_MASK | ERROR_SPECIFIC_SEQ_MASK);
    *generic_idx = ((errcode & ERROR_GENERIC_MASK) >> ERROR_GENERIC_SHIFT) - 1;
    
    /* Test on both the max_error_ring_loc and MAX_ERROR_RING to guard 
       against memory overwrites */
    if (*ring_idx < 0 || *ring_idx >= MAX_ERROR_RING || 
	*ring_idx > max_error_ring_loc) return 1;

    return 0;
}
static int checkErrcodeIsValid( int errcode )
{
    int ring_id, generic_idx, ring_idx;

    /* If the errcode is a class, then it is valid */
    if (errcode <= MPIR_MAX_ERROR_CLASS_INDEX && errcode >= 0) return 0;

    convertErrcodeToIndexes( errcode, &ring_idx, &ring_id, &generic_idx );
    if (ring_idx < 0 || ring_idx >= MAX_ERROR_RING ||
	ring_idx > max_error_ring_loc) return 1;
    if (ErrorRing[ring_idx].id != ring_id) return 2;
    /* It looks like the code uses a generic idx of -1 to indicate no
       generic message */
    if (generic_idx < -1 || generic_idx > generic_msgs_len) return 3;
    return 0;
}
static const char *ErrcodeInvalidReasonStr( int reason )
{
    const char *str = 0;
    switch (reason) {
    case 1:
	str = "Ring Index out of range";
	break;
    case 2:
	str = "Ring ids do not match";
	break;
    case 3:
	str = "Generic message index out of range";
	break;
    default:
	str = "Unknown reason for invalid errcode";
	break;
    }
    return str;
}
/* Check to see if the error code is a user-specified error code
   (e.g., from the attribute delete function) and if so, set the error code
   to the value provide by the user */
static int checkForUserErrcode( int errcode )
{
    error_ring_mutex_lock();
    {
	if (errcode != MPI_SUCCESS) {
	    int ring_idx;
	    int ring_id;
	    int generic_idx;
	    
	    if (convertErrcodeToIndexes( errcode, &ring_idx, &ring_id,
					 &generic_idx ) != 0) {
		MPIU_Error_printf( 
		  "Invalid error code (%d) (error ring index %d invalid)\n", 
		  errcode, ring_idx );
	    }
	    else {
		/* Can we get a more specific error message */
		if (generic_idx >= 0 && 
		    ErrorRing[ring_idx].id == ring_id && 
		    ErrorRing[ring_idx].use_user_error_code)
		    {
			errcode = ErrorRing[ring_idx].user_error_code;
		    }
	    }
	}
    }
    error_ring_mutex_unlock();
    return errcode;
}

/*
 * This is the real routine for generating an error code.  It takes
 * a va_list so that it can be called by any routine that accepts a 
 * variable number of arguments.
 */
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 )
{
    int err_code;
    int generic_idx;
    int use_user_error_code = 0;
    int user_error_code = -1;
    char user_ring_msg[MPIR_MAX_ERROR_LINE+1];

    /* Create the code from the class and the message ring index */

    /* Check that lastcode is valid */
    if (lastcode != MPI_SUCCESS) {
	int reason;
	reason = checkErrcodeIsValid(lastcode);
	if (reason) {
	    MPIU_Error_printf( "Internal Error: invalid error code %x (%s) in %s:%d\n", 
			       lastcode, ErrcodeInvalidReasonStr( reason ), 
			       fcname, line );
	    lastcode = MPI_SUCCESS;
	}
    }

    /* FIXME: ERR_OTHER is overloaded; this may mean "OTHER" or it may
       mean "No additional error, just routine stack info" */
    if (error_class == MPI_ERR_OTHER)
    {
        if (MPIR_ERR_GET_CLASS(lastcode) > MPI_SUCCESS && 
	    MPIR_ERR_GET_CLASS(lastcode) <= MPICH_ERR_LAST_CLASS)
	{
	    /* If the last class is more specific (and is valid), then pass it 
	       through */
	    error_class = MPIR_ERR_GET_CLASS(lastcode);
	}
	else
	{
	    error_class = MPI_ERR_OTHER;
	}
    }

    /* Handle special case of MPI_ERR_IN_STATUS.  According to the standard,
       the code must be equal to the class. See section 3.7.5.  
       Information on the particular error is in the MPI_ERROR field 
       of the status. */
    if (error_class == MPI_ERR_IN_STATUS)
    {
	return MPI_ERR_IN_STATUS;
    }

    err_code = error_class;

    /* Handle the generic message.  This selects a subclass, based on a text 
       string */
#   if MPICH_ERROR_MSG_LEVEL >= MPICH_ERROR_MSG_GENERIC
    {
	generic_idx = FindGenericMsgIndex(generic_msg);
	if (generic_idx >= 0) {
	    if (strcmp( generic_err_msgs[generic_idx].short_name, "**user" ) == 0)
	    {
		use_user_error_code = 1;
		/* This is a special case.  The format is
		   "**user", "**userxxx %d", intval
		   (generic, specific, parameter).  In this
		   case we must ... save the user value because
		   we store it explicitly in the ring.  
		   We do this here because we cannot both access the 
		   user error code and pass the argp to vsnprintf_mpi . */
		if (specific_msg) {
		    const char *specific_fmt; 
		    int specific_idx;
		    user_error_code = va_arg(Argp,int);
#if MPICH_ERROR_MSG_LEVEL > MPICH_ERROR_MSG_GENERIC
		    specific_idx = FindSpecificMsgIndex(specific_msg);
		    if (specific_idx >= 0) {
			specific_fmt = specific_err_msgs[specific_idx].long_name;
		    }
		    else {
			specific_fmt = specific_msg;
		    }
#else
			specific_fmt = specific_msg;
#endif
		    MPIU_Snprintf( user_ring_msg, sizeof(user_ring_msg),
				   specific_fmt, user_error_code );
		}
		else {
		    user_ring_msg[0] = 0;
		}
	    }
	    err_code |= (generic_idx + 1) << ERROR_GENERIC_SHIFT;
	}
	else
	{
	    /* TODO: lookup index for class error message */
	    err_code &= ~ERROR_GENERIC_MASK;
	    
#           ifdef MPICH_DBG_OUTPUT
	    {
		if (generic_msg[0] == '*' && generic_msg[1] == '*')
		{
		    /* FIXME : Internal error.  Generate some debugging 
		       information; Fix for the general release */
		    fprintf( stderr, "Could not find %s in list of messages\n", generic_msg );
		}
	    }
#           endif
	}
    }
#   endif

    /* Handle the instance-specific part of the error message */
#   if MPICH_ERROR_MSG_LEVEL == MPICH_ERROR_MSG_ALL
    {
	int specific_idx;
	const char * specific_fmt = 0;
	int  ring_idx, ring_seq=0;
	char * ring_msg;
	
	error_ring_mutex_lock();
	{
	    /* Get the next entry in the ring; keep track of what part of the 
	       ring is in use (max_error_ring_loc) */
	    ring_idx = error_ring_loc++;
	    if (error_ring_loc >= MAX_ERROR_RING) 
		error_ring_loc %= MAX_ERROR_RING;
	    if (error_ring_loc > max_error_ring_loc)
		max_error_ring_loc = error_ring_loc;
	
	    ring_msg = ErrorRing[ring_idx].msg;

	    if (specific_msg != NULL)
	    {
		specific_idx = FindSpecificMsgIndex(specific_msg);
		if (specific_idx >= 0)
		{
		    specific_fmt = specific_err_msgs[specific_idx].long_name;
		}
		else
		{
		    specific_fmt = specific_msg;
		}
		/* See the code above for handling user errors */
		if (!use_user_error_code) {
		    vsnprintf_mpi( ring_msg, MPIR_MAX_ERROR_LINE, 
				   specific_fmt, Argp );
		}
		else {
		    MPIU_Strncpy( ring_msg, user_ring_msg, MPIR_MAX_ERROR_LINE );
		}
	    }
	    else if (generic_idx >= 0)
	    {
		MPIU_Strncpy( ring_msg,generic_err_msgs[generic_idx].long_name,
			      MPIR_MAX_ERROR_LINE );
	    }
	    else
	    {
		MPIU_Strncpy( ring_msg, generic_msg, MPIR_MAX_ERROR_LINE );
	    }

	    ring_msg[MPIR_MAX_ERROR_LINE] = '\0';
	
	    /* Get the ring sequence number and set the ring id */
	    ErrcodeCreateID( error_class, generic_idx, ring_msg, 
			     &ErrorRing[ring_idx].id, &ring_seq );
	    /* Set the previous code. */
	    ErrorRing[ring_idx].prev_error = lastcode;

	    /* */