Actual source code: mtr.c

  2: /*
  3:      Interface to malloc() and free(). This code allows for 
  4:   logging of memory usage and some error checking 
  5: */
  6: #include <petscsys.h>           /*I "petscsys.h" I*/
  7: #if defined(PETSC_HAVE_STDLIB_H)
  8: #include <stdlib.h>
  9: #endif
 10: #if defined(PETSC_HAVE_MALLOC_H)
 11: #include <malloc.h>
 12: #endif


 15: /*
 16:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
 17: */


 24: #define CLASSID_VALUE   ((PetscClassId) 0xf0e0d0c9)
 25: #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)

 27: typedef struct _trSPACE {
 28:     size_t          size;
 29:     int             id;
 30:     int             lineno;
 31:     const char      *filename;
 32:     const char      *functionname;
 33:     const char      *dirname;
 34:     PetscClassId    classid;
 35: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD)
 36:     PetscStack      stack;
 37: #endif
 38:     struct _trSPACE *next,*prev;
 39: } TRSPACE;

 41: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
 42:    It is sizeof(TRSPACE) padded to be a multiple of PETSC_MEMALIGN.
 43: */

 45: #define HEADER_BYTES      (sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1)


 48: /* This union is used to insure that the block passed to the user retains
 49:    a minimum alignment of PETSC_MEMALIGN.
 50: */
 51: typedef union {
 52:     TRSPACE sp;
 53:     char    v[HEADER_BYTES];
 54: } TrSPACE;


 57: static size_t     TRallocated  = 0;
 58: static int        TRfrags      = 0;
 59: static TRSPACE    *TRhead      = 0;
 60: static int        TRid         = 0;
 61: static PetscBool  TRdebugLevel = PETSC_FALSE;
 62: static size_t     TRMaxMem     = 0;
 63: /*
 64:       Arrays to log information on all Mallocs
 65: */
 66: static int        PetscLogMallocMax = 10000,PetscLogMalloc = -1;
 67: static size_t     *PetscLogMallocLength;
 68: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;

 72: PetscErrorCode PetscSetUseTrMalloc_Private(void)
 73: {
 74: #if !defined(PETSC_USE_PTHREAD)
 76: #endif

 79: #if defined(PETSC_USE_PTHREAD)
 80:   SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot use PETSc's debug malloc when using pthreads");
 81: #else
 82:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
 83:   TRallocated       = 0;
 84:   TRfrags           = 0;
 85:   TRhead            = 0;
 86:   TRid              = 0;
 87:   TRdebugLevel      = PETSC_FALSE;
 88:   TRMaxMem          = 0;
 89:   PetscLogMallocMax = 10000;
 90:   PetscLogMalloc    = -1;
 91:   return(0);
 92: #endif
 93: }

 97: /*@C
 98:    PetscMallocValidate - Test the memory for corruption.  This can be used to
 99:    check for memory overwrites.

101:    Input Parameter:
102: +  line - line number where call originated.
103: .  function - name of function calling
104: .  file - file where function is
105: -  dir - directory where function is

107:    Return value:
108:    The number of errors detected.
109:    
110:    Output Effect:
111:    Error messages are written to stdout.  

113:    Level: advanced

115:    Notes:
116:     You should generally use CHKMEMQ as a short cut for calling this 
117:     routine.

119:     The line, function, file and dir are given by the C preprocessor as 
120:     __LINE__, __FUNCT__, __FILE__, and __DIR__

122:     The Fortran calling sequence is simply PetscMallocValidate(ierr)

124:    No output is generated if there are no problems detected.

126: .seealso: CHKMEMQ

128: @*/
129: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
130: {
131:   TRSPACE     *head,*lasthead;
132:   char        *a;
133:   PetscClassId *nend;

136:   head = TRhead; lasthead = NULL;
137:   while (head) {
138:     if (head->classid != CLASSID_VALUE) {
139:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s%s\n",function,line,dir,file);
140:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
141:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
142:       if (lasthead)
143:         (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s%s\n",lasthead->functionname,lasthead->lineno,lasthead->dirname,lasthead->filename);
144:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
145:     }
146:     a    = (char *)(((TrSPACE*)head) + 1);
147:     nend = (PetscClassId *)(a + head->size);
148:     if (*nend != CLASSID_VALUE) {
149:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
150:       if (*nend == ALREADY_FREED) {
151:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
152:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
153:       } else {
154:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
155:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
156:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
157:       }
158:     }
159:     lasthead = head;
160:     head = head->next;
161:   }
162:   return(0);
163: }

167: /*
168:     PetscTrMallocDefault - Malloc with tracing.

170:     Input Parameters:
171: +   a   - number of bytes to allocate
172: .   lineno - line number where used.  Use __LINE__ for this
173: .   function - function calling routine. Use __FUNCT__ for this
174: .   filename  - file name where used.  Use __FILE__ for this
175: -   dir - directory where file is. Use __SDIR__ for this

177:     Returns:
178:     double aligned pointer to requested storage, or null if not
179:     available.
180:  */
181: PetscErrorCode  PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
182: {
183:   TRSPACE        *head;
184:   char           *inew;
185:   size_t         nsize;

189:   if (!a) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to malloc zero size array");

191:   if (TRdebugLevel) {
192:     PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
193:   }

195:   nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
196:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,dir,(void**)&inew);

198:   head   = (TRSPACE *)inew;
199:   inew  += sizeof(TrSPACE);

201:   if (TRhead) TRhead->prev = head;
202:   head->next     = TRhead;
203:   TRhead         = head;
204:   head->prev     = 0;
205:   head->size     = nsize;
206:   head->id       = TRid;
207:   head->lineno   = lineno;

209:   head->filename     = filename;
210:   head->functionname = function;
211:   head->dirname      = dir;
212:   head->classid       = CLASSID_VALUE;
213:   *(PetscClassId *)(inew + nsize) = CLASSID_VALUE;

215:   TRallocated += nsize;
216:   if (TRallocated > TRMaxMem) {
217:     TRMaxMem   = TRallocated;
218:   }
219:   TRfrags++;

221: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD)
222:   PetscStackCopy(petscstack,&head->stack);
223: #endif

