trmem.c

fortran并行计算包

"[%d] Block [id=%d(%lu)] at address %s is corrupted (probably write past end)\n", 
			 world_rank, head->id, head->size, hexstring );
	    }
	    else {
		MPIU_Error_printf( 
"[%d] Block at address %s is corrupted (probably write past end)\n", 
			 world_rank, hexstring );
	    }
	    MPIU_Error_printf(
			 "[%d] Block allocated in %s[%d]\n", 
			 world_rank, head->fname, head->lineno );
	}
	head = head->next;
    }
    return errs;
}

/*+C
   MPIU_trspace - Return space statistics
   
   Output parameters:
.   space - number of bytes currently allocated
.   frags - number of blocks currently allocated
 +*/
void MPIU_trspace( int *space, int *fr )
{
    /* We use ints because systems without prototypes will usually
       allow calls with ints instead of longs, leading to unexpected
       behavior */
    *space = (int)allocated;
    *fr    = (int)frags;
}

/*+C
  MPIU_trdump - Dump the allocated memory blocks to a file

  Input Parameter:
+  fp  - file pointer.  If fp is NULL, stderr is assumed.
-  minid - Only print allocated memory blocks whose id is at least 'minid'

 +*/
void MPIU_trdump( FILE *fp, int minid )
{
    TRSPACE *head;
    char    hexstring[MAX_ADDRESS_CHARS];

    if (fp == 0) fp = stderr;
    head = TRhead;
    while (head) {
	if (head->id >= minid) {
	    addrToHex( (char *)head + sizeof(TrSPACE), hexstring );
	    FPRINTF( fp, "[%d] %lu at [%s], ", 
		 world_rank, head->size, hexstring );
	    head->fname[TR_FNAME_LEN-1] = 0; /* Be extra careful */
	    if (TRidSet) {
		/* For head->id >= 0, we can add code to map the id to
		   the name of a package, rather than using a raw number */
		FPRINTF( fp, "id = %d %s[%d]\n", 
			 head->id, head->fname, head->lineno );
	    }
	    else {
		FPRINTF( fp, "%s[%d]\n", head->fname, head->lineno );
	    }
	}
	head = head->next;
    }
/*
    msg_fprintf( fp, "# [%d] The maximum space allocated was %ld bytes [%ld]\n", 
	     world_rank, TRMaxMem, TRMaxMemId );
 */
}

/* Configure will set HAVE_SEARCH for these systems.  We assume that
   the system does NOT have search.h unless otherwise noted.
   The otherwise noted lets the non-configure approach work on our
   two major systems */
#if defined(HAVE_SEARCH_H)

/* The following routine uses the tsearch routines to summarize the
   memory heap by id */

#include <search.h>
typedef struct TRINFO { int id, size, lineno; char *fname; } TRINFO;

static int IntCompare( TRINFO *a, TRINFO *b )
{
    return a->id - b->id;
}

static FILE *TRFP = 0;
/*ARGSUSED*/
static void PrintSum( TRINFO **a, VISIT order, int level )
{ 
    if (order == postorder || order == leaf) 
	FPRINTF( TRFP, "[%d]%s[%d] has %d\n", 
		 (*a)->id, (*a)->fname, (*a)->lineno, (*a)->size );
}

/*+C
  MPIU_trSummary - Summarize the allocate memory blocks by id

  Input Parameter:
+  fp  - file pointer.  If fp is NULL, stderr is assumed.
-  minid - Only print allocated memory blocks whose id is at least 'minid'

  Note:
  This routine is the same as MPIU_trDump on those systems that do not include
  /usr/include/search.h .
 +*/
void MPIU_trSummary( FILE *fp, int minid )
{
    TRSPACE *head;
    TRINFO  *root, *key, **fnd;
    TRINFO  nspace[1000];

    if (fp == 0) fp = stderr;
    root = 0;
    head = TRhead;
    key  = nspace;
    while (head) {
	if (head->id >= minid) {
	    key->id     = head->id;
	    key->size   = 0;
	    key->lineno = head->lineno;
	    key->fname  = head->fname;
#if defined(USE_TSEARCH_WITH_CHARP)
	    fnd    = (TRINFO **)tsearch( (char *) key, (char **) &root, 
					 IntCompare );
#else
	    fnd    = (TRINFO **)tsearch( (void *) key, (void **) &root, 
					 (int (*)())IntCompare );
#endif
	    if (*fnd == key) {
		key->size = 0;
		key++;
	    }
	    (*fnd)->size += head->size;
	}
	head = head->next;
    }
    
    /* Print the data */
    TRFP = fp;
    twalk( (char *)root, (void (*)())PrintSum );
    /*
      msg_fprintf( fp, "# [%d] The maximum space allocated was %d bytes [%d]\n", 
      world_rank, TRMaxMem, TRMaxMemId );
    */
}
#else
void MPIU_trSummary( FILE *fp, int minid )
{
    if (fp == 0) fp = stderr;
    FPRINTF( fp, 
		 "# [%d] The maximum space allocated was %ld bytes [%ld]\n", 
		 world_rank, TRMaxMem, TRMaxMemId );
}	
#endif

