Actual source code: mtr.c

petsc-master 2020-08-25
Report Typos and Errors

  2: /*
  3:      Interface to malloc() and free(). This code allows for logging of memory usage and some error checking
  4: */
  5:  #include <petscsys.h>
  6:  #include <petscviewer.h>
  7: #if defined(PETSC_HAVE_MALLOC_H)
  8: #include <malloc.h>
  9: #endif

 11: /*
 12:      These are defined in mal.c and ensure that malloced space is PetscScalar aligned
 13: */
 14: PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,PetscBool,int,const char[],const char[],void**);
 15: PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
 16: PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t,int,const char[],const char[],void**);

 18: #define CLASSID_VALUE  ((PetscClassId) 0xf0e0d0c9)
 19: #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)

 21: /*  this is the header put at the beginning of each malloc() using for tracking allocated space and checking of allocated space heap */
 22: typedef struct _trSPACE {
 23:   size_t          size;
 24:   int             id;
 25:   int             lineno;
 26:   const char      *filename;
 27:   const char      *functionname;
 28:   PetscClassId    classid;
 29: #if defined(PETSC_USE_DEBUG)
 30:   PetscStack      stack;
 31: #endif
 32:   struct _trSPACE *next,*prev;
 33: } TRSPACE;

 35: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
 36:    It is sizeof(trSPACE) padded to be a multiple of PETSC_MEMALIGN.
 37: */
 38: #define HEADER_BYTES  ((sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1))

 40: /* This union is used to insure that the block passed to the user retains
 41:    a minimum alignment of PETSC_MEMALIGN.
 42: */
 43: typedef union {
 44:   TRSPACE sp;
 45:   char    v[HEADER_BYTES];
 46: } TrSPACE;

 48: #define MAXTRMAXMEMS 50
 49: static size_t    TRallocated          = 0;
 50: static int       TRfrags              = 0;
 51: static TRSPACE   *TRhead              = NULL;
 52: static int       TRid                 = 0;
 53: static PetscBool TRdebugLevel         = PETSC_FALSE;
 54: static PetscBool TRdebugIinitializenan= PETSC_FALSE;
 55: static size_t    TRMaxMem             = 0;
 56: static int       NumTRMaxMems         = 0;
 57: static size_t    TRMaxMems[MAXTRMAXMEMS];
 58: static int       TRMaxMemsEvents[MAXTRMAXMEMS];
 59: /*
 60:       Arrays to log information on mallocs for PetscMallocView()
 61: */
 62: static int        PetscLogMallocMax       = 10000;
 63: static int        PetscLogMalloc          = -1;
 64: static size_t     PetscLogMallocThreshold = 0;
 65: static size_t     *PetscLogMallocLength;
 66: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

 68: /*@C
 69:    PetscMallocValidate - Test the memory for corruption.  This can be called at any time between PetscInitialize() and PetscFinalize()

 71:    Input Parameters:
 72: +  line - line number where call originated.
 73: .  function - name of function calling
 74: -  file - file where function is

 76:    Return value:
 77:    The number of errors detected.

 79:    Options Database:.
 80: +  -malloc_test - turns this feature on when PETSc was not configured with --with-debugging=0
 81: -  -malloc_debug - turns this feature on anytime

 83:    Output Effect:
 84:    Error messages are written to stdout.

 86:    Level: advanced

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

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

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

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

 97:    Developers Note:
 98:      Uses the flg TRdebugLevel (set as the first argument to PetscMallocSetDebug()) to determine if it should run

100: .seealso: CHKMEMQ

102: @*/
103: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[])
104: {
105:   TRSPACE      *head,*lasthead;
106:   char         *a;
107:   PetscClassId *nend;

109:   if (!TRdebugLevel) return 0;
111:   head = TRhead; lasthead = NULL;
112:   if (head && head->prev) {
113:     (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
114:     (*PetscErrorPrintf)("Root memory header %p has invalid back pointer %p\n",head,head->prev);
115:   }
116:   while (head) {
117:     if (head->classid != CLASSID_VALUE) {
118:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s\n",function,line,file);
119:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
120:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
121:       if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
122:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
123:     }
124:     a    = (char*)(((TrSPACE*)head) + 1);
125:     nend = (PetscClassId*)(a + head->size);
126:     if (*nend != CLASSID_VALUE) {
127:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
128:       if (*nend == ALREADY_FREED) {
129:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
130:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
131:       } else {
132:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
133:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
134:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
135:       }
136:     }
137:     if (head->prev && head->prev != lasthead) {
138:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
139:       (*PetscErrorPrintf)("Backpointer %p is invalid, should be %p\n",head->prev,lasthead);
140:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
141:     }
142:     if (head->next && head != head->next->prev) {
143:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
144:       (*PetscErrorPrintf)("Next memory header %p has invalid back pointer %p, should be %p\n",head->next,head->next->prev,head);
145:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
146:     }
147:     lasthead = head;
148:     head     = head->next;
149:   }
150:   return(0);
151: }

153: /*
154:     PetscTrMallocDefault - Malloc with tracing.

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

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

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

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

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

180:   head  = (TRSPACE*)inew;
181:   inew += sizeof(TrSPACE);

183:   if (TRhead) TRhead->prev = head;
184:   head->next   = TRhead;
185:   TRhead       = head;
186:   head->prev   = NULL;
187:   head->size   = nsize;
188:   head->id     = TRid;
189:   head->lineno = lineno;

191:   head->filename                 = filename;
192:   head->functionname             = function;
193:   head->classid                  = CLASSID_VALUE;
194:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

196:   TRallocated += nsize;
197:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
198:   if (PetscLogMemory) {
199:     PetscInt i;
200:     for (i=0; i<NumTRMaxMems; i++) {
201:       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
202:     }
203:   }
204:   TRfrags++;

206: #if defined(PETSC_USE_DEBUG)
207:   if (PetscStackActive()) {
208:     PetscStackCopy(petscstack,&head->stack);
210:     head->stack.line[head->stack.currentsize-2] = lineno;
211:   } else {
212:     head->stack.currentsize = 0;
213:   }
214: #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE)
215:   if (!clear && TRdebugIinitializenan) {
216:     size_t     i, n = a/sizeof(PetscReal);
217:     PetscReal *s = (PetscReal*) inew;
218:     /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */
219: #if defined(PETSC_USE_REAL_SINGLE)
220:     int        nas = 0x7F800002;
221: #else
222:     PetscInt64 nas = 0x7FF0000000000002;
223: #endif
224:     for (i=0; i<n; i++) {
225:       memcpy(s+i,&nas,sizeof(PetscReal));
226:     }
227:   }
228: #endif
229: #endif

