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