1: #include <petsc/private/petscimpl.h>

  3: #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
  4: PetscStack petscstack;
  5: #endif

  7: #if defined(PETSC_HAVE_SAWS)
  8: #include <petscviewersaws.h>

 10: static PetscBool amsmemstack = PETSC_FALSE;

 12: /*@
 13:   PetscStackSAWsGrantAccess - Grants access of the PETSc stack frames to the SAWs publisher

 15:   Collective on `PETSC_COMM_WORLD`?

 17:   Level: developer

 19:   Developer Notes:
 20:   Cannot use `PetscFunctionBegin`/`PetscFunctionReturn()` or `PetscCallSAWs()` since it may be
 21:   used within those routines

 23: .seealso: `PetscObjectSetName()`, `PetscObjectSAWsViewOff()`, `PetscObjectSAWsTakeAccess()`
 24: @*/
 25: void PetscStackSAWsGrantAccess(void)
 26: {
 27:   if (amsmemstack) {
 28:     /* ignore any errors from SAWs */
 29:     (void)SAWs_Unlock();
 30:   }
 31: }

 33: /*@
 34:   PetscStackSAWsTakeAccess - Takes access of the PETSc stack frames from the SAWs publisher

 36:   Collective on `PETSC_COMM_WORLD`?

 38:   Level: developer

 40:   Developer Notes:
 41:   Cannot use `PetscFunctionBegin`/`PetscFunctionReturn()` or `PetscCallSAWs()` since it may be
 42:   used within those routines

 44: .seealso: `PetscObjectSetName()`, `PetscObjectSAWsViewOff()`, `PetscObjectSAWsGrantAccess()`
 45: @*/
 46: void PetscStackSAWsTakeAccess(void)
 47: {
 48:   if (amsmemstack) {
 49:     /* ignore any errors from SAWs */
 50:     (void)SAWs_Lock();
 51:   }
 52: }

 54: /*@C
 55:   PetscStackViewSAWs - Publish PETSc's current debug call stack through the SAWs (Scientific Application Web server) so it can be inspected from a remote browser

 57:   Logically Collective on `PETSC_COMM_WORLD`; No Fortran Support

 59:   Level: developer

 61:   Note:
 62:   Only MPI rank 0 publishes; other MPI processes immediately return success. In non-debug builds the stack contents are not published but the call still succeeds.

 64: .seealso: `PetscStackView()`, `PetscStackSAWsViewOff()`, `PetscObjectSAWsViewOff()`
 65: @*/
 66: PetscErrorCode PetscStackViewSAWs(void)
 67: {
 68:   PetscMPIInt rank;

 70:   PetscCallMPI(MPI_Comm_rank(PETSC_COMM_WORLD, &rank));
 71:   if (rank) return PETSC_SUCCESS;
 72:   #if PetscDefined(USE_DEBUG)
 73:   PetscCallSAWs(SAWs_Register, ("/PETSc/Stack/functions", petscstack.function, 20, SAWs_READ, SAWs_STRING));
 74:   PetscCallSAWs(SAWs_Register, ("/PETSc/Stack/__current_size", &petscstack.currentsize, 1, SAWs_READ, SAWs_INT));
 75:   #endif
 76:   amsmemstack = PETSC_TRUE;
 77:   return PETSC_SUCCESS;
 78: }

 80: /*@C
 81:   PetscStackSAWsViewOff - Stop publishing the PETSc debug call stack through SAWs (Scientific Application Web server)

 83:   Logically Collective

 85:   Level: developer

 87:   Note:
 88:   No-op when `PetscStackViewSAWs()` was never called. Compiled to a no-op when PETSc is not configured `--with-saws`.

 90: .seealso: `PetscStackViewSAWs()`, `PetscStackView()`, `PetscObjectSAWsViewOff()`
 91: @*/
 92: PetscErrorCode PetscStackSAWsViewOff(void)
 93: {
 94:   PetscFunctionBegin;
 95:   if (!amsmemstack) PetscFunctionReturn(PETSC_SUCCESS);
 96:   PetscCallSAWs(SAWs_Delete, ("/PETSc/Stack"));
 97:   amsmemstack = PETSC_FALSE;
 98:   PetscFunctionReturn(PETSC_SUCCESS);
 99: }
100: #endif /* PETSC_HAVE_SAWS */

102: #if PetscDefined(USE_DEBUG) && !PetscDefined(HAVE_THREADSAFETY)
103: PetscErrorCode PetscStackSetCheck(PetscBool check)
104: {
105:   petscstack.check = check;
106:   return PETSC_SUCCESS;
107: }

109: PetscErrorCode PetscStackReset(void)
110: {
111:   memset(&petscstack, 0, sizeof(petscstack));
112:   return PETSC_SUCCESS;
113: }