225:   /*
226:          Allow logging of all mallocs made
227:   */
228:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
229:     if (!PetscLogMalloc) {
230:       PetscLogMallocLength    = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
231:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
232:       PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
233:       if (!PetscLogMallocDirectory) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
234:       PetscLogMallocFile      = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
235:       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
236:       PetscLogMallocFunction  = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
237:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
238:     }
239:     PetscLogMallocLength[PetscLogMalloc]      = nsize;
240:     PetscLogMallocDirectory[PetscLogMalloc]   = dir;
241:     PetscLogMallocFile[PetscLogMalloc]        = filename;
242:     PetscLogMallocFunction[PetscLogMalloc++]  = function;
243:   }
244:   *result = (void*)inew;
245:   return(0);
246: }


251: /*
252:    PetscTrFreeDefault - Free with tracing.

254:    Input Parameters:
255: .   a    - pointer to a block allocated with PetscTrMalloc
256: .   lineno - line number where used.  Use __LINE__ for this
257: .   function - function calling routine. Use __FUNCT__ for this
258: .   file  - file name where used.  Use __FILE__ for this
259: .   dir - directory where file is. Use __SDIR__ for this
260:  */
261: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
262: {
263:   char           *a = (char*)aa;
264:   TRSPACE        *head;
265:   char           *ahead;
267:   PetscClassId   *nend;
268: 
270:   /* Do not try to handle empty blocks */
271:   if (!a) {
272:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
273:     SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s%s\n",function,line,dir,file);
274:   }
275: 
276:   if (TRdebugLevel) {
277:     PetscMallocValidate(line,function,file,dir);
278:   }
279: 
280:   ahead = a;
281:   a     = a - sizeof(TrSPACE);
282:   head  = (TRSPACE *)a;
283: 
284:   if (head->classid != CLASSID_VALUE) {
285:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
286:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
287:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
288:   }
289:   nend = (PetscClassId *)(ahead + head->size);
290:   if (*nend != CLASSID_VALUE) {
291:     if (*nend == ALREADY_FREED) {
292:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
293:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
294:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
295:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
296:       } else {
297:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
298:       }
299:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
300:     } else {
301:       /* Damaged tail */
302:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
303:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
304:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
305:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
306:     }
307:   }
308:   /* Mark the location freed */
309:   *nend        = ALREADY_FREED;
310:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
311:   if (line > 0 && line < 50000) {
312:     head->lineno       = line;
313:     head->filename     = file;
314:     head->functionname = function;
315:     head->dirname      = dir;
316:   } else {
317:     head->lineno = - head->lineno;
318:   }
319:   /* zero out memory - helps to find some reuse of already freed memory */
320:   PetscMemzero(aa,head->size);
321: 
322:   TRallocated -= head->size;
323:   TRfrags     --;
324:   if (head->prev) head->prev->next = head->next;
325:   else TRhead = head->next;
326: 
327:   if (head->next) head->next->prev = head->prev;
328:   PetscFreeAlign(a,line,function,file,dir);
329:   return(0);
330: }


