Actual source code: mtr.c

petsc-3.7.0 2016-04-25
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      = NULL;
 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;
 64: static int        PetscLogMalloc          = -1;
 65: static size_t     PetscLogMallocThreshold = 0;
 66: static size_t     *PetscLogMallocLength;
 67: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

 71: PetscErrorCode PetscSetUseTrMalloc_Private(void)
 72: {

 76:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);

 78:   TRallocated       = 0;
 79:   TRfrags           = 0;
 80:   TRhead            = NULL;
 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

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

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

106:    Level: advanced

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

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

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

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

119: .seealso: CHKMEMQ

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

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

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

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

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

180:   /* Do not try to handle empty blocks */
181:   if (!a) { *result = NULL; return(0); }

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

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

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

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

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

206:   TRallocated += nsize;
207:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
208:   TRfrags++;

210: #if defined(PETSC_USE_DEBUG)
211:   if (PetscStackActive()) {
212:     PetscStackCopy(petscstack,&head->stack);
214:     head->stack.line[head->stack.currentsize-2] = lineno;
215:   }
216: #endif

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

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

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


243: /*
244:    PetscTrFreeDefault - Free with tracing.

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

261:   /* Do not try to handle empty blocks */
262:   if (!a) return(0);

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

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

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

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

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


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

326:     Collective on PetscViewer

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

332:     Options Database:
333: +    -malloc - have PETSc track how much memory it has allocated
334: -    -memory_view - during PetscFinalize() have this routine called

336:     Level: intermediate

338:     Concepts: memory usage

340: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
341:  @*/
342: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
343: {
344:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
345:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
347:   MPI_Comm       comm;

350:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
351:   PetscMallocGetCurrentUsage(&allocated);
352:   PetscMallocGetMaximumUsage(&allocatedmax);
353:   PetscMemoryGetCurrentUsage(&resident);
354:   PetscMemoryGetMaximumUsage(&residentmax);
355:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
356:   PetscObjectGetComm((PetscObject)viewer,&comm);
357:   PetscViewerASCIIPrintf(viewer,message);
358:   if (resident && residentmax && allocated) {
359:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
360:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
361:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
362:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
363:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
364:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
365:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
366:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
367:     MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
368:     MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
369:     MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
370:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
371:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
372:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
373:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
374:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
375:   } else if (resident && residentmax) {
376:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
377:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
378:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
379:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
380:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
381:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
382:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
383:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
384:   } else if (resident && allocated) {
385:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
386:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
387:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
388:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
389:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
390:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
391:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
392:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
393:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
394:   } else if (allocated) {
395:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
396:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
397:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
398:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
399:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
400:     PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
401:   } else {
402:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
403:   }
404:   PetscViewerFlush(viewer);
405:   return(0);
406: }

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

413:     Not Collective

415:     Output Parameters:
416: .   space - number of bytes currently allocated

418:     Level: intermediate

420:     Concepts: memory usage

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

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

438:     Not Collective

440:     Output Parameters:
441: .   space - maximum number of bytes ever allocated at one time

443:     Level: intermediate

445:     Concepts: memory usage

447: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
448:           PetscMemoryGetCurrentUsage()
449:  @*/
450: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
451: {
453:   *space = (PetscLogDouble) TRMaxMem;
454:   return(0);
455: }

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

463:    Collective on PETSC_COMM_WORLD

465:    Input Parameter:
466: .    ptr - the memory location

468:    Output Paramter:
469: .    stack - the stack indicating where the program allocated this memory

471:    Level: intermediate

473: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
474: @*/
475: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
476: {
477:   TRSPACE *head;

480:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
481:   *stack = &head->stack;
482:   return(0);
483: }
484: #else
487: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
488: {
490:   *stack = NULL;
491:   return(0);
492: }
493: #endif

497: /*@C
498:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
499:    printed is: size of space (in bytes), address of space, id of space,
500:    file in which space was allocated, and line number at which it was
501:    allocated.

503:    Collective on PETSC_COMM_WORLD

505:    Input Parameter:
506: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

511:    Level: intermediate

513:    Fortran Note:
514:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
515:    The fp defaults to stdout.

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

520:    Concepts: memory usage
521:    Concepts: memory bleeding
522:    Concepts: bleeding memory

524: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
525: @*/
526: PetscErrorCode  PetscMallocDump(FILE *fp)
527: {
528:   TRSPACE        *head;
529:   PetscInt       libAlloc = 0;
531:   PetscMPIInt    rank;

534:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
535:   if (!fp) fp = PETSC_STDOUT;
536:   head = TRhead;
537:   while (head) {
538:     PetscBool isLib;

540:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
541:     libAlloc += head->size;
542:     head = head->next;
543:   }
544:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
545:   head = TRhead;
546:   while (head) {
547:     PetscBool isLib;

549:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
550:     if (!isLib) {
551:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
552: #if defined(PETSC_USE_DEBUG)
553:       PetscStackPrint(&head->stack,fp);
554: #endif
555:     }
556:     head = head->next;
557:   }
558:   return(0);
559: }

