Actual source code: mtr.c
petsc-3.5.4 2015-05-23
2: /*
3: Interface to malloc() and free(). This code allows for
4: logging of memory usage and some error checking
5: */
6: #include <petscsys.h> /*I "petscsys.h" I*/
7: #include <petscviewer.h>
8: #if defined(PETSC_HAVE_MALLOC_H)
9: #include <malloc.h>
10: #endif
13: /*
14: These are defined in mal.c and ensure that malloced space is PetscScalar aligned
15: */
16: extern PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**);
17: extern PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
18: extern PetscErrorCode PetscTrMallocDefault(size_t,int,const char[],const char[],void**);
19: extern PetscErrorCode PetscTrFreeDefault(void*,int,const char[],const char[]);
22: #define CLASSID_VALUE ((PetscClassId) 0xf0e0d0c9)
23: #define ALREADY_FREED ((PetscClassId) 0x0f0e0d9c)
25: typedef struct _trSPACE {
26: size_t size;
27: int id;
28: int lineno;
29: const char *filename;
30: const char *functionname;
31: PetscClassId classid;
32: #if defined(PETSC_USE_DEBUG)
33: PetscStack stack;
34: #endif
35: struct _trSPACE *next,*prev;
36: } TRSPACE;
38: /* HEADER_BYTES is the number of bytes in a PetscMalloc() header.
39: It is sizeof(TRSPACE) padded to be a multiple of PETSC_MEMALIGN.
40: */
42: #define HEADER_BYTES ((sizeof(TRSPACE)+(PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1))
45: /* This union is used to insure that the block passed to the user retains
46: a minimum alignment of PETSC_MEMALIGN.
47: */
48: typedef union {
49: TRSPACE sp;
50: char v[HEADER_BYTES];
51: } TrSPACE;
54: static size_t TRallocated = 0;
55: static int TRfrags = 0;
56: static TRSPACE *TRhead = 0;
57: static int TRid = 0;
58: static PetscBool TRdebugLevel = PETSC_FALSE;
59: static size_t TRMaxMem = 0;
60: /*
61: Arrays to log information on all Mallocs
62: */
63: static int PetscLogMallocMax = 10000,PetscLogMalloc = -1;
64: static size_t PetscLogMallocThreshold = 0;
65: static size_t *PetscLogMallocLength;
66: static const char **PetscLogMallocFile,**PetscLogMallocFunction;
70: PetscErrorCode PetscSetUseTrMalloc_Private(void)
71: {
75: PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);
77: TRallocated = 0;
78: TRfrags = 0;
79: TRhead = 0;
80: TRid = 0;
81: TRdebugLevel = PETSC_FALSE;
82: TRMaxMem = 0;
83: PetscLogMallocMax = 10000;
84: PetscLogMalloc = -1;
85: return(0);
86: }
90: /*@C
91: PetscMallocValidate - Test the memory for corruption. This can be used to
92: check for memory overwrites.
94: Input Parameter:
95: + line - line number where call originated.
96: . function - name of function calling
97: - file - file where function is
99: Return value:
100: The number of errors detected.
102: Output Effect:
103: Error messages are written to stdout.
105: Level: advanced
107: Notes:
108: You should generally use CHKMEMQ as a short cut for calling this
109: routine.
111: The line, function, file are given by the C preprocessor as
112: __LINE__, __FUNCT__, __FILE__
114: The Fortran calling sequence is simply PetscMallocValidate(ierr)
116: No output is generated if there are no problems detected.
118: .seealso: CHKMEMQ
120: @*/
121: PetscErrorCode PetscMallocValidate(int line,const char function[],const char file[])
122: {
123: TRSPACE *head,*lasthead;
124: char *a;
125: PetscClassId *nend;
128: head = TRhead; lasthead = NULL;
129: while (head) {
130: if (head->classid != CLASSID_VALUE) {
131: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
132: (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
133: (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
134: if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
135: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
136: }
137: a = (char*)(((TrSPACE*)head) + 1);
138: nend = (PetscClassId*)(a + head->size);
139: if (*nend != CLASSID_VALUE) {
140: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
141: if (*nend == ALREADY_FREED) {
142: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
143: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
144: } else {
145: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
146: (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
147: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
148: }
149: }
150: lasthead = head;
151: head = head->next;
152: }
153: return(0);
154: }
158: /*
159: PetscTrMallocDefault - Malloc with tracing.
161: Input Parameters:
162: + a - number of bytes to allocate
163: . lineno - line number where used. Use __LINE__ for this
164: . function - function calling routine. Use __FUNCT__ for this
165: - filename - file name where used. Use __FILE__ for this
167: Returns:
168: double aligned pointer to requested storage, or null if not
169: available.
170: */
171: PetscErrorCode PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],void **result)
172: {
173: TRSPACE *head;
174: char *inew;
175: size_t nsize;
179: if (TRdebugLevel) {
180: PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
181: }
183: nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
184: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);
186: head = (TRSPACE*)inew;
187: inew += sizeof(TrSPACE);
189: if (TRhead) TRhead->prev = head;
190: head->next = TRhead;
191: TRhead = head;
192: head->prev = 0;
193: head->size = nsize;
194: head->id = TRid;
195: head->lineno = lineno;
197: head->filename = filename;
198: head->functionname = function;
199: head->classid = CLASSID_VALUE;
200: *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
202: TRallocated += nsize;
203: if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
204: TRfrags++;
206: #if defined(PETSC_USE_DEBUG)
207: if (PetscStackActive()) {
208: PetscStackCopy((PetscStack*)PetscThreadLocalGetValue(petscstack),&head->stack);
210: head->stack.line[head->stack.currentsize-2] = lineno;
211: }
212: #endif
214: /*
215: Allow logging of all mallocs made
216: */
217: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
218: if (!PetscLogMalloc) {
219: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
220: if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
222: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
223: if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
225: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
226: if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
227: }
228: PetscLogMallocLength[PetscLogMalloc] = nsize;
229: PetscLogMallocFile[PetscLogMalloc] = filename;
230: PetscLogMallocFunction[PetscLogMalloc++] = function;
231: }
232: *result = (void*)inew;
233: return(0);
234: }
239: /*
240: PetscTrFreeDefault - Free with tracing.
242: Input Parameters:
243: . a - pointer to a block allocated with PetscTrMalloc
244: . lineno - line number where used. Use __LINE__ for this
245: . function - function calling routine. Use __FUNCT__ for this
246: . file - file name where used. Use __FILE__ for this
247: */
248: PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
249: {
250: char *a = (char*)aa;
251: TRSPACE *head;
252: char *ahead;
254: PetscClassId *nend;
257: /* Do not try to handle empty blocks */
258: if (!a) return(0);
260: if (TRdebugLevel) {
261: PetscMallocValidate(line,function,file);
262: }
264: ahead = a;
265: a = a - sizeof(TrSPACE);
266: head = (TRSPACE*)a;
268: if (head->classid != CLASSID_VALUE) {
269: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
270: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
271: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
272: }
273: nend = (PetscClassId*)(ahead + head->size);
274: if (*nend != CLASSID_VALUE) {
275: if (*nend == ALREADY_FREED) {
276: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
277: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
278: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
279: (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
280: } else {
281: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
282: }
283: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
284: } else {
285: /* Damaged tail */
286: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
287: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
288: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
289: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
290: }
291: }
292: /* Mark the location freed */
293: *nend = ALREADY_FREED;
294: /* Save location where freed. If we suspect the line number, mark as allocated location */
295: if (line > 0 && line < 50000) {
296: head->lineno = line;
297: head->filename = file;
298: head->functionname = function;
299: } else {
300: head->lineno = -head->lineno;
301: }
302: /* zero out memory - helps to find some reuse of already freed memory */
303: PetscMemzero(aa,head->size);
305: TRallocated -= head->size;
306: TRfrags--;
307: if (head->prev) head->prev->next = head->next;
308: else TRhead = head->next;
310: if (head->next) head->next->prev = head->prev;
311: PetscFreeAlign(a,line,function,file);
312: return(0);
313: }
318: /*@C
319: PetscMemoryShowUsage - Shows the amount of memory currently being used
320: in a communicator.
322: Collective on PetscViewer
324: Input Parameter:
325: + viewer - the viewer that defines the communicator
326: - message - string printed before values
328: Level: intermediate
330: Concepts: memory usage
332: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
333: @*/
334: PetscErrorCode PetscMemoryShowUsage(PetscViewer viewer,const char message[])
335: {
336: PetscLogDouble allocated,maximum,resident,residentmax;
338: PetscMPIInt rank;
339: MPI_Comm comm;
342: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
343: PetscMallocGetCurrentUsage(&allocated);
344: PetscMallocGetMaximumUsage(&maximum);
345: PetscMemoryGetCurrentUsage(&resident);
346: PetscMemoryGetMaximumUsage(&residentmax);
347: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
348: PetscObjectGetComm((PetscObject)viewer,&comm);
349: MPI_Comm_rank(comm,&rank);
350: PetscViewerASCIIPrintf(viewer,message);
351: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
352: if (resident && residentmax && allocated) {
353: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g max process memory %g\n",rank,allocated,maximum,rank,resident,residentmax);
354: } else if (resident && residentmax) {
355: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Run with -malloc to get statistics on PetscMalloc() calls\n[%d]Current process memory %g max process memory %g\n",rank,rank,resident,residentmax);
356: } else if (resident && allocated) {
357: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]Current process memory %g, run with -memory_info to get max memory usage\n",rank,allocated,maximum,rank,resident);
358: } else if (allocated) {
359: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
360: } else {
361: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
362: }
363: PetscViewerFlush(viewer);
364: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
365: return(0);
366: }
370: /*@C
371: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
373: Not Collective
375: Output Parameters:
376: . space - number of bytes currently allocated
378: Level: intermediate
380: Concepts: memory usage
382: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
383: PetscMemoryGetMaximumUsage()
384: @*/
385: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
386: {
388: *space = (PetscLogDouble) TRallocated;
389: return(0);
390: }
394: /*@C
395: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
396: during this run.
398: Not Collective
400: Output Parameters:
401: . space - maximum number of bytes ever allocated at one time
403: Level: intermediate
405: Concepts: memory usage
407: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
408: PetscMemoryGetCurrentUsage()
409: @*/
410: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
411: {
413: *space = (PetscLogDouble) TRMaxMem;
414: return(0);
415: }
417: #if defined(PETSC_USE_DEBUG)
420: /*@C
421: PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory
423: Collective on PETSC_COMM_WORLD
425: Input Parameter:
426: . ptr - the memory location
428: Output Paramter:
429: . stack - the stack indicating where the program allocated this memory
431: Level: intermediate
433: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
434: @*/
435: PetscErrorCode PetscMallocGetStack(void *ptr,PetscStack **stack)
436: {
437: TRSPACE *head;
440: head = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
441: *stack = &head->stack;
442: return(0);
443: }
444: #else
447: PetscErrorCode PetscMallocGetStack(void *ptr,void **stack)
448: {
450: *stack = 0;
451: return(0);
452: }
453: #endif
457: /*@C
458: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
459: printed is: size of space (in bytes), address of space, id of space,
460: file in which space was allocated, and line number at which it was
461: allocated.
463: Collective on PETSC_COMM_WORLD
465: Input Parameter:
466: . fp - file pointer. If fp is NULL, stdout is assumed.
468: Options Database Key:
469: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
471: Level: intermediate
473: Fortran Note:
474: The calling sequence in Fortran is PetscMallocDump(integer ierr)
475: The fp defaults to stdout.
477: Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
478: has been freed.
480: Concepts: memory usage
481: Concepts: memory bleeding
482: Concepts: bleeding memory
484: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
485: @*/
486: PetscErrorCode PetscMallocDump(FILE *fp)
487: {
488: TRSPACE *head;
490: PetscMPIInt rank;
493: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
494: if (!fp) fp = PETSC_STDOUT;
495: if (TRallocated > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
496: head = TRhead;
497: while (head) {
498: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
499: #if defined(PETSC_USE_DEBUG)
500: PetscStackPrint(&head->stack,fp);
501: #endif
502: head = head->next;
503: }
504: return(0);
505: }
507: /* ---------------------------------------------------------------------------- */
511: /*@C
512: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
514: Not Collective
516: Options Database Key:
517: + -malloc_log <filename> - Activates PetscMallocDumpLog()
518: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
520: Level: advanced
522: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
523: @*/
524: PetscErrorCode PetscMallocSetDumpLog(void)
525: {
529: PetscLogMalloc = 0;
531: PetscMemorySetGetMaximumUsage();
532: return(0);
533: }
537: /*@C
538: PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().
540: Not Collective
542: Input Arguments:
543: . logmin - minimum allocation size to log, or PETSC_DEFAULT
545: Options Database Key:
546: + -malloc_log <filename> - Activates PetscMallocDumpLog()
547: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
549: Level: advanced
551: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
552: @*/
553: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
554: {
558: PetscMallocSetDumpLog();
559: if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
560: PetscLogMallocThreshold = (size_t)logmin;
561: return(0);
562: }
566: /*@C
567: PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged
569: Not Collective
571: Output Arguments
572: . logging - PETSC_TRUE if logging is active
574: Options Database Key:
575: . -malloc_log - Activates PetscMallocDumpLog()
577: Level: advanced
579: .seealso: PetscMallocDump(), PetscMallocDumpLog()
580: @*/
581: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
582: {
585: *logging = (PetscBool)(PetscLogMalloc >= 0);
586: return(0);
587: }
591: /*@C
592: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
593: PetscMemoryGetMaximumUsage()
595: Collective on PETSC_COMM_WORLD
597: Input Parameter:
598: . fp - file pointer; or NULL
600: Options Database Key:
601: . -malloc_log - Activates PetscMallocDumpLog()
603: Level: advanced
605: Fortran Note:
606: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
607: The fp defaults to stdout.
609: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
610: @*/
611: PetscErrorCode PetscMallocDumpLog(FILE *fp)
612: {
613: PetscInt i,j,n,dummy,*perm;
614: size_t *shortlength;
615: int *shortcount,err;
616: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
617: PetscBool match;
618: const char **shortfunction;
619: PetscLogDouble rss;
620: MPI_Status status;
624: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
625: MPI_Comm_size(MPI_COMM_WORLD,&size);
626: /*
627: Try to get the data printed in order by processor. This will only sometimes work
628: */
629: err = fflush(fp);
630: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
632: MPI_Barrier(MPI_COMM_WORLD);
633: if (rank) {
634: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
635: }
637: if (PetscLogMalloc < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"PetscMallocDumpLog() called without call to PetscMallocSetDumpLog() this is often due to\n setting the option -malloc_log AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()");
639: if (!fp) fp = PETSC_STDOUT;
640: PetscMemoryGetMaximumUsage(&rss);
641: if (rss) {
642: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
643: } else {
644: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
645: }
646: shortcount = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
647: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
648: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
649: for (i=0,n=0; i<PetscLogMalloc; i++) {
650: for (j=0; j<n; j++) {
651: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
652: if (match) {
653: shortlength[j] += PetscLogMallocLength[i];
654: shortcount[j]++;
655: goto foundit;
656: }
657: }
658: shortfunction[n] = PetscLogMallocFunction[i];
659: shortlength[n] = PetscLogMallocLength[i];
660: shortcount[n] = 1;
661: n++;
662: foundit:;
663: }
665: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
666: for (i=0; i<n; i++) perm[i] = i;
667: PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);
669: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
670: for (i=0; i<n; i++) {
671: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
672: }
673: free(perm);
674: free(shortlength);
675: free(shortcount);
676: free((char**)shortfunction);
677: err = fflush(fp);
678: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
679: if (rank != size-1) {
680: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
681: }
682: return(0);
683: }
685: /* ---------------------------------------------------------------------------- */
689: /*@C
690: PetscMallocDebug - Turns on/off debugging for the memory management routines.
692: Not Collective
694: Input Parameter:
695: . level - PETSC_TRUE or PETSC_FALSE
697: Level: intermediate
699: .seealso: CHKMEMQ(), PetscMallocValidate()
700: @*/
701: PetscErrorCode PetscMallocDebug(PetscBool level)
702: {
704: TRdebugLevel = level;
705: return(0);
706: }
710: /*@C
711: PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.
713: Not Collective
715: Output Parameter:
716: . flg - PETSC_TRUE if any debugger
718: Level: intermediate
720: Note that by default, the debug version always does some debugging unless you run with -malloc no
723: .seealso: CHKMEMQ(), PetscMallocValidate()
724: @*/
725: PetscErrorCode PetscMallocGetDebug(PetscBool *flg)
726: {
728: if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
729: else *flg = PETSC_FALSE;
730: return(0);
731: }