/* Logging of memory usage and some error checking */ #include /*I "petscsys.h" I*/ #include #if defined(PETSC_HAVE_MALLOC_H) #include #endif /* These are defined in mal.c and ensure that malloced space is PetscScalar aligned */ PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t, PetscBool, int, const char[], const char[], void **); PETSC_EXTERN PetscErrorCode PetscFreeAlign(void *, int, const char[], const char[]); PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t, int, const char[], const char[], void **); #define CLASSID_VALUE ((PetscClassId)0xf0e0d0c9) #define ALREADY_FREED ((PetscClassId)0x0f0e0d9c) /* this is the header put at the beginning of each PetscTrMallocDefault() for tracking allocated space and checking of allocated space heap */ typedef struct _trSPACE { size_t size, rsize; /* Aligned size and requested size */ int id; int lineno; const char *filename; const char *functionname; PetscClassId classid; #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) PetscStack stack; #endif struct _trSPACE *next, *prev; } TRSPACE; /* HEADER_BYTES is the number of bytes in a PetscTrMallocDefault() header. It is sizeof(trSPACE) padded to be a multiple of PETSC_MEMALIGN. */ #define HEADER_BYTES ((sizeof(TRSPACE) + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1)) /* This union is used to insure that the block passed to the user retains a minimum alignment of PETSC_MEMALIGN. */ typedef union { TRSPACE sp; char v[HEADER_BYTES]; } TrSPACE; #define MAXTRMAXMEMS 50 static size_t TRallocated = 0; static int TRfrags = 0; static TRSPACE *TRhead = NULL; static int TRid = 0; static PetscBool TRdebug = PETSC_FALSE; static PetscBool TRdebugIinitializenan = PETSC_FALSE; static PetscBool TRrequestedSize = PETSC_FALSE; static size_t TRMaxMem = 0; static int NumTRMaxMems = 0; static size_t TRMaxMems[MAXTRMAXMEMS]; static int TRMaxMemsEvents[MAXTRMAXMEMS]; /* Arrays to log information on mallocs for PetscMallocView() */ static int PetscLogMallocMax = 10000; static int PetscLogMalloc = -1; static size_t PetscLogMallocThreshold = 0; static size_t *PetscLogMallocLength; static const char **PetscLogMallocFile, **PetscLogMallocFunction; static int PetscLogMallocTrace = -1; static size_t PetscLogMallocTraceThreshold = 0; static PetscViewer PetscLogMallocTraceViewer = NULL; /*@C PetscMallocValidate - Test the memory for corruption. This can be called at any time between `PetscInitialize()` and `PetscFinalize()` Input Parameters: + line - line number where call originated. . function - name of function calling - file - file where function is Options Database Keys: + -malloc_test - turns this feature on when PETSc was not configured with `--with-debugging=0` - -malloc_debug - turns this feature on anytime Level: advanced Notes: You should generally use `CHKMEMQ` as a short cut for calling this routine. Error messages are written to `stdout`. This is only run if `PetscMallocSetDebug()` has been called which is set by `-malloc_test` (if debugging is turned on) or `-malloc_debug` (any time) No output is generated if there are no problems detected. Fortran Notes: The Fortran calling sequence is simply `PetscMallocValidate(ierr)` .seealso: `CHKMEMQ`, `PetscMalloc()`, `PetscFree()`, `PetscMallocSetDebug()` @*/ PetscErrorCode PetscMallocValidate(int line, const char function[], const char file[]) { TRSPACE *head, *lasthead; char *a; PetscClassId *nend; if (!TRdebug) return PETSC_SUCCESS; head = TRhead; lasthead = NULL; if (head && head->prev) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line)); PetscCall((*PetscErrorPrintf)("Root memory header %p has invalid back pointer %p\n", (void *)head, (void *)head->prev)); return PETSC_ERR_MEMC; } while (head) { if (head->classid != CLASSID_VALUE) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line)); PetscCall((*PetscErrorPrintf)("Memory at address %p is corrupted\n", (void *)head)); PetscCall((*PetscErrorPrintf)("Probably write before beginning of or past end of array\n")); if (lasthead) { a = (char *)(((TrSPACE *)head) + 1); PetscCall((*PetscErrorPrintf)("Last intact block [id=%d(%.0f)] at address %p allocated in %s() at %s:%d\n", lasthead->id, (PetscLogDouble)lasthead->size, a, lasthead->functionname, lasthead->filename, lasthead->lineno)); } abort(); return PETSC_ERR_MEMC; } a = (char *)(((TrSPACE *)head) + 1); nend = (PetscClassId *)(a + head->size); if (*nend != CLASSID_VALUE) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line)); if (*nend == ALREADY_FREED) { PetscCall((*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p already freed\n", head->id, (PetscLogDouble)head->size, a)); return PETSC_ERR_MEMC; } else { PetscCall((*PetscErrorPrintf)("Memory [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a)); PetscCall((*PetscErrorPrintf)("Memory originally allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); return PETSC_ERR_MEMC; } } if (head->prev && head->prev != lasthead) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscMallocValidate: error detected in %s() at %s:%d\n", function, file, line)); PetscCall((*PetscErrorPrintf)("Backpointer %p is invalid, should be %p\n", (void *)head->prev, (void *)lasthead)); PetscCall((*PetscErrorPrintf)("Previous memory originally allocated in %s() at %s:%d\n", lasthead->functionname, lasthead->filename, lasthead->lineno)); PetscCall((*PetscErrorPrintf)("Memory originally allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); return PETSC_ERR_MEMC; } lasthead = head; head = head->next; } return PETSC_SUCCESS; } /* PetscTrMallocDefault - Malloc with logging and error checking */ static PetscErrorCode PetscTrMallocDefault(size_t a, PetscBool clear, int lineno, const char function[], const char filename[], void **result) { TRSPACE *head; char *inew; size_t nsize; PetscFunctionBegin; if (!a) { *result = NULL; PetscFunctionReturn(PETSC_SUCCESS); } PetscCall(PetscMallocValidate(lineno, function, filename)); nsize = (a + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1); PetscCall(PetscMallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), clear, lineno, function, filename, (void **)&inew)); head = (TRSPACE *)inew; inew += sizeof(TrSPACE); if (TRhead) TRhead->prev = head; head->next = TRhead; TRhead = head; head->prev = NULL; head->size = nsize; head->rsize = a; head->id = TRid++; head->lineno = lineno; head->filename = filename; head->functionname = function; head->classid = CLASSID_VALUE; *(PetscClassId *)(inew + nsize) = CLASSID_VALUE; TRallocated += TRrequestedSize ? head->rsize : head->size; if (TRallocated > TRMaxMem) TRMaxMem = TRallocated; if (PetscLogMemory) { for (PetscInt i = 0; i < NumTRMaxMems; i++) { if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated; } } TRfrags++; #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) PetscCall(PetscStackCopy(&petscstack, &head->stack)); /* fix the line number to where PetscTrMallocDefault() was called, not the PetscFunctionBegin; */ head->stack.line[PetscMax(head->stack.currentsize - 2, 0)] = lineno; head->stack.currentsize--; #if defined(PETSC_USE_REAL_SINGLE) || defined(PETSC_USE_REAL_DOUBLE) if (!clear && TRdebugIinitializenan) { size_t n = a / sizeof(PetscReal); PetscReal *s = (PetscReal *)inew; /* from https://www.doc.ic.ac.uk/~eedwards/compsys/float/nan.html */ #if defined(PETSC_USE_REAL_SINGLE) int nas = 0x7F800002; #else PetscInt64 nas = 0x7FF0000000000002; #endif for (size_t i = 0; i < n; i++) memcpy(s + i, &nas, sizeof(PetscReal)); } #endif #endif /* Allow logging of all mallocs made. TODO: Currently this memory is never freed, it should be freed during PetscFinalize() */ if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && a >= PetscLogMallocThreshold) { if (!PetscLogMalloc) { PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t)); PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *)); PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *)); PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); } PetscLogMallocLength[PetscLogMalloc] = nsize; PetscLogMallocFile[PetscLogMalloc] = filename; PetscLogMallocFunction[PetscLogMalloc++] = function; } if (PetscLogMallocTrace > -1 && a >= PetscLogMallocTraceThreshold) PetscCall(PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Alloc %zu %s:%d (%s)\n", a, filename ? filename : "null", lineno, function ? function : "null")); *result = (void *)inew; PetscFunctionReturn(PETSC_SUCCESS); } /* PetscTrFreeDefault - Free with logging and error checking */ static PetscErrorCode PetscTrFreeDefault(void *aa, int lineno, const char function[], const char filename[]) { char *a = (char *)aa; TRSPACE *head; char *ahead; size_t asize; PetscClassId *nend; PetscFunctionBegin; if (!a) PetscFunctionReturn(PETSC_SUCCESS); PetscCall(PetscMallocValidate(lineno, function, filename)); ahead = a; a = a - sizeof(TrSPACE); head = (TRSPACE *)a; if (head->classid != CLASSID_VALUE) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a)); SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory"); } nend = (PetscClassId *)(ahead + head->size); if (*nend != CLASSID_VALUE) { TRdebug = PETSC_FALSE; if (*nend == ALREADY_FREED) { PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE))); if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) { PetscCall((*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); } else { PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno)); } SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed"); } else { /* Damaged tail */ PetscCall((*PetscErrorPrintf)("PetscTrFreeDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a)); PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory"); } } if (PetscLogMallocTrace > -1 && head->rsize >= PetscLogMallocTraceThreshold) { PetscCall(PetscViewerASCIIPrintf(PetscLogMallocTraceViewer, "Free %zu %s:%d (%s)\n", head->rsize, filename ? filename : "null", lineno, function ? function : "null")); } *nend = ALREADY_FREED; /* Save location where freed. If we suspect the line number, mark as allocated location */ if (lineno > 0 && lineno < 50000) { head->lineno = lineno; head->filename = filename; head->functionname = function; } else { head->lineno = -head->lineno; } asize = TRrequestedSize ? head->rsize : head->size; PetscCheck(TRallocated >= asize, PETSC_COMM_SELF, PETSC_ERR_MEMC, "TRallocate is smaller than memory just freed"); TRallocated -= asize; TRfrags--; if (head->prev) head->prev->next = head->next; else TRhead = head->next; if (head->next) head->next->prev = head->prev; PetscCall(PetscFreeAlign(a, lineno, function, filename)); PetscFunctionReturn(PETSC_SUCCESS); } /* PetscTrReallocDefault - Realloc with logging and error checking */ static PetscErrorCode PetscTrReallocDefault(size_t len, int lineno, const char function[], const char filename[], void **result) { char *a = (char *)*result; TRSPACE *head; char *ahead, *inew; PetscClassId *nend; size_t nsize; PetscFunctionBegin; /* Realloc requests zero space so just free the current space */ if (!len) { PetscCall(PetscTrFreeDefault(*result, lineno, function, filename)); *result = NULL; PetscFunctionReturn(PETSC_SUCCESS); } /* If the original space was NULL just use the regular malloc() */ if (!*result) { PetscCall(PetscTrMallocDefault(len, PETSC_FALSE, lineno, function, filename, result)); PetscFunctionReturn(PETSC_SUCCESS); } PetscCall(PetscMallocValidate(lineno, function, filename)); ahead = a; a = a - sizeof(TrSPACE); head = (TRSPACE *)a; inew = a; if (head->classid != CLASSID_VALUE) { TRdebug = PETSC_FALSE; PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block at address %p is corrupted; cannot free;\nmay be block not allocated with PetscMalloc()\n", a)); SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Bad location or corrupted memory"); } nend = (PetscClassId *)(ahead + head->size); if (*nend != CLASSID_VALUE) { TRdebug = PETSC_FALSE; if (*nend == ALREADY_FREED) { PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p was already freed\n", head->id, (PetscLogDouble)head->size, a + sizeof(TrSPACE))); if (head->lineno > 0 && head->lineno < 50000 /* sanity check */) { PetscCall((*PetscErrorPrintf)("Block freed in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); } else { PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, -head->lineno)); } SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_WRONG, "Memory already freed"); } else { /* Damaged tail */ PetscCall((*PetscErrorPrintf)("PetscTrReallocDefault() called from %s() at %s:%d\n", function, filename, lineno)); PetscCall((*PetscErrorPrintf)("Block [id=%d(%.0f)] at address %p is corrupted (probably write past end of array)\n", head->id, (PetscLogDouble)head->size, a)); PetscCall((*PetscErrorPrintf)("Block allocated in %s() at %s:%d\n", head->functionname, head->filename, head->lineno)); SETERRQ(PETSC_COMM_SELF, PETSC_ERR_MEMC, "Corrupted memory"); } } /* remove original reference to the memory allocated from the PETSc debugging heap */ TRallocated -= TRrequestedSize ? head->rsize : head->size; TRfrags--; if (head->prev) head->prev->next = head->next; else TRhead = head->next; if (head->next) head->next->prev = head->prev; nsize = (len + (PETSC_MEMALIGN - 1)) & ~(PETSC_MEMALIGN - 1); PetscCall(PetscReallocAlign(nsize + sizeof(TrSPACE) + sizeof(PetscClassId), lineno, function, filename, (void **)&inew)); head = (TRSPACE *)inew; inew += sizeof(TrSPACE); if (TRhead) TRhead->prev = head; head->next = TRhead; TRhead = head; head->prev = NULL; head->size = nsize; head->rsize = len; head->id = TRid++; head->lineno = lineno; head->filename = filename; head->functionname = function; head->classid = CLASSID_VALUE; *(PetscClassId *)(inew + nsize) = CLASSID_VALUE; TRallocated += TRrequestedSize ? head->rsize : head->size; if (TRallocated > TRMaxMem) TRMaxMem = TRallocated; if (PetscLogMemory) { for (PetscInt i = 0; i < NumTRMaxMems; i++) { if (TRallocated > TRMaxMems[i]) TRMaxMems[i] = TRallocated; } } TRfrags++; #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) PetscCall(PetscStackCopy(&petscstack, &head->stack)); /* fix the line number to where the malloc() was called, not the PetscFunctionBegin; */ head->stack.line[PetscMax(head->stack.currentsize - 2, 0)] = lineno; #endif /* Allow logging of all mallocs made. This adds a new entry to the list of allocated memory and does not remove the previous entry to the list hence this memory is "double counted" in PetscMallocView() */ if (PetscLogMalloc > -1 && PetscLogMalloc < PetscLogMallocMax && len >= PetscLogMallocThreshold) { if (!PetscLogMalloc) { PetscLogMallocLength = (size_t *)malloc(PetscLogMallocMax * sizeof(size_t)); PetscCheck(PetscLogMallocLength, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); PetscLogMallocFile = (const char **)malloc(PetscLogMallocMax * sizeof(char *)); PetscCheck(PetscLogMallocFile, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); PetscLogMallocFunction = (const char **)malloc(PetscLogMallocMax * sizeof(char *)); PetscCheck(PetscLogMallocFunction, PETSC_COMM_SELF, PETSC_ERR_MEM, " "); } PetscLogMallocLength[PetscLogMalloc] = nsize; PetscLogMallocFile[PetscLogMalloc] = filename; PetscLogMallocFunction[PetscLogMalloc++] = function; } *result = (void *)inew; PetscFunctionReturn(PETSC_SUCCESS); } /*@C PetscMemoryView - Shows the amount of memory currently being used in a communicator. Collective Input Parameters: + viewer - the viewer to output the information on - message - string printed before values Options Database Keys: + -malloc_debug - have PETSc track how much memory it has allocated . -log_view_memory - print memory usage per event when `-log_view` is used - -memory_view - during `PetscFinalize()` have this routine called Level: intermediate .seealso: `PetscMallocDump()`, `PetscMemoryGetCurrentUsage()`, `PetscMemorySetGetMaximumUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMemoryView(PetscViewer viewer, const char message[]) { PetscLogDouble allocated, allocatedmax, resident, residentmax, gallocated, gallocatedmax, gresident, gresidentmax, maxgallocated, maxgallocatedmax; PetscLogDouble mingallocated, mingallocatedmax, mingresident, mingresidentmax, maxgresident, maxgresidentmax; MPI_Comm comm; PetscFunctionBegin; if (!viewer) viewer = PETSC_VIEWER_STDOUT_WORLD; PetscCall(PetscMallocGetCurrentUsage(&allocated)); PetscCall(PetscMallocGetMaximumUsage(&allocatedmax)); PetscCall(PetscMemoryGetCurrentUsage(&resident)); PetscCall(PetscMemoryGetMaximumUsage(&residentmax)); if (residentmax > 0) residentmax = PetscMax(resident, residentmax); PetscCall(PetscObjectGetComm((PetscObject)viewer, &comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "%s", message)); if (resident && residentmax && allocated) { PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory: total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax)); PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory: total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident)); PetscCallMPI(MPI_Reduce(&allocatedmax, &gallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&allocatedmax, &maxgallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&allocatedmax, &mingallocatedmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocatedmax, maxgallocatedmax, mingallocatedmax)); PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated)); } else if (resident && residentmax) { PetscCallMPI(MPI_Reduce(&residentmax, &gresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&residentmax, &maxgresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&residentmax, &mingresidentmax, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Maximum (over computational time) process memory: total %5.4e max %5.4e min %5.4e\n", gresidentmax, maxgresidentmax, mingresidentmax)); PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory: total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident)); } else if (resident && allocated) { PetscCallMPI(MPI_Reduce(&resident, &gresident, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &maxgresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&resident, &mingresident, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current process memory: total %5.4e max %5.4e min %5.4e\n", gresident, maxgresident, mingresident)); PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated)); PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n")); } else if (allocated) { PetscCallMPI(MPI_Reduce(&allocated, &gallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_SUM, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &maxgallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MAX, 0, comm)); PetscCallMPI(MPI_Reduce(&allocated, &mingallocated, 1, MPIU_PETSCLOGDOUBLE, MPI_MIN, 0, comm)); PetscCall(PetscViewerASCIIPrintf(viewer, "Current space PetscMalloc()ed: total %5.4e max %5.4e min %5.4e\n", gallocated, maxgallocated, mingallocated)); PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -memory_view to get maximum memory usage\n")); PetscCall(PetscViewerASCIIPrintf(viewer, "OS cannot compute process memory\n")); } else { PetscCall(PetscViewerASCIIPrintf(viewer, "Run with -malloc_debug to get statistics on PetscMalloc() calls\nOS cannot compute process memory\n")); } PetscCall(PetscViewerFlush(viewer)); PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocGetCurrentUsage - gets the current amount of memory used that was allocated with `PetscMalloc()` Not Collective Output Parameter: . space - number of bytes currently allocated Level: intermediate Note: This only works if `-memory_view` or `-log_view_memory` have been used .seealso: `PetscMallocDump()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`, `PetscMemoryGetMaximumUsage()` @*/ PetscErrorCode PetscMallocGetCurrentUsage(PetscLogDouble *space) { PetscFunctionBegin; *space = (PetscLogDouble)TRallocated; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocGetMaximumUsage - gets the maximum amount of memory used that was obtained with `PetscMalloc()` at any time during this run, the high water mark. Not Collective Output Parameter: . space - maximum number of bytes ever allocated at one time Level: intermediate Note: This only works if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`, `PetscMallocPushMaximumUsage()` @*/ PetscErrorCode PetscMallocGetMaximumUsage(PetscLogDouble *space) { PetscFunctionBegin; *space = (PetscLogDouble)TRMaxMem; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocPushMaximumUsage - Adds another event to collect the maximum memory usage over an event Not Collective Input Parameter: . event - an event id; this is just for error checking Level: developer Note: This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`, `PetscMallocPopMaximumUsage()` @*/ PetscErrorCode PetscMallocPushMaximumUsage(int event) { PetscFunctionBegin; if (event < 0 || ++NumTRMaxMems > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS); TRMaxMems[NumTRMaxMems - 1] = TRallocated; TRMaxMemsEvents[NumTRMaxMems - 1] = event; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocPopMaximumUsage - collect the maximum memory usage over an event Not Collective Input Parameter: . event - an event id; this is just for error checking Output Parameter: . mu - maximum amount of memory malloced during this event; high water mark relative to the beginning of the event Level: developer Note: This only does anything if `PetscMemorySetGetMaximumUsage()`, `-memory_view`, or `-log_view_memory` have been used .seealso: `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocGetMaximumUsage()`, `PetscMemoryGetCurrentUsage()`, `PetscMalloc()`, `PetscFree()`, `PetscMallocPushMaximumUsage()` @*/ PetscErrorCode PetscMallocPopMaximumUsage(int event, PetscLogDouble *mu) { PetscFunctionBegin; *mu = 0; if (event < 0 || NumTRMaxMems-- > MAXTRMAXMEMS) PetscFunctionReturn(PETSC_SUCCESS); PetscCheck(TRMaxMemsEvents[NumTRMaxMems] == event, PETSC_COMM_SELF, PETSC_ERR_MEMC, "PetscMallocPush/PopMaximumUsage() are not nested"); *mu = TRMaxMems[NumTRMaxMems]; PetscFunctionReturn(PETSC_SUCCESS); } /*@C PetscMallocGetStack - returns a pointer to the stack for the location in the program a call to `PetscMalloc()` was used to obtain that memory Not Collective Input Parameter: . ptr - the memory location Output Parameter: . stack - the stack indicating where the program allocated this memory Level: intermediate Note: This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocGetStack(void *ptr, PetscStack **stack) { #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) TRSPACE *head; PetscFunctionBegin; head = (TRSPACE *)(((char *)ptr) - HEADER_BYTES); *stack = &head->stack; PetscFunctionReturn(PETSC_SUCCESS); #else *stack = NULL; return PETSC_SUCCESS; #endif } /*@C PetscMallocDump - Dumps the currently allocated memory blocks to a file. The information printed is: size of space (in bytes), address of space, id of space, file in which space was allocated, and line number at which it was allocated. Not Collective Input Parameter: . fp - file pointer. If `fp` is `NULL`, `stdout` is assumed. Options Database Key: . -malloc_dump - Print summary of unfreed memory during call to `PetscFinalize()`, writing to filename if given Level: intermediate Notes: Uses `MPI_COMM_WORLD` to display rank, because this may be called in `PetscFinalize()` after `PETSC_COMM_WORLD` has been freed. When called in `PetscFinalize()` dumps only the allocations that have not been properly freed `PetscMallocView()` prints a list of all memory ever allocated This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used Fortran Notes: The calling sequence is `PetscMallocDump`(PetscErrorCode ierr). A `fp` parameter is not supported. Developer Notes: This should be absorbed into `PetscMallocView()` .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocView()`, `PetscMallocViewSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocDump(FILE *fp) { TRSPACE *head; size_t libAlloc = 0; PetscMPIInt rank; PetscFunctionBegin; PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank)); if (!fp) fp = PETSC_STDOUT; head = TRhead; while (head) { libAlloc += TRrequestedSize ? head->rsize : head->size; head = head->next; } if (TRallocated - libAlloc > 0) fprintf(fp, "[%d]Total space allocated %.0f bytes\n", rank, (PetscLogDouble)TRallocated); head = TRhead; while (head) { PetscBool isLib; PetscCall(PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib)); if (!isLib) { #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY) fprintf(fp, "[%2d] %.0f bytes\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size)); PetscCall(PetscStackPrint(&head->stack, fp)); #else fprintf(fp, "[%2d] %.0f bytes %s() at %s:%d\n", rank, (PetscLogDouble)(TRrequestedSize ? head->rsize : head->size), head->functionname, head->filename, head->lineno); #endif } head = head->next; } PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocViewSet - Activates logging of all calls to `PetscMalloc()` with a minimum size to view Not Collective Input Parameter: . logmin - minimum allocation size to log, or `PETSC_DEFAULT` to log all memory allocations Options Database Keys: + -malloc_view - Activates `PetscMallocView()` in `PetscFinalize()` . -malloc_view_threshold - Sets a minimum size if `-malloc_view` is used - -log_view_memory - view the memory usage also with the -log_view option Level: advanced Note: Must be called after `PetscMallocSetDebug()` Developer Notes: Uses `MPI_COMM_WORLD` to determine rank because PETSc communicators may not be available .seealso: `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceSet()`, `PetscMallocValidate()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocViewSet(PetscLogDouble logmin) { PetscFunctionBegin; PetscLogMalloc = 0; PetscCall(PetscMemorySetGetMaximumUsage()); if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */ PetscLogMallocThreshold = (size_t)logmin; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocViewGet - Determine whether calls to `PetscMalloc()` are being logged Not Collective Output Parameter: . logging - `PETSC_TRUE` if logging is active Options Database Key: . -malloc_view - Activates `PetscMallocView()` Level: advanced .seealso: `PetscMallocViewSet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMallocTraceGet()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocViewGet(PetscBool *logging) { PetscFunctionBegin; *logging = (PetscBool)(PetscLogMalloc >= 0); PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocTraceSet - Trace all calls to `PetscMalloc()`. That is print each `PetscMalloc()` and `PetscFree()` call to a viewer. Not Collective Input Parameters: + viewer - The viewer to use for tracing, or `NULL` to use `PETSC_VIEWER_STDOUT_SELF` . active - Flag to activate or deactivate tracing - logmin - The smallest memory size that will be logged Level: advanced Note: The viewer should not be collective. This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used .seealso: `PetscMallocTraceGet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocTraceSet(PetscViewer viewer, PetscBool active, PetscLogDouble logmin) { PetscFunctionBegin; if (!active) { PetscLogMallocTrace = -1; PetscFunctionReturn(PETSC_SUCCESS); } if (!viewer) viewer = PETSC_VIEWER_STDOUT_SELF; PetscValidHeaderSpecific(viewer, PETSC_VIEWER_CLASSID, 1); PetscLogMallocTraceViewer = viewer; PetscLogMallocTrace = 0; PetscCall(PetscMemorySetGetMaximumUsage()); if (logmin < 0) logmin = 0.0; /* PETSC_DEFAULT or PETSC_DECIDE */ PetscLogMallocTraceThreshold = (size_t)logmin; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocTraceGet - Determine whether all calls to `PetscMalloc()` are being traced Not Collective Output Parameter: . logging - `PETSC_TRUE` if logging is active Options Database Key: . -malloc_view - Activates `PetscMallocView()` Level: advanced This only does anything if `-malloc_debug` (or `-malloc_test` if PETSc was configured with debugging) has been used .seealso: `PetscMallocTraceSet()`, `PetscMallocViewGet()`, `PetscMallocDump()`, `PetscMallocView()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocTraceGet(PetscBool *logging) { PetscFunctionBegin; *logging = (PetscBool)(PetscLogMallocTrace >= 0); PetscFunctionReturn(PETSC_SUCCESS); } /*@C PetscMallocView - Saves the log of all calls to `PetscMalloc()`; also calls `PetscMemoryGetMaximumUsage()` Not Collective Input Parameter: . fp - file pointer; or `NULL` Options Database Key: . -malloc_view - Activates `PetscMallocView()` in `PetscFinalize()` Level: advanced Notes: `PetscMallocDump()` dumps only the currently unfreed memory, this dumps all memory ever allocated `PetscMemoryView()` gives a brief summary of current memory usage Fortran Notes: The calling sequence in Fortran is `PetscMallocView`(integer ierr) .seealso: `PetscMallocGetCurrentUsage()`, `PetscMallocDump()`, `PetscMallocViewSet()`, `PetscMemoryView()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocView(FILE *fp) { PetscInt n, *perm; size_t *shortlength; int *shortcount; PetscMPIInt rank; PetscBool match; const char **shortfunction; PetscLogDouble rss; PetscFunctionBegin; PetscCallMPI(MPI_Comm_rank(MPI_COMM_WORLD, &rank)); PetscCall(PetscFFlush(fp)); PetscCheck(PetscLogMalloc >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "PetscMallocView() called without call to PetscMallocViewSet() this is often due to setting the option -malloc_view AFTER PetscInitialize() with PetscOptionsInsert() or PetscOptionsInsertFile()"); if (!fp) fp = PETSC_STDOUT; PetscCall(PetscMemoryGetMaximumUsage(&rss)); if (rss) { (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f maximum size of entire process %.0f\n", rank, (PetscLogDouble)TRMaxMem, rss); } else { (void)fprintf(fp, "[%d] Maximum memory PetscMalloc()ed %.0f OS cannot compute size of entire process\n", rank, (PetscLogDouble)TRMaxMem); } if (PetscLogMalloc > 0) { shortcount = (int *)malloc(PetscLogMalloc * sizeof(int)); PetscCheck(shortcount, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory"); shortlength = (size_t *)malloc(PetscLogMalloc * sizeof(size_t)); PetscCheck(shortlength, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory"); shortfunction = (const char **)malloc(PetscLogMalloc * sizeof(char *)); PetscCheck(shortfunction, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory"); n = 0; for (PetscInt i = 0; i < PetscLogMalloc; i++) { for (PetscInt j = 0; j < n; j++) { PetscCall(PetscStrcmp(shortfunction[j], PetscLogMallocFunction[i], &match)); if (match) { shortlength[j] += PetscLogMallocLength[i]; shortcount[j]++; goto foundit; } } shortfunction[n] = PetscLogMallocFunction[i]; shortlength[n] = PetscLogMallocLength[i]; shortcount[n] = 1; n++; foundit:; } perm = (PetscInt *)malloc(n * sizeof(PetscInt)); PetscCheck(perm, PETSC_COMM_SELF, PETSC_ERR_MEM, "Out of memory"); for (PetscInt i = 0; i < n; i++) perm[i] = i; PetscCall(PetscSortStrWithPermutation(n, (const char **)shortfunction, perm)); (void)fprintf(fp, "[%d] Memory usage sorted by function\n", rank); for (PetscInt i = 0; i < n; i++) (void)fprintf(fp, "[%d] %d %.0f %s()\n", rank, shortcount[perm[i]], (PetscLogDouble)shortlength[perm[i]], shortfunction[perm[i]]); free(perm); free(shortlength); free(shortcount); free((char **)shortfunction); } PetscCall(PetscFFlush(fp)); PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocSetDebug - Set's PETSc memory debugging Not Collective Input Parameters: + eachcall - checks the entire heap of allocated memory for issues on each call to `PetscMalloc()` and `PetscFree()`, slow - initializenan - initializes all memory with `NaN` to catch use of uninitialized floating point arrays Options Database Keys: + -malloc_debug - turns on or off debugging . -malloc_test - turns on all debugging if PETSc was configured with debugging including `-malloc_dump`, otherwise ignored . -malloc_view_threshold t - log only allocations larger than t - -malloc_dump - print a list of all memory that has not been freed, in `PetscFinalize()` Level: developer Note: This is called in `PetscInitialize()` and should not be called elsewhere .seealso: `CHKMEMQ`, `PetscMallocValidate()`, `PetscMallocGetDebug()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocSetDebug(PetscBool eachcall, PetscBool initializenan) { PetscFunctionBegin; PetscCheck(PetscTrMalloc != PetscTrMallocDefault, PETSC_COMM_SELF, PETSC_ERR_ARG_WRONGSTATE, "Cannot call this routine more than once, it can only be called in PetscInitialize()"); PetscCall(PetscMallocSet(PetscTrMallocDefault, PetscTrFreeDefault, PetscTrReallocDefault)); TRallocated = 0; TRfrags = 0; TRhead = NULL; TRid = 0; TRdebug = eachcall; TRMaxMem = 0; PetscLogMallocMax = 10000; PetscLogMalloc = -1; TRdebugIinitializenan = initializenan; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocGetDebug - Indicates what PETSc memory debugging it is doing. Not Collective Output Parameters: + basic - doing basic debugging . eachcall - checks the entire memory heap at each `PetscMalloc()`/`PetscFree()` - initializenan - initializes memory with `NaN` Level: intermediate Note: By default, the debug configuration of PETSc always does some debugging unless you run with `-malloc_debug no` .seealso: `CHKMEMQ`, `PetscMallocValidate()`, `PetscMallocSetDebug()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocGetDebug(PetscBool *basic, PetscBool *eachcall, PetscBool *initializenan) { PetscFunctionBegin; if (basic) *basic = (PetscTrMalloc == PetscTrMallocDefault) ? PETSC_TRUE : PETSC_FALSE; if (eachcall) *eachcall = TRdebug; if (initializenan) *initializenan = TRdebugIinitializenan; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocLogRequestedSizeSet - Whether to log the requested or aligned memory size Not Collective Input Parameter: . flg - `PETSC_TRUE` to log the requested memory size Options Database Key: . -malloc_requested_size - Sets this flag Level: developer .seealso: `PetscMallocLogRequestedSizeGet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocLogRequestedSizeSet(PetscBool flg) { PetscFunctionBegin; TRrequestedSize = flg; PetscFunctionReturn(PETSC_SUCCESS); } /*@ PetscMallocLogRequestedSizeGet - Whether to log the requested or aligned memory size Not Collective Output Parameter: . flg - `PETSC_TRUE` if we log the requested memory size Level: developer .seealso: `PetscMallocLogRequestedSizeSet()`, `PetscMallocViewSet()`, `PetscMalloc()`, `PetscFree()` @*/ PetscErrorCode PetscMallocLogRequestedSizeGet(PetscBool *flg) { PetscFunctionBegin; *flg = TRrequestedSize; PetscFunctionReturn(PETSC_SUCCESS); }