231:   /*
232:          Allow logging of all mallocs made.
233:          TODO: Currently this memory is never freed, it should be freed during PetscFinalize()
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: }

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

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

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

274:   PetscMallocValidate(line,function,file);

276:   ahead = a;
277:   a     = a - sizeof(TrSPACE);
278:   head  = (TRSPACE*)a;

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

320:   if (head->next) head->next->prev = head->prev;
321:   PetscFreeAlign(a,line,function,file);
322:   return(0);
323: }

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

328:   Input Parameters:
329: + len      - number of bytes to allocate
330: . lineno   - line number where used.  Use __LINE__ for this
331: . filename - file name where used.  Use __FILE__ for this
332: - result - original memory

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

337:   Level: developer

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

351:   /* Realloc requests zero space so just free the current space */
352:   if (!len) {
353:     PetscTrFreeDefault(*result,lineno,function,filename);
354:     *result = NULL;
355:     return(0);
356:   }
357:   /* If the orginal space was NULL just use the regular malloc() */
358:   if (!*result) {
359:     PetscTrMallocDefault(len,PETSC_FALSE,lineno,function,filename,result);
360:     return(0);
361:   }

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

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

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

395:   /* remove original reference to the memory allocated from the PETSc debugging heap */
396:   TRallocated -= head->size;
397:   TRfrags--;
398:   if (head->prev) head->prev->next = head->next;
399:   else TRhead = head->next;
400:   if (head->next) head->next->prev = head->prev;

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

