Actual source code: mtr.c

petsc-master 2019-04-21
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;


 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: /*
 63:       Arrays to log information on all Mallocs
 64: */
 65: static int        PetscLogMallocMax       = 10000;
 66: static int        PetscLogMalloc          = -1;
 67: static size_t     PetscLogMallocThreshold = 0;
 68: static size_t     *PetscLogMallocLength;
 69: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

 71: PETSC_INTERN PetscErrorCode PetscSetUseTrMalloc_Private(void)
 72: {

 76:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
 77:   PetscTrRealloc = PetscTrReallocDefault;

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

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

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

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

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

105:    Level: advanced

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

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

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

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

117: .seealso: CHKMEMQ

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

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

155: /*
156:     PetscTrMallocDefault - Malloc with tracing.

158:     Input Parameters:
159: +   a   - number of bytes to allocate
160: .   lineno - line number where used.  Use __LINE__ for this
161: -   filename  - file name where used.  Use __FILE__ for this

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

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

178:   if (TRdebugLevel) {
179:     PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
180:   }

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

185:   head  = (TRSPACE*)inew;
186:   inew += sizeof(TrSPACE);

188:   if (TRhead) TRhead->prev = head;
189:   head->next   = TRhead;
190:   TRhead       = head;
191:   head->prev   = NULL;
192:   head->size   = nsize;
193:   head->id     = TRid;
194:   head->lineno = lineno;

196:   head->filename                 = filename;
197:   head->functionname             = function;
198:   head->classid                  = CLASSID_VALUE;
199:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

201:   TRallocated += nsize;
202:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
203:   TRfrags++;

205: #if defined(PETSC_USE_DEBUG)
206:   if (PetscStackActive()) {
207:     PetscStackCopy(petscstack,&head->stack);
209:     head->stack.line[head->stack.currentsize-2] = lineno;
210:   } else {
211:     head->stack.currentsize = 0;
212:   }
213: #endif

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

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

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


238: /*
239:    PetscTrFreeDefault - Free with tracing.

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

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

258:   if (TRdebugLevel) {
259:     PetscMallocValidate(line,function,file);
260:   }

262:   ahead = a;
263:   a     = a - sizeof(TrSPACE);
264:   head  = (TRSPACE*)a;

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

303:   TRallocated -= head->size;
304:   TRfrags--;
305:   if (head->prev) head->prev->next = head->next;
306:   else TRhead = head->next;

308:   if (head->next) head->next->prev = head->prev;
309:   PetscFreeAlign(a,line,function,file);
310:   return(0);
311: }



315: /*
316:   PetscTrReallocDefault - Realloc with tracing.

318:   Input Parameters:
319: + len      - number of bytes to allocate
320: . lineno   - line number where used.  Use __LINE__ for this
321: . filename - file name where used.  Use __FILE__ for this
322: - result   - double aligned pointer to initial storage.

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

327:   Level: developer

329: .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
330: */
331: PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
332: {
333:   char           *a = (char *) *result;
334:   TRSPACE        *head;
335:   char           *ahead, *inew;
336:   PetscClassId   *nend;
337:   size_t         nsize;

341:   /* Realloc to zero = free */
342:   if (!len) {
343:     PetscTrFreeDefault(*result,lineno,function,filename);
344:     *result = NULL;
345:     return(0);
346:   }
347:   /* Realloc with NULL = malloc */
348:   if (!*result) {
349:     PetscTrMallocDefault(len,lineno,function,filename,result);
350:     return(0);
351:   }

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

355:   ahead = a;
356:   a     = a - sizeof(TrSPACE);
357:   head  = (TRSPACE *) a;
358:   inew  = a;

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

385:   TRallocated -= head->size;
386:   TRfrags--;
387:   if (head->prev) head->prev->next = head->next;
388:   else TRhead = head->next;
389:   if (head->next) head->next->prev = head->prev;

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

394:   head  = (TRSPACE*)inew;
395:   inew += sizeof(TrSPACE);

397:   if (TRhead) TRhead->prev = head;
398:   head->next   = TRhead;
399:   TRhead       = head;
400:   head->prev   = NULL;
401:   head->size   = nsize;
402:   head->id     = TRid;
403:   head->lineno = lineno;

405:   head->filename                 = filename;
406:   head->functionname             = function;
407:   head->classid                  = CLASSID_VALUE;
408:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

410:   TRallocated += nsize;
411:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
412:   TRfrags++;

414: #if defined(PETSC_USE_DEBUG)
415:   if (PetscStackActive()) {
416:     PetscStackCopy(petscstack,&head->stack);
418:     head->stack.line[head->stack.currentsize-2] = lineno;
419:   } else {
420:     head->stack.currentsize = 0;
421:   }
422: #endif

424:   /*
425:          Allow logging of all mallocs made
426:   */
427:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
428:     if (!PetscLogMalloc) {
429:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
430:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

435:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
436:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
437:     }
438:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
439:     PetscLogMallocFile[PetscLogMalloc]       = filename;
440:     PetscLogMallocFunction[PetscLogMalloc++] = function;
441:   }
442:   *result = (void*)inew;
443:   return(0);
444: }


