Actual source code: mtr.c
1: #define PETSC_DLL
2: /*
3: Interface to malloc() and free(). This code allows for
4: logging of memory usage and some error checking
5: */
6: #include petsc.h
7: #include petscsys.h
8: #if defined(PETSC_HAVE_STDLIB_H)
9: #include <stdlib.h>
10: #endif
11: #if defined(PETSC_HAVE_MALLOC_H)
12: #include <malloc.h>
13: #endif
14: #include "petscfix.h"
17: /*
18: These are defined in mal.c and ensure that malloced space is PetscScalar aligned
19: */
20: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscMallocAlign(size_t,int,const char[],const char[],const char[],void**);
21: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscFreeAlign(void*,int,const char[],const char[],const char[]);
22: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t,int,const char[],const char[],const char[],void**);
23: EXTERN PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void*,int,const char[],const char[],const char[]);
27: PetscErrorCode PetscSetUseTrMalloc_Private(void)
28: {
32: PetscSetMalloc(PetscTrMallocDefault,PetscTrFreeDefault);
33: return(0);
34: }
36: #if (PETSC_SIZEOF_VOID_P == 8)
37: #define TR_ALIGN_BYTES 8
38: #define TR_ALIGN_MASK 0x7
39: #else
40: #define TR_ALIGN_BYTES 4
41: #define TR_ALIGN_MASK 0x3
42: #endif
44: #define COOKIE_VALUE 0xf0e0d0c9
45: #define ALREADY_FREED 0x0f0e0d9c
46: #define MAX_TR_STACK 20
47: #define TR_MALLOC 0x1
48: #define TR_FREE 0x2
50: typedef struct _trSPACE {
51: size_t size;
52: int id;
53: int lineno;
54: const char *filename;
55: const char *functionname;
56: const char *dirname;
57: unsigned long cookie;
58: #if defined(PETSC_USE_DEBUG)
59: PetscStack stack;
60: #endif
61: struct _trSPACE *next,*prev;
62: } TRSPACE;
64: /* HEADER_DOUBLES is the number of doubles in a PetscMalloc() header */
65: /* We have to be careful about alignment rules here */
67: #define HEADER_DOUBLES sizeof(TRSPACE)/sizeof(double)+1
70: /* This union is used to insure that the block passed to the user is
71: aligned on a double boundary */
72: typedef union {
73: TRSPACE sp;
74: double v[HEADER_DOUBLES];
75: } TrSPACE;
77: static size_t TRallocated = 0;
78: static int TRfrags = 0;
79: static TRSPACE *TRhead = 0;
80: static int TRid = 0;
81: static PetscTruth TRdebugLevel = PETSC_FALSE;
82: static size_t TRMaxMem = 0;
83: /*
84: Arrays to log information on all Mallocs
85: */
86: static int PetscLogMallocMax = 10000,PetscLogMalloc = -1;
87: static size_t *PetscLogMallocLength;
88: static const char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;
92: /*@C
93: PetscMallocValidate - Test the memory for corruption. This can be used to
94: check for memory overwrites.
96: Input Parameter:
97: + line - line number where call originated.
98: . function - name of function calling
99: . file - file where function is
100: - dir - directory where function is
102: Return value:
103: The number of errors detected.
104:
105: Output Effect:
106: Error messages are written to stdout.
108: Level: advanced
110: Notes:
111: You should generally use CHKMEMQ as a short cut for calling this
112: routine.
114: The line, function, file and dir are given by the C preprocessor as
115: __LINE__, __FUNCT__, __FILE__, and __DIR__
117: The Fortran calling sequence is simply PetscMallocValidate(ierr)
119: No output is generated if there are no problems detected.
121: .seealso: CHKMEMQ
123: @*/
124: PetscErrorCode PETSC_DLLEXPORT PetscMallocValidate(int line,const char function[],const char file[],const char dir[])
125: {
126: TRSPACE *head,*lasthead;
127: char *a;
128: unsigned long *nend;
131: head = TRhead; lasthead = NULL;
132: while (head) {
133: if (head->cookie != COOKIE_VALUE) {
134: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
135: (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
136: (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
137: if (lasthead)
138: (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s%s\n",lasthead->functionname,lasthead->lineno,lasthead->dirname,lasthead->filename);
139: SETERRQ(PETSC_ERR_MEMC," ");
140: }
141: a = (char *)(((TrSPACE*)head) + 1);
142: nend = (unsigned long *)(a + head->size);
143: if (*nend != COOKIE_VALUE) {
144: (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s%s\n",function,line,dir,file);
145: if (*nend == ALREADY_FREED) {
146: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
147: SETERRQ(PETSC_ERR_MEMC," ");
148: } else {
149: (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
150: (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
151: SETERRQ(PETSC_ERR_MEMC," ");
152: }
153: }
154: lasthead = head;
155: head = head->next;
156: }
157: return(0);
158: }
162: /*
163: PetscTrMallocDefault - Malloc with tracing.
165: Input Parameters:
166: + a - number of bytes to allocate
167: . lineno - line number where used. Use __LINE__ for this
168: . function - function calling routine. Use __FUNCT__ for this
169: . filename - file name where used. Use __FILE__ for this
170: - dir - directory where file is. Use __SDIR__ for this
172: Returns:
173: double aligned pointer to requested storage, or null if not
174: available.
175: */
176: PetscErrorCode PETSC_DLLEXPORT PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],const char dir[],void**result)
177: {
178: TRSPACE *head;
179: char *inew;
180: size_t nsize;
184: if (TRdebugLevel) {
185: PetscMallocValidate(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
186: }
187: if (!a) SETERRQ(PETSC_ERR_MEM_MALLOC_0,"Cannot malloc size zero");
189: nsize = a;
190: if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
191: PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscScalar),lineno,function,filename,dir,(void**)&inew);
193: head = (TRSPACE *)inew;
194: inew += sizeof(TrSPACE);
196: if (TRhead) TRhead->prev = head;
197: head->next = TRhead;
198: TRhead = head;
199: head->prev = 0;
200: head->size = nsize;
201: head->id = TRid;
202: head->lineno = lineno;
204: head->filename = filename;
205: head->functionname = function;
206: head->dirname = dir;
207: head->cookie = COOKIE_VALUE;
208: *(unsigned long *)(inew + nsize) = COOKIE_VALUE;
210: TRallocated += nsize;
211: if (TRallocated > TRMaxMem) {
212: TRMaxMem = TRallocated;
213: }
214: TRfrags++;
216: #if defined(PETSC_USE_DEBUG)
217: PetscStackCopy(petscstack,&head->stack);
218: #endif
220: /*
221: Allow logging of all mallocs made
222: */
223: if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
224: if (!PetscLogMalloc) {
225: PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
226: if (!PetscLogMallocLength) SETERRQ(PETSC_ERR_MEM," ");
227: PetscLogMallocDirectory = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
228: if (!PetscLogMallocDirectory) SETERRQ(PETSC_ERR_MEM," ");
229: PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
230: if (!PetscLogMallocFile) SETERRQ(PETSC_ERR_MEM," ");
231: PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char**));
232: if (!PetscLogMallocFunction) SETERRQ(PETSC_ERR_MEM," ");
233: }
234: PetscLogMallocLength[PetscLogMalloc] = nsize;
235: PetscLogMallocDirectory[PetscLogMalloc] = dir;
236: PetscLogMallocFile[PetscLogMalloc] = filename;
237: PetscLogMallocFunction[PetscLogMalloc++] = function;
238: }
239: *result = (void*)inew;
240: return(0);
241: }
246: /*
247: PetscTrFreeDefault - Free with tracing.
249: Input Parameters:
250: . a - pointer to a block allocated with PetscTrMalloc
251: . lineno - line number where used. Use __LINE__ for this
252: . function - function calling routine. Use __FUNCT__ for this
253: . file - file name where used. Use __FILE__ for this
254: . dir - directory where file is. Use __SDIR__ for this
255: */
256: PetscErrorCode PETSC_DLLEXPORT PetscTrFreeDefault(void *aa,int line,const char function[],const char file[],const char dir[])
257: {
258: char *a = (char*)aa;
259: TRSPACE *head;
260: char *ahead;
262: unsigned long *nend;
263:
265: /* Do not try to handle empty blocks */
266: if (!a) {
267: (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%s\n",function,line,dir,file);
268: SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block");
269: }
270:
271: if (TRdebugLevel) {
272: PetscMallocValidate(line,function,file,dir);
273: }
274:
275: ahead = a;
276: a = a - sizeof(TrSPACE);
277: head = (TRSPACE *)a;
278:
279: if (head->cookie != COOKIE_VALUE) {
280: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
281: (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
282: SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
283: }
284: nend = (unsigned long *)(ahead + head->size);
285: if (*nend != COOKIE_VALUE) {
286: if (*nend == ALREADY_FREED) {
287: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
288: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
289: if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
290: (*PetscErrorPrintf)("Block freed in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
291: } else {
292: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,-head->lineno,head->dirname,head->filename);
293: }
294: SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
295: } else {
296: /* Damaged tail */
297: (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s%s\n",function,line,dir,file);
298: (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
299: (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%s\n",head->functionname,head->lineno,head->dirname,head->filename);
300: SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
301: }
302: }
303: /* Mark the location freed */
304: *nend = ALREADY_FREED;
305: /* Save location where freed. If we suspect the line number, mark as allocated location */
306: if (line > 0 && line < 50000) {
307: head->lineno = line;
308: head->filename = file;
309: head->functionname = function;
310: head->dirname = dir;
311: } else {
312: head->lineno = - head->lineno;
313: }
314: /* zero out memory - helps to find some reuse of already freed memory */
315: PetscMemzero(aa,head->size);
316:
317: TRallocated -= head->size;
318: TRfrags --;
319: if (head->prev) head->prev->next = head->next;
320: else TRhead = head->next;
321:
322: if (head->next) head->next->prev = head->prev;
323: PetscFreeAlign(a,line,function,file,dir);
324: return(0);
325: }
330: /*@
331: PetscMemoryShowUsage - Shows the amount of memory currently being used
332: in a communicator.
333:
334: Collective on PetscViewer
336: Input Parameter:
337: + viewer - the viewer that defines the communicator
338: - message - string printed before values
340: Level: intermediate
342: Concepts: memory usage
344: .seealso: PetscMemoryDump(), PetscMemoryGetCurrentUsage()
345: @*/
346: PetscErrorCode PETSC_DLLEXPORT PetscMemoryShowUsage(PetscViewer viewer,const char message[])
347: {
348: PetscLogDouble allocated,maximum,resident,residentmax;
350: PetscMPIInt rank;
351: MPI_Comm comm;
354: if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
355: PetscMallocGetCurrentUsage(&allocated);
356: PetscMallocGetMaximumUsage(&maximum);
357: PetscMemoryGetCurrentUsage(&resident);
358: PetscMemoryGetMaximumUsage(&residentmax);
359: if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
360: PetscObjectGetComm((PetscObject)viewer,&comm);
361: MPI_Comm_rank(comm,&rank);
362: PetscViewerASCIIPrintf(viewer,message);
363: if (resident && residentmax && allocated) {
364: 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);
365: } else if (resident && residentmax) {
366: 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);
367: } else if (resident && allocated) {
368: 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);
369: } else if (allocated) {
370: PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Current space PetscMalloc()ed %g, max space PetscMalloced() %g\n[%d]OS cannot compute process memory\n",rank,allocated,maximum,rank);
371: } else {
372: PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
373: }
374: PetscViewerFlush(viewer);
375: return(0);
376: }
380: /*@C
381: PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed
382:
383: Not Collective
385: Output Parameters:
386: . space - number of bytes currently allocated
388: Level: intermediate
390: Concepts: memory usage
392: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
393: PetscMemoryGetMaximumUsage()
394: @*/
395: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetCurrentUsage(PetscLogDouble *space)
396: {
398: *space = (PetscLogDouble) TRallocated;
399: return(0);
400: }
404: /*@C
405: PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
406: during this run.
407:
408: Not Collective
410: Output Parameters:
411: . space - maximum number of bytes ever allocated at one time
413: Level: intermediate
415: Concepts: memory usage
417: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
418: PetscMemoryGetCurrentUsage()
419: @*/
420: PetscErrorCode PETSC_DLLEXPORT PetscMallocGetMaximumUsage(PetscLogDouble *space)
421: {
423: *space = (PetscLogDouble) TRMaxMem;
424: return(0);
425: }
429: /*@C
430: PetscMallocDump - Dumps the allocated memory blocks to a file. The information
431: printed is: size of space (in bytes), address of space, id of space,
432: file in which space was allocated, and line number at which it was
433: allocated.
435: Collective on PETSC_COMM_WORLD
437: Input Parameter:
438: . fp - file pointer. If fp is NULL, stdout is assumed.
440: Options Database Key:
441: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize()
443: Level: intermediate
445: Fortran Note:
446: The calling sequence in Fortran is PetscMallocDump(integer ierr)
447: The fp defaults to stdout.
449: Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
450: has been freed.
452: Concepts: memory usage
453: Concepts: memory bleeding
454: Concepts: bleeding memory
456: .seealso: PetscMallocGetCurrentSize(), PetscMallocDumpLog()
457: @*/
458: PetscErrorCode PETSC_DLLEXPORT PetscMallocDump(FILE *fp)
459: {
460: TRSPACE *head;
462: PetscMPIInt rank;
465: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
466: if (!fp) fp = stdout;
467: if (TRallocated > 0) {
468: fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
469: }
470: head = TRhead;
471: while (head) {
472: fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s%s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->dirname,head->filename);
473: #if defined(PETSC_USE_DEBUG)
474: PetscStackPrint(&head->stack,fp);
475: #endif
476: head = head->next;
477: }
478: return(0);
479: }
481: /* ---------------------------------------------------------------------------- */
485: /*@C
486: PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().
488: Not Collective
490: Options Database Key:
491: . -malloc_log - Activates PetscMallocDumpLog()
493: Level: advanced
495: .seealso: PetscMallocDump(), PetscMallocDumpLog()
496: @*/
497: PetscErrorCode PETSC_DLLEXPORT PetscMallocSetDumpLog(void)
498: {
500: PetscLogMalloc = 0;
501: return(0);
502: }
506: /*@C
507: PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
508: PetscMemoryGetCurrentUsage() and PetscMemoryGetMaximumUsage()
510: Collective on PETSC_COMM_WORLD
512: Input Parameter:
513: . fp - file pointer; or PETSC_NULL
515: Options Database Key:
516: . -malloc_log - Activates PetscMallocDumpLog()
518: Level: advanced
520: Fortran Note:
521: The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
522: The fp defaults to stdout.
524: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
525: @*/
526: PetscErrorCode PETSC_DLLEXPORT PetscMallocDumpLog(FILE *fp)
527: {
528: PetscInt i,j,n,dummy,*perm;
529: size_t *shortlength;
530: PetscMPIInt rank,size,tag = 1212 /* very bad programming */;
531: PetscTruth match;
532: const char **shortfunction;
533: PetscLogDouble rss;
534: MPI_Status status;
538: MPI_Comm_rank(MPI_COMM_WORLD,&rank);
539: MPI_Comm_size(MPI_COMM_WORLD,&size);
540: /*
541: Try to get the data printed in order by processor. This will only sometimes work
542: */
543: fflush(fp);
544: MPI_Barrier(MPI_COMM_WORLD);
545: if (rank) {
546: MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
547: }
549: if (!fp) fp = stdout;
550: PetscMemoryGetCurrentUsage(&rss);
551: if (rss) {
552: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %D\n",rank,(PetscLogDouble)TRMaxMem,rss);
553: } else {
554: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
555: }
556: shortlength = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_ERR_MEM,"Out of memory");
557: shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char *));if (!shortfunction) SETERRQ(PETSC_ERR_MEM,"Out of memory");
558: shortfunction[0] = PetscLogMallocFunction[0];
559: shortlength[0] = PetscLogMallocLength[0];
560: n = 1;
561: for (i=1; i<PetscLogMalloc; i++) {
562: for (j=0; j<n; j++) {
563: PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
564: if (match) {
565: shortlength[j] += PetscLogMallocLength[i];
566: goto foundit;
567: }
568: }
569: shortfunction[n] = PetscLogMallocFunction[i];
570: shortlength[n] = PetscLogMallocLength[i];
571: n++;
572: foundit:;
573: }
575: perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_ERR_MEM,"Out of memory");
576: for (i=0; i<n; i++) perm[i] = i;
577: PetscSortStrWithPermutation(n,(const char **)shortfunction,perm);
579: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
580: for (i=0; i<n; i++) {
581: PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %.0f %s()\n",rank,(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
582: }
583: free(perm);
584: free(shortlength);
585: free((char **)shortfunction);
586: fflush(fp);
587: if (rank != size-1) {
588: MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
589: }
590: return(0);
591: }
593: /* ---------------------------------------------------------------------------- */
597: /*@C
598: PetscMallocDebug - Turns on/off debugging for the memory management routines.
600: Not Collective
602: Input Parameter:
603: . level - PETSC_TRUE or PETSC_FALSE
605: Level: intermediate
607: .seealso: CHKMEMQ(), PetscMallocValidate()
608: @*/
609: PetscErrorCode PETSC_DLLEXPORT PetscMallocDebug(PetscTruth level)
610: {
612: TRdebugLevel = level;
613: return(0);
614: }