Actual source code: mtr.c

  1: /*$Id: mtr.c,v 1.153 2001/04/10 19:34:33 bsmith Exp $*/
  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: #if defined(PETSC_HAVE_STDLIB_H)
  8: #include <stdlib.h>
  9: #endif
 10: #if defined(PETSC_HAVE_MALLOC_H) && !defined(__cplusplus)
 11: #include <malloc.h>
 12: #endif
 13: #include "petscfix.h"


 16: /*
 17:      These are defined in mal.c and ensure that malloced space is Scalar aligned
 18: */
 19: EXTERN int   PetscMallocAlign(int,int,char*,char*,char*,void**);
 20: EXTERN int   PetscFreeAlign(void*,int,char*,char*,char*);
 21: EXTERN int   PetscTrMallocDefault(int,int,char*,char*,char*,void**);
 22: EXTERN int   PetscTrFreeDefault(void*,int,char*,char*,char*);

 24: /*
 25:   Code for checking if a pointer is out of the range 
 26:   of malloced memory. This will only work on flat memory models and 
 27:   even then is suspicious.
 28: */
 29: #if (PETSC_SIZEOF_VOIDP == 8)
 30: void *PetscLow = (void*)0x0 ,*PetscHigh = (void*)0xEEEEEEEEEEEEEEEE;
 31: #else
 32: void *PetscLow  = (void*)0x0,*PetscHigh = (void*)0xEEEEEEEE;
 33: #endif

 35: int PetscSetUseTrMalloc_Private(void)
 36: {

 40: #if (PETSC_SIZEOF_VOIDP == 8)
 41:   PetscLow     = (void*)0xEEEEEEEEEEEEEEEE;
 42: #else
 43:   PetscLow     = (void*)0xEEEEEEEE;
 44: #endif
 45:   PetscHigh    = (void*)0x0;
 46:   ierr         = PetscSetMalloc(PetscTrMallocDefault,PetscTrFreeDefault);
 47:   return(0);
 48: }

 50: /*
 51:     PetscTrSpace - Routines for tracing space usage.

 53:     Description:
 54:     PetscTrMalloc replaces malloc and PetscTrFree replaces free.  These routines
 55:     have the same syntax and semantics as the routines that they replace,
 56:     In addition, there are routines to report statistics on the memory
 57:     usage, and to report the currently allocated space.  These routines
 58:     are built on top of malloc and free, and can be used together with
 59:     them as long as any space allocated with PetscTrMalloc is only freed with
 60:     PetscTrFree.
 61:  */


 64: #if (PETSC_SIZEOF_VOIDP == 8)
 65: #define TR_ALIGN_BYTES      8
 66: #define TR_ALIGN_MASK       0x7
 67: #else
 68: #define TR_ALIGN_BYTES      4
 69: #define TR_ALIGN_MASK       0x3
 70: #endif

 72: #define COOKIE_VALUE   0xf0e0d0c9
 73: #define ALREADY_FREED  0x0f0e0d9c
 74: #define MAX_TR_STACK   20
 75: #define TR_MALLOC      0x1
 76: #define TR_FREE        0x2

 78: typedef struct _trSPACE {
 79:     unsigned long   size;
 80:     int             id;
 81:     int             lineno;
 82:     char            *filename;
 83:     char            *functionname;
 84:     char            *dirname;
 85:     unsigned long   cookie;
 86: #if defined(PETSC_USE_STACK)
 87:     PetscStack      stack;
 88: #endif
 89:     struct _trSPACE *next,*prev;
 90: } TRSPACE;

 92: /* HEADER_DOUBLES is the number of doubles in a PetscTrSpace header */
 93: /* We have to be careful about alignment rules here */

 95: #define HEADER_DOUBLES      sizeof(TRSPACE)/sizeof(double)+1


 98: /* This union is used to insure that the block passed to the user is
 99:    aligned on a double boundary */
100: typedef union {
101:     TRSPACE sp;
102:     double  v[HEADER_DOUBLES];
103: } TrSPACE;

105: static long    TRallocated    = 0,TRfrags = 0;
106: static TRSPACE *TRhead      = 0;
107: static int     TRid         = 0;
108: static int     TRdebugLevel = 0;
109: static long    TRMaxMem     = 0;
110: /*
111:       Arrays to log information on all Mallocs
112: */
113: static int  PetscLogMallocMax = 10000,PetscLogMalloc = -1,*PetscLogMallocLength;
114: static char **PetscLogMallocDirectory,**PetscLogMallocFile,**PetscLogMallocFunction;