/*+
  MPIU_trid - set an "id" field to be used with each fragment
 +*/
void MPIU_trid( int id )
{
    TRid    = id;
    TRidSet = 1;   /* Recall whether we ever use this feature to 
		      help clean up output */
}

/*+C
  MPIU_trlevel - Set the level of output to be used by the tracing routines
 
  Input Parameters:
. level = 0 - notracing
. level = 1 - trace mallocs
. level = 2 - trace frees

  Note:
  You can add levels together to get combined tracing.
 +*/
void MPIU_trlevel( int level )
{
    TRlevel = level;
}


/*+C
    MPIU_trDebugLevel - set the level of debugging for the space management
    routines

    Input Parameter:
.   level - level of debugging.  Currently, either 0 (no checking) or 1
    (use MPIU_trvalid at each MPIU_trmalloc or MPIU_trfree).
+*/
void MPIU_trDebugLevel( int level )
{
    TRdebugLevel = level;
}

/*+C
    MPIU_trcalloc - Calloc with tracing

    Input Parameters:
.   nelem  - number of elements to allocate
.   elsize - size of each element
.   lineno - line number where used.  Use __LINE__ for this
.   fname  - file name where used.  Use __FILE__ for this

    Returns:
    Double aligned pointer to requested storage, or null if not
    available.
 +*/
void *MPIU_trcalloc( unsigned int nelem, unsigned int elsize, int lineno, 
		     const char fname[] )
{
    void *p;
    
    p = MPIU_trmalloc( (unsigned)(nelem*elsize), lineno, fname );
    if (p) {
	memset(p,0,nelem*elsize);
    }
    return p;
}

/*+C
    MPIU_trrealloc - Realloc with tracing

    Input Parameters:
.   p      - pointer to old storage
.   size   - number of bytes to allocate
.   lineno - line number where used.  Use __LINE__ for this
.   fname  - file name where used.  Use __FILE__ for this

    Returns:
    Double aligned pointer to requested storage, or null if not
    available.  This implementation ALWAYS allocates new space and copies 
    the contents into the new space.
 +*/
void *MPIU_trrealloc( void *p, int size, int lineno, const char fname[] )
{
    void    *pnew;
    char    *pa;
    int     nsize;
    TRSPACE *head=0;
    char    hexstring[MAX_ADDRESS_CHARS];

/* We should really use the size of the old block... */
    if (p) {
	pa   = (char *)p;
	head = (TRSPACE *)(pa - sizeof(TrSPACE));
	if (head->cookie != COOKIE_VALUE) {
	    /* Damaged header */
	    addrToHex( pa, hexstring );
	    MPIU_Error_printf( 
		"[%d] Block at address %s is corrupted; cannot realloc;\n\
may be block not allocated with MPIU_trmalloc or MALLOC\n", 
		world_rank, hexstring );
	    return 0;
	}
    }
    pnew = MPIU_trmalloc( (unsigned)size, lineno, fname );
    if (!pnew) return p;

    if (p) {
	nsize = size;
	if (head->size < (unsigned long)nsize) nsize = (int)(head->size);
	memcpy( pnew, p, nsize );
	MPIU_trfree( p, lineno, fname );
    }
    return pnew;
}

/*+C
    MPIU_trstrdup - Strdup with tracing

    Input Parameters:
.   str    - string to duplicate
.   lineno - line number where used.  Use __LINE__ for this
.   fname  - file name where used.  Use __FILE__ for this

    Returns:
    Pointer to copy of the input string.
 +*/
void *MPIU_trstrdup( const char *str, int lineno, const char fname[] )
{
    void *p;
    unsigned len = (unsigned)strlen( str ) + 1;

    p = MPIU_trmalloc( len, lineno, (char *)fname );
    if (p) {
	memcpy( p, str, len );
    }
    return p;
}

