Actual source code: mtr.c
petsc-3.7.1 2016-05-15
Report Typos and Errors

      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      = NULL;
     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;
     64: static int        PetscLogMalloc          = -1;
     65: static size_t     PetscLogMallocThreshold = 0;
     66: static size_t     *PetscLogMallocLength;
     67: static const char **PetscLogMallocFile,**PetscLogMallocFunction;

     71: PetscErrorCode PetscSetUseTrMalloc_Private(void)
     72: {

     76:   PetscMallocSet(PetscTrMallocDefault,PetscTrFreeDefault);

     78:   TRallocated       = 0;
     79:   TRfrags           = 0;
     80:   TRhead            = NULL;
     81:   TRid              = 0;
     82:   TRdebugLevel      = PETSC_FALSE;
     83:   TRMaxMem          = 0;
     84:   PetscLogMallocMax = 10000;
     85:   PetscLogMalloc    = -1;
     86:   return(0);
     87: }

     91: /*@C
     92:    PetscMallocValidate - Test the memory for corruption.  This can be used to
     93:    check for memory overwrites.

     95:    Input Parameter:
     96: +  line - line number where call originated.
     97: .  function - name of function calling
     98: -  file - file where function is

    100:    Return value:
    101:    The number of errors detected.

    103:    Output Effect:
    104:    Error messages are written to stdout.

    106:    Level: advanced

    108:    Notes:
    109:     You should generally use CHKMEMQ as a short cut for calling this
    110:     routine.

    112:     The line, function, file are given by the C preprocessor as
    113:     __LINE__, __FUNCT__, __FILE__

    115:     The Fortran calling sequence is simply PetscMallocValidate(ierr)

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

    119: .seealso: CHKMEMQ

    121: @*/
    122: PetscErrorCode  PetscMallocValidate(int line,const char function[],const char file[])
    123: {
    124:   TRSPACE      *head,*lasthead;
    125:   char         *a;
    126:   PetscClassId *nend;

    129:   head = TRhead; lasthead = NULL;
    130:   while (head) {
    131:     if (head->classid != CLASSID_VALUE) {
    132:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at  %s() line %d in %s\n",function,line,file);
    133:       (*PetscErrorPrintf)("Memory at address %p is corrupted\n",head);
    134:       (*PetscErrorPrintf)("Probably write past beginning or end of array\n");
    135:       if (lasthead) (*PetscErrorPrintf)("Last intact block allocated in %s() line %d in %s\n",lasthead->functionname,lasthead->lineno,lasthead->filename);
    136:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    137:     }
    138:     a    = (char*)(((TrSPACE*)head) + 1);
    139:     nend = (PetscClassId*)(a + head->size);
    140:     if (*nend != CLASSID_VALUE) {
    141:       (*PetscErrorPrintf)("PetscMallocValidate: error detected at %s() line %d in %s\n",function,line,file);
    142:       if (*nend == ALREADY_FREED) {
    143:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n",head->id,(PetscLogDouble)head->size,a);
    144:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    145:       } else {
    146:         (*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    147:         (*PetscErrorPrintf)("Memory originally allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    148:         SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC," ");
    149:       }
    150:     }
    151:     lasthead = head;
    152:     head     = head->next;
    153:   }
    154:   return(0);
    155: }

    159: /*
    160:     PetscTrMallocDefault - Malloc with tracing.

    162:     Input Parameters:
    163: +   a   - number of bytes to allocate
    164: .   lineno - line number where used.  Use __LINE__ for this
    165: .   function - function calling routine. Use __FUNCT__ for this
    166: -   filename  - file name where used.  Use __FILE__ for this

    168:     Returns:
    169:     double aligned pointer to requested storage, or null if not
    170:     available.
    171:  */
    172: PetscErrorCode  PetscTrMallocDefault(size_t a,int lineno,const char function[],const char filename[],void **result)
    173: {
    174:   TRSPACE        *head;
    175:   char           *inew;
    176:   size_t         nsize;

    180:   /* Do not try to handle empty blocks */
    181:   if (!a) { *result = NULL; return(0); }

    183:   if (TRdebugLevel) {
    184:     PetscMallocValidate(lineno,function,filename); if (ierr) PetscFunctionReturn(ierr);
    185:   }

    187:   nsize = (a + (PETSC_MEMALIGN-1)) & ~(PETSC_MEMALIGN-1);
    188:   PetscMallocAlign(nsize+sizeof(TrSPACE)+sizeof(PetscClassId),lineno,function,filename,(void**)&inew);

    190:   head  = (TRSPACE*)inew;
    191:   inew += sizeof(TrSPACE);

    193:   if (TRhead) TRhead->prev = head;
    194:   head->next   = TRhead;
    195:   TRhead       = head;
    196:   head->prev   = NULL;
    197:   head->size   = nsize;
    198:   head->id     = TRid;
    199:   head->lineno = lineno;

    201:   head->filename                 = filename;
    202:   head->functionname             = function;
    203:   head->classid                  = CLASSID_VALUE;
    204:   *(PetscClassId*)(inew + nsize) = CLASSID_VALUE;

    206:   TRallocated += nsize;
    207:   if (TRallocated > TRMaxMem) TRMaxMem = TRallocated;
    208:   TRfrags++;

    210: #if defined(PETSC_USE_DEBUG)
    211:   if (PetscStackActive()) {
    212:     PetscStackCopy(petscstack,&head->stack);
    214:     head->stack.line[head->stack.currentsize-2] = lineno;
    215:   } else {
    216:     head->stack.currentsize = 0;
    217:   }
    218: #endif

    220:   /*
    221:          Allow logging of all mallocs made
    222:   */
    223:   if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) {
    224:     if (!PetscLogMalloc) {
    225:       PetscLogMallocLength = (size_t*)malloc(PetscLogMallocMax*sizeof(size_t));
    226:       if (!PetscLogMallocLength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    228:       PetscLogMallocFile = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    229:       if (!PetscLogMallocFile) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");

    231:       PetscLogMallocFunction = (const char**)malloc(PetscLogMallocMax*sizeof(char*));
    232:       if (!PetscLogMallocFunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM," ");
    233:     }
    234:     PetscLogMallocLength[PetscLogMalloc]     = nsize;
    235:     PetscLogMallocFile[PetscLogMalloc]       = filename;
    236:     PetscLogMallocFunction[PetscLogMalloc++] = function;
    237:   }
    238:   *result = (void*)inew;
    239:   return(0);
    240: }

    245: /*
    246:    PetscTrFreeDefault - Free with tracing.

    248:    Input Parameters:
    249: .   a    - pointer to a block allocated with PetscTrMalloc
    250: .   lineno - line number where used.  Use __LINE__ for this
    251: .   function - function calling routine. Use __FUNCT__ for this
    252: .   file  - file name where used.  Use __FILE__ for this
    253:  */
    254: PetscErrorCode  PetscTrFreeDefault(void *aa,int line,const char function[],const char file[])
    255: {
    256:   char           *a = (char*)aa;
    257:   TRSPACE        *head;
    258:   char           *ahead;
    260:   PetscClassId   *nend;

    263:   /* Do not try to handle empty blocks */
    264:   if (!a) return(0);

    266:   if (TRdebugLevel) {
    267:     PetscMallocValidate(line,function,file);
    268:   }

    270:   ahead = a;
    271:   a     = a - sizeof(TrSPACE);
    272:   head  = (TRSPACE*)a;

    274:   if (head->classid != CLASSID_VALUE) {
    275:     (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    276:     (*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n",a);
    277:     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Bad location or corrupted memory");
    278:   }
    279:   nend = (PetscClassId*)(ahead + head->size);
    280:   if (*nend != CLASSID_VALUE) {
    281:     if (*nend == ALREADY_FREED) {
    282:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    283:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n",head->id,(PetscLogDouble)head->size,a + sizeof(TrSPACE));
    284:       if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) {
    285:         (*PetscErrorPrintf)("Block freed in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    286:       } else {
    287:         (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,-head->lineno,head->filename);
    288:       }
    289:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Memory already freed");
    290:     } else {
    291:       /* Damaged tail */
    292:       (*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() line %d in %s\n",function,line,file);
    293:       (*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n",head->id,(PetscLogDouble)head->size,a);
    294:       (*PetscErrorPrintf)("Block allocated in %s() line %d in %s\n",head->functionname,head->lineno,head->filename);
    295:       SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEMC,"Corrupted memory");
    296:     }
    297:   }
    298:   /* Mark the location freed */
    299:   *nend = ALREADY_FREED;
    300:   /* Save location where freed.  If we suspect the line number, mark as  allocated location */
    301:   if (line > 0 && line < 50000) {
    302:     head->lineno       = line;
    303:     head->filename     = file;
    304:     head->functionname = function;
    305:   } else {
    306:     head->lineno = -head->lineno;
    307:   }
    308:   /* zero out memory - helps to find some reuse of already freed memory */
    309:   PetscMemzero(aa,head->size);

    311:   TRallocated -= head->size;
    312:   TRfrags--;
    313:   if (head->prev) head->prev->next = head->next;
    314:   else TRhead = head->next;

    316:   if (head->next) head->next->prev = head->prev;
    317:   PetscFreeAlign(a,line,function,file);
    318:   return(0);
    319: }

    324: /*@C
    325:     PetscMemoryView - Shows the amount of memory currently being used
    326:         in a communicator.

    328:     Collective on PetscViewer

    330:     Input Parameter:
    331: +    viewer - the viewer that defines the communicator
    332: -    message - string printed before values

    334:     Options Database:
    335: +    -malloc - have PETSc track how much memory it has allocated
    336: -    -memory_view - during PetscFinalize() have this routine called

    338:     Level: intermediate

    340:     Concepts: memory usage

    342: .seealso: PetscMallocDump(), PetscMemoryGetCurrentUsage(), PetscMemorySetGetMaximumUsage()
    343:  @*/
    344: PetscErrorCode  PetscMemoryView(PetscViewer viewer,const char message[])
    345: {
    346:   PetscLogDouble allocated,allocatedmax,resident,residentmax,gallocated,gallocatedmax,gresident,gresidentmax,maxgallocated,maxgallocatedmax,maxgresident,maxgresidentmax;
    347:   PetscLogDouble mingallocated,mingallocatedmax,mingresident,mingresidentmax;
    349:   MPI_Comm       comm;

    352:   if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD;
    353:   PetscMallocGetCurrentUsage(&allocated);
    354:   PetscMallocGetMaximumUsage(&allocatedmax);
    355:   PetscMemoryGetCurrentUsage(&resident);
    356:   PetscMemoryGetMaximumUsage(&residentmax);
    357:   if (residentmax > 0) residentmax = PetscMax(resident,residentmax);
    358:   PetscObjectGetComm((PetscObject)viewer,&comm);
    359:   PetscViewerASCIIPrintf(viewer,message);
    360:   if (resident && residentmax && allocated) {
    361:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    362:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    363:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    364:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
    365:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    366:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    367:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    368:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
    369:     MPI_Reduce(&allocatedmax,&gallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    370:     MPI_Reduce(&allocatedmax,&maxgallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    371:     MPI_Reduce(&allocatedmax,&mingallocatedmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    372:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n",gallocatedmax,maxgallocatedmax,mingallocatedmax);
    373:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    374:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    375:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    376:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    377:   } else if (resident && residentmax) {
    378:     MPI_Reduce(&residentmax,&gresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    379:     MPI_Reduce(&residentmax,&maxgresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    380:     MPI_Reduce(&residentmax,&mingresidentmax,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    381:     PetscViewerASCIIPrintf(viewer,"Maximum (over computational time) process memory:        total %5.4e max %5.4e min %5.4e\n",gresidentmax,maxgresidentmax,mingresidentmax);
    382:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    383:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    384:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    385:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
    386:   } else if (resident && allocated) {
    387:     MPI_Reduce(&resident,&gresident,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    388:     MPI_Reduce(&resident,&maxgresident,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    389:     MPI_Reduce(&resident,&mingresident,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    390:     PetscViewerASCIIPrintf(viewer,"Current process memory:                                  total %5.4e max %5.4e min %5.4e\n",gresident,maxgresident,mingresident);
    391:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    392:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    393:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    394:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    395:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
    396:   } else if (allocated) {
    397:     MPI_Reduce(&allocated,&gallocated,1,MPIU_PETSCLOGDOUBLE,MPI_SUM,0,comm);
    398:     MPI_Reduce(&allocated,&maxgallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MAX,0,comm);
    399:     MPI_Reduce(&allocated,&mingallocated,1,MPIU_PETSCLOGDOUBLE,MPI_MIN,0,comm);
    400:     PetscViewerASCIIPrintf(viewer,"Current space PetscMalloc()ed:                           total %5.4e max %5.4e min %5.4e\n",gallocated,maxgallocated,mingallocated);
    401:     PetscViewerASCIIPrintf(viewer,"Run with -memory_view to get maximum memory usage\n");
    402:     PetscViewerASCIIPrintf(viewer,"OS cannot compute process memory\n");
    403:   } else {
    404:     PetscViewerASCIIPrintf(viewer,"Run with -malloc to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n");
    405:   }
    406:   PetscViewerFlush(viewer);
    407:   return(0);
    408: }

    412: /*@C
    413:     PetscMallocGetCurrentUsage - gets the current amount of memory used that was PetscMalloc()ed

    415:     Not Collective

    417:     Output Parameters:
    418: .   space - number of bytes currently allocated

    420:     Level: intermediate

    422:     Concepts: memory usage

    424: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    425:           PetscMemoryGetMaximumUsage()
    426:  @*/
    427: PetscErrorCode  PetscMallocGetCurrentUsage(PetscLogDouble *space)
    428: {
    430:   *space = (PetscLogDouble) TRallocated;
    431:   return(0);
    432: }

    436: /*@C
    437:     PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was PetscMalloc()ed at any time
    438:         during this run.

    440:     Not Collective

    442:     Output Parameters:
    443: .   space - maximum number of bytes ever allocated at one time

    445:     Level: intermediate

    447:     Concepts: memory usage

    449: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocGetMaximumUsage(), PetscMemoryGetCurrentUsage(),
    450:           PetscMemoryGetCurrentUsage()
    451:  @*/
    452: PetscErrorCode  PetscMallocGetMaximumUsage(PetscLogDouble *space)
    453: {
    455:   *space = (PetscLogDouble) TRMaxMem;
    456:   return(0);
    457: }

    459: #if defined(PETSC_USE_DEBUG)
    462: /*@C
    463:    PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to PetscMalloc() was used to obtain that memory

    465:    Collective on PETSC_COMM_WORLD

    467:    Input Parameter:
    468: .    ptr - the memory location

    470:    Output Paramter:
    471: .    stack - the stack indicating where the program allocated this memory

    473:    Level: intermediate

    475: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
    476: @*/
    477: PetscErrorCode  PetscMallocGetStack(void *ptr,PetscStack **stack)
    478: {
    479:   TRSPACE *head;

    482:   head   = (TRSPACE*) (((char*)ptr) - HEADER_BYTES);
    483:   *stack = &head->stack;
    484:   return(0);
    485: }
    486: #else
    489: PetscErrorCode  PetscMallocGetStack(void *ptr,void **stack)
    490: {
    492:   *stack = NULL;
    493:   return(0);
    494: }
    495: #endif

    499: /*@C
    500:    PetscMallocDump - Dumps the allocated memory blocks to a file. The information
    501:    printed is: size of space (in bytes), address of space, id of space,
    502:    file in which space was allocated, and line number at which it was
    503:    allocated.

    505:    Collective on PETSC_COMM_WORLD

    507:    Input Parameter:
    508: .  fp  - file pointer.  If fp is NULL, stdout is assumed.

    510:    Options Database Key:
    511: .  -malloc_dump - Dumps unfreed memory during call to PetscFinalize()

    513:    Level: intermediate

    515:    Fortran Note:
    516:    The calling sequence in Fortran is PetscMallocDump(integer ierr)
    517:    The fp defaults to stdout.

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

    522:    Concepts: memory usage
    523:    Concepts: memory bleeding
    524:    Concepts: bleeding memory

    526: .seealso:  PetscMallocGetCurrentUsage(), PetscMallocDumpLog()
    527: @*/
    528: PetscErrorCode  PetscMallocDump(FILE *fp)
    529: {
    530:   TRSPACE        *head;
    531:   PetscInt       libAlloc = 0;
    533:   PetscMPIInt    rank;

    536:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    537:   if (!fp) fp = PETSC_STDOUT;
    538:   head = TRhead;
    539:   while (head) {
    540:     PetscBool isLib;

    542:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
    543:     libAlloc += head->size;
    544:     head = head->next;
    545:   }
    546:   if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated);
    547:   head = TRhead;
    548:   while (head) {
    549:     PetscBool isLib;

    551:     PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);
    552:     if (!isLib) {
    553:       fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename);
    554: #if defined(PETSC_USE_DEBUG)
    555:       PetscStackPrint(&head->stack,fp);
    556: #endif
    557:     }
    558:     head = head->next;
    559:   }
    560:   return(0);
    561: }

    563: /* ---------------------------------------------------------------------------- */

    567: /*@C
    568:     PetscMallocSetDumpLog - Activates logging of all calls to PetscMalloc().

    570:     Not Collective

    572:     Options Database Key:
    573: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
    574: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

    576:     Level: advanced

    578: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLogThreshold()
    579: @*/
    580: PetscErrorCode PetscMallocSetDumpLog(void)
    581: {

    585:   PetscLogMalloc = 0;

    587:   PetscMemorySetGetMaximumUsage();
    588:   return(0);
    589: }

    593: /*@C
    594:     PetscMallocSetDumpLogThreshold - Activates logging of all calls to PetscMalloc().

    596:     Not Collective

    598:     Input Arguments:
    599: .   logmin - minimum allocation size to log, or PETSC_DEFAULT

    601:     Options Database Key:
    602: +  -malloc_log <filename> - Activates PetscMallocDumpLog()
    603: -  -malloc_log_threshold <min> - Activates logging and sets a minimum size

    605:     Level: advanced

    607: .seealso: PetscMallocDump(), PetscMallocDumpLog(), PetscMallocSetDumpLog()
    608: @*/
    609: PetscErrorCode PetscMallocSetDumpLogThreshold(PetscLogDouble logmin)
    610: {

    614:   PetscMallocSetDumpLog();
    615:   if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */
    616:   PetscLogMallocThreshold = (size_t)logmin;
    617:   return(0);
    618: }

    622: /*@C
    623:     PetscMallocGetDumpLog - Determine whether all calls to PetscMalloc() are being logged

    625:     Not Collective

    627:     Output Arguments
    628: .   logging - PETSC_TRUE if logging is active

    630:     Options Database Key:
    631: .  -malloc_log - Activates PetscMallocDumpLog()

    633:     Level: advanced

    635: .seealso: PetscMallocDump(), PetscMallocDumpLog()
    636: @*/
    637: PetscErrorCode PetscMallocGetDumpLog(PetscBool *logging)
    638: {

    641:   *logging = (PetscBool)(PetscLogMalloc >= 0);
    642:   return(0);
    643: }

    647: /*@C
    648:     PetscMallocDumpLog - Dumps the log of all calls to PetscMalloc(); also calls
    649:        PetscMemoryGetMaximumUsage()

    651:     Collective on PETSC_COMM_WORLD

    653:     Input Parameter:
    654: .   fp - file pointer; or NULL

    656:     Options Database Key:
    657: .  -malloc_log - Activates PetscMallocDumpLog()

    659:     Level: advanced

    661:    Fortran Note:
    662:    The calling sequence in Fortran is PetscMallocDumpLog(integer ierr)
    663:    The fp defaults to stdout.

    665: .seealso: PetscMallocGetCurrentUsage(), PetscMallocDump(), PetscMallocSetDumpLog()
    666: @*/
    667: PetscErrorCode  PetscMallocDumpLog(FILE *fp)
    668: {
    669:   PetscInt       i,j,n,dummy,*perm;
    670:   size_t         *shortlength;
    671:   int            *shortcount,err;
    672:   PetscMPIInt    rank,size,tag = 1212 /* very bad programming */;
    673:   PetscBool      match;
    674:   const char     **shortfunction;
    675:   PetscLogDouble rss;
    676:   MPI_Status     status;

    680:   MPI_Comm_rank(MPI_COMM_WORLD,&rank);
    681:   MPI_Comm_size(MPI_COMM_WORLD,&size);
    682:   /*
    683:        Try to get the data printed in order by processor. This will only sometimes work
    684:   */
    685:   err = fflush(fp);
    686:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");

    688:   MPI_Barrier(MPI_COMM_WORLD);
    689:   if (rank) {
    690:     MPI_Recv(&dummy,1,MPIU_INT,rank-1,tag,MPI_COMM_WORLD,&status);
    691:   }

    693:   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()");

    695:   if (!fp) fp = PETSC_STDOUT;
    696:   PetscMemoryGetMaximumUsage(&rss);
    697:   if (rss) {
    698:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n",rank,(PetscLogDouble)TRMaxMem,rss);
    699:   } else {
    700:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n",rank,(PetscLogDouble)TRMaxMem);
    701:   }
    702:   shortcount    = (int*)malloc(PetscLogMalloc*sizeof(int));if (!shortcount) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    703:   shortlength   = (size_t*)malloc(PetscLogMalloc*sizeof(size_t));if (!shortlength) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    704:   shortfunction = (const char**)malloc(PetscLogMalloc*sizeof(char*));if (!shortfunction) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    705:   for (i=0,n=0; i<PetscLogMalloc; i++) {
    706:     for (j=0; j<n; j++) {
    707:       PetscStrcmp(shortfunction[j],PetscLogMallocFunction[i],&match);
    708:       if (match) {
    709:         shortlength[j] += PetscLogMallocLength[i];
    710:         shortcount[j]++;
    711:         goto foundit;
    712:       }
    713:     }
    714:     shortfunction[n] = PetscLogMallocFunction[i];
    715:     shortlength[n]   = PetscLogMallocLength[i];
    716:     shortcount[n]    = 1;
    717:     n++;
    718: foundit:;
    719:   }

    721:   perm = (PetscInt*)malloc(n*sizeof(PetscInt));if (!perm) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Out of memory");
    722:   for (i=0; i<n; i++) perm[i] = i;
    723:   PetscSortStrWithPermutation(n,(const char**)shortfunction,perm);

    725:   PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] Memory usage sorted by function\n",rank);
    726:   for (i=0; i<n; i++) {
    727:     PetscFPrintf(MPI_COMM_WORLD,fp,"[%d] %d %.0f %s()\n",rank,shortcount[perm[i]],(PetscLogDouble)shortlength[perm[i]],shortfunction[perm[i]]);
    728:   }
    729:   free(perm);
    730:   free(shortlength);
    731:   free(shortcount);
    732:   free((char**)shortfunction);
    733:   err = fflush(fp);
    734:   if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file");
    735:   if (rank != size-1) {
    736:     MPI_Send(&dummy,1,MPIU_INT,rank+1,tag,MPI_COMM_WORLD);
    737:   }
    738:   return(0);
    739: }

    741: /* ---------------------------------------------------------------------------- */

    745: /*@C
    746:     PetscMallocDebug - Turns on/off debugging for the memory management routines.

    748:     Not Collective

    750:     Input Parameter:
    751: .   level - PETSC_TRUE or PETSC_FALSE

    753:    Level: intermediate

    755: .seealso: CHKMEMQ(), PetscMallocValidate()
    756: @*/
    757: PetscErrorCode  PetscMallocDebug(PetscBool level)
    758: {
    760:   TRdebugLevel = level;
    761:   return(0);
    762: }

    766: /*@C
    767:     PetscMallocGetDebug - Indicates if any PETSc is doing ANY memory debugging.

    769:     Not Collective

    771:     Output Parameter:
    772: .    flg - PETSC_TRUE if any debugger

    774:    Level: intermediate

    776:     Note that by default, the debug version always does some debugging unless you run with -malloc no

    779: .seealso: CHKMEMQ(), PetscMallocValidate()
    780: @*/
    781: PetscErrorCode  PetscMallocGetDebug(PetscBool *flg)
    782: {
    784:   if (PetscTrMalloc == PetscTrMallocDefault) *flg = PETSC_TRUE;
    785:   else *flg = PETSC_FALSE;
    786:   return(0);
    787: }