116: /*@C
117:    PetscTrValid - Test the memory for corruption.  This can be used to
118:    check for memory overwrites.

120:    Input Parameter:
121: +  line - line number where call originated.
122: .  function - name of function calling
123: .  file - file where function is
124: -  dir - directory where function is

126:    Return value:
127:    The number of errors detected.
128:    
129:    Output Effect:
130:    Error messages are written to stdout.  

132:    Level: advanced

134:    Notes:
135:     You should generally use CHKMEMQ or CHKMEMA as a short cut for calling this 
136:     routine.

138:     The line, function, file and dir are given by the C preprocessor as 

140:     The Fortran calling sequence is simply PetscTrValid(ierr)

142:    No output is generated if there are no problems detected.

144: .seealso: CHKMEMQ, CHKMEMA

146: @*/
147: int PetscTrValid(int line,const char function[],const char file[],const char dir[])
148: {
149:   TRSPACE  *head;
150:   char     *a;
151:   unsigned long *nend;

154:   head = TRhead;
155:   while (head) {
156:     if (head->cookie != COOKIE_VALUE) {
157:       (*PetscErrorPrintf)("error detected at  %s() line %d in %s%sn",function,line,dir,file);
158:       (*PetscErrorPrintf)("Memory at address %p is corruptedn",head);
159:       (*PetscErrorPrintf)("Probably write past beginning or end of arrayn");
160:       SETERRQ(PETSC_ERR_MEMC,"");
161:     }
162:     if (head->size <=0) {
163:       (*PetscErrorPrintf)("error detected at  %s() line %d in %s%sn",function,line,dir,file);
164:       (*PetscErrorPrintf)("Memory at address %p is corruptedn",head);
165:       (*PetscErrorPrintf)("Probably write past beginning or end of arrayn");
166:       SETERRQ(PETSC_ERR_MEMC,"");
167:     }
168:     a    = (char *)(((TrSPACE*)head) + 1);
169:     nend = (unsigned long *)(a + head->size);
170:     if (nend[0] != COOKIE_VALUE) {
171:       (*PetscErrorPrintf)("error detected at %s() line %d in %s%sn",function,line,dir,file);
172:       if (nend[0] == ALREADY_FREED) {
173:         (*PetscErrorPrintf)("Memory [id=%d(%lx)] at address %p already freedn",head->id,head->size,a);
174:       } else {
175:         (*PetscErrorPrintf)("Memory [id=%d(%lx)] at address %p is corrupted (probably write past end)n",
176:                 head->id,head->size,a);
177:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s%sn",head->functionname,
178:                 head->lineno,head->dirname,head->filename);
179:         SETERRQ(PETSC_ERR_MEMC,"");
180:       }
181:     }
182:     head = head->next;
183:   }

185:   return(0);
186: }