#define TR_MAX_DUMP 100
/*
   The following routine attempts to give useful information about the
   memory usage when an "out-of-memory" error is encountered.  The rules are:
   If there are less than TR_MAX_DUMP blocks, output those.
   Otherwise, try to find multiple instances of the same routine/line #, and
   print a summary by number:
   file line number-of-blocks total-number-of-blocks

   We have to do a sort-in-place for this
 */

/*
  Sort by file/line number.  Do this without calling a system routine or
  allocating ANY space (space is being optimized here).

  We do this by first recursively sorting halves of the list and then
  merging them.  
 */
/* Forward refs for these local (hence static) routines */
static TRSPACE *MPIU_trImerge ( TRSPACE *, TRSPACE * );
static TRSPACE *MPIU_trIsort  ( TRSPACE *, int );
static void MPIU_trSortBlocks ( void );
 
/* Merge two lists, returning the head of the merged list */
static TRSPACE *MPIU_trImerge( TRSPACE *l1, TRSPACE *l2 )
{
    TRSPACE *head = 0, *tail = 0;
    int     sign;
    while (l1 && l2) {
	sign = strncmp(l1->fname, l2->fname, TR_FNAME_LEN - 1 );
	if (sign > 0 || (sign == 0 && l1->lineno >= l2->lineno)) {
	    if (head) tail->next = l1; 
	    else      head = tail = l1;
	    tail = l1;
	    l1   = l1->next;
	}
	else {
	    if (head) tail->next = l2; 
	    else      head = tail = l2;
	    tail = l2;
	    l2   = l2->next;
	}
    }
    /* Add the remaining elements to the end */
    if (l1) tail->next = l1;
    if (l2) tail->next = l2;
    
    return head;
}
/* Sort head with n elements, returning the head */
static TRSPACE *MPIU_trIsort( TRSPACE *head, int n )
{
    TRSPACE *p, *l1, *l2;
    int     m, i;

    if (n <= 1) return head;
    
    /* This guarentees that m, n are both > 0 */
    m = n / 2;
    p = head;
    for (i=0; i<m-1; i++) p = p->next;
    /* p now points to the END of the first list */
    l2 = p->next;
    p->next = 0;
    l1 = MPIU_trIsort( head, m );
    l2 = MPIU_trIsort( l2,   n - m );
    return MPIU_trImerge( l1, l2 );
}

static void MPIU_trSortBlocks( void )
{
    TRSPACE *head;
    int     cnt;
    
    head = TRhead;
    cnt  = 0;
    while (head) {
	cnt ++;
	head = head->next;
    }
    TRhead = MPIU_trIsort( TRhead, cnt );
}

/* Takes sorted input and dumps as an aggregate */
void MPIU_trdumpGrouped( FILE *fp, int minid )
{
    TRSPACE *head, *cur;
    int     nblocks, nbytes;
    
    if (fp == 0) fp = stderr;
    
    MPIU_trSortBlocks();
    head = TRhead;
    cur  = 0;
    while (head) {
	cur     = head->next;
	if (head->id >= minid) {
	    nblocks = 1;
	    nbytes  = (int)head->size;
	    while (cur && 
		   strncmp(cur->fname,head->fname,TR_FNAME_LEN-1) == 0 && 
		   cur->lineno == head->lineno ) {
		nblocks++;
		nbytes += (int)cur->size;
		cur    = cur->next;
	    }
	    FPRINTF( fp, 
		     "[%d] File %13s line %5d: %d bytes in %d allocation%c\n", 
		     world_rank, head->fname, head->lineno, nbytes, nblocks, 
		     (nblocks > 1) ? 's' : ' ' );
	}
	head = cur;
    }
    fflush( fp );
}

void MPIU_TrSetMaxMem( int size )
{
    TRMaxMemAllow = size;
}

static void addrToHex( void *addr, char string[MAX_ADDRESS_CHARS] )
{
    int i;
    static char hex[16] = { '0', '1', '2', '3', '4', '5', '6', '7',
			    '8', '9', 'a', 'b', 'c', 'd', 'e', 'f' };
    /* The following construction is used to keep compilers from issuing
       a warning message about casting a pointer to an integer type */
    MPI_Aint iaddr = (MPI_Aint) ((char *)addr - (char*)0);

    /* Initial location */
    i = sizeof(void*) * 2;
    string[i+2] = 0;
    while (i) {
	string[i+1] = hex[iaddr & 0xF];
	iaddr >>= 4;
	i--;
    }
    string[0] = '0';
    string[1] = 'x';
}