Actual source code: mtr.c

petsc-master 2019-08-15
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>
  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: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,PetscBool,int,const char[],const char[],void**);
 17: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
 18: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t,int,const char[],const char[],void**);
 19: PETSC_EXTERN PetscErrorCode PetscTrMallocDefault(size_t,PetscBool,int,const char[],const char[],void**);
 20: PETSC_EXTERN PetscErrorCode PetscTrFreeDefault(void*,int,const char[],const char[]);
 21: PETSC_EXTERN PetscErrorCode PetscTrReallocDefault(size_t,int,const char[],const char[],void**);


 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:   PetscClassId classid;
 34: #if defined(PETSC_USE_DEBUG)
 35:   PetscStack   stack;
 36: #endif
 37:   struct _trSPACE *next,*prev;
 38: } TRSPACE;

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

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


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

 55: #define MAXTRMAXMEMS 50
 56: static size_t    TRallocated  = 0;
 57: static int       TRfrags      = 0;
 58: static TRSPACE   *TRhead      = NULL;
 59: static int       TRid         = 0;
 60: static PetscBool TRdebugLevel = PETSC_FALSE;
 61: static size_t    TRMaxMem     = 0;
 62: static int       NumTRMaxMems = 0;
 63: static size_t    TRMaxMems[MAXTRMAXMEMS];
 64: static int       TRMaxMemsEvents[MAXTRMAXMEMS];
 65: /*
 66:       Arrays to log information on all Mallocs
 67: */
 68: static int        PetscLogMallocMax       = 10000;
 69: static int        PetscLogMalloc          = -1;
 70: static size_t     PetscLogMallocThreshold = 0;
 71: static size_t     *PetscLogMallocLength;
 72: static const char **PetscLogMallocFile,**PetscLogMallocFunction;
 73: static PetscBool  PetscSetUseTrMallocCalled = PETSC_FALSE;

 75: PETSC_INTERN PetscErrorCode PetscSetUseTrMalloc_Private(void)
 76: {

 80:   if (PetscSetUseTrMallocCalled) return(0);
 81:   PetscSetUseTrMallocCalled = PETSC_TRUE;
 82:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
 83:   PetscTrRealloc = PetscTrReallocDefault;

 85:   TRallocated       = 0;
 86:   TRfrags           = 0;
 87:   TRhead            = NULL;
 88:   TRid              = 0;
 89:   TRdebugLevel      = PETSC_FALSE;
 90:   TRMaxMem          = 0;
 91:   PetscLogMallocMax = 10000;
 92:   PetscLogMalloc    = -1;
 93:   return(0);
 94: }

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

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

105:    Return value:
106:    The number of errors detected.

108:    Output Effect:
109:    Error messages are written to stdout.

111:    Level: advanced

113:    Notes:
114:     This is only run if PetscMallocDebug() has been called which is set by -malloc_test (if debugging is turned on) or -malloc_debug (any time)

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

119:     The line, function, file are given by the C preprocessor as

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

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

125: .seealso: CHKMEMQ

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

134:   if (!TRdebugLevel) return 0;
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\n",function,line,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) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
143:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
144:     }
145:     a    = (char*)(((TrSPACE*)head) + 1);
146:     nend = (PetscClassId*)(a + head->size);
147:     if (*nend != CLASSID_VALUE) {
148:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
149:       if (*nend == ALREADY_FREED) {
150:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
151:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
152:       } else {
153:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
154:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
155:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
156:       }
157:     }
158:     lasthead = head;
159:     head     = head->next;
160:   }
161:   return(0);
162: }

164: /*
165:     PetscTrMallocDefault - Malloc with tracing.

167:     Input Parameters:
168: +   a   - number of bytes to allocate
169: .   lineno - line number where used.  Use __LINE__ for this
170: -   filename  - file name where used.  Use __FILE__ for this

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

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

187:   PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);

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

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

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

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

208:   TRallocated += nsize;
209:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
210:   if (PetscLogMemory) {
211:     PetscInt i;
212:     for (i=0; i<NumTRMaxMems; i++) {
213:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
214:     }
215:   }
216:   TRfrags++;

218: #if defined(PETSC_USE_DEBUG)
219:   if (PetscStackActive()) {
220:     PetscStackCopy(petscstack,&head->stack);
222:     head->stack.line[head->stack.currentsize-2] = lineno;
223:   } else {
224:     head->stack.currentsize = 0;
225:   }
226: #endif

228:   /*
229:          Allow logging of all mallocs made
230:   */
231:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
232:     if (!PetscLogMalloc) {
233:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
234:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

239:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
240:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
241:     }
242:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
243:     PetscLogMallocFile[PetscLogMalloc]       = filename;
244:     PetscLogMallocFunction[PetscLogMalloc++] = function;
245:   }
246:   *result = (void*)inew;
247:   return(0);
248: }


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: .   file  - file name where used.  Use __FILE__ for this
258:  */
259: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
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) return(0);

