Actual source code: mtr.c

petsc-3.4.4 2014-03-13
  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: #include <petscviewer.h>
  8: #if defined(PETSC_HAVE_MALLOC_H)
  9: #include <malloc.h>
 10: #endif


 13: /*
 14:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
 15: */
 16: extern PetscErrorCode  PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
 17: extern PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[],const char[]);
 18: extern PetscErrorCode  PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
 19: extern PetscErrorCode  PetscTrFreeDefault(void*,int,const char[],const char[],const char[]);


 22: #define CLASSID_VALUE   ((PetscClassId) 0xf0e0d0c9)
 23: #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)

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

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

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


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


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

 71: PetscErrorCode PetscSetUseTrMalloc_Private(void)
 72: {

 76:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);

 78:   TRallocated       = 0;
 79:   TRfrags           = 0;
 80:   TRhead            = 0;
 81:   TRid              = 0;
 82:   TRdebugLevel      = PETSC_FALSE;
 83:   TRMaxMem          = 0;
 84:   PetscLogMallocMax = 10000;
 85:   PetscLogMalloc    = -1;
 86:   return(0);
 87: }

 91: /*@C
 92:    PetscMallocValidate - Test the memory for corruption.  This can be used to
 93:    check for memory overwrites.

 95:    Input Parameter:
 96: +  line - line number where call originated.
 97: .  function - name of function calling
 98: .  file - file where function is
 99: -  dir - directory where function is

101:    Return value:
102:    The number of errors detected.

104:    Output Effect:
105:    Error messages are written to stdout.

107:    Level: advanced

109:    Notes:
110:     You should generally use CHKMEMQ as a short cut for calling this
111:     routine.

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

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

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

120: .seealso: CHKMEMQ

122: @*/
123: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
124: {
125:   TRSPACE      *head,*lasthead;
126:   char         *a;
127:   PetscClassId *nend;

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

160: /*
161:     PetscTrMallocDefault - Malloc with tracing.

163:     Input Parameters:
164: +   a   - number of bytes to allocate
165: .   lineno - line number where used.  Use __LINE__ for this
166: .   function - function calling routine. Use __FUNCT__ for this
167: .   filename  - file name where used.  Use __FILE__ for this
168: -   dir - directory where file is. Use __SDIR__ for this

170:     Returns:
171:     double aligned pointer to requested storage, or null if not
172:     available.
173:  */
174: PetscErrorCode  PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void **result)
175: {
176:   TRSPACE        *head;
177:   char           *inew;
178:   size_t         nsize;

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

184:   if (TRdebugLevel) {
185:     PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
186:   }

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

191:   head  = (TRSPACE*)inew;
192:   inew += sizeof(TrSPACE);

194:   if (TRhead) TRhead->prev = head;
195:   head->next   = TRhead;
196:   TRhead       = head;
197:   head->prev   = 0;
198:   head->size   = nsize;
199:   head->id     = TRid;
200:   head->lineno = lineno;

202:   head->filename                 = filename;
203:   head->functionname             = function;
204:   head->dirname                  = dir;
205:   head->classid                  = CLASSID_VALUE;
206:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

208:   TRallocated += nsize;
209:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
210:   TRfrags++;

212: #if defined(PETSC_USE_DEBUG)
213:   if (PetscStackActive()) {
214:     PetscStackCopy((PetscStack*)PetscThreadLocalGetValue(petscstack),&head->stack);
216:     head->stack.line[head->stack.currentsize-2] = lineno;
217:   }
218: #endif

220:   /*
221:          Allow logging of all mallocs made
222:   */
223:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
224:     if (!PetscLogMalloc) {
225:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
226:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

228:       PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
229:       if (!PetscLogMallocDirectory) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

231:       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
232:       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

234:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
235:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
236:     }
237:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
238:     PetscLogMallocDirectory[PetscLogMalloc]  = dir;
239:     PetscLogMallocFile[PetscLogMalloc]       = filename;
240:     PetscLogMallocFunction[PetscLogMalloc++] = function;
241:   }
242:   *result = (void*)inew;
243:   return(0);
244: }