405:   head  = (TRSPACE*)inew;
406:   inew += sizeof(TrSPACE);

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

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

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

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

441:   /*
442:          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
443:          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
444:   */
445:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
446:     if (!PetscLogMalloc) {
447:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
448:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

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

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

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

467:     Collective on PetscViewer

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

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

477:     Level: intermediate

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

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

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

550:     Not Collective

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

555:     Level: intermediate

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

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

571:     Not Collective

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

576:     Level: intermediate

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

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

591:     Not Collective

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

596:     Level: developer

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

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

613:     Not Collective

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

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

621:     Level: developer

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

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

640:    Collective on PETSC_COMM_WORLD

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

645:    Output Parameter:
646: .    stack - the stack indicating where the program allocated this memory

648:    Level: intermediate

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

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

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

676:    Not Collective

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

681:    Options Database Key:
682: .  -malloc_dump <optional filename> - Dumps unfreed memory during call to PetscFinalize()

684:    Level: intermediate

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

690:    Notes:
691:      Uses MPI_COMM_WORLD to display rank, because this may be called in PetscFinalize() after PETSC_COMM_WORLD has been freed.

693:      When called in PetscFinalize() dumps only the allocations that have not been properly freed

695:      PetscMallocView() prints a list of all memory ever allocated

697: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocView(), PetscMallocViewSet()
698: @*/
699: PetscErrorCode  PetscMallocDump(FILE *fp)
700: {
701:   TRSPACE        *head;
702:   size_t         libAlloc = 0;
704:   PetscMPIInt    rank;

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

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

731: /*@
732:     PetscMallocViewSet - Activates logging of all calls to PetscMalloc() with a minimum size to view

734:     Not Collective

736:     Input Arguments:
737: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

739:     Options Database Key:
740: +  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()
741: .  -malloc_view_threshold <min> - Sets a minimum size if -malloc_view is used
742: -  -log_view_memory - view the memory usage also with the -log_view option

744:     Level: advanced

746:     Notes: Must be called after PetscMallocSetDebug()

748:     Uses MPI_COMM_WORLD to determine rank because PETSc communicators may not be available

750: .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocViewSet()
751: @*/
752: PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
753: {

757:   PetscLogMalloc = 0;
758:   PetscMemorySetGetMaximumUsage();
759:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
760:   PetscLogMallocThreshold = (size_t)logmin;
761:   return(0);
762: }

764: /*@
765:     PetscMallocViewGet - Determine whether all calls to PetscMalloc() are being logged

767:     Not Collective

769:     Output Arguments
770: .   logging - PETSC_TRUE if logging is active

772:     Options Database Key:
773: .  -malloc_view <optional filename> - Activates PetscMallocView()

775:     Level: advanced

777: .seealso: PetscMallocDump(), PetscMallocView()
778: @*/
779: PetscErrorCode PetscMallocViewGet(PetscBool *logging)
780: {

783:   *logging = (PetscBool)(PetscLogMalloc >= 0);
784:   return(0);
785: }

787: /*@C
788:     PetscMallocView - Saves the log of all calls to PetscMalloc(); also calls
789:        PetscMemoryGetMaximumUsage()

791:     Not Collective

793:     Input Parameter:
794: .   fp - file pointer; or NULL

796:     Options Database Key:
797: .  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()

799:     Level: advanced

801:    Fortran Note:
802:    The calling sequence in Fortran is PetscMallocView(integer ierr)
803:    The fp defaults to stdout.

805:    Notes:
806:      PetscMallocDump() dumps only the currently unfreed memory, this dumps all memory ever allocated

808:      PetscMemoryView() gives a brief summary of current memory usage

810: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocViewSet(), PetscMemoryView()
811: @*/
812: PetscErrorCode  PetscMallocView(FILE *fp)
813: {
814:   PetscInt       i,j,n,*perm;
815:   size_t         *shortlength;
816:   int            *shortcount,err;
817:   PetscMPIInt    rank;
818:   PetscBool      match;
819:   const char     **shortfunction;
820:   PetscLogDouble rss;

824:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
825:   err = fflush(fp);
826:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

828:   if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"PetscMallocView() called without call to PetscMallocViewSet() this is often due to\n                      setting the option -malloc_view AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");

830:   if (!fp) fp = PETSC_STDOUT;
831:   PetscMemoryGetMaximumUsage(&rss);
832:   if (rss) {
833:     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
834:   } else {
835:     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
836:   }
837:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
838:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
839:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
840:   for (i=0,n=0; i<PetscLogMalloc; i++) {
841:     for (j=0; j<n; j++) {
842:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
843:       if (match) {
844:         shortlength[j] += PetscLogMallocLength[i];
845:         shortcount[j]++;
846:         goto foundit;
847:       }
848:     }
849:     shortfunction[n] = PetscLogMallocFunction[i];
850:     shortlength[n]   = PetscLogMallocLength[i];
851:     shortcount[n]    = 1;
852:     n++;
853: foundit:;
854:   }

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

860:   (void) fprintf(fp,"[%d] Memory usage sorted by function\n",rank);
861:   for (i=0; i<n; i++) {
862:     (void) fprintf(fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
863:   }
864:   free(perm);
865:   free(shortlength);
866:   free(shortcount);
867:   free((char**)shortfunction);
868:   err = fflush(fp);
869:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
870:   return(0);
871: }

873: /* ---------------------------------------------------------------------------- */

875: /*@
876:     PetscMallocSetDebug - Set's PETSc memory debugging

878:     Not Collective

880:     Input Parameter:
881: +   eachcall - checks the entire heap of allocated memory for issues on each call to PetscMalloc() and PetscFree()
882: -   initializenan - initializes all memory with NaN to catch use of uninitialized floating point arrays

884:     Options Database:
885: +   -malloc_debug <true or false> - turns on or off debugging
886: .   -malloc_test - turns on all debugging if PETSc was configured with debugging including -malloc_dump, otherwise ignored
887: .   -malloc_view_threshold t - log only allocations larger than t
888: .   -malloc_dump <filename> - print a list of all memory that has not been freed
889: .   -malloc no - (deprecated) same as -malloc_debug no
890: -   -malloc_log - (deprecated) same as -malloc_view

892:    Level: developer

894:     Notes: This is called in PetscInitialize() and should not be called elsewhere

896: .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocGetDebug()
897: @*/
898: PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
899: {

903:   if (PetscTrMalloc == PetscTrMallocDefault) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Cannot call this routine more than once, it can only be called in PetscInitialize()");
904:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault,PetscTrReallocDefault);

906:   TRallocated         = 0;
907:   TRfrags             = 0;
908:   TRhead              = NULL;
909:   TRid                = 0;
910:   TRdebugLevel        = eachcall;
911:   TRMaxMem            = 0;
912:   PetscLogMallocMax   = 10000;
913:   PetscLogMalloc      = -1;
914:   TRdebugIinitializenan = initializenan;
915:   return(0);
916: }

918: /*@
919:     PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.

921:     Not Collective

923:     Output Parameters:
924: +    basic - doing basic debugging
925: .    eachcall - checks the entire memory heap at each PetscMalloc()/PetscFree()
926: -    initializenan - initializes memory with NaN

928:    Level: intermediate

930:    Notes:
931:      By default, the debug version always does some debugging unless you run with -malloc_debug no

933: .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocSetDebug()
934: @*/
935: PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
936: {
938:   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
939:   if (eachcall) *eachcall           = TRdebugLevel;
940:   if (initializenan) *initializenan = TRdebugIinitializenan;
941:   return(0);
942: }