561: /* ---------------------------------------------------------------------------- */

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

568:     Not Collective

570:     Options Database Key:
571: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
572: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

574:     Level: advanced

576: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
577: @*/
578: PetscErrorCode PetscMallocSetDumpLog(void)
579: {

583:   PetscLogMalloc = 0;

585:   PetscMemorySetGetMaximumUsage();
586:   return(0);
587: }

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

594:     Not Collective

596:     Input Arguments:
597: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

599:     Options Database Key:
600: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
601: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

603:     Level: advanced

605: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
606: @*/
607: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
608: {

612:   PetscMallocSetDumpLog();
613:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
614:   PetscLogMallocThreshold = (size_t)logmin;
615:   return(0);
616: }

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

623:     Not Collective

625:     Output Arguments
626: .   logging - PETSC_TRUE if logging is active

628:     Options Database Key:
629: .  -malloc_log - Activates PetscMallocDumpLog()

631:     Level: advanced

633: .seealso: PetscMallocDump(), PetscMallocDumpLog()
634: @*/
635: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
636: {

639:   *logging = (PetscBool)(PetscLogMalloc >= 0);
640:   return(0);
641: }

645: /*@C
646:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
647:        PetscMemoryGetMaximumUsage()

649:     Collective on PETSC_COMM_WORLD

651:     Input Parameter:
652: .   fp - file pointer; or NULL

654:     Options Database Key:
655: .  -malloc_log - Activates PetscMallocDumpLog()

657:     Level: advanced

659:    Fortran Note:
660:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
661:    The fp defaults to stdout.

663: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
664: @*/
665: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
666: {
667:   PetscInt       i,j,n,dummy,*perm;
668:   size_t         *shortlength;
669:   int            *shortcount,err;
670:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
671:   PetscBool      match;
672:   const char     **shortfunction;
673:   PetscLogDouble rss;
674:   MPI_Status     status;

678:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
679:   MPI_Comm_size(MPI_COMM_WORLD,&size);
680:   /*
681:        Try to get the data printed in order by processor. This will only sometimes work
682:   */
683:   err = fflush(fp);
684:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

686:   MPI_Barrier(MPI_COMM_WORLD);
687:   if (rank) {
688:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
689:   }

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

693:   if (!fp) fp = PETSC_STDOUT;
694:   PetscMemoryGetMaximumUsage(&rss);
695:   if (rss) {
696:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
697:   } else {
698:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
699:   }
700:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
701:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
702:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
703:   for (i=0,n=0; i<PetscLogMalloc; i++) {
704:     for (j=0; j<n; j++) {
705:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
706:       if (match) {
707:         shortlength[j] += PetscLogMallocLength[i];
708:         shortcount[j]++;
709:         goto foundit;
710:       }
711:     }
712:     shortfunction[n] = PetscLogMallocFunction[i];
713:     shortlength[n]   = PetscLogMallocLength[i];
714:     shortcount[n]    = 1;
715:     n++;
716: foundit:;
717:   }

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

723:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
724:   for (i=0; i<n; i++) {
725:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
726:   }
727:   free(perm);
728:   free(shortlength);
729:   free(shortcount);
730:   free((char**)shortfunction);
731:   err = fflush(fp);
732:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
733:   if (rank != size-1) {
734:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
735:   }
736:   return(0);
737: }

739: /* ---------------------------------------------------------------------------- */

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

746:     Not Collective

748:     Input Parameter:
749: .   level - PETSC_TRUE or PETSC_FALSE

751:    Level: intermediate

753: .seealso: CHKMEMQ(), PetscMallocValidate()
754: @*/
755: PetscErrorCode  PetscMallocDebug(PetscBool level)
756: {
758:   TRdebugLevel = level;
759:   return(0);
760: }

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

767:     Not Collective

769:     Output Parameter:
770: .    flg - PETSC_TRUE if any debugger

772:    Level: intermediate

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


777: .seealso: CHKMEMQ(), PetscMallocValidate()
778: @*/
779: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
780: {
782:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
783:   else *flg = PETSC_FALSE;
784:   return(0);
785: }