335: /*@C
336:     PetscMemoryShowUsage - Shows the amount of memory currently being used 
337:         in a communicator.
338:    
339:     Collective on PetscViewer

341:     Input Parameter:
342: +    viewer - the viewer that defines the communicator
343: -    message - string printed before values

345:     Level: intermediate

347:     Concepts: memory usage

349: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
350:  @*/
351: PetscErrorCode  PetscMemoryShowUsage(PetscViewer viewer,const char message[])
352: {
353:   PetscLogDouble allocated,maximum,resident,residentmax;
355:   PetscMPIInt    rank;
356:   MPI_Comm       comm;

359:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
360:   PetscMallocGetCurrentUsage(&allocated);
361:   PetscMallocGetMaximumUsage(&maximum);
362:   PetscMemoryGetCurrentUsage(&resident);
363:   PetscMemoryGetMaximumUsage(&residentmax);
364:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
365:   PetscObjectGetComm((PetscObject)viewer,&comm);
366:   MPI_Comm_rank(comm,&rank);
367:   PetscViewerASCIIPrintf(viewer,message);
368:   PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
369:   if (resident && residentmax && allocated) {
370:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g max process memory %g\n",rank,allocated,maximum,rank,resident,residentmax);
371:   } else if (resident && residentmax) {
372:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Run with -malloc to get statistics on PetscMalloc() calls\n[%d]Current process memory %g max process memory %g\n",rank,rank,resident,residentmax);
373:   } else if (resident && allocated) {
374:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g, run with -memory_info to get max memory usage\n",rank,allocated,maximum,rank,resident);
375:   } else if (allocated) {
376:     PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
377:   } else {
378:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
379:   }
380:   PetscViewerFlush(viewer);
381:   PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
382:   return(0);
383: }

387: /*@C
388:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
389:    
390:     Not Collective

392:     Output Parameters:
393: .   space - number of bytes currently allocated

395:     Level: intermediate

397:     Concepts: memory usage

399: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
400:           PetscMemoryGetMaximumUsage()
401:  @*/
402: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
403: {
405:   *space = (PetscLogDouble) TRallocated;
406:   return(0);
407: }

411: /*@C
412:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
413:         during this run.
414:    
415:     Not Collective

417:     Output Parameters:
418: .   space - maximum number of bytes ever allocated at one time

420:     Level: intermediate

422:     Concepts: memory usage

424: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
425:           PetscMemoryGetCurrentUsage()
426:  @*/
427: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
428: {
430:   *space = (PetscLogDouble) TRMaxMem;
431:   return(0);
432: }

436: /*@C
437:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information 
438:    printed is: size of space (in bytes), address of space, id of space, 
439:    file in which space was allocated, and line number at which it was 
440:    allocated.

442:    Collective on PETSC_COMM_WORLD

444:    Input Parameter:
445: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

447:    Options Database Key:
448: .  -malloc_dump - Dumps unfreed memory during call to PetscFinalize()

450:    Level: intermediate

452:    Fortran Note:
453:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
454:    The fp defaults to stdout.

456:    Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
457:           has been freed.

459:    Concepts: memory usage
460:    Concepts: memory bleeding
461:    Concepts: bleeding memory

463: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog() 
464: @*/
465: PetscErrorCode  PetscMallocDump(FILE *fp)
466: {
467:   TRSPACE        *head;
469:   PetscMPIInt    rank;

472:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
473:   if (!fp) fp = PETSC_STDOUT;
474:   if (TRallocated > 0) {
475:     fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
476:   }
477:   head = TRhead;
478:   while (head) {
479:     fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
480: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_USE_PTHREAD)
481:     PetscStackPrint(&head->stack,fp);
482: #endif
483:     head = head->next;
484:   }
485:   return(0);
486: }

