Actual source code: mtr.c

petsc-master 2019-06-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,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,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:     You should generally use CHKMEMQ as a short cut for calling this
115:     routine.

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

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

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

123: .seealso: CHKMEMQ

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

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

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

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

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

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

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

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

191:   if (PetscLogMemory) {
192:     /* zero the memory to force the value of PetscMemoryGetCurrentUsage() to accurately reflect allocated memory */
193:     PetscMemzero(inew,nsize+sizeof(TrSPACE)+sizeof(PetscClassId));
194:   }

196:   head  = (TRSPACE*)inew;
197:   inew += sizeof(TrSPACE);

199:   if (TRhead) TRhead->prev = head;
200:   head->next   = TRhead;
201:   TRhead       = head;
202:   head->prev   = NULL;
203:   head->size   = nsize;
204:   head->id     = TRid;
205:   head->lineno = lineno;

207:   head->filename                 = filename;
208:   head->functionname             = function;
209:   head->classid                  = CLASSID_VALUE;
210:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

212:   TRallocated += nsize;
213:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
214:   if (PetscLogMemory) {
215:     PetscInt i;
216:     for (i=0; i<NumTRMaxMems; i++) {
217:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
218:     }
219:   }
220:   TRfrags++;

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

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

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

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


255: /*
256:    PetscTrFreeDefault - Free with tracing.

258:    Input Parameters:
259: .   a    - pointer to a block allocated with PetscTrMalloc
260: .   lineno - line number where used.  Use __LINE__ for this
261: .   file  - file name where used.  Use __FILE__ for this
262:  */
263: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
264: {
265:   char           *a = (char*)aa;
266:   TRSPACE        *head;
267:   char           *ahead;
269:   PetscClassId   *nend;

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

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

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

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

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



333: /*
334:   PetscTrReallocDefault - Realloc with tracing.

336:   Input Parameters:
337: + len      - number of bytes to allocate
338: . lineno   - line number where used.  Use __LINE__ for this
339: . filename - file name where used.  Use __FILE__ for this
340: - result   - double aligned pointer to initial storage.

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

345:   Level: developer

347: .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
348: */
349: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
350: {
351:   char           *a = (char *) *result;
352:   TRSPACE        *head;
353:   char           *ahead, *inew;
354:   PetscClassId   *nend;
355:   size_t         nsize;

359:   /* Realloc to zero = free */
360:   if (!len) {
361:     PetscTrFreeDefault(*result,lineno,function,filename);
362:     *result = NULL;
363:     return(0);
364:   }
365:   /* Realloc with NULL = malloc */
366:   if (!*result) {
367:     PetscTrMallocDefault(len,lineno,function,filename,result);
368:     return(0);
369:   }

371:   if (TRdebugLevel) {PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);}

373:   ahead = a;
374:   a     = a - sizeof(TrSPACE);
375:   head  = (TRSPACE *) a;
376:   inew  = a;

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

403:   TRallocated -= head->size;
404:   TRfrags--;
405:   if (head->prev) head->prev->next = head->next;
406:   else TRhead = head->next;
407:   if (head->next) head->next->prev = head->prev;

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

412:   head  = (TRSPACE*)inew;
413:   inew += sizeof(TrSPACE);

415:   if (TRhead) TRhead->prev = head;
416:   head->next   = TRhead;
417:   TRhead       = head;
418:   head->prev   = NULL;
419:   head->size   = nsize;
420:   head->id     = TRid;
421:   head->lineno = lineno;

423:   head->filename                 = filename;
424:   head->functionname             = function;
425:   head->classid                  = CLASSID_VALUE;
426:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

428:   TRallocated += nsize;
429:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
430:   if (PetscLogMemory) {
431:     PetscInt i;
432:     for (i=0; i<NumTRMaxMems; i++) {
433:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
434:     }
435:   }
436:   TRfrags++;

438: #if defined(PETSC_USE_DEBUG)
439:   if (PetscStackActive()) {
440:     PetscStackCopy(petscstack,&head->stack);
442:     head->stack.line[head->stack.currentsize-2] = lineno;
443:   } else {
444:     head->stack.currentsize = 0;
445:   }
446: #endif

448:   /*
449:          Allow logging of all mallocs made
450:   */
451:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
452:     if (!PetscLogMalloc) {
453:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
454:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

459:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
460:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
461:     }
462:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
463:     PetscLogMallocFile[PetscLogMalloc]       = filename;
464:     PetscLogMallocFunction[PetscLogMalloc++] = function;
465:   }
466:   *result = (void*)inew;
467:   return(0);
468: }