188: /*
189:     PetscTrMallocDefault - Malloc with tracing.

191:     Input Parameters:
192: +   a   - number of bytes to allocate
193: .   lineno - line number where used.  Use __LINE__ for this
194: .   filename  - file name where used.  Use __FILE__ for this
195: -   dir - directory where file is. Use __SDIR__ for this

197:     Returns:
198:     double aligned pointer to requested storage, or null if not
199:     available.
200:  */
201: int PetscTrMallocDefault(int a,int lineno,char *function,char *filename,char *dir,void**result)
202: {
203:   TRSPACE          *head;
204:   char             *inew;
205:   unsigned long    *nend;
206:   unsigned int     nsize;
207:   int              ierr;

210:   if (TRdebugLevel > 0) {
211:     PetscTrValid(lineno,function,filename,dir); if (ierr) PetscFunctionReturn(ierr);
212:   }

214:   if (!a) {
215:     (*PetscErrorPrintf)("PETSC ERROR: PetscTrMalloc: malloc zero length, this is illegal!n");
216:     PetscFunctionReturn(1);
217:   }
218:   if (a < 0) {
219:     (*PetscErrorPrintf)("PETSC ERROR: PetscTrMalloc: malloc negative length, this is illegal!n");
220:     PetscFunctionReturn(1);
221:   }
222:   nsize = a;
223:   if (nsize & TR_ALIGN_MASK) nsize += (TR_ALIGN_BYTES - (nsize & TR_ALIGN_MASK));
224:   PetscMallocAlign((unsigned)(nsize+sizeof(TrSPACE)+sizeof(Scalar)),lineno,function,filename,dir,(void**)&inew);
225:   if (ierr) PetscFunctionReturn(ierr);


228:   /*
229:    Keep track of range of memory locations we have malloced in 
230:   */
231:   if (PetscLow > (void*)inew) PetscLow = (void*)inew;
232:   if (PetscHigh < (void*)(inew+nsize+sizeof(TrSPACE)+sizeof(unsigned long))) {
233:     PetscHigh = (void*)(inew+nsize+sizeof(TrSPACE)+sizeof(unsigned long));
234:   }

236:   head   = (TRSPACE *)inew;
237:   inew  += sizeof(TrSPACE);

239:   if (TRhead) TRhead->prev = head;
240:   head->next     = TRhead;
241:   TRhead         = head;
242:   head->prev     = 0;
243:   head->size     = nsize;
244:   head->id       = TRid;
245:   head->lineno   = lineno;

247:   head->filename     = filename;
248:   head->functionname = function;
249:   head->dirname      = dir;
250:   head->cookie       = COOKIE_VALUE;
251:   nend               = (unsigned long *)(inew + nsize);
252:   nend[0]            = COOKIE_VALUE;

254:   TRallocated += nsize;
255:   if (TRallocated > TRMaxMem) {
256:     TRMaxMem   = TRallocated;
257:   }
258:   TRfrags++;

260: #if defined(PETSC_USE_STACK)
261:   PetscStackCopy(petscstack,&head->stack); if (ierr) PetscFunctionReturn(ierr);
262: #endif

264:   /*
265:          Allow logging of all mallocs made
266:   */
267:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax) {
268:     if (PetscLogMalloc == 0) {
269:       PetscLogMallocLength    = (int*)malloc(PetscLogMallocMax*sizeof(int));
270:       if (!PetscLogMallocLength) PetscFunctionReturn(ierr);
271:       PetscLogMallocDirectory = (char**)malloc(PetscLogMallocMax*sizeof(char**));
272:       if (!PetscLogMallocDirectory) PetscFunctionReturn(ierr);
273:       PetscLogMallocFile      = (char**)malloc(PetscLogMallocMax*sizeof(char**));
274:       if (!PetscLogMallocFile) PetscFunctionReturn(ierr);
275:       PetscLogMallocFunction  = (char**)malloc(PetscLogMallocMax*sizeof(char**));
276:       if (!PetscLogMallocFunction) PetscFunctionReturn(ierr);
277:     }
278:     PetscLogMallocLength[PetscLogMalloc]      = nsize;
279:     PetscLogMallocDirectory[PetscLogMalloc]   = dir;
280:     PetscLogMallocFile[PetscLogMalloc]        = filename;
281:     PetscLogMallocFunction[PetscLogMalloc++]  = function;
282:   }
283:   *result = (void*)inew;
284:   return(0);
285: }


288: /*
289:    PetscTrFreeDefault - Free with tracing.

291:    Input Parameters:
292: .   a    - pointer to a block allocated with PetscTrMalloc
293: .   lineno - line number where used.  Use __LINE__ for this
294: .   file  - file name where used.  Use __FILE__ for this
295: .   dir - directory where file is. Use __SDIR__ for this
296:  */
297: int PetscTrFreeDefault(void *aa,int line,char *function,char *file,char *dir)
298: {
299:   char     *a = (char*)aa;
300:   TRSPACE  *head;
301:   char     *ahead;
302:   int      ierr;
303:   unsigned long *nend;
304: 
306:   /* Do not try to handle empty blocks */
307:   if (!a) {
308:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%sn",function,line,dir,file);
309:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Trying to free null block");
310:   }
311: 
312:   if (TRdebugLevel > 0) {
313:     PetscTrValid(line,function,file,dir);
314:   }
315: 
316:   if (PetscLow > aa || PetscHigh < aa){
317:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%sn",function,line,dir,file);
318:     SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"PetscTrFreeDefault called with address not allocated by PetscTrMallocDefault");
319:   }
320: 
321:   ahead = a;
322:   a     = a - sizeof(TrSPACE);
323:   head  = (TRSPACE *)a;
324: 
325:   if (head->cookie != COOKIE_VALUE) {
326:     (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%sn",function,line,dir,file);
327:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;n
328: may be block not allocated with PetscTrMalloc or PetscMallocn",a);
329:     SETERRQ(PETSC_ERR_MEMC,"Bad location or corrupted memory");
330:   }
331:   nend = (unsigned long *)(ahead + head->size);
332:   if (*nend != COOKIE_VALUE) {
333:     if (*nend == ALREADY_FREED) {
334:       (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%sn",function,line,dir,file);
335:       (*PetscErrorPrintf)("Block [id=%d(%lx)] at address %p was already freedn",
336:                           head->id,head->size,a + sizeof(TrSPACE));
337:       if (head->lineno > 0 && head->lineno < 5000 /* sanity check */) {
338:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s%sn",head->functionname,
339:                             head->lineno,head->dirname,head->filename);
340:       } else {
341:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%sn",head->functionname,
342:                             -head->lineno,head->dirname,head->filename);
343:       }
344:       SETERRQ(PETSC_ERR_ARG_WRONG,"Memory already freed");
345:     } else {
346:       /* Damaged tail */
347:       (*PetscErrorPrintf)("PetscTrFreeDefault called from %s() line %d in %s%sn",function,line,dir,file);
348:       (*PetscErrorPrintf)("Block [id=%d(%lx)] at address %p is corrupted (probably write past end)n",
349:                           head->id,head->size,a);
350:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s%sn",head->functionname,
351:                           head->lineno,head->dirname,head->filename);
352:       SETERRQ(PETSC_ERR_MEMC,"Corrupted memory");
353:     }
354:   }
355:   /* Mark the location freed */
356:   *nend        = ALREADY_FREED;
357:   /* Save location where freed.  If we suspect the line number, mark as 
358:      allocated location */
359:   if (line > 0 && line < 50000) {
360:     head->lineno       = line;
361:     head->filename     = file;
362:     head->functionname = function;
363:     head->dirname      = dir;
364:   } else {
365:     head->lineno = - head->lineno;
366:   }
367:   /* zero out memory - helps to find some reuse of already freed memory */
368:   PetscMemzero(aa,(int)(head->size));
369: 
370:   TRallocated -= head->size;
371:   TRfrags     --;
372:   if (head->prev) head->prev->next = head->next;
373:   else TRhead = head->next;
374: 
375:   if (head->next) head->next->prev = head->prev;
376:   PetscFreeAlign(a,line,function,file,dir);
377:   return(0);
378: }


