Actual source code: mtr.c

petsc-dev 2014-02-02
Report Typos and Errors
  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[],void**);
 17: extern PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[]);
 18: extern PetscErrorCode  PetscTrMallocDefault(size_t,int,const char[],const char[],void**);
 19: extern PetscErrorCode  PetscTrFreeDefault(void*,int,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:   PetscClassId classid;
 32: #if defined(PETSC_USE_DEBUG)
 33:   PetscStack   stack;
 34: #endif
 35:   struct _trSPACE *next,*prev;
 36: } TRSPACE;

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

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


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


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

 70: PetscErrorCode PetscSetUseTrMalloc_Private(void)
 71: {

 75:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);

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

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

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

 99:    Return value:
100:    The number of errors detected.

102:    Output Effect:
103:    Error messages are written to stdout.

105:    Level: advanced

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

111:     The line, function, file are given by the C preprocessor as
112:     __LINE__, __FUNCT__, __FILE__

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

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

118: .seealso: CHKMEMQ

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

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

158: /*
159:     PetscTrMallocDefault - Malloc with tracing.

161:     Input Parameters:
162: +   a   - number of bytes to allocate
163: .   lineno - line number where used.  Use __LINE__ for this
164: .   function - function calling routine. Use __FUNCT__ for this
165: -   filename  - file name where used.  Use __FILE__ for this

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

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

181:   if (TRdebugLevel) {
182:     PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
183:   }

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

188:   head  = (TRSPACE*)inew;
189:   inew += sizeof(TrSPACE);

191:   if (TRhead) TRhead->prev = head;
192:   head->next   = TRhead;
193:   TRhead       = head;
194:   head->prev   = 0;
195:   head->size   = nsize;
196:   head->id     = TRid;
197:   head->lineno = lineno;

199:   head->filename                 = filename;
200:   head->functionname             = function;
201:   head->classid                  = CLASSID_VALUE;
202:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

204:   TRallocated += nsize;
205:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
206:   TRfrags++;

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

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

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

227:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
228:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
229:     }
230:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
231:     PetscLogMallocFile[PetscLogMalloc]       = filename;
232:     PetscLogMallocFunction[PetscLogMalloc++] = function;
233:   }
234:   *result = (void*)inew;
235:   return(0);
236: }


241: /*
242:    PetscTrFreeDefault - Free with tracing.

244:    Input Parameters:
245: .   a    - pointer to a block allocated with PetscTrMalloc
246: .   lineno - line number where used.  Use __LINE__ for this
247: .   function - function calling routine. Use __FUNCT__ for this
248: .   file  - file name where used.  Use __FILE__ for this
249:  */
250: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
251: {
252:   char           *a = (char*)aa;
253:   TRSPACE        *head;
254:   char           *ahead;
256:   PetscClassId   *nend;

259:   /* Do not try to handle empty blocks */
260:   if (!a) {
261:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s\n",function,line,file);
262:     SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s\n",function,line,file);
263:   }

265:   if (TRdebugLevel) {
266:     PetscMallocValidate(line,function,file);
267:   }

269:   ahead = a;
270:   a     = a - sizeof(TrSPACE);
271:   head  = (TRSPACE*)a;

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

310:   TRallocated -= head->size;
311:   TRfrags--;
312:   if (head->prev) head->prev->next = head->next;
313:   else TRhead = head->next;

315:   if (head->next) head->next->prev = head->prev;
316:   PetscFreeAlign(a,line,function,file);
317:   return(0);
318: }