471: /*@C
472:     PetscMemoryView - Shows the amount of memory currently being used
473:         in a communicator.

475:     Collective on PetscViewer

477:     Input Parameter:
478: +    viewer - the viewer that defines the communicator
479: -    message - string printed before values

481:     Options Database:
482: +    -malloc - have PETSc track how much memory it has allocated
483: -    -memory_view - during PetscFinalize() have this routine called

485:     Level: intermediate

487: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
488:  @*/
489: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
490: {
491:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
492:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
494:   MPI_Comm       comm;

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

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

558:     Not Collective

560:     Output Parameters:
561: .   space - number of bytes currently allocated

563:     Level: intermediate

565: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
566:           PetscMemoryGetMaximumUsage()
567:  @*/
568: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
569: {
571:   *space = (PetscLogDouble) TRallocated;
572:   return(0);
573: }

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

579:     Not Collective

581:     Output Parameters:
582: .   space - maximum number of bytes ever allocated at one time

584:     Level: intermediate

586: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
587:           PetscMallocPushMaximumUsage()
588:  @*/
589: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
590: {
592:   *space = (PetscLogDouble) TRMaxMem;
593:   return(0);
594: }

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

599:     Not Collective

601:     Input Parameter:
602: .   event - an event id; this is just for error checking

604:     Level: developer

606: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
607:           PetscMallocPopMaximumUsage()
608:  @*/
609: PetscErrorCode  PetscMallocPushMaximumUsage(int event)
610: {
612:   if (++NumTRMaxMems > MAXTRMAXMEMS) return(0);
613:   TRMaxMems[NumTRMaxMems-1]       = TRallocated;
614:   TRMaxMemsEvents[NumTRMaxMems-1] = event;
615:   return(0);
616: }

618: /*@
619:     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event

621:     Not Collective

623:     Input Parameter:
624: .   event - an event id; this is just for error checking

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

629:     Level: developer

631: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
632:           PetscMallocPushMaximumUsage()
633:  @*/
634: PetscErrorCode  PetscMallocPopMaximumUsage(int event,PetscLogDouble *mu)
635: {
637:   *mu = 0;
638:   if (NumTRMaxMems-- > MAXTRMAXMEMS) return(0);
639:   if (TRMaxMemsEvents[NumTRMaxMems] != event) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"PetscMallocPush/PopMaximumUsage() are not nested");
640:   *mu = TRMaxMems[NumTRMaxMems];
641:   return(0);
642: }

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

648:    Collective on PETSC_COMM_WORLD

650:    Input Parameter:
651: .    ptr - the memory location

653:    Output Paramter:
654: .    stack - the stack indicating where the program allocated this memory

656:    Level: intermediate

658: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
659: @*/
660: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
661: {
662:   TRSPACE *head;

665:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
666:   *stack = &head->stack;
667:   return(0);
668: }
669: #else
670: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
671: {
673:   *stack = NULL;
674:   return(0);
675: }
676: #endif