381: /*@
382:     PetscShowMemoryUsage - Shows the amount of memory currently being used 
383:         in a communicator.
384:    
385:     Collective on PetscViewer

387:     Input Parameter:
388: +    viewer - the viewer that defines the communicator
389: -    message - string printed before values

391:     Level: intermediate

393:     Concepts: memory usage

395: .seealso: PetscTrDump(),PetscTrSpace(), PetscGetResidentSetSize()
396:  @*/
397: int PetscShowMemoryUsage(PetscViewer viewer,char *message)
398: {
399:   PetscLogDouble allocated,maximum,resident;
400:   int            ierr,rank;
401:   MPI_Comm       comm;

404:   PetscTrSpace(&allocated,PETSC_NULL,&maximum);
405:   PetscGetResidentSetSize(&resident);
406:   PetscObjectGetComm((PetscObject)viewer,&comm);
407:   MPI_Comm_rank(comm,&rank);
408:   PetscViewerASCIIPrintf(viewer,message);
409:   PetscViewerASCIISynchronizedPrintf(viewer,"[%d]Space allocated %g, max space allocated %g, process memory %gn",rank,allocated,maximum,resident);
410:   PetscViewerFlush(viewer);
411:   return(0);
412: }

414: /*@
415:     PetscTrSpace - Returns space statistics.
416:    
417:     Not Collective

419:     Output Parameters:
420: +   space - number of bytes currently allocated
421: .   frags - number of blocks currently allocated
422: -   maxs - maximum number of bytes ever allocated

424:     Level: intermediate

426:     Concepts: memory usage

428: .seealso: PetscTrDump()
429:  @*/
430: int PetscTrSpace(PetscLogDouble *space,PetscLogDouble *fr,PetscLogDouble *maxs)
431: {

434:   if (space) *space = (PetscLogDouble) TRallocated;
435:   if (fr)    *fr    = (PetscLogDouble) TRfrags;
436:   if (maxs)  *maxs  = (PetscLogDouble) TRMaxMem;
437:   return(0);
438: }

