xref: /petsc/src/sys/memory/mtr.c (revision 1e1ea65d8de51fde77ce8a787efbef25e407badc)
1 
2 /*
3      Interface to malloc() and free(). This code allows for logging of memory usage and some error checking
4 */
5 #include <petscsys.h>           /*I "petscsys.h" I*/
6 #include <petscviewer.h>
7 #if defined(PETSC_HAVE_MALLOC_H)
8 #include <malloc.h>
9 #endif
10 
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**);
17 
18 #define CLASSID_VALUE  ((PetscClassId) 0xf0e0d0c9)
19 #define ALREADY_FREED  ((PetscClassId) 0x0f0e0d9c)
20 
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, rsize; /* Aligned size and requested 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;
34 
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))
39 
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;
47 
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 PetscBool TRrequestedSize      = PETSC_FALSE;
56 static size_t    TRMaxMem             = 0;
57 static int       NumTRMaxMems         = 0;
58 static size_t    TRMaxMems[MAXTRMAXMEMS];
59 static int       TRMaxMemsEvents[MAXTRMAXMEMS];
60 /*
61       Arrays to log information on mallocs for PetscMallocView()
62 */
63 static int        PetscLogMallocMax       = 10000;
64 static int        PetscLogMalloc          = -1;
65 static size_t     PetscLogMallocThreshold = 0;
66 static size_t     *PetscLogMallocLength;
67 static const char **PetscLogMallocFile,**PetscLogMallocFunction;
68 static int        PetscLogMallocTrace          = -1;
69 static size_t     PetscLogMallocTraceThreshold = 0;
70 static PetscViewer PetscLogMallocTraceViewer   = NULL;
71 
72 /*@C
73    PetscMallocValidate - Test the memory for corruption.  This can be called at any time between PetscInitialize() and PetscFinalize()
74 
75    Input Parameters:
76 +  line - line number where call originated.
77 .  function - name of function calling
78 -  file - file where function is
79 
80    Return value:
81    The number of errors detected.
82 
83    Options Database:.
84 +  -malloc_test - turns this feature on when PETSc was not configured with --with-debugging=0
85 -  -malloc_debug - turns this feature on anytime
86 
87    Output Effect:
88    Error messages are written to stdout.
89 
90    Level: advanced
91 
92    Notes:
93     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)
94 
95     You should generally use CHKMEMQ as a short cut for calling this  routine.
96 
97     The Fortran calling sequence is simply PetscMallocValidate(ierr)
98 
99    No output is generated if there are no problems detected.
100 
101    Developers Note:
102      Uses the flg TRdebugLevel (set as the first argument to PetscMallocSetDebug()) to determine if it should run
103 
104 .seealso: CHKMEMQ
105 
106 @*/
107 PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[])
108 {
109   TRSPACE      *head,*lasthead;
110   char         *a;
111   PetscClassId *nend;
112 
113   if (!TRdebugLevel) return 0;
114   head = TRhead; lasthead = NULL;
115   if (head && head->prev) {
116     (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
117     (*PetscErrorPrintf)("Root memory header %p has invalid back pointer %p\n",head,head->prev);
118     return PETSC_ERR_MEMC;
119   }
120   while (head) {
121     if (head->classid != CLASSID_VALUE) {
122       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s\n",function,line,file);
123       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
124       (*PetscErrorPrintf)("Probably write before beginning of or past end of array\n");
125       if (lasthead) {
126         a    = (char*)(((TrSPACE*)head) + 1);
127         (*PetscErrorPrintf)("Last intact block [id=%d(%.0f)] at address %p allocated in %s() line %d in %s\n",lasthead->id,(PetscLogDouble)lasthead->size,a,lasthead->functionname,lasthead->lineno,lasthead->filename);
128       }
129       abort();
130       return PETSC_ERR_MEMC;
131     }
132     a    = (char*)(((TrSPACE*)head) + 1);
133     nend = (PetscClassId*)(a + head->size);
134     if (*nend != CLASSID_VALUE) {
135       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
136       if (*nend == ALREADY_FREED) {
137         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
138         return PETSC_ERR_MEMC;
139       } else {
140         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
141         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
142         return PETSC_ERR_MEMC;
143       }
144     }
145     if (head->prev && head->prev != lasthead) {
146       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
147       (*PetscErrorPrintf)("Backpointer %p is invalid, should be %p\n",head->prev,lasthead);
148       (*PetscErrorPrintf)("Previous memory originally allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
149       (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
150       return PETSC_ERR_MEMC;
151     }
152     lasthead = head;
153     head     = head->next;
154   }
155   return 0;
156 }
157 
158 /*
159     PetscTrMallocDefault - Malloc with tracing.
160 
161     Input Parameters:
162 +   a   - number of bytes to allocate
163 .   lineno - line number where used.  Use __LINE__ for this
164 -   filename  - file name where used.  Use __FILE__ for this
165 
166     Returns:
167     double aligned pointer to requested storage, or null if not  available.
168  */
169 PetscErrorCode  PetscTrMallocDefault(size_t a,PetscBool clear,int lineno,const char function[],const char filename[],void **result)
170 {
171   TRSPACE        *head;
172   char           *inew;
173   size_t         nsize;
174   PetscErrorCode ierr;
175 
176   PetscFunctionBegin;
177   /* Do not try to handle empty blocks */
178   if (!a) { *result = NULL; PetscFunctionReturn(0); }
179 
180   ierr = PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
181 
182   nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
183   ierr  = PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),clear,lineno,function,filename,(void**)&inew);CHKERRQ(ierr);
184 
185   head  = (TRSPACE*)inew;
186   inew += sizeof(TrSPACE);
187 
188   if (TRhead) TRhead->prev = head;
189   head->next   = TRhead;
190   TRhead       = head;
191   head->prev   = NULL;
192   head->size   = nsize;
193   head->rsize  = a;
194   head->id     = TRid++;
195   head->lineno = lineno;
196 
197   head->filename                 = filename;
198   head->functionname             = function;
199   head->classid                  = CLASSID_VALUE;
200   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
201 
202   TRallocated += TRrequestedSize ? head->rsize : head->size;
203   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
204   if (PetscLogMemory) {
205     PetscInt i;
206     for (i=0; i<NumTRMaxMems; i++) {
207       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
208     }
209   }
210   TRfrags++;
211 
212 #if defined(PETSC_USE_DEBUG)
213   if (PetscStackActive()) {
214     ierr = PetscStackCopy(petscstack,&head->stack);CHKERRQ(ierr);
215     /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */
216     head->stack.line[head->stack.currentsize-2] = lineno;
217   } else {
218     head->stack.currentsize = 0;
219   }
220 #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE)
221   if (!clear && TRdebugIinitializenan) {
222     size_t     i, n = a/sizeof(PetscReal);
223     PetscReal *s = (PetscReal*) inew;
224     /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */
225 #if defined(PETSC_USE_REAL_SINGLE)
226     int        nas = 0x7F800002;
227 #else
228     PetscInt64 nas = 0x7FF0000000000002;
229 #endif
230     for (i=0; i<n; i++) {
231       memcpy(s+i,&nas,sizeof(PetscReal));
232     }
233   }
234 #endif
235 #endif
236 
237   /*
238          Allow logging of all mallocs made.
239          TODO: Currently this memory is never freed, it should be freed during PetscFinalize()
240   */
241   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
242     if (!PetscLogMalloc) {
243       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
244       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
245 
246       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
247       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
248 
249       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
250       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
251     }
252     PetscLogMallocLength[PetscLogMalloc]     = nsize;
253     PetscLogMallocFile[PetscLogMalloc]       = filename;
254     PetscLogMallocFunction[PetscLogMalloc++] = function;
255   }
256   if (PetscLogMallocTrace > -1 && a >= PetscLogMallocTraceThreshold) {
257     ierr = PetscViewerASCIIPrintf(PetscLogMallocTraceViewer,"Alloc %zu %s:%d (%s)\n", a, filename ? filename : "null", lineno, function ? function : "null");CHKERRQ(ierr);
258   }
259   *result = (void*)inew;
260   PetscFunctionReturn(0);
261 }
262 
263 /*
264    PetscTrFreeDefault - Free with tracing.
265 
266    Input Parameters:
267 .   a    - pointer to a block allocated with PetscTrMalloc
268 .   lineno - line number where used.  Use __LINE__ for this
269 .   filename  - file name where used.  Use __FILE__ for this
270  */
271 PetscErrorCode  PetscTrFreeDefault(void *aa,int lineno,const char function[],const char filename[])
272 {
273   char           *a = (char*)aa;
274   TRSPACE        *head;
275   char           *ahead;
276   size_t         asize;
277   PetscErrorCode ierr;
278   PetscClassId   *nend;
279 
280   PetscFunctionBegin;
281   /* Do not try to handle empty blocks */
282   if (!a) PetscFunctionReturn(0);
283 
284   ierr = PetscMallocValidate(lineno,function,filename);CHKERRQ(ierr);
285 
286   ahead = a;
287   a     = a - sizeof(TrSPACE);
288   head  = (TRSPACE*)a;
289 
290   if (head->classid != CLASSID_VALUE) {
291     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,lineno,filename);
292     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
293     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
294   }
295   nend = (PetscClassId*)(ahead + head->size);
296   if (*nend != CLASSID_VALUE) {
297     if (*nend == ALREADY_FREED) {
298       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,lineno,filename);
299       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
300       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
301         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
302       } else {
303         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
304       }
305       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
306     } else {
307       /* Damaged tail */
308       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,lineno,filename);
309       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
310       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
311       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
312     }
313   }
314   if (PetscLogMallocTrace > -1 && head->rsize >= PetscLogMallocTraceThreshold) {
315     ierr = PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Free  %zu %s:%d (%s)\n", head->rsize, filename ? filename : "null", lineno, function ? function : "null");CHKERRQ(ierr);
316   }
317   /* Mark the location freed */
318   *nend = ALREADY_FREED;
319   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
320   if (lineno > 0 && lineno < 50000) {
321     head->lineno       = lineno;
322     head->filename     = filename;
323     head->functionname = function;
324   } else {
325     head->lineno = -head->lineno;
326   }
327   asize = TRrequestedSize ? head->rsize : head->size;
328   if (TRallocated < asize) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"TRallocate is smaller than memory just freed");
329   TRallocated -= asize;
330   TRfrags--;
331   if (head->prev) head->prev->next = head->next;
332   else TRhead = head->next;
333 
334   if (head->next) head->next->prev = head->prev;
335   ierr = PetscFreeAlign(a,lineno,function,filename);CHKERRQ(ierr);
336   PetscFunctionReturn(0);
337 }
338 
339 /*
340   PetscTrReallocDefault - Realloc with tracing.
341 
342   Input Parameters:
343 + len      - number of bytes to allocate
344 . lineno   - line number where used.  Use __LINE__ for this
345 . filename - file name where used.  Use __FILE__ for this
346 - result - original memory
347 
348   Output Parameter:
349 . result - double aligned pointer to requested storage, or null if not available.
350 
351   Level: developer
352 
353 .seealso: PetscTrMallocDefault(), PetscTrFreeDefault()
354 */
355 PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result)
356 {
357   char           *a = (char *) *result;
358   TRSPACE        *head;
359   char           *ahead, *inew;
360   PetscClassId   *nend;
361   size_t         nsize;
362   PetscErrorCode ierr;
363 
364   PetscFunctionBegin;
365   /* Realloc requests zero space so just free the current space */
366   if (!len) {
367     ierr = PetscTrFreeDefault(*result,lineno,function,filename);CHKERRQ(ierr);
368     *result = NULL;
369     PetscFunctionReturn(0);
370   }
371   /* If the orginal space was NULL just use the regular malloc() */
372   if (!*result) {
373     ierr = PetscTrMallocDefault(len,PETSC_FALSE,lineno,function,filename,result);CHKERRQ(ierr);
374     PetscFunctionReturn(0);
375   }
376 
377   ierr = PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
378 
379   ahead = a;
380   a     = a - sizeof(TrSPACE);
381   head  = (TRSPACE *) a;
382   inew  = a;
383 
384   if (head->classid != CLASSID_VALUE) {
385     (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
386     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
387     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
388   }
389   nend = (PetscClassId *)(ahead + head->size);
390   if (*nend != CLASSID_VALUE) {
391     if (*nend == ALREADY_FREED) {
392       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
393       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
394       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
395         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
396       } else {
397         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
398       }
399       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
400     } else {
401       /* Damaged tail */
402       (*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() line %d in %s\n",function,lineno,filename);
403       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
404       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
405       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
406     }
407   }
408 
409   /* remove original reference to the memory allocated from the PETSc debugging heap */
410   TRallocated -= TRrequestedSize ? head->rsize : head->size;
411   TRfrags--;
412   if (head->prev) head->prev->next = head->next;
413   else TRhead = head->next;
414   if (head->next) head->next->prev = head->prev;
415 
416   nsize = (len + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
417   ierr  = PetscReallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);CHKERRQ(ierr);
418 
419   head  = (TRSPACE*)inew;
420   inew += sizeof(TrSPACE);
421 
422   if (TRhead) TRhead->prev = head;
423   head->next   = TRhead;
424   TRhead       = head;
425   head->prev   = NULL;
426   head->size   = nsize;
427   head->rsize  = len;
428   head->id     = TRid++;
429   head->lineno = lineno;
430 
431   head->filename                 = filename;
432   head->functionname             = function;
433   head->classid                  = CLASSID_VALUE;
434   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
435 
436   TRallocated += TRrequestedSize ? head->rsize : head->size;
437   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
438   if (PetscLogMemory) {
439     PetscInt i;
440     for (i=0; i<NumTRMaxMems; i++) {
441       if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated;
442     }
443   }
444   TRfrags++;
445 
446 #if defined(PETSC_USE_DEBUG)
447   if (PetscStackActive()) {
448     ierr = PetscStackCopy(petscstack,&head->stack);CHKERRQ(ierr);
449     /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */
450     head->stack.line[head->stack.currentsize-2] = lineno;
451   } else {
452     head->stack.currentsize = 0;
453   }
454 #endif
455 
456   /*
457          Allow logging of all mallocs made. This adds a new entry to the list of allocated memory
458          and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView()
459   */
460   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) {
461     if (!PetscLogMalloc) {
462       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
463       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
464 
465       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
466       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
467 
468       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
469       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
470     }
471     PetscLogMallocLength[PetscLogMalloc]     = nsize;
472     PetscLogMallocFile[PetscLogMalloc]       = filename;
473     PetscLogMallocFunction[PetscLogMalloc++] = function;
474   }
475   *result = (void*)inew;
476   PetscFunctionReturn(0);
477 }
478 
479 /*@C
480     PetscMemoryView - Shows the amount of memory currently being used in a communicator.
481 
482     Collective on PetscViewer
483 
484     Input Parameter:
485 +    viewer - the viewer that defines the communicator
486 -    message - string printed before values
487 
488     Options Database:
489 +    -malloc_debug - have PETSc track how much memory it has allocated
490 -    -memory_view - during PetscFinalize() have this routine called
491 
492     Level: intermediate
493 
494 .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage(), PetscMallocView()
495  @*/
496 PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
497 {
498   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
499   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
500   PetscErrorCode ierr;
501   MPI_Comm       comm;
502 
503   PetscFunctionBegin;
504   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
505   ierr = PetscMallocGetCurrentUsage(&allocated);CHKERRQ(ierr);
506   ierr = PetscMallocGetMaximumUsage(&allocatedmax);CHKERRQ(ierr);
507   ierr = PetscMemoryGetCurrentUsage(&resident);CHKERRQ(ierr);
508   ierr = PetscMemoryGetMaximumUsage(&residentmax);CHKERRQ(ierr);
509   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
510   ierr = PetscObjectGetComm((PetscObject)viewer,&comm);CHKERRQ(ierr);
511   ierr = PetscViewerASCIIPrintf(viewer,message);CHKERRQ(ierr);
512   if (resident && residentmax && allocated) {
513     ierr = MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
514     ierr = MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
515     ierr = MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
516     ierr = PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);CHKERRQ(ierr);
517     ierr = MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
518     ierr = MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
519     ierr = MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
520     ierr = PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);CHKERRQ(ierr);
521     ierr = MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
522     ierr = MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
523     ierr = MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
524     ierr = PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);CHKERRQ(ierr);
525     ierr = MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
526     ierr = MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
527     ierr = MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
528     ierr = PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);CHKERRQ(ierr);
529   } else if (resident && residentmax) {
530     ierr = MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
531     ierr = MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
532     ierr = MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
533     ierr = PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);CHKERRQ(ierr);
534     ierr = MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
535     ierr = MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
536     ierr = MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
537     ierr = PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);CHKERRQ(ierr);
538   } else if (resident && allocated) {
539     ierr = MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
540     ierr = MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
541     ierr = MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
542     ierr = PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);CHKERRQ(ierr);
543     ierr = MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
544     ierr = MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
545     ierr = MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
546     ierr = PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);CHKERRQ(ierr);
547     ierr = PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");CHKERRQ(ierr);
548   } else if (allocated) {
549     ierr = MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);CHKERRMPI(ierr);
550     ierr = MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);CHKERRMPI(ierr);
551     ierr = MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);CHKERRMPI(ierr);
552     ierr = PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);CHKERRQ(ierr);
553     ierr = PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");CHKERRQ(ierr);
554     ierr = PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");CHKERRQ(ierr);
555   } else {
556     ierr = PetscViewerASCIIPrintf(viewer,"Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");CHKERRQ(ierr);
557   }
558   ierr = PetscViewerFlush(viewer);CHKERRQ(ierr);
559   PetscFunctionReturn(0);
560 }
561 
562 /*@
563     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
564 
565     Not Collective
566 
567     Output Parameters:
568 .   space - number of bytes currently allocated
569 
570     Level: intermediate
571 
572 .seealso: PetscMallocDump(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
573           PetscMemoryGetMaximumUsage()
574  @*/
575 PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
576 {
577   PetscFunctionBegin;
578   *space = (PetscLogDouble) TRallocated;
579   PetscFunctionReturn(0);
580 }
581 
582 /*@
583     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
584         during this run.
585 
586     Not Collective
587 
588     Output Parameters:
589 .   space - maximum number of bytes ever allocated at one time
590 
591     Level: intermediate
592 
593 .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
594           PetscMallocPushMaximumUsage()
595  @*/
596 PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
597 {
598   PetscFunctionBegin;
599   *space = (PetscLogDouble) TRMaxMem;
600   PetscFunctionReturn(0);
601 }
602 
603 /*@
604     PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event
605 
606     Not Collective
607 
608     Input Parameter:
609 .   event - an event id; this is just for error checking
610 
611     Level: developer
612 
613 .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
614           PetscMallocPopMaximumUsage()
615  @*/
616 PetscErrorCode  PetscMallocPushMaximumUsage(int event)
617 {
618   PetscFunctionBegin;
619   if (++NumTRMaxMems > MAXTRMAXMEMS) PetscFunctionReturn(0);
620   TRMaxMems[NumTRMaxMems-1]       = TRallocated;
621   TRMaxMemsEvents[NumTRMaxMems-1] = event;
622   PetscFunctionReturn(0);
623 }
624 
625 /*@
626     PetscMallocPopMaximumUsage - collect the maximum memory usage over an event
627 
628     Not Collective
629 
630     Input Parameter:
631 .   event - an event id; this is just for error checking
632 
633     Output Parameter:
634 .   mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event
635 
636     Level: developer
637 
638 .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
639           PetscMallocPushMaximumUsage()
640  @*/
641 PetscErrorCode  PetscMallocPopMaximumUsage(int event,PetscLogDouble *mu)
642 {
643   PetscFunctionBegin;
644   *mu = 0;
645   if (NumTRMaxMems-- > MAXTRMAXMEMS) PetscFunctionReturn(0);
646   if (TRMaxMemsEvents[NumTRMaxMems] != event) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"PetscMallocPush/PopMaximumUsage() are not nested");
647   *mu = TRMaxMems[NumTRMaxMems];
648   PetscFunctionReturn(0);
649 }
650 
651 #if defined(PETSC_USE_DEBUG)
652 /*@C
653    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory
654 
655    Collective on PETSC_COMM_WORLD
656 
657    Input Parameter:
658 .    ptr - the memory location
659 
660    Output Parameter:
661 .    stack - the stack indicating where the program allocated this memory
662 
663    Level: intermediate
664 
665 .seealso:  PetscMallocGetCurrentUsage(), PetscMallocView()
666 @*/
667 PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
668 {
669   TRSPACE *head;
670 
671   PetscFunctionBegin;
672   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
673   *stack = &head->stack;
674   PetscFunctionReturn(0);
675 }
676 #else
677 PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
678 {
679   PetscFunctionBegin;
680   *stack = NULL;
681   PetscFunctionReturn(0);
682 }
683 #endif
684 
685 /*@C
686    PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information
687    printed is: size of space (in bytes), address of space, id of space,
688    file in which space was allocated, and line number at which it was
689    allocated.
690 
691    Not Collective
692 
693    Input Parameter:
694 .  fp  - file pointer.  If fp is NULL, stdout is assumed.
695 
696    Options Database Key:
697 .  -malloc_dump <optional filename> - Dumps unfreed memory during call to PetscFinalize()
698 
699    Level: intermediate
700 
701    Fortran Note:
702    The calling sequence in Fortran is PetscMallocDump(integer ierr)
703    The fp defaults to stdout.
704 
705    Notes:
706      Uses MPI_COMM_WORLD to display rank, because this may be called in PetscFinalize() after PETSC_COMM_WORLD has been freed.
707 
708      When called in PetscFinalize() dumps only the allocations that have not been properly freed
709 
710      PetscMallocView() prints a list of all memory ever allocated
711 
712 .seealso:  PetscMallocGetCurrentUsage(), PetscMallocView(), PetscMallocViewSet(), PetscMallocValidate()
713 @*/
714 PetscErrorCode  PetscMallocDump(FILE *fp)
715 {
716   TRSPACE        *head;
717   size_t         libAlloc = 0;
718   PetscErrorCode ierr;
719   PetscMPIInt    rank;
720 
721   PetscFunctionBegin;
722   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&rank);CHKERRMPI(ierr);
723   if (!fp) fp = PETSC_STDOUT;
724   head = TRhead;
725   while (head) {
726     libAlloc += TRrequestedSize ? head->rsize : head->size;
727     head = head->next;
728   }
729   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
730   head = TRhead;
731   while (head) {
732     PetscBool isLib;
733 
734     ierr = PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);CHKERRQ(ierr);
735     if (!isLib) {
736       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble) (TRrequestedSize ? head->rsize : head->size),head->functionname,head->lineno,head->filename);
737 #if defined(PETSC_USE_DEBUG)
738       ierr = PetscStackPrint(&head->stack,fp);CHKERRQ(ierr);
739 #endif
740     }
741     head = head->next;
742   }
743   PetscFunctionReturn(0);
744 }
745 
746 /*@
747     PetscMallocViewSet - Activates logging of all calls to PetscMalloc() with a minimum size to view
748 
749     Not Collective
750 
751     Input Arguments:
752 .   logmin - minimum allocation size to log, or PETSC_DEFAULT
753 
754     Options Database Key:
755 +  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()
756 .  -malloc_view_threshold <min> - Sets a minimum size if -malloc_view is used
757 -  -log_view_memory - view the memory usage also with the -log_view option
758 
759     Level: advanced
760 
761     Notes: Must be called after PetscMallocSetDebug()
762 
763     Uses MPI_COMM_WORLD to determine rank because PETSc communicators may not be available
764 
765 .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocViewSet(), PetscMallocTraceSet(), PetscMallocValidate()
766 @*/
767 PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin)
768 {
769   PetscErrorCode ierr;
770 
771   PetscFunctionBegin;
772   PetscLogMalloc = 0;
773   ierr = PetscMemorySetGetMaximumUsage();CHKERRQ(ierr);
774   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
775   PetscLogMallocThreshold = (size_t)logmin;
776   PetscFunctionReturn(0);
777 }
778 
779 /*@
780     PetscMallocViewGet - Determine whether all calls to PetscMalloc() are being logged
781 
782     Not Collective
783 
784     Output Arguments
785 .   logging - PETSC_TRUE if logging is active
786 
787     Options Database Key:
788 .  -malloc_view <optional filename> - Activates PetscMallocView()
789 
790     Level: advanced
791 
792 .seealso: PetscMallocDump(), PetscMallocView(), PetscMallocTraceGet()
793 @*/
794 PetscErrorCode PetscMallocViewGet(PetscBool *logging)
795 {
796 
797   PetscFunctionBegin;
798   *logging = (PetscBool)(PetscLogMalloc >= 0);
799   PetscFunctionReturn(0);
800 }
801 
802 /*@
803   PetscMallocTraceSet - Trace all calls to PetscMalloc()
804 
805   Not Collective
806 
807   Input Arguments:
808 + viewer - The viewer to use for tracing, or NULL to use stdout
809 . active - Flag to activate or deactivate tracing
810 - logmin - The smallest memory size that will be logged
811 
812   Note:
813   The viewer should not be collective.
814 
815   Level: advanced
816 
817 .seealso: PetscMallocTraceGet(), PetscMallocViewGet(), PetscMallocDump(), PetscMallocView()
818 @*/
819 PetscErrorCode PetscMallocTraceSet(PetscViewer viewer, PetscBool active, PetscLogDouble logmin)
820 {
821   PetscErrorCode ierr;
822 
823   PetscFunctionBegin;
824   if (!active) {PetscLogMallocTrace = -1; PetscFunctionReturn(0);}
825   PetscLogMallocTraceViewer = !viewer ? PETSC_VIEWER_STDOUT_SELF : viewer;
826   PetscLogMallocTrace = 0;
827   ierr = PetscMemorySetGetMaximumUsage();CHKERRQ(ierr);
828   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
829   PetscLogMallocTraceThreshold = (size_t) logmin;
830   PetscFunctionReturn(0);
831 }
832 
833 /*@
834   PetscMallocTraceGet - Determine whether all calls to PetscMalloc() are being traced
835 
836   Not Collective
837 
838   Output Argument:
839 . logging - PETSC_TRUE if logging is active
840 
841   Options Database Key:
842 . -malloc_view <optional filename> - Activates PetscMallocView()
843 
844   Level: advanced
845 
846 .seealso: PetscMallocTraceSet(), PetscMallocViewGet(), PetscMallocDump(), PetscMallocView()
847 @*/
848 PetscErrorCode PetscMallocTraceGet(PetscBool *logging)
849 {
850 
851   PetscFunctionBegin;
852   *logging = (PetscBool) (PetscLogMallocTrace >= 0);
853   PetscFunctionReturn(0);
854 }
855 
856 /*@C
857     PetscMallocView - Saves the log of all calls to PetscMalloc(); also calls
858        PetscMemoryGetMaximumUsage()
859 
860     Not Collective
861 
862     Input Parameter:
863 .   fp - file pointer; or NULL
864 
865     Options Database Key:
866 .  -malloc_view <optional filename> - Activates PetscMallocView() in PetscFinalize()
867 
868     Level: advanced
869 
870    Fortran Note:
871    The calling sequence in Fortran is PetscMallocView(integer ierr)
872    The fp defaults to stdout.
873 
874    Notes:
875      PetscMallocDump() dumps only the currently unfreed memory, this dumps all memory ever allocated
876 
877      PetscMemoryView() gives a brief summary of current memory usage
878 
879 .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocViewSet(), PetscMemoryView()
880 @*/
881 PetscErrorCode  PetscMallocView(FILE *fp)
882 {
883   PetscInt       i,j,n,*perm;
884   size_t         *shortlength;
885   int            *shortcount,err;
886   PetscMPIInt    rank;
887   PetscBool      match;
888   const char     **shortfunction;
889   PetscLogDouble rss;
890   PetscErrorCode ierr;
891 
892   PetscFunctionBegin;
893   ierr = MPI_Comm_rank(MPI_COMM_WORLD,&rank);CHKERRMPI(ierr);
894   err = fflush(fp);
895   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
896 
897   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()");
898 
899   if (!fp) fp = PETSC_STDOUT;
900   ierr = PetscMemoryGetMaximumUsage(&rss);CHKERRQ(ierr);
901   if (rss) {
902     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
903   } else {
904     (void) fprintf(fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
905   }
906   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
907   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
908   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
909   for (i=0,n=0; i<PetscLogMalloc; i++) {
910     for (j=0; j<n; j++) {
911       ierr = PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);CHKERRQ(ierr);
912       if (match) {
913         shortlength[j] += PetscLogMallocLength[i];
914         shortcount[j]++;
915         goto foundit;
916       }
917     }
918     shortfunction[n] = PetscLogMallocFunction[i];
919     shortlength[n]   = PetscLogMallocLength[i];
920     shortcount[n]    = 1;
921     n++;
922 foundit:;
923   }
924 
925   perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
926   for (i=0; i<n; i++) perm[i] = i;
927   ierr = PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);CHKERRQ(ierr);
928 
929   (void) fprintf(fp,"[%d] Memory usage sorted by function\n",rank);
930   for (i=0; i<n; i++) {
931     (void) fprintf(fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
932   }
933   free(perm);
934   free(shortlength);
935   free(shortcount);
936   free((char**)shortfunction);
937   err = fflush(fp);
938   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
939   PetscFunctionReturn(0);
940 }
941 
942 /* ---------------------------------------------------------------------------- */
943 
944 /*@
945     PetscMallocSetDebug - Set's PETSc memory debugging
946 
947     Not Collective
948 
949     Input Parameter:
950 +   eachcall - checks the entire heap of allocated memory for issues on each call to PetscMalloc() and PetscFree()
951 -   initializenan - initializes all memory with NaN to catch use of uninitialized floating point arrays
952 
953     Options Database:
954 +   -malloc_debug <true or false> - turns on or off debugging
955 .   -malloc_test - turns on all debugging if PETSc was configured with debugging including -malloc_dump, otherwise ignored
956 .   -malloc_view_threshold t - log only allocations larger than t
957 .   -malloc_dump <filename> - print a list of all memory that has not been freed
958 .   -malloc no - (deprecated) same as -malloc_debug no
959 -   -malloc_log - (deprecated) same as -malloc_view
960 
961    Level: developer
962 
963     Notes: This is called in PetscInitialize() and should not be called elsewhere
964 
965 .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocGetDebug()
966 @*/
967 PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan)
968 {
969   PetscErrorCode ierr;
970 
971   PetscFunctionBegin;
972   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()");
973   ierr = PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault,PetscTrReallocDefault);CHKERRQ(ierr);
974 
975   TRallocated         = 0;
976   TRfrags             = 0;
977   TRhead              = NULL;
978   TRid                = 0;
979   TRdebugLevel        = eachcall;
980   TRMaxMem            = 0;
981   PetscLogMallocMax   = 10000;
982   PetscLogMalloc      = -1;
983   TRdebugIinitializenan = initializenan;
984   PetscFunctionReturn(0);
985 }
986 
987 /*@
988     PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing.
989 
990     Not Collective
991 
992     Output Parameters:
993 +    basic - doing basic debugging
994 .    eachcall - checks the entire memory heap at each PetscMalloc()/PetscFree()
995 -    initializenan - initializes memory with NaN
996 
997    Level: intermediate
998 
999    Notes:
1000      By default, the debug version always does some debugging unless you run with -malloc_debug no
1001 
1002 .seealso: CHKMEMQ(), PetscMallocValidate(), PetscMallocSetDebug()
1003 @*/
1004 PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan)
1005 {
1006   PetscFunctionBegin;
1007   if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE;
1008   if (eachcall) *eachcall           = TRdebugLevel;
1009   if (initializenan) *initializenan = TRdebugIinitializenan;
1010   PetscFunctionReturn(0);
1011 }
1012 
1013 /*@
1014   PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size
1015 
1016   Not Collective
1017 
1018   Input Parameter:
1019 . flg - PETSC_TRUE to log the requested memory size
1020 
1021   Options Database:
1022 . -malloc_requested_size <bool> - Sets this flag
1023 
1024   Level: developer
1025 
1026 .seealso: PetscMallocLogRequestedSizeGet(), PetscMallocViewSet()
1027 @*/
1028 PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg)
1029 {
1030   PetscFunctionBegin;
1031   TRrequestedSize = flg;
1032   PetscFunctionReturn(0);
1033 }
1034 
1035 /*@
1036   PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size
1037 
1038   Not Collective
1039 
1040   Output Parameter:
1041 . flg - PETSC_TRUE if we log the requested memory size
1042 
1043   Level: developer
1044 
1045 .seealso: PetscMallocLogRequestedSizeSetinalSizeSet(), PetscMallocViewSet()
1046 @*/
1047 PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg)
1048 {
1049   PetscFunctionBegin;
1050   *flg = TRrequestedSize;
1051   PetscFunctionReturn(0);
1052 }
1053