678: /*@C
679:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
680:    printed is: size of space (in bytes), address of space, id of space,
681:    file in which space was allocated, and line number at which it was
682:    allocated.

684:    Collective on PETSC_COMM_WORLD

686:    Input Parameter:
687: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

692:    Level: intermediate

694:    Fortran Note:
695:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
696:    The fp defaults to stdout.

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

702: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
703: @*/
704: PetscErrorCode  PetscMallocDump(FILE *fp)
705: {
706:   TRSPACE        *head;
707:   size_t         libAlloc = 0;
709:   PetscMPIInt    rank;

712:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
713:   if (!fp) fp = PETSC_STDOUT;
714:   head = TRhead;
715:   while (head) {
716:     libAlloc += head->size;
717:     head = head->next;
718:   }
719:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
720:   head = TRhead;
721:   while (head) {
722:     PetscBool isLib;

724:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
725:     if (!isLib) {
726:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
727: #if defined(PETSC_USE_DEBUG)
728:       PetscStackPrint(&head->stack,fp);
729: #endif
730:     }
731:     head = head->next;
732:   }
733:   return(0);
734: }

736: /* ---------------------------------------------------------------------------- */

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

741:     Not Collective

743:     Options Database Key:
744: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
745: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

747:     Level: advanced

749: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
750: @*/
751: PetscErrorCode PetscMallocSetDumpLog(void)
752: {

756:   PetscLogMalloc = 0;

758:   PetscMemorySetGetMaximumUsage();
759:   return(0);
760: }

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

765:     Not Collective

767:     Input Arguments:
768: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

770:     Options Database Key:
771: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
772: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

774:     Level: advanced

776: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
777: @*/
778: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
779: {

783:   PetscMallocSetDumpLog();
784:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
785:   PetscLogMallocThreshold = (size_t)logmin;
786:   return(0);
787: }

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

792:     Not Collective

794:     Output Arguments
795: .   logging - PETSC_TRUE if logging is active

797:     Options Database Key:
798: .  -malloc_log - Activates PetscMallocDumpLog()

800:     Level: advanced

802: .seealso: PetscMallocDump(), PetscMallocDumpLog()
803: @*/
804: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
805: {

808:   *logging = (PetscBool)(PetscLogMalloc >= 0);
809:   return(0);
810: }

812: /*@C
813:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
814:        PetscMemoryGetMaximumUsage()

816:     Collective on PETSC_COMM_WORLD

818:     Input Parameter:
819: .   fp - file pointer; or NULL

821:     Options Database Key:
822: .  -malloc_log - Activates PetscMallocDumpLog()

824:     Level: advanced

826:    Fortran Note:
827:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
828:    The fp defaults to stdout.

830: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
831: @*/
832: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
833: {
834:   PetscInt       i,j,n,dummy,*perm;
835:   size_t         *shortlength;
836:   int            *shortcount,err;
837:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
838:   PetscBool      match;
839:   const char     **shortfunction;
840:   PetscLogDouble rss;
841:   MPI_Status     status;

845:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
846:   MPI_Comm_size(MPI_COMM_WORLD,&size);
847:   /*
848:        Try to get the data printed in order by processor. This will only sometimes work
849:   */
850:   err = fflush(fp);
851:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

853:   MPI_Barrier(MPI_COMM_WORLD);
854:   if (rank) {
855:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
856:   }

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

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

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

890:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
891:   for (i=0; i<n; i++) {
892:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
893:   }
894:   free(perm);
895:   free(shortlength);
896:   free(shortcount);
897:   free((char**)shortfunction);
898:   err = fflush(fp);
899:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
900:   if (rank != size-1) {
901:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
902:   }
903:   return(0);
904: }

906: /* ---------------------------------------------------------------------------- */

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

911:     Not Collective

913:     Input Parameter:
914: .   level - PETSC_TRUE or PETSC_FALSE

916:    Level: intermediate

918: .seealso: CHKMEMQ(), PetscMallocValidate()
919: @*/
920: PetscErrorCode  PetscMallocDebug(PetscBool level)
921: {
923:   TRdebugLevel = level;
924:   return(0);
925: }

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

930:     Not Collective

932:     Output Parameter:
933: .    flg - PETSC_TRUE if any debugger

935:    Level: intermediate

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


940: .seealso: CHKMEMQ(), PetscMallocValidate()
941: @*/
942: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
943: {
945:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
946:   else *flg = PETSC_FALSE;
947:   return(0);
948: }