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