249: /*
250:    PetscTrFreeDefault - Free with tracing.

252:    Input Parameters:
253: .   a    - pointer to a block allocated with PetscTrMalloc
254: .   lineno - line number where used.  Use __LINE__ for this
255: .   function - function calling routine. Use __FUNCT__ for this
256: .   file  - file name where used.  Use __FILE__ for this
257: .   dir - directory where file is. Use __SDIR__ for this
258:  */
259: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
260: {
261:   char           *a = (char*)aa;
262:   TRSPACE        *head;
263:   char           *ahead;
265:   PetscClassId   *nend;

268:   /* Do not try to handle empty blocks */
269:   if (!a) {
270:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
271:     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);
272:   }

274:   if (TRdebugLevel) {
275:     PetscMallocValidate(line,function,file,dir);
276:   }

278:   ahead = a;
279:   a     = a - sizeof(TrSPACE);
280:   head  = (TRSPACE*)a;

282:   if (head->classid != CLASSID_VALUE) {
283:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
284:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
285:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
286:   }
287:   nend = (PetscClassId*)(ahead + head->size);
288:   if (*nend != CLASSID_VALUE) {
289:     if (*nend == ALREADY_FREED) {
290:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
291:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
292:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
293:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
294:       } else {
295:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
296:       }
297:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
298:     } else {
299:       /* Damaged tail */
300:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
301:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
302:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
303:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
304:     }
305:   }
306:   /* Mark the location freed */
307:   *nend = ALREADY_FREED;
308:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
309:   if (line > 0 && line < 50000) {
310:     head->lineno       = line;
311:     head->filename     = file;
312:     head->functionname = function;
313:     head->dirname      = dir;
314:   } else {
315:     head->lineno = -head->lineno;
316:   }
317:   /* zero out memory - helps to find some reuse of already freed memory */
318:   PetscMemzero(aa,head->size);

320:   TRallocated -= head->size;
321:   TRfrags--;
322:   if (head->prev) head->prev->next = head->next;
323:   else TRhead = head->next;

325:   if (head->next) head->next->prev = head->prev;
326:   PetscFreeAlign(a,line,function,file,dir);
327:   return(0);
328: }


333: /*@C
334:     PetscMemoryShowUsage - Shows the amount of memory currently being used
335:         in a communicator.

337:     Collective on PetscViewer

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

343:     Level: intermediate

345:     Concepts: memory usage

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

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

385: /*@C
386:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed

388:     Not Collective

390:     Output Parameters:
391: .   space - number of bytes currently allocated

393:     Level: intermediate

395:     Concepts: memory usage

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

409: /*@C
410:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
411:         during this run.

413:     Not Collective

415:     Output Parameters:
416: .   space - maximum number of bytes ever allocated at one time

418:     Level: intermediate

420:     Concepts: memory usage

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

432: #if defined(PETSC_USE_DEBUG)
435: /*@C
436:    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory

438:    Collective on PETSC_COMM_WORLD

440:    Input Parameter:
441: .    ptr - the memory location

443:    Output Paramter:
444: .    stack - the stack indicating where the program allocated this memory

446:    Level: intermediate

448: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
449: @*/
450: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
451: {
452:   TRSPACE *head;

455:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
456:   *stack = &head->stack;
457:   return(0);
458: }
459: #else
462: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
463: {
465:   *stack = 0;
466:   return(0);
467: }
468: #endif