440: /*@C
441:    PetscTrDump - Dumps the allocated memory blocks to a file. The information 
442:    printed is: size of space (in bytes), address of space, id of space, 
443:    file in which space was allocated, and line number at which it was 
444:    allocated.

446:    Collective on PETSC_COMM_WORLD

448:    Input Parameter:
449: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

451:    Options Database Key:
452: .  -trdump - Dumps unfreed memory during call to PetscFinalize()

454:    Level: intermediate

456:    Fortran Note:
457:    The calling sequence in Fortran is PetscTrDump(integer ierr)
458:    The fp defaults to stdout.

460:    Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD
461:           has been freed.

463:    Concepts: memory usage
464:    Concepts: memory bleeding
465:    Concepts: bleeding memory

467: .seealso:  PetscTrSpace(), PetscTrLogDump() 
468: @*/
469: int PetscTrDump(FILE *fp)
470: {
471:   TRSPACE *head;
472:   int     rank,ierr;

475:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
476:   if (!fp) fp = stdout;
477:   if (TRallocated > 0) {
478:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d]Total space allocated %d bytesn",rank,(int)TRallocated);
479:   }
480:   head = TRhead;
481:   while (head) {
482:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%2d]%8d bytes %s() line %d in %s%sn",rank,(int)head->size,
483:             head->functionname,head->lineno,head->dirname,head->filename);
484: #if defined(PETSC_USE_STACK)
485:     PetscStackPrint(&head->stack,fp);
486: #endif
487:     head = head->next;
488:   }
489:   return(0);
490: }

492: /* ---------------------------------------------------------------------------- */

494: /*@C
495:     PetscTrLog - Activates logging of all calls to malloc.

497:     Not Collective

499:     Options Database Key:
500: .  -trmalloc_log - Activates PetscTrLog() and PetscTrLogDump()

502:     Level: advanced

504: .seealso: PetscTrLogDump()
505: @*/
506: int PetscTrLog(void)
507: {

510:   PetscLogMalloc = 0;
511:   return(0);
512: }

514: /*@C
515:     PetscTrLogDump - Dumps the log of all calls to malloc; also calls 
516:     PetscGetResidentSetSize().

518:     Collective on PETSC_COMM_WORLD

520:     Input Parameter:
521: .   fp - file pointer; or PETSC_NULL

523:     Options Database Key:
524: .  -trmalloc_log - Activates PetscTrLog() and PetscTrLogDump()

526:     Level: advanced

528:    Fortran Note:
529:    The calling sequence in Fortran is PetscTrLogDump(integer ierr)
530:    The fp defaults to stdout.

532: .seealso: PetscTrLog(), PetscTrDump()
533: @*/
534: int PetscTrLogDump(FILE *fp)
535: {
536:   int            i,rank,j,n,*shortlength,ierr,dummy,size,tag = 1212 /* very bad programming */;
537:   PetscTruth     match;
538:   char           **shortfunction;
539:   PetscLogDouble rss;
540:   MPI_Status     status;

543:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
544:   MPI_Comm_size(MPI_COMM_WORLD,&size);
545:   /*
546:        Try to get the data printed in order by processor. This will only sometimes work 
547:   */
548:   fflush(fp);
549:   MPI_Barrier(MPI_COMM_WORLD);
550:   if (rank) {
551:     MPI_Recv(&dummy,1,MPI_INT,rank-1,tag,MPI_COMM_WORLD,&status);
552:   }


555:   if (!fp) fp = stdout;
556:   PetscGetResidentSetSize(&rss);
557:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory used %d Size of entire process %dn",rank,(int)TRMaxMem,(int)rss);

559:   shortlength   = (int*)malloc(PetscLogMalloc*sizeof(int));
560:   shortfunction = (char**)malloc(PetscLogMalloc*sizeof(char *));
561:   shortfunction[0] = PetscLogMallocFunction[0];
562:   shortlength[0]   = PetscLogMallocLength[0];
563:   n = 1;
564:   for (i=1; i<PetscLogMalloc; i++) {
565:     for (j=0; j<n; j++) {
566:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
567:       if (match) {
568:         shortlength[j] += PetscLogMallocLength[i];
569:         goto foundit;
570:       }
571:     }
572:     shortfunction[n] = PetscLogMallocFunction[i];
573:     shortlength[n]   = PetscLogMallocLength[i];
574:     n++;
575:     foundit:;
576:   }

578:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by functionn",rank);
579:   for (i=0; i<n; i++) {
580:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] % 9d %s()n",rank,shortlength[i],shortfunction[i]);
581:   }
582:   free(shortlength);
583:   free(shortfunction);
584:   fflush(fp);
585:   if (size > 1 && rank != size-1) {
586:     MPI_Send(&dummy,1,MPI_INT,rank+1,tag,MPI_COMM_WORLD);
587:   }

589:   return(0);
590: }

592: /* ---------------------------------------------------------------------------- */

594: /*
595:     PetscTrDebugLevel - Set the level of debugging for the space management 
596:                    routines.

598:     Input Parameter:
599: .   level - level of debugging.  Currently, either 0 (no checking) or 1
600:     (use PetscTrValid at each PetscTrMalloc or PetscTrFree).
601: */
602: int  PetscTrDebugLevel(int level)
603: {

606:   TRdebugLevel = level;
607:   return(0);
608: }