323: /*@C
324:     PetscMemoryShowUsage - Shows the amount of memory currently being used
325:         in a communicator.

327:     Collective on PetscViewer

329:     Input Parameter:
330: +    viewer - the viewer that defines the communicator
331: -    message - string printed before values

333:     Level: intermediate

335:     Concepts: memory usage

337: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
338:  @*/
339: PetscErrorCode  PetscMemoryShowUsage(PetscViewer viewer,const char message[])
340: {
341:   PetscLogDouble allocated,maximum,resident,residentmax;
343:   PetscMPIInt    rank;
344:   MPI_Comm       comm;

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

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

378:     Not Collective

380:     Output Parameters:
381: .   space - number of bytes currently allocated

383:     Level: intermediate

385:     Concepts: memory usage

387: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
388:           PetscMemoryGetMaximumUsage()
389:  @*/
390: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
391: {
393:   *space = (PetscLogDouble) TRallocated;
394:   return(0);
395: }

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

403:     Not Collective

405:     Output Parameters:
406: .   space - maximum number of bytes ever allocated at one time

408:     Level: intermediate

410:     Concepts: memory usage

412: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
413:           PetscMemoryGetCurrentUsage()
414:  @*/
415: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
416: {
418:   *space = (PetscLogDouble) TRMaxMem;
419:   return(0);
420: }

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

428:    Collective on PETSC_COMM_WORLD

430:    Input Parameter:
431: .    ptr - the memory location

433:    Output Paramter:
434: .    stack - the stack indicating where the program allocated this memory

436:    Level: intermediate

438: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
439: @*/
440: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
441: {
442:   TRSPACE *head;

445:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
446:   *stack = &head->stack;
447:   return(0);
448: }
449: #else
452: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
453: {
455:   *stack = 0;
456:   return(0);
457: }
458: #endif

462: /*@C
463:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
464:    printed is: size of space (in bytes), address of space, id of space,
465:    file in which space was allocated, and line number at which it was
466:    allocated.

468:    Collective on PETSC_COMM_WORLD

470:    Input Parameter:
471: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

476:    Level: intermediate

478:    Fortran Note:
479:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
480:    The fp defaults to stdout.

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

485:    Concepts: memory usage
486:    Concepts: memory bleeding
487:    Concepts: bleeding memory

489: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
490: @*/
491: PetscErrorCode  PetscMallocDump(FILE *fp)
492: {
493:   TRSPACE        *head;
495:   PetscMPIInt    rank;

498:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
499:   if (!fp) fp = PETSC_STDOUT;
500:   if (TRallocated > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
501:   head = TRhead;
502:   while (head) {
503:     fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
504: #if defined(PETSC_USE_DEBUG)
505:     PetscStackPrint(&head->stack,fp);
506: #endif
507:     head = head->next;
508:   }
509:   return(0);
510: }

512: /* ---------------------------------------------------------------------------- */

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

519:     Not Collective

521:     Options Database Key:
522: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
523: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

525:     Level: advanced

527: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
528: @*/
529: PetscErrorCode PetscMallocSetDumpLog(void)
530: {

534:   PetscLogMalloc = 0;

536:   PetscMemorySetGetMaximumUsage();
537:   return(0);
538: }

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

545:     Not Collective

547:     Input Arguments:
548: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

550:     Options Database Key:
551: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
552: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

554:     Level: advanced

556: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
557: @*/
558: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
559: {

563:   PetscMallocSetDumpLog();
564:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
565:   PetscLogMallocThreshold = (size_t)logmin;
566:   return(0);
567: }

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

574:     Not Collective

576:     Output Arguments
577: .   logging - PETSC_TRUE if logging is active

579:     Options Database Key:
580: .  -malloc_log - Activates PetscMallocDumpLog()

582:     Level: advanced

584: .seealso: PetscMallocDump(), PetscMallocDumpLog()
585: @*/
586: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
587: {

590:   *logging = (PetscBool)(PetscLogMalloc >= 0);
591:   return(0);
592: }

596: /*@C
597:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
598:        PetscMemoryGetMaximumUsage()

600:     Collective on PETSC_COMM_WORLD

602:     Input Parameter:
603: .   fp - file pointer; or NULL

605:     Options Database Key:
606: .  -malloc_log - Activates PetscMallocDumpLog()

608:     Level: advanced

610:    Fortran Note:
611:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
612:    The fp defaults to stdout.

614: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
615: @*/
616: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
617: {
618:   PetscInt       i,j,n,dummy,*perm;
619:   size_t         *shortlength;
620:   int            *shortcount,err;
621:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
622:   PetscBool      match;
623:   const char     **shortfunction;
624:   PetscLogDouble rss;
625:   MPI_Status     status;

629:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
630:   MPI_Comm_size(MPI_COMM_WORLD,&size);
631:   /*
632:        Try to get the data printed in order by processor. This will only sometimes work
633:   */
634:   err = fflush(fp);
635:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

637:   MPI_Barrier(MPI_COMM_WORLD);
638:   if (rank) {
639:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
640:   }

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

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

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

674:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
675:   for (i=0; i<n; i++) {
676:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
677:   }
678:   free(perm);
679:   free(shortlength);
680:   free(shortcount);
681:   free((char**)shortfunction);
682:   err = fflush(fp);
683:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
684:   if (rank != size-1) {
685:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
686:   }
687:   return(0);
688: }

690: /* ---------------------------------------------------------------------------- */

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

697:     Not Collective

699:     Input Parameter:
700: .   level - PETSC_TRUE or PETSC_FALSE

702:    Level: intermediate

704: .seealso: CHKMEMQ(), PetscMallocValidate()
705: @*/
706: PetscErrorCode  PetscMallocDebug(PetscBool level)
707: {
709:   TRdebugLevel = level;
710:   return(0);
711: }

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

718:     Not Collective

720:     Output Parameter:
721: .    flg - PETSC_TRUE if any debugger

723:    Level: intermediate

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


728: .seealso: CHKMEMQ(), PetscMallocValidate()
729: @*/
730: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
731: {
733:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
734:   else *flg = PETSC_FALSE;
735:   return(0);
736: }