472: /*@C
473:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
474:    printed is: size of space (in bytes), address of space, id of space,
475:    file in which space was allocated, and line number at which it was
476:    allocated.

478:    Collective on PETSC_COMM_WORLD

480:    Input Parameter:
481: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

486:    Level: intermediate

488:    Fortran Note:
489:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
490:    The fp defaults to stdout.

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

495:    Concepts: memory usage
496:    Concepts: memory bleeding
497:    Concepts: bleeding memory

499: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
500: @*/
501: PetscErrorCode  PetscMallocDump(FILE *fp)
502: {
503:   TRSPACE        *head;
505:   PetscMPIInt    rank;

508:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
509:   if (!fp) fp = PETSC_STDOUT;
510:   if (TRallocated > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
511:   head = TRhead;
512:   while (head) {
513:     fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
514: #if defined(PETSC_USE_DEBUG)
515:     PetscStackPrint(&head->stack,fp);
516: #endif
517:     head = head->next;
518:   }
519:   return(0);
520: }

522: /* ---------------------------------------------------------------------------- */

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

529:     Not Collective

531:     Options Database Key:
532: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
533: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

535:     Level: advanced

537: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
538: @*/
539: PetscErrorCode PetscMallocSetDumpLog(void)
540: {

544:   PetscLogMalloc = 0;

546:   PetscMemorySetGetMaximumUsage();
547:   return(0);
548: }

552: /*@C
553:     PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().

555:     Not Collective

557:     Input Arguments:
558: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

560:     Options Database Key:
561: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
562: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

564:     Level: advanced

566: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
567: @*/
568: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
569: {

573:   PetscMallocSetDumpLog();
574:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
575:   PetscLogMallocThreshold = (size_t)logmin;
576:   return(0);
577: }

581: /*@C
582:     PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged

584:     Not Collective

586:     Output Arguments
587: .   logging - PETSC_TRUE if logging is active

589:     Options Database Key:
590: .  -malloc_log - Activates PetscMallocDumpLog()

592:     Level: advanced

594: .seealso: PetscMallocDump(), PetscMallocDumpLog()
595: @*/
596: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
597: {

600:   *logging = (PetscBool)(PetscLogMalloc >= 0);
601:   return(0);
602: }

606: /*@C
607:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
608:        PetscMemoryGetMaximumUsage()

610:     Collective on PETSC_COMM_WORLD

612:     Input Parameter:
613: .   fp - file pointer; or NULL

615:     Options Database Key:
616: .  -malloc_log - Activates PetscMallocDumpLog()

618:     Level: advanced

620:    Fortran Note:
621:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
622:    The fp defaults to stdout.

624: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
625: @*/
626: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
627: {
628:   PetscInt       i,j,n,dummy,*perm;
629:   size_t         *shortlength;
630:   int            *shortcount,err;
631:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
632:   PetscBool      match;
633:   const char     **shortfunction;
634:   PetscLogDouble rss;
635:   MPI_Status     status;

639:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
640:   MPI_Comm_size(MPI_COMM_WORLD,&size);
641:   /*
642:        Try to get the data printed in order by processor. This will only sometimes work
643:   */
644:   err = fflush(fp);
645:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

647:   MPI_Barrier(MPI_COMM_WORLD);
648:   if (rank) {
649:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
650:   }

652:   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()");

654:   if (!fp) fp = PETSC_STDOUT;
655:   PetscMemoryGetMaximumUsage(&rss);
656:   if (rss) {
657:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
658:   } else {
659:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
660:   }
661:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
662:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
663:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
664:   for (i=0,n=0; i<PetscLogMalloc; i++) {
665:     for (j=0; j<n; j++) {
666:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
667:       if (match) {
668:         shortlength[j] += PetscLogMallocLength[i];
669:         shortcount[j]++;
670:         goto foundit;
671:       }
672:     }
673:     shortfunction[n] = PetscLogMallocFunction[i];
674:     shortlength[n]   = PetscLogMallocLength[i];
675:     shortcount[n]    = 1;
676:     n++;
677: foundit:;
678:   }

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

684:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
685:   for (i=0; i<n; i++) {
686:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
687:   }
688:   free(perm);
689:   free(shortlength);
690:   free(shortcount);
691:   free((char**)shortfunction);
692:   err = fflush(fp);
693:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
694:   if (rank != size-1) {
695:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
696:   }
697:   return(0);
698: }

700: /* ---------------------------------------------------------------------------- */

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

707:     Not Collective

709:     Input Parameter:
710: .   level - PETSC_TRUE or PETSC_FALSE

712:    Level: intermediate

714: .seealso: CHKMEMQ(), PetscMallocValidate()
715: @*/
716: PetscErrorCode  PetscMallocDebug(PetscBool level)
717: {
719:   TRdebugLevel = level;
720:   return(0);
721: }

725: /*@C
726:     PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.

728:     Not Collective

730:     Output Parameter:
731: .    flg - PETSC_TRUE if any debugger

733:    Level: intermediate

735:     Note that by default, the debug version always does some debugging unless you run with -malloc no


738: .seealso: CHKMEMQ(), PetscMallocValidate()
739: @*/
740: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
741: {
743:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
744:   else *flg = PETSC_FALSE;
745:   return(0);
746: }