271:   PetscMallocValidate(line,function,file);

273:   ahead = a;
274:   a     = a - sizeof(TrSPACE);
275:   head  = (TRSPACE*)a;

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

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



324: /*
325:   PetscTrReallocDefault - Realloc with tracing.

327:   Input Parameters:
328: + len      - number of bytes to allocate
329: . lineno   - line number where used.  Use __LINE__ for this
330: . filename - file name where used.  Use __FILE__ for this
331: - result   - double aligned pointer to initial storage.

333:   Output Parameter:
334: . result - double aligned pointer to requested storage, or null if not available.

336:   Level: developer

338: .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
339: */
340: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
341: {
342:   char           *a = (char *) *result;
343:   TRSPACE        *head;
344:   char           *ahead, *inew;
345:   PetscClassId   *nend;
346:   size_t         nsize;

350:   /* Realloc to zero = free */
351:   if (!len) {
352:     PetscTrFreeDefault(*result,lineno,function,filename);
353:     *result = NULL;
354:     return(0);
355:   }
356:   /* Realloc with NULL = malloc */
357:   if (!*result) {
358:     PetscTrMallocDefault(len,PETSC_FALSE,lineno,function,filename,result);
359:     return(0);
360:   }

362:   PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);

364:   ahead = a;
365:   a     = a - sizeof(TrSPACE);
366:   head  = (TRSPACE *) a;
367:   inew  = a;

369:   if (head->classid != CLASSID_VALUE) {
370:     (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
371:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
372:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
373:   }
374:   nend = (PetscClassId *)(ahead + head->size);
375:   if (*nend != CLASSID_VALUE) {
376:     if (*nend == ALREADY_FREED) {
377:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
378:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
379:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
380:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
381:       } else {
382:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
383:       }
384:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
385:     } else {
386:       /* Damaged tail */
387:       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
388:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
389:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
390:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
391:     }
392:   }

394:   TRallocated -= head->size;
395:   TRfrags--;
396:   if (head->prev) head->prev->next = head->next;
397:   else TRhead = head->next;
398:   if (head->next) head->next->prev = head->prev;

400:   nsize = (len + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
401:   PetscReallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);

403:   head  = (TRSPACE*)inew;
404:   inew += sizeof(TrSPACE);

406:   if (TRhead) TRhead->prev = head;
407:   head->next   = TRhead;
408:   TRhead       = head;
409:   head->prev   = NULL;
410:   head->size   = nsize;
411:   head->id     = TRid;
412:   head->lineno = lineno;

414:   head->filename                 = filename;
415:   head->functionname             = function;
416:   head->classid                  = CLASSID_VALUE;
417:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

419:   TRallocated += nsize;
420:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
421:   if (PetscLogMemory) {
422:     PetscInt i;
423:     for (i=0; i<NumTRMaxMems; i++) {
424:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
425:     }
426:   }
427:   TRfrags++;

429: #if defined(PETSC_USE_DEBUG)
430:   if (PetscStackActive()) {
431:     PetscStackCopy(petscstack,&head->stack);
433:     head->stack.line[head->stack.currentsize-2] = lineno;
434:   } else {
435:     head->stack.currentsize = 0;
436:   }
437: #endif

439:   /*
440:          Allow logging of all mallocs made
441:   */
442:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
443:     if (!PetscLogMalloc) {
444:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
445:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

450:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
451:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
452:     }
453:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
454:     PetscLogMallocFile[PetscLogMalloc]       = filename;
455:     PetscLogMallocFunction[PetscLogMalloc++] = function;
456:   }
457:   *result = (void*)inew;
458:   return(0);
459: }