115: // PetscClangLinter pragma disable: -fdoc-sowing-chars
116: /*@
117:   PetscStackView - Print the current (default) PETSc stack to an ASCII file

119:   Not Collective, No Fortran Support

121:   Input Parameter:
122: . file - the file pointer, or `NULL` to use `PETSC_STDERR`

124:   Level: developer

126:   Notes:
127:   In debug mode PETSc maintains a stack of the current function calls that can be used to help
128:   to quickly see where a problem has occurred, for example, when a signal is received. It is
129:   recommended to use the debugger if extensive information is needed to help debug the problem.

131:   If `file` is `PETSC_STDERR` (or `NULL`) then `PetscErrorPrintf()` is used to print the stack, otherwise `fprintf()` is used.

133:   The stack is maintained only when PETSc is configured `--with-debugging` and without thread safety; in other configurations this becomes a no-op that returns `PETSC_SUCCESS`.

135:   Developer Note:
136:   The default stack is a global variable called `petscstack`.

138: .seealso: `PetscAttachDebugger()`, `PetscStackCopy()`, `PetscStackPrint()`, `PetscStackSAWsGrantAccess()`, `PetscStackSAWsTakeAccess()`
139: @*/
140: PetscErrorCode PetscStackView(FILE *file)
141: {
142:   if (!file) file = PETSC_STDERR;
143:   if (petscstack.currentsize < 0) {
144:     /* < 0 is absolutely a corrupted stack, but this function is usually called in an error
145:      * handler, which are not capable of recovering from errors so best we can do is print
146:      * this warning */
147:     fprintf(file, "PetscStack is definitely corrupted with stack size %d\n", petscstack.currentsize);
148:   } else if (petscstack.currentsize == 0) {
149:     if (file == PETSC_STDERR) {
150:       PetscCall((*PetscErrorPrintf)("No error traceback is available, the problem could be in the main program. \n"));
151:     } else {
152:       fprintf(file, "No error traceback is available, the problem could be in the main program. \n");
153:     }
154:   } else {
155:     char *ptr = NULL;

157:     if (file == PETSC_STDERR) {
158:       PetscCall((*PetscErrorPrintf)("The line numbers in the error traceback may not be exact.\n"));
159:       for (int i = petscstack.currentsize - 1, j = 1; i >= 0; --i, ++j) {
160:         if (petscstack.file[i]) PetscCall((*PetscErrorPrintf)("#%d %s() at %s:%d\n", j, petscstack.function[i], PetscCIFilename(petscstack.file[i]), PetscCILinenumber(petscstack.line[i])));
161:         else {
162:           PetscCall(PetscStrstr(petscstack.function[i], " ", &ptr));
163:           if (!ptr) PetscCall((*PetscErrorPrintf)("#%d %s()\n", j, petscstack.function[i]));
164:           else PetscCall((*PetscErrorPrintf)("#%d %s\n", j, petscstack.function[i]));
165:         }
166:       }
167:     } else {
168:       fprintf(file, "The line numbers in the error traceback are not always exact.\n");
169:       for (int i = petscstack.currentsize - 1, j = 1; i >= 0; --i, ++j) {
170:         if (petscstack.file[i]) fprintf(file, "[%d] #%d %s() at %s:%d\n", PetscGlobalRank, j, petscstack.function[i], PetscCIFilename(petscstack.file[i]), PetscCILinenumber(petscstack.line[i]));
171:         else {
172:           PetscCall(PetscStrstr(petscstack.function[i], " ", &ptr));
173:           if (!ptr) fprintf(file, "[%d] #%d %s()\n", PetscGlobalRank, j, petscstack.function[i]);
174:           else fprintf(file, "[%d] #%d %s\n", PetscGlobalRank, j, petscstack.function[i]);
175:         }
176:       }
177:     }
178:   }
179:   return PETSC_SUCCESS;
180: }

182: /*@
183:   PetscStackCopy - Copy the information from one PETSc stack to another

185:   Not Collective

187:   Input Parameter:
188: . sint - the stack to be copied from

190:   Output Parameter:
191: . sout - the stack to be copied to, this stack must already exist

193:   Level: developer

195:   Note:
196:   In debug mode PETSc maintains a stack of the current function calls that can be used to help
197:   to quickly see where a problem has occurred, for example, when a signal is received. It is
198:   recommended to use the debugger if extensive information is needed to help debug the problem.

200: .seealso: `PetscAttachDebugger()`, `PetscStackView()`
201: @*/
202: PetscErrorCode PetscStackCopy(PetscStack *sint, PetscStack *sout)
203: {
204:   if (sint) {
205:     for (int i = 0; i < sint->currentsize; ++i) {
206:       sout->function[i]     = sint->function[i];
207:       sout->file[i]         = sint->file[i];
208:       sout->line[i]         = sint->line[i];
209:       sout->petscroutine[i] = sint->petscroutine[i];
210:     }
211:     sout->currentsize = sint->currentsize;
212:   } else {
213:     sout->currentsize = 0;
214:   }
215:   return PETSC_SUCCESS;
216: }

218: // PetscClangLinter pragma disable: -fdoc-sowing-chars
219: /*@
220:   PetscStackPrint - Prints a given PETSc stack to an ASCII file

222:   Not Collective

224:   Input Parameters:
225: + sint - the PETSc stack to print
226: - fp   - the file pointer

228:   Level: developer

230:   Notes:
231:   In debug mode PETSc maintains a stack of the current function calls that can be used to help
232:   to quickly see where a problem has occurred, for example, when a signal is received. It is
233:   recommended to use the debugger if extensive information is needed to help debug the problem.

235:   The default stack is a global variable called `petscstack`.

237:   Developer Note:
238:   `PetscStackPrint()` and `PetscStackView()` should be merged into a single API.

240: .seealso: `PetscAttachDebugger()`, `PetscStackCopy()`, `PetscStackView()`
241: @*/
242: PetscErrorCode PetscStackPrint(PetscStack *sint, FILE *fp)
243: {
244:   if (sint) {
245:     for (int i = sint->currentsize; i >= 0; --i) {
246:       if (sint->file[i]) fprintf(fp, "      [%d]  %s() at %s:%d\n", PetscGlobalRank, sint->function[i], PetscCIFilename(sint->file[i]), PetscCILinenumber(sint->line[i]));
247:       else fprintf(fp, "      [%d]  %s()\n", PetscGlobalRank, sint->function[i]);
248:     }
249:   }
250:   return PETSC_SUCCESS;
251: }
252: #endif /* PetscDefined(USE_DEBUG) */