447: /*@C
448:     PetscMemoryView - Shows the amount of memory currently being used
449:         in a communicator.

451:     Collective on PetscViewer

453:     Input Parameter:
454: +    viewer - the viewer that defines the communicator
455: -    message - string printed before values

457:     Options Database:
458: +    -malloc - have PETSc track how much memory it has allocated
459: -    -memory_view - during PetscFinalize() have this routine called

461:     Level: intermediate

463:     Concepts: memory usage

465: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
466:  @*/
467: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
468: {
469:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
470:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
472:   MPI_Comm       comm;

475:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
476:   PetscMallocGetCurrentUsage(&allocated);
477:   PetscMallocGetMaximumUsage(&allocatedmax);
478:   PetscMemoryGetCurrentUsage(&resident);
479:   PetscMemoryGetMaximumUsage(&residentmax);
480:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
481:   PetscObjectGetComm((PetscObject)viewer,&comm);
482:   PetscViewerASCIIPrintf(viewer,message);
483:   if (resident && residentmax && allocated) {
484:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
485:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
486:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
487:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
488:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
489:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
490:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
491:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
492:     MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
493:     MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
494:     MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
495:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
496:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
497:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
498:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
499:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
500:   } else if (resident && residentmax) {
501:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
502:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
503:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
504:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
505:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
506:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
507:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
508:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
509:   } else if (resident && allocated) {
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(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
515:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
516:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
517:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
518:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
519:   } else if (allocated) {
520:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
521:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
522:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
523:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
524:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
525:     PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
526:   } else {
527:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
528:   }
529:   PetscViewerFlush(viewer);
530:   return(0);
531: }

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

536:     Not Collective

538:     Output Parameters:
539: .   space - number of bytes currently allocated

541:     Level: intermediate

543:     Concepts: memory usage

545: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
546:           PetscMemoryGetMaximumUsage()
547:  @*/
548: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
549: {
551:   *space = (PetscLogDouble) TRallocated;
552:   return(0);
553: }

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

559:     Not Collective

561:     Output Parameters:
562: .   space - maximum number of bytes ever allocated at one time

564:     Level: intermediate

566:     Concepts: memory usage

568: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
569:           PetscMemoryGetCurrentUsage()
570:  @*/
571: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
572: {
574:   *space = (PetscLogDouble) TRMaxMem;
575:   return(0);
576: }

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

582:    Collective on PETSC_COMM_WORLD

584:    Input Parameter:
585: .    ptr - the memory location

587:    Output Paramter:
588: .    stack - the stack indicating where the program allocated this memory

590:    Level: intermediate

592: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
593: @*/
594: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
595: {
596:   TRSPACE *head;

599:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
600:   *stack = &head->stack;
601:   return(0);
602: }
603: #else
604: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
605: {
607:   *stack = NULL;
608:   return(0);
609: }
610: #endif

612: /*@C
613:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
614:    printed is: size of space (in bytes), address of space, id of space,
615:    file in which space was allocated, and line number at which it was
616:    allocated.

618:    Collective on PETSC_COMM_WORLD

620:    Input Parameter:
621: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

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

626:    Level: intermediate

628:    Fortran Note:
629:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
630:    The fp defaults to stdout.

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

636:    Concepts: memory usage
637:    Concepts: memory bleeding
638:    Concepts: bleeding memory

640: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
641: @*/
642: PetscErrorCode  PetscMallocDump(FILE *fp)
643: {
644:   TRSPACE        *head;
645:   PetscInt       libAlloc = 0;
647:   PetscMPIInt    rank;

650:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
651:   if (!fp) fp = PETSC_STDOUT;
652:   head = TRhead;
653:   while (head) {
654:     PetscBool isLib;

656:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
657:     libAlloc += head->size;
658:     head = head->next;
659:   }
660:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
661:   head = TRhead;
662:   while (head) {
663:     PetscBool isLib;

665:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
666:     if (!isLib) {
667:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
668: #if defined(PETSC_USE_DEBUG)
669:       PetscStackPrint(&head->stack,fp);
670: #endif
671:     }
672:     head = head->next;
673:   }
674:   return(0);
675: }

677: /* ---------------------------------------------------------------------------- */

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

682:     Not Collective

684:     Options Database Key:
685: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
686: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

688:     Level: advanced

690: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
691: @*/
692: PetscErrorCode PetscMallocSetDumpLog(void)
693: {

697:   PetscLogMalloc = 0;

699:   PetscMemorySetGetMaximumUsage();
700:   return(0);
701: }

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

706:     Not Collective

708:     Input Arguments:
709: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

711:     Options Database Key:
712: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
713: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

715:     Level: advanced

717: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
718: @*/
719: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
720: {

724:   PetscMallocSetDumpLog();
725:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
726:   PetscLogMallocThreshold = (size_t)logmin;
727:   return(0);
728: }

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

733:     Not Collective

735:     Output Arguments
736: .   logging - PETSC_TRUE if logging is active

738:     Options Database Key:
739: .  -malloc_log - Activates PetscMallocDumpLog()

741:     Level: advanced

743: .seealso: PetscMallocDump(), PetscMallocDumpLog()
744: @*/
745: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
746: {

749:   *logging = (PetscBool)(PetscLogMalloc >= 0);
750:   return(0);
751: }

753: /*@C
754:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
755:        PetscMemoryGetMaximumUsage()

757:     Collective on PETSC_COMM_WORLD

759:     Input Parameter:
760: .   fp - file pointer; or NULL

762:     Options Database Key:
763: .  -malloc_log - Activates PetscMallocDumpLog()

765:     Level: advanced

767:    Fortran Note:
768:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
769:    The fp defaults to stdout.

771: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
772: @*/
773: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
774: {
775:   PetscInt       i,j,n,dummy,*perm;
776:   size_t         *shortlength;
777:   int            *shortcount,err;
778:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
779:   PetscBool      match;
780:   const char     **shortfunction;
781:   PetscLogDouble rss;
782:   MPI_Status     status;

786:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
787:   MPI_Comm_size(MPI_COMM_WORLD,&size);
788:   /*
789:        Try to get the data printed in order by processor. This will only sometimes work
790:   */
791:   err = fflush(fp);
792:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

794:   MPI_Barrier(MPI_COMM_WORLD);
795:   if (rank) {
796:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
797:   }

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

801:   if (!fp) fp = PETSC_STDOUT;
802:   PetscMemoryGetMaximumUsage(&rss);
803:   if (rss) {
804:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
805:   } else {
806:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
807:   }
808:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
809:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
810:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
811:   for (i=0,n=0; i<PetscLogMalloc; i++) {
812:     for (j=0; j<n; j++) {
813:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
814:       if (match) {
815:         shortlength[j] += PetscLogMallocLength[i];
816:         shortcount[j]++;
817:         goto foundit;
818:       }
819:     }
820:     shortfunction[n] = PetscLogMallocFunction[i];
821:     shortlength[n]   = PetscLogMallocLength[i];
822:     shortcount[n]    = 1;
823:     n++;
824: foundit:;
825:   }

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

831:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
832:   for (i=0; i<n; i++) {
833:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
834:   }
835:   free(perm);
836:   free(shortlength);
837:   free(shortcount);
838:   free((char**)shortfunction);
839:   err = fflush(fp);
840:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
841:   if (rank != size-1) {
842:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
843:   }
844:   return(0);
845: }

847: /* ---------------------------------------------------------------------------- */

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

852:     Not Collective

854:     Input Parameter:
855: .   level - PETSC_TRUE or PETSC_FALSE

857:    Level: intermediate

859: .seealso: CHKMEMQ(), PetscMallocValidate()
860: @*/
861: PetscErrorCode  PetscMallocDebug(PetscBool level)
862: {
864:   TRdebugLevel = level;
865:   return(0);
866: }

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

871:     Not Collective

873:     Output Parameter:
874: .    flg - PETSC_TRUE if any debugger

876:    Level: intermediate

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


881: .seealso: CHKMEMQ(), PetscMallocValidate()
882: @*/
883: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
884: {
886:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
887:   else *flg = PETSC_FALSE;
888:   return(0);
889: }