462: /*@C
463:     PetscMemoryView - Shows the amount of memory currently being used
464:         in a communicator.

466:     Collective on PetscViewer

468:     Input Parameter:
469: +    viewer - the viewer that defines the communicator
470: -    message - string printed before values

472:     Options Database:
473: +    -malloc - have PETSc track how much memory it has allocated
474: -    -memory_view - during PetscFinalize() have this routine called

476:     Level: intermediate

478: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
479:  @*/
480: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
481: {
482:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
483:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
485:   MPI_Comm       comm;

488:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
489:   PetscMallocGetCurrentUsage(&allocated);
490:   PetscMallocGetMaximumUsage(&allocatedmax);
491:   PetscMemoryGetCurrentUsage(&resident);
492:   PetscMemoryGetMaximumUsage(&residentmax);
493:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
494:   PetscObjectGetComm((PetscObject)viewer,&comm);
495:   PetscViewerASCIIPrintf(viewer,message);
496:   if (resident && residentmax && allocated) {
497:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
498:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
499:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
500:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
501:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
502:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
503:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
504:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
505:     MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
506:     MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
507:     MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
508:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
509:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
510:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
511:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
512:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
513:   } else if (resident && residentmax) {
514:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
515:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
516:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
517:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
518:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
519:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
520:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
521:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
522:   } else if (resident && allocated) {
523:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
524:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
525:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
526:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
527:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
528:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
529:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
530:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
531:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
532:   } else if (allocated) {
533:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
534:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
535:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
536:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
537:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
538:     PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
539:   } else {
540:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
541:   }
542:   PetscViewerFlush(viewer);
543:   return(0);
544: }

546: /*@
547:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed

549:     Not Collective

551:     Output Parameters:
552: .   space - number of bytes currently allocated

554:     Level: intermediate

556: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
557:           PetscMemoryGetMaximumUsage()
558:  @*/
559: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
560: {
562:   *space = (PetscLogDouble) TRallocated;
563:   return(0);
564: }

566: /*@
567:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
568:         during this run.

570:     Not Collective

572:     Output Parameters:
573: .   space - maximum number of bytes ever allocated at one time

575:     Level: intermediate

577: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
578:           PetscMallocPushMaximumUsage()
579:  @*/
580: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
581: {
583:   *space = (PetscLogDouble) TRMaxMem;
584:   return(0);
585: }

587: /*@
588:     PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event

590:     Not Collective

592:     Input Parameter:
593: .   event - an event id; this is just for error checking

595:     Level: developer

597: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
598:           PetscMallocPopMaximumUsage()
599:  @*/
600: PetscErrorCode  PetscMallocPushMaximumUsage(int event)
601: {
603:   if (++NumTRMaxMems > MAXTRMAXMEMS) return(0);
604:   TRMaxMems[NumTRMaxMems-1]       = TRallocated;
605:   TRMaxMemsEvents[NumTRMaxMems-1] = event;
606:   return(0);
607: }

609: /*@
610:     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

612:     Not Collective

614:     Input Parameter:
615: .   event - an event id; this is just for error checking

617:     Output Parameter:
618: .   mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event

620:     Level: developer

622: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
623:           PetscMallocPushMaximumUsage()
624:  @*/
625: PetscErrorCode  PetscMallocPopMaximumUsage(int event,PetscLogDouble *mu)
626: {
628:   *mu = 0;
629:   if (NumTRMaxMems-- > MAXTRMAXMEMS) return(0);
630:   if (TRMaxMemsEvents[NumTRMaxMems] != event) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"PetscMallocPush/PopMaximumUsage() are not nested");
631:   *mu = TRMaxMems[NumTRMaxMems];
632:   return(0);
633: }

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

639:    Collective on PETSC_COMM_WORLD

641:    Input Parameter:
642: .    ptr - the memory location

644:    Output Paramter:
645: .    stack - the stack indicating where the program allocated this memory

647:    Level: intermediate

649: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
650: @*/
651: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
652: {
653:   TRSPACE *head;

656:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
657:   *stack = &head->stack;
658:   return(0);
659: }
660: #else
661: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
662: {
664:   *stack = NULL;
665:   return(0);
666: }
667: #endif

669: /*@C
670:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
671:    printed is: size of space (in bytes), address of space, id of space,
672:    file in which space was allocated, and line number at which it was
673:    allocated.

675:    Collective on PETSC_COMM_WORLD

677:    Input Parameter:
678: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

683:    Level: intermediate

685:    Fortran Note:
686:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
687:    The fp defaults to stdout.

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

693: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
694: @*/
695: PetscErrorCode  PetscMallocDump(FILE *fp)
696: {
697:   TRSPACE        *head;
698:   size_t         libAlloc = 0;
700:   PetscMPIInt    rank;

703:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
704:   if (!fp) fp = PETSC_STDOUT;
705:   head = TRhead;
706:   while (head) {
707:     libAlloc += head->size;
708:     head = head->next;
709:   }
710:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
711:   head = TRhead;
712:   while (head) {
713:     PetscBool isLib;

715:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
716:     if (!isLib) {
717:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
718: #if defined(PETSC_USE_DEBUG)
719:       PetscStackPrint(&head->stack,fp);
720: #endif
721:     }
722:     head = head->next;
723:   }
724:   return(0);
725: }

