Actual source code: mtr.c
petsc-dev 2014-02-02
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 (!a) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to malloc zero size array");
181: if (TRdebugLevel) {
182: PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
183: }
185: nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
186: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);
188: head = (TRSPACE*)inew;
189: inew += sizeof(TrSPACE);
191: if (TRhead) TRhead->prev = head;
192: head->next = TRhead;
193: TRhead = head;
194: head->prev = 0;
195: head->size = nsize;
196: head->id = TRid;
197: head->lineno = lineno;
199: head->filename = filename;
200: head->functionname = function;
201: head->classid = CLASSID_VALUE;
202: *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;
204: TRallocated += nsize;
205: if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
206: TRfrags++;
208: #if defined(PETSC_USE_DEBUG)
209: if (PetscStackActive()) {
210: PetscStackCopy((PetscStack*)PetscThreadLocalGetValue(petscstack),&head->stack);
212: head->stack.line[head->stack.currentsize-2] = lineno;
213: }
214: #endif
216: /*
217: Allow logging of all mallocs made
218: */
219: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
220: if (!PetscLogMalloc) {
221: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
222: if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
224: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
225: if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
227: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
228: if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
229: }
230: PetscLogMallocLength[PetscLogMalloc] = nsize;
231: PetscLogMallocFile[PetscLogMalloc] = filename;
232: PetscLogMallocFunction[PetscLogMalloc++] = function;
233: }
234: *result = (void*)inew;
235: return(0);
236: }
241: /*
242: PetscTrFreeDefault - Free with tracing.
244: Input Parameters:
245: . a - pointer to a block allocated with PetscTrMalloc
246: . lineno - line number where used. Use __LINE__ for this
247: . function - function calling routine. Use __FUNCT__ for this
248: . file - file name where used. Use __FILE__ for this
249: */
250: PetscErrorCode PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
251: {
252: char *a = (char*)aa;
253: TRSPACE *head;
254: char *ahead;
256: PetscClassId *nend;
259: /* Do not try to handle empty blocks */
260: if (!a) {
261: (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s\n",function,line,file);
262: SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block: Free called from %s() line %d in %s\n",function,line,file);
263: }
265: if (TRdebugLevel) {
266: PetscMallocValidate(line,function,file);
267: }
269: ahead = a;
270: a = a - sizeof(TrSPACE);
271: head = (TRSPACE*)a;
273: if (head->classid != CLASSID_VALUE) {
274: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
275: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
276: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
277: }
278: nend = (PetscClassId*)(ahead + head->size);
279: if (*nend != CLASSID_VALUE) {
280: if (*nend == ALREADY_FREED) {
281: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
282: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
283: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
284: (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
285: } else {
286: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
287: }
288: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
289: } else {
290: /* Damaged tail */
291: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
292: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
293: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
294: SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
295: }
296: }
297: /* Mark the location freed */
298: *nend = ALREADY_FREED;
299: /* Save location where freed. If we suspect the line number, mark as allocated location */
300: if (line > 0 && line < 50000) {
301: head->lineno = line;
302: head->filename = file;
303: head->functionname = function;
304: } else {
305: head->lineno = -head->lineno;
306: }
307: /* zero out memory - helps to find some reuse of already freed memory */
308: PetscMemzero(aa,head->size);
310: TRallocated -= head->size;
311: TRfrags--;
312: if (head->prev) head->prev->next = head->next;
313: else TRhead = head->next;
315: if (head->next) head->next->prev = head->prev;
316: PetscFreeAlign(a,line,function,file);
317: return(0);
318: }
323: /*@C
324: PetscMemoryShowUsage - Shows the amount of memory currently being used
325: in a communicator.
327: Collective on PetscViewer
329: Input Parameter:
330: + viewer - the viewer that defines the communicator
331: - message - string printed before values
333: Level: intermediate
335: Concepts: memory usage
337: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage()
338: @*/
339: PetscErrorCode PetscMemoryShowUsage(PetscViewer viewer,const char message[])
340: {
341: PetscLogDouble allocated,maximum,resident,residentmax;
343: PetscMPIInt rank;
344: MPI_Comm comm;
347: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
348: PetscMallocGetCurrentUsage(&allocated);
349: PetscMallocGetMaximumUsage(&maximum);
350: PetscMemoryGetCurrentUsage(&resident);
351: PetscMemoryGetMaximumUsage(&residentmax);
352: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
353: PetscObjectGetComm((PetscObject)viewer,&comm);
354: MPI_Comm_rank(comm,&rank);
355: PetscViewerASCIIPrintf(viewer,message);
356: PetscViewerASCIISynchronizedAllow(viewer,PETSC_TRUE);
357: if (resident && residentmax && allocated) {
358: 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);
359: } else if (resident && residentmax) {
360: 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);
361: } else if (resident && allocated) {
362: 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);
363: } else if (allocated) {
364: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
365: } else {
366: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
367: }
368: PetscViewerFlush(viewer);
369: PetscViewerASCIISynchronizedAllow(viewer,PETSC_FALSE);
370: return(0);
371: }
375: /*@C
376: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
378: Not Collective
380: Output Parameters:
381: . space - number of bytes currently allocated
383: Level: intermediate
385: Concepts: memory usage
387: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
388: PetscMemoryGetMaximumUsage()
389: @*/
390: PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space)
391: {
393: *space = (PetscLogDouble) TRallocated;
394: return(0);
395: }
399: /*@C
400: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
401: during this run.
403: Not Collective
405: Output Parameters:
406: . space - maximum number of bytes ever allocated at one time
408: Level: intermediate
410: Concepts: memory usage
412: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
413: PetscMemoryGetCurrentUsage()
414: @*/
415: PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space)
416: {
418: *space = (PetscLogDouble) TRMaxMem;
419: return(0);
420: }
422: #if defined(PETSC_USE_DEBUG)
425: /*@C
426: PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory
428: Collective on PETSC_COMM_WORLD
430: Input Parameter:
431: . ptr - the memory location
433: Output Paramter:
434: . stack - the stack indicating where the program allocated this memory
436: Level: intermediate
438: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
439: @*/
440: PetscErrorCode PetscMallocGetStack(void *ptr,PetscStack **stack)
441: {
442: TRSPACE *head;
445: head = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
446: *stack = &head->stack;
447: return(0);
448: }
449: #else
452: PetscErrorCode PetscMallocGetStack(void *ptr,void **stack)
453: {
455: *stack = 0;
456: return(0);
457: }
458: #endif
462: /*@C
463: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
464: printed is: size of space (in bytes), address of space, id of space,
465: file in which space was allocated, and line number at which it was
466: allocated.
468: Collective on PETSC_COMM_WORLD
470: Input Parameter:
471: . fp - file pointer. If fp is NULL, stdout is assumed.
473: Options Database Key:
474: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
476: Level: intermediate
478: Fortran Note:
479: The calling sequence in Fortran is PetscMallocDump(integer ierr)
480: The fp defaults to stdout.
482: Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
483: has been freed.
485: Concepts: memory usage
486: Concepts: memory bleeding
487: Concepts: bleeding memory
489: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
490: @*/
491: PetscErrorCode PetscMallocDump(FILE *fp)
492: {
493: TRSPACE *head;
495: PetscMPIInt rank;
498: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
499: if (!fp) fp = PETSC_STDOUT;
500: if (TRallocated > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
501: head = TRhead;
502: while (head) {
503: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
504: #if defined(PETSC_USE_DEBUG)
505: PetscStackPrint(&head->stack,fp);
506: #endif
507: head = head->next;
508: }
509: return(0);
510: }
512: /* ---------------------------------------------------------------------------- */
516: /*@C
517: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
519: Not Collective
521: Options Database Key:
522: + -malloc_log <filename> - Activates PetscMallocDumpLog()
523: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
525: Level: advanced
527: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
528: @*/
529: PetscErrorCode PetscMallocSetDumpLog(void)
530: {
534: PetscLogMalloc = 0;
536: PetscMemorySetGetMaximumUsage();
537: return(0);
538: }
542: /*@C
543: PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().
545: Not Collective
547: Input Arguments:
548: . logmin - minimum allocation size to log, or PETSC_DEFAULT
550: Options Database Key:
551: + -malloc_log <filename> - Activates PetscMallocDumpLog()
552: - -malloc_log_threshold <min> - Activates logging and sets a minimum size
554: Level: advanced
556: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
557: @*/
558: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
559: {
563: PetscMallocSetDumpLog();
564: if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
565: PetscLogMallocThreshold = (size_t)logmin;
566: return(0);
567: }
571: /*@C
572: PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged
574: Not Collective
576: Output Arguments
577: . logging - PETSC_TRUE if logging is active
579: Options Database Key:
580: . -malloc_log - Activates PetscMallocDumpLog()
582: Level: advanced
584: .seealso: PetscMallocDump(), PetscMallocDumpLog()
585: @*/
586: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
587: {
590: *logging = (PetscBool)(PetscLogMalloc >= 0);
591: return(0);
592: }
596: /*@C
597: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
598: PetscMemoryGetMaximumUsage()
600: Collective on PETSC_COMM_WORLD
602: Input Parameter:
603: . fp - file pointer; or NULL
605: Options Database Key:
606: . -malloc_log - Activates PetscMallocDumpLog()
608: Level: advanced
610: Fortran Note:
611: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
612: The fp defaults to stdout.
614: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
615: @*/
616: PetscErrorCode PetscMallocDumpLog(FILE *fp)
617: {
618: PetscInt i,j,n,dummy,*perm;
619: size_t *shortlength;
620: int *shortcount,err;
621: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
622: PetscBool match;
623: const char **shortfunction;
624: PetscLogDouble rss;
625: MPI_Status status;
629: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
630: MPI_Comm_size(MPI_COMM_WORLD,&size);
631: /*
632: Try to get the data printed in order by processor. This will only sometimes work
633: */
634: err = fflush(fp);
635: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
637: MPI_Barrier(MPI_COMM_WORLD);
638: if (rank) {
639: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
640: }
642: 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()");
644: if (!fp) fp = PETSC_STDOUT;
645: PetscMemoryGetMaximumUsage(&rss);
646: if (rss) {
647: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
648: } else {
649: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
650: }
651: shortcount = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
652: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
653: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
654: for (i=0,n=0; i<PetscLogMalloc; i++) {
655: for (j=0; j<n; j++) {
656: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
657: if (match) {
658: shortlength[j] += PetscLogMallocLength[i];
659: shortcount[j]++;
660: goto foundit;
661: }
662: }
663: shortfunction[n] = PetscLogMallocFunction[i];
664: shortlength[n] = PetscLogMallocLength[i];
665: shortcount[n] = 1;
666: n++;
667: foundit:;
668: }
670: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
671: for (i=0; i<n; i++) perm[i] = i;
672: PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);
674: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
675: for (i=0; i<n; i++) {
676: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
677: }
678: free(perm);
679: free(shortlength);
680: free(shortcount);
681: free((char**)shortfunction);
682: err = fflush(fp);
683: if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
684: if (rank != size-1) {
685: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
686: }
687: return(0);
688: }
690: /* ---------------------------------------------------------------------------- */
694: /*@C
695: PetscMallocDebug - Turns on/off debugging for the memory management routines.
697: Not Collective
699: Input Parameter:
700: . level - PETSC_TRUE or PETSC_FALSE
702: Level: intermediate
704: .seealso: CHKMEMQ(), PetscMallocValidate()
705: @*/
706: PetscErrorCode PetscMallocDebug(PetscBool level)
707: {
709: TRdebugLevel = level;
710: return(0);
711: }
715: /*@C
716: PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.
718: Not Collective
720: Output Parameter:
721: . flg - PETSC_TRUE if any debugger
723: Level: intermediate
725: Note that by default, the debug version always does some debugging unless you run with -malloc no
728: .seealso: CHKMEMQ(), PetscMallocValidate()
729: @*/
730: PetscErrorCode PetscMallocGetDebug(PetscBool *flg)
731: {
733: if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
734: else *flg = PETSC_FALSE;
735: return(0);
736: }