488: /* ---------------------------------------------------------------------------- */

492: /*@C
493:     PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().

495:     Not Collective

497:     Options Database Key:
498: .  -malloc_log - Activates PetscMallocDumpLog()

500:     Level: advanced

502: .seealso: PetscMallocDump(), PetscMallocDumpLog()
503: @*/
504: PetscErrorCode  PetscMallocSetDumpLog(void)
505: {

509:   PetscLogMalloc = 0;
510:   PetscMemorySetGetMaximumUsage();
511:   return(0);
512: }

516: /*@C
517:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
518:        PetscMemoryGetMaximumUsage()

520:     Collective on PETSC_COMM_WORLD

522:     Input Parameter:
523: .   fp - file pointer; or PETSC_NULL

525:     Options Database Key:
526: .  -malloc_log - Activates PetscMallocDumpLog()

528:     Level: advanced

530:    Fortran Note:
531:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
532:    The fp defaults to stdout.

534: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
535: @*/
536: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
537: {
538:   PetscInt       i,j,n,dummy,*perm;
539:   size_t         *shortlength;
540:   int            *shortcount,err;
541:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
542:   PetscBool      match;
543:   const char     **shortfunction;
544:   PetscLogDouble rss;
545:   MPI_Status     status;

549:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
550:   MPI_Comm_size(MPI_COMM_WORLD,&size);
551:   /*
552:        Try to get the data printed in order by processor. This will only sometimes work 
553:   */
554:   err = fflush(fp);
555:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

557:   MPI_Barrier(MPI_COMM_WORLD);
558:   if (rank) {
559:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
560:   }

562:   if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"PetscMallocDumpLog() called without call to PetscMallocSetDumpLog() this is often due to\n                      setting the option -malloc_log AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");

564:   if (!fp) fp = PETSC_STDOUT;
565:   PetscMemoryGetMaximumUsage(&rss);
566:   if (rss) {
567:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
568:   } else {
569:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
570:   }
571:   shortcount       = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
572:   shortlength      = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
573:   shortfunction    = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
574:   shortfunction[0] = PetscLogMallocFunction[0];
575:   shortlength[0]   = PetscLogMallocLength[0];
576:   shortcount[0]    = 0;
577:   n = 1;
578:   for (i=1; i<PetscLogMalloc; i++) {
579:     for (j=0; j<n; j++) {
580:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
581:       if (match) {
582:         shortlength[j] += PetscLogMallocLength[i];
583:         shortcount[j]++;
584:         goto foundit;
585:       }
586:     }
587:     shortfunction[n] = PetscLogMallocFunction[i];
588:     shortlength[n]   = PetscLogMallocLength[i];
589:     shortcount[n]    = 1;
590:     n++;
591:     foundit:;
592:   }

594:   perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
595:   for (i=0; i<n; i++) perm[i] = i;
596:   PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);

598:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
599:   for (i=0; i<n; i++) {
600:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
601:   }
602:   free(perm);
603:   free(shortlength);
604:   free(shortcount);
605:   free((char **)shortfunction);
606:   err = fflush(fp);
607:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
608:   if (rank != size-1) {
609:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
610:   }
611:   return(0);
612: }

614: /* ---------------------------------------------------------------------------- */

618: /*@C
619:     PetscMallocDebug - Turns on/off debugging for the memory management routines.

621:     Not Collective

623:     Input Parameter:
624: .   level - PETSC_TRUE or PETSC_FALSE

626:    Level: intermediate

628: .seealso: CHKMEMQ(), PetscMallocValidate()
629: @*/
630: PetscErrorCode  PetscMallocDebug(PetscBool  level)
631: {
633:   TRdebugLevel = level;
634:   return(0);
635: }