727: /* ---------------------------------------------------------------------------- */

729: /*@
730:     PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().

732:     Not Collective

734:     Options Database Key:
735: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
736: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

738:     Level: advanced

740: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
741: @*/
742: PetscErrorCode PetscMallocSetDumpLog(void)
743: {

747:   PetscLogMalloc = 0;

749:   PetscMemorySetGetMaximumUsage();
750:   return(0);
751: }

753: /*@
754:     PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().

756:     Not Collective

758:     Input Arguments:
759: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

761:     Options Database Key:
762: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
763: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

765:     Level: advanced

767: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
768: @*/
769: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
770: {

774:   PetscMallocSetDumpLog();
775:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
776:   PetscLogMallocThreshold = (size_t)logmin;
777:   return(0);
778: }

780: /*@
781:     PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged

783:     Not Collective

785:     Output Arguments
786: .   logging - PETSC_TRUE if logging is active

788:     Options Database Key:
789: .  -malloc_log - Activates PetscMallocDumpLog()

791:     Level: advanced

793: .seealso: PetscMallocDump(), PetscMallocDumpLog()
794: @*/
795: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
796: {

799:   *logging = (PetscBool)(PetscLogMalloc >= 0);
800:   return(0);
801: }

803: /*@C
804:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
805:        PetscMemoryGetMaximumUsage()

807:     Collective on PETSC_COMM_WORLD

809:     Input Parameter:
810: .   fp - file pointer; or NULL

812:     Options Database Key:
813: .  -malloc_log - Activates PetscMallocDumpLog()

815:     Level: advanced

817:    Fortran Note:
818:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
819:    The fp defaults to stdout.

821: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
822: @*/
823: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
824: {
825:   PetscInt       i,j,n,dummy,*perm;
826:   size_t         *shortlength;
827:   int            *shortcount,err;
828:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
829:   PetscBool      match;
830:   const char     **shortfunction;
831:   PetscLogDouble rss;
832:   MPI_Status     status;

836:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
837:   MPI_Comm_size(MPI_COMM_WORLD,&size);
838:   /*
839:        Try to get the data printed in order by processor. This will only sometimes work
840:   */
841:   err = fflush(fp);
842:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

844:   MPI_Barrier(MPI_COMM_WORLD);
845:   if (rank) {
846:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
847:   }

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

851:   if (!fp) fp = PETSC_STDOUT;
852:   PetscMemoryGetMaximumUsage(&rss);
853:   if (rss) {
854:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
855:   } else {
856:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
857:   }
858:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
859:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
860:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
861:   for (i=0,n=0; i<PetscLogMalloc; i++) {
862:     for (j=0; j<n; j++) {
863:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
864:       if (match) {
865:         shortlength[j] += PetscLogMallocLength[i];
866:         shortcount[j]++;
867:         goto foundit;
868:       }
869:     }
870:     shortfunction[n] = PetscLogMallocFunction[i];
871:     shortlength[n]   = PetscLogMallocLength[i];
872:     shortcount[n]    = 1;
873:     n++;
874: foundit:;
875:   }

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

881:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
882:   for (i=0; i<n; i++) {
883:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
884:   }
885:   free(perm);
886:   free(shortlength);
887:   free(shortcount);
888:   free((char**)shortfunction);
889:   err = fflush(fp);
890:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
891:   if (rank != size-1) {
892:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
893:   }
894:   return(0);
895: }

897: /* ---------------------------------------------------------------------------- */

899: /*@
900:     PetscMallocDebug - Turns on/off debugging for the memory management routines.

902:     Not Collective

904:     Input Parameter:
905: .   level - PETSC_TRUE or PETSC_FALSE

907:    Level: intermediate

909: .seealso: CHKMEMQ(), PetscMallocValidate()
910: @*/
911: PetscErrorCode  PetscMallocDebug(PetscBool level)
912: {
914:   TRdebugLevel = level;
915:   return(0);
916: }

918: /*@
919:     PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.

921:     Not Collective

923:     Output Parameter:
924: .    flg - PETSC_TRUE if any debugger

926:    Level: intermediate

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


931: .seealso: CHKMEMQ(), PetscMallocValidate()
932: @*/
933: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
934: {
936:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
937:   else *flg = PETSC_FALSE;
938:   return(0);
939: }