xref: /petsc/include/petscerror.h (revision 2205254efee3a00a594e5e2a3a70f74dcb40bc03)
1 /*
2     Contains all error handling interfaces for PETSc.
3 */
4 #if !defined(__PETSCERROR_H)
5 #define __PETSCERROR_H
6 
7 #if defined(PETSC_HAVE_STRING_H)
8 #include <string.h> /* for strcmp */
9 #endif
10 
11 
12 /*
13    Defines the directory where the compiled source is located; used
14    in printing error messages. Each makefile has an entry
15    LOCDIR  =  thedirectory
16    and bmake/common_variables includes in CCPPFLAGS -D__SDIR__=${LOCDIR}
17    which is a flag passed to the C/C++ compilers. This declaration below
18    is only needed if some code is compiled without the -D__SDIR__
19 */
20 #if !defined(__INSDIR__)
21 #define __INSDIR__ "unknowndirectory/"
22 #endif
23 
24 /*
25    Defines the function where the compiled source is located; used
26    in printing error messages. This is defined here in case the user
27    does not declare it.
28 */
29 #if !defined(__FUNCT__)
30 #define __FUNCT__ "User provided function"
31 #endif
32 
33 /*
34      These are the generic error codes. These error codes are used
35      many different places in the PETSc source code. The string versions are
36      at src/sys/error/err.c any changes here must also be made there
37      These are also define in include/finclude/petscerror.h any CHANGES here
38      must be also made there.
39 
40 */
41 #define PETSC_ERR_MIN_VALUE        54   /* should always be one less then the smallest value */
42 
43 #define PETSC_ERR_MEM              55   /* unable to allocate requested memory */
44 #define PETSC_ERR_SUP              56   /* no support for requested operation */
45 #define PETSC_ERR_SUP_SYS          57   /* no support for requested operation on this computer system */
46 #define PETSC_ERR_ORDER            58   /* operation done in wrong order */
47 #define PETSC_ERR_SIG              59   /* signal received */
48 #define PETSC_ERR_FP               72   /* floating point exception */
49 #define PETSC_ERR_COR              74   /* corrupted PETSc object */
50 #define PETSC_ERR_LIB              76   /* error in library called by PETSc */
51 #define PETSC_ERR_PLIB             77   /* PETSc library generated inconsistent data */
52 #define PETSC_ERR_MEMC             78   /* memory corruption */
53 #define PETSC_ERR_CONV_FAILED      82   /* iterative method (KSP or SNES) failed */
54 #define PETSC_ERR_USER             83   /* user has not provided needed function */
55 #define PETSC_ERR_SYS              88   /* error in system call */
56 #define PETSC_ERR_POINTER          70   /* pointer does not point to valid address */
57 
58 #define PETSC_ERR_ARG_SIZ          60   /* nonconforming object sizes used in operation */
59 #define PETSC_ERR_ARG_IDN          61   /* two arguments not allowed to be the same */
60 #define PETSC_ERR_ARG_WRONG        62   /* wrong argument (but object probably ok) */
61 #define PETSC_ERR_ARG_CORRUPT      64   /* null or corrupted PETSc object as argument */
62 #define PETSC_ERR_ARG_OUTOFRANGE   63   /* input argument, out of range */
63 #define PETSC_ERR_ARG_BADPTR       68   /* invalid pointer argument */
64 #define PETSC_ERR_ARG_NOTSAMETYPE  69   /* two args must be same object type */
65 #define PETSC_ERR_ARG_NOTSAMECOMM  80   /* two args must be same communicators */
66 #define PETSC_ERR_ARG_WRONGSTATE   73   /* object in argument is in wrong state, e.g. unassembled mat */
67 #define PETSC_ERR_ARG_TYPENOTSET   89   /* the type of the object has not yet been set */
68 #define PETSC_ERR_ARG_INCOMP       75   /* two arguments are incompatible */
69 #define PETSC_ERR_ARG_NULL         85   /* argument is null that should not be */
70 #define PETSC_ERR_ARG_UNKNOWN_TYPE 86   /* type name doesn't match any registered type */
71 
72 #define PETSC_ERR_FILE_OPEN        65   /* unable to open file */
73 #define PETSC_ERR_FILE_READ        66   /* unable to read from file */
74 #define PETSC_ERR_FILE_WRITE       67   /* unable to write to file */
75 #define PETSC_ERR_FILE_UNEXPECTED  79   /* unexpected data in file */
76 
77 #define PETSC_ERR_MAT_LU_ZRPVT     71   /* detected a zero pivot during LU factorization */
78 #define PETSC_ERR_MAT_CH_ZRPVT     81   /* detected a zero pivot during Cholesky factorization */
79 
80 #define PETSC_ERR_INT_OVERFLOW     84   /* should always be one less then the smallest value */
81 
82 #define PETSC_ERR_FLOP_COUNT       90
83 #define PETSC_ERR_NOT_CONVERGED    91  /* solver did not converge */
84 #define PETSC_ERR_MAX_VALUE        92  /* this is always the one more than the largest error code */
85 
86 #define PetscStringizeArg(a) #a
87 #define PetscStringize(a) PetscStringizeArg(a)
88 #define __SDIR__ PetscStringize(__INSDIR__)
89 
90 #if defined(PETSC_USE_ERRORCHECKING)
91 
92 /*MC
93    SETERRQ - Macro that is called when an error has been detected,
94 
95    Synopsis:
96    #include "petscsys.h"
97    PetscErrorCode SETERRQ(MPI_Comm comm,PetscErrorCode errorcode,char *message)
98 
99    Not Collective
100 
101    Input Parameters:
102 +  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
103 -  message - error message
104 
105   Level: beginner
106 
107    Notes:
108     Once the error handler is called the calling function is then returned from with the given error code.
109 
110     See SETERRQ1(), SETERRQ2(), SETERRQ3() for versions that take arguments
111 
112     In Fortran MPI_Abort() is always called
113 
114     Experienced users can set the error handler with PetscPushErrorHandler().
115 
116    Concepts: error^setting condition
117 
118 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), SETERRQ3()
119 M*/
120 #define SETERRQ(comm,n,s)              return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s)
121 
122 /*MC
123    SETERRQ1 - Macro that is called when an error has been detected,
124 
125    Synopsis:
126    #include "petscsys.h"
127    PetscErrorCode SETERRQ1(MPI_Comm comm,PetscErrorCode errorcode,char *formatmessage,arg)
128 
129    Not Collective
130 
131    Input Parameters:
132 +  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
133 .  message - error message in the printf format
134 -  arg - argument (for example an integer, string or double)
135 
136   Level: beginner
137 
138    Notes:
139     Once the error handler is called the calling function is then returned from with the given error code.
140 
141    Experienced users can set the error handler with PetscPushErrorHandler().
142 
143    Concepts: error^setting condition
144 
145 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), CHKERRQ(), CHKMEMQ, SETERRQ(), SETERRQ2(), SETERRQ3()
146 M*/
147 #define SETERRQ1(comm,n,s,a1)          return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1)
148 
149 /*MC
150    SETERRQ2 - Macro that is called when an error has been detected,
151 
152    Synopsis:
153    #include "petscsys.h"
154    PetscErrorCode SETERRQ2(PetscErrorCode errorcode,char *formatmessage,arg1,arg2)
155 
156    Not Collective
157 
158    Input Parameters:
159 +  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
160 .  message - error message in the printf format
161 .  arg1 - argument (for example an integer, string or double)
162 -  arg2 - argument (for example an integer, string or double)
163 
164   Level: beginner
165 
166    Notes:
167     Once the error handler is called the calling function is then returned from with the given error code.
168 
169    Experienced users can set the error handler with PetscPushErrorHandler().
170 
171    Concepts: error^setting condition
172 
173 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ3()
174 M*/
175 #define SETERRQ2(comm,n,s,a1,a2)       return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2)
176 
177 /*MC
178    SETERRQ3 - Macro that is called when an error has been detected,
179 
180    Synopsis:
181    #include "petscsys.h"
182    PetscErrorCode SETERRQ3(PetscErrorCode errorcode,char *formatmessage,arg1,arg2,arg3)
183 
184    Not Collective
185 
186    Input Parameters:
187 +  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
188 .  message - error message in the printf format
189 .  arg1 - argument (for example an integer, string or double)
190 .  arg2 - argument (for example an integer, string or double)
191 -  arg3 - argument (for example an integer, string or double)
192 
193   Level: beginner
194 
195    Notes:
196     Once the error handler is called the calling function is then returned from with the given error code.
197 
198     There are also versions for 4, 5, 6 and 7 arguments.
199 
200    Experienced users can set the error handler with PetscPushErrorHandler().
201 
202    Concepts: error^setting condition
203 
204 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), CHKERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2()
205 M*/
206 #define SETERRQ3(comm,n,s,a1,a2,a3)    return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3)
207 
208 #define SETERRQ4(comm,n,s,a1,a2,a3,a4) return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3,a4)
209 #define SETERRQ5(comm,n,s,a1,a2,a3,a4,a5)       return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3,a4,a5)
210 #define SETERRQ6(comm,n,s,a1,a2,a3,a4,a5,a6)    return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3,a4,a5,a6)
211 #define SETERRQ7(comm,n,s,a1,a2,a3,a4,a5,a6,a7) return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3,a4,a5,a6,a7)
212 #define SETERRQ8(comm,n,s,a1,a2,a3,a4,a5,a6,a7,a8) return PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s,a1,a2,a3,a4,a5,a6,a7,a8)
213 #define SETERRABORT(comm,n,s)     do {PetscError(comm,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_INITIAL,s);MPI_Abort(comm,n);} while (0)
214 
215 /*MC
216    CHKERRQ - Checks error code, if non-zero it calls the error handler and then returns
217 
218    Synopsis:
219    #include "petscsys.h"
220    PetscErrorCode CHKERRQ(PetscErrorCode errorcode)
221 
222    Not Collective
223 
224    Input Parameters:
225 .  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
226 
227   Level: beginner
228 
229    Notes:
230     Once the error handler is called the calling function is then returned from with the given error code.
231 
232     Experienced users can set the error handler with PetscPushErrorHandler().
233 
234     CHKERRQ(n) is fundamentally a macro replacement for
235          if (n) return(PetscError(...,n,...));
236 
237     Although typical usage resembles "void CHKERRQ(PetscErrorCode)" as described above, for certain uses it is
238     highly inappropriate to use it in this manner as it invokes return(PetscErrorCode). In particular,
239     it cannot be used in functions which return(void) or any other datatype.  In these types of functions,
240     you can use CHKERRV() which returns without an error code (bad idea since the error is ignored or
241          if (n) {PetscError(....); return(YourReturnType);}
242     where you may pass back a PETSC_NULL to indicate an error. You can also call CHKERRABORT(comm,n) to have
243     MPI_Abort() returned immediately.
244 
245     In Fortran MPI_Abort() is always called
246 
247    Concepts: error^setting condition
248 
249 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), SETERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), SETERRQ2()
250 M*/
251 #define CHKERRQ(n)             do {if (PetscUnlikely(n)) return PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_REPEAT," ");} while (0)
252 
253 #define CHKERRV(n)             do {if (PetscUnlikely(n)) {n = PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_REPEAT," ");return;}} while(0)
254 #define CHKERRABORT(comm,n)    do {if (PetscUnlikely(n)) {PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_REPEAT," ");MPI_Abort(comm,n);}} while (0)
255 #define CHKERRCONTINUE(n)      do {if (PetscUnlikely(n)) {PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_REPEAT," ");}} while (0)
256 
257 #ifdef PETSC_CLANGUAGE_CXX
258 
259 /*MC
260    CHKERRXX - Checks error code, if non-zero it calls the C++ error handler which throws an exception
261 
262    Synopsis:
263    #include "petscsys.h"
264    void CHKERRXX(PetscErrorCode errorcode)
265 
266    Not Collective
267 
268    Input Parameters:
269 .  errorcode - nonzero error code, see the list of standard error codes in include/petscerror.h
270 
271   Level: beginner
272 
273    Notes:
274     Once the error handler throws a ??? exception.
275 
276     You can use CHKERRV() which returns without an error code (bad idea since the error is ignored)
277     or CHKERRABORT(comm,n) to have MPI_Abort() returned immediately.
278 
279    Concepts: error^setting condition
280 
281 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), SETERRQ(), CHKERRQ(), CHKMEMQ
282 M*/
283 #define CHKERRXX(n)            do {if (PetscUnlikely(n)) {PetscError(PETSC_COMM_SELF,__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__,n,PETSC_ERROR_IN_CXX,0);}} while(0)
284 
285 #endif
286 
287 /*MC
288    CHKMEMQ - Checks the memory for corruption, calls error handler if any is detected
289 
290    Synopsis:
291    #include "petscsys.h"
292    CHKMEMQ;
293 
294    Not Collective
295 
296   Level: beginner
297 
298    Notes:
299     Must run with the option -malloc_debug to enable this option
300 
301     Once the error handler is called the calling function is then returned from with the given error code.
302 
303     By defaults prints location where memory that is corrupted was allocated.
304 
305     Use CHKMEMA for functions that return void
306 
307    Concepts: memory corruption
308 
309 .seealso: PetscTraceBackErrorHandler(), PetscPushErrorHandler(), PetscError(), SETERRQ(), CHKMEMQ, SETERRQ1(), SETERRQ2(), SETERRQ3(),
310           PetscMallocValidate()
311 M*/
312 #define CHKMEMQ do {PetscErrorCode _7_ierr = PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__);CHKERRQ(_7_ierr);} while(0)
313 
314 #define CHKMEMA PetscMallocValidate(__LINE__,PETSC_FUNCTION_NAME,__FILE__,__SDIR__)
315 
316 #else /* PETSC_USE_ERRORCHECKING */
317 
318 /*
319     These are defined to be empty for when error checking is turned off, with ./configure --with-errorchecking=0
320 */
321 
322 #define SETERRQ(c,n,s)
323 #define SETERRQ1(c,n,s,a1)
324 #define SETERRQ2(c,n,s,a1,a2)
325 #define SETERRQ3(c,n,s,a1,a2,a3)
326 #define SETERRQ4(c,n,s,a1,a2,a3,a4)
327 #define SETERRQ5(c,n,s,a1,a2,a3,a4,a5)
328 #define SETERRQ6(c,n,s,a1,a2,a3,a4,a5,a6)
329 #define SETERRQ7(c,n,s,a1,a2,a3,a4,a5,a6,a7)
330 #define SETERRQ8(c,n,s,a1,a2,a3,a4,a5,a6,a7,a8)
331 #define SETERRABORT(comm,n,s)
332 
333 #define CHKERRQ(n)     ;
334 #define CHKERRABORT(comm,n) ;
335 #define CHKERRCONTINUE(n) ;
336 #define CHKMEMQ        ;
337 
338 #ifdef PETSC_CLANGUAGE_CXX
339 #define CHKERRXX(n) ;
340 #endif
341 
342 #endif /* PETSC_USE_ERRORCHECKING */
343 
344 /*E
345   PetscErrorType - passed to the PETSc error handling routines indicating if this is the first or a later call to the error handlers
346 
347   Level: advanced
348 
349   PETSC_ERROR_IN_CXX indicates the error was detected in C++ and an exception should be generated
350 
351   Developer Notes: This is currently used to decide when to print the detailed information about the run in PetscTraceBackErrorHandling()
352 
353 .seealso: PetscError(), SETERRXX()
354 E*/
355 typedef enum {PETSC_ERROR_INITIAL=0,PETSC_ERROR_REPEAT=1,PETSC_ERROR_IN_CXX = 2} PetscErrorType;
356 
357 PETSC_EXTERN PetscErrorCode PetscErrorPrintfInitialize(void);
358 PETSC_EXTERN PetscErrorCode PetscErrorMessage(int,const char*[],char **);
359 PETSC_EXTERN PetscErrorCode PetscTraceBackErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
360 PETSC_EXTERN PetscErrorCode PetscIgnoreErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
361 PETSC_EXTERN PetscErrorCode PetscEmacsClientErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
362 PETSC_EXTERN PetscErrorCode PetscMPIAbortErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
363 PETSC_EXTERN PetscErrorCode PetscAbortErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
364 PETSC_EXTERN PetscErrorCode PetscAttachDebuggerErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
365 PETSC_EXTERN PetscErrorCode PetscReturnErrorHandler(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*);
366 PETSC_EXTERN PetscErrorCode PetscError(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,...);
367 PETSC_EXTERN PetscErrorCode PetscPushErrorHandler(PetscErrorCode (*handler)(MPI_Comm,int,const char*,const char*,const char*,PetscErrorCode,PetscErrorType,const char*,void*),void*);
368 PETSC_EXTERN PetscErrorCode PetscPopErrorHandler(void);
369 PETSC_EXTERN PetscErrorCode PetscDefaultSignalHandler(int,void*);
370 PETSC_EXTERN PetscErrorCode PetscPushSignalHandler(PetscErrorCode (*)(int,void *),void*);
371 PETSC_EXTERN PetscErrorCode PetscPopSignalHandler(void);
372 
373 
374 /*MC
375     PetscErrorPrintf - Prints error messages.
376 
377    Synopsis:
378     #include "petscsys.h"
379      PetscErrorCode (*PetscErrorPrintf)(const char format[],...);
380 
381     Not Collective
382 
383     Input Parameters:
384 .   format - the usual printf() format string
385 
386    Options Database Keys:
387 +    -error_output_stdout - cause error messages to be printed to stdout instead of the
388          (default) stderr
389 -    -error_output_none to turn off all printing of error messages (does not change the way the
390           error is handled.)
391 
392    Notes: Use
393 $     PetscErrorPrintf = PetscErrorPrintfNone; to turn off all printing of error messages (does not change the way the
394 $                        error is handled.) and
395 $     PetscErrorPrintf = PetscErrorPrintfDefault; to turn it back on
396 $        of you can use your own function
397 
398           Use
399      PETSC_STDERR = FILE* obtained from a file open etc. to have stderr printed to the file.
400      PETSC_STDOUT = FILE* obtained from a file open etc. to have stdout printed to the file.
401 
402           Use
403       PetscPushErrorHandler() to provide your own error handler that determines what kind of messages to print
404 
405    Level: developer
406 
407     Fortran Note:
408     This routine is not supported in Fortran.
409 
410     Concepts: error messages^printing
411     Concepts: printing^error messages
412 
413 .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscHelpPrintf(), PetscPrintf(), PetscErrorHandlerPush(), PetscVFPrintf(), PetscHelpPrintf()
414 M*/
415 PETSC_EXTERN PetscErrorCode (*PetscErrorPrintf)(const char[],...);
416 
417 typedef enum {PETSC_FP_TRAP_OFF=0,PETSC_FP_TRAP_ON=1} PetscFPTrap;
418 PETSC_EXTERN PetscErrorCode PetscSetFPTrap(PetscFPTrap);
419 PETSC_EXTERN PetscErrorCode PetscFPTrapPush(PetscFPTrap);
420 PETSC_EXTERN PetscErrorCode PetscFPTrapPop(void);
421 
422 /*  Linux functions CPU_SET and others don't work if sched.h is not included before
423     including pthread.h. Also, these functions are active only if either _GNU_SOURCE
424     or __USE_GNU is not set (see /usr/include/sched.h and /usr/include/features.h), hence
425     set these first.
426 */
427 #if defined(PETSC_HAVE_PTHREADCLASSES)
428 #if defined(PETSC_HAVE_SCHED_H)
429 #ifndef _GNU_SOURCE
430 #define _GNU_SOURCE
431 #endif
432 #include <sched.h>
433 #endif
434 #include <pthread.h>
435 #endif
436 
437 #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL)
438 /* Get the value associated with key */
439 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(pthread_key_t key)
440 {
441   return pthread_getspecific(key);
442 }
443 
444 /* Set the value for key */
445 PETSC_STATIC_INLINE void PetscThreadLocalSetValue(pthread_key_t key,void* value)
446 {
447   pthread_setspecific(key,(void*)value);
448 }
449 
450 /* Create pthread thread local key */
451 PETSC_STATIC_INLINE void PetscThreadLocalRegister(pthread_key_t *key)
452 {
453   pthread_key_create(key,PETSC_NULL);
454 }
455 
456 /* Delete pthread thread local key */
457 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(pthread_key_t key)
458 {
459   pthread_key_delete(key);
460 }
461 #else
462 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(void* key)
463 {
464   return key;
465 }
466 
467 #define PetscThreadLocalSetValue(key,value) (key = value)
468 
469 PETSC_STATIC_INLINE void PetscThreadLocalRegister(PETSC_UNUSED void *key)
470 {
471 }
472 
473 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(PETSC_UNUSED void *key)
474 {
475 }
476 #endif
477 
478 /*
479       Allows the code to build a stack frame as it runs
480 */
481 #if defined(PETSC_USE_DEBUG)
482 
483 #define PETSCSTACKSIZE 64
484 
485 typedef struct  {
486   const char      *function[PETSCSTACKSIZE];
487   const char      *file[PETSCSTACKSIZE];
488   const char      *directory[PETSCSTACKSIZE];
489         int       line[PETSCSTACKSIZE];
490         PetscBool petscroutine[PETSCSTACKSIZE];
491         int       currentsize;
492 } PetscStack;
493 
494 #if defined(PETSC_HAVE_PTHREADCLASSES)
495 #if defined(PETSC_PTHREAD_LOCAL)
496 PETSC_EXTERN PETSC_PTHREAD_LOCAL PetscStack *petscstack;
497 #else
498 PETSC_EXTERN pthread_key_t petscstack;
499 #endif
500 #elif defined(PETSC_HAVE_OPENMP)
501 PETSC_EXTERN PetscStack *petscstack;
502 #pragma omp threadprivate(petscstack)
503 #else
504 PETSC_EXTERN PetscStack *petscstack;
505 #endif
506 
507 PETSC_EXTERN PetscErrorCode PetscStackCopy(PetscStack*,PetscStack*);
508 PETSC_EXTERN PetscErrorCode PetscStackPrint(PetscStack*,FILE* fp);
509 
510 #define PetscStackActive (((PetscStack*)PetscThreadLocalGetValue(petscstack)) != 0)
511 
512 /*MC
513    PetscFunctionBegin - First executable line of each PETSc function
514         used for error handling.
515 
516    Synopsis:
517    #include "petscsys.h"
518    void PetscFunctionBegin;
519 
520    Not Collective
521 
522    Usage:
523 .vb
524      int something;
525 
526      PetscFunctionBegin;
527 .ve
528 
529    Notes:
530      Not available in Fortran
531 
532    Level: developer
533 
534 .seealso: PetscFunctionReturn()
535 
536 .keywords: traceback, error handling
537 M*/
538 #define PetscFunctionBegin \
539   do {                                                                        \
540     PetscStack* petscstackp;                                                  \
541     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
542     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
543       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
544       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
545       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
546       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
547       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_TRUE;       \
548       petscstackp->currentsize++;                                             \
549     }                                                                         \
550     PetscCheck__FUNCT__();                                                    \
551     PetscRegister__FUNCT__();                                                 \
552   } while (0)
553 
554 /*MC
555    PetscFunctionBeginUser - First executable line of user provided PETSc routine
556 
557    Synopsis:
558    #include "petscsys.h"
559    void PetscFunctionBeginUser;
560 
561    Not Collective
562 
563    Usage:
564 .vb
565      int something;
566 
567      PetscFunctionBegin;
568 .ve
569 
570    Notes:
571      Not available in Fortran
572 
573    Level: developer
574 
575 .seealso: PetscFunctionReturn()
576 
577 .keywords: traceback, error handling
578 M*/
579 #define PetscFunctionBeginUser \
580   do {                                                                        \
581     PetscStack* petscstackp;                                                  \
582     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
583     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
584       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
585       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
586       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
587       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
588       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_FALSE;      \
589       petscstackp->currentsize++;                                             \
590     }                                                                         \
591     PetscCheck__FUNCT__();                                                    \
592     PetscRegister__FUNCT__();                                                 \
593   } while (0)
594 
595 
596 #if defined(PETSC_SERIALIZE_FUNCTIONS)
597 #include <petsc-private/petscfptimpl.h>
598 /*
599    Registers the current function into the global function pointer to function name table
600 
601    Have to fix this to handle errors but cannot return error since used in PETSC_VIEWER_DRAW_() etc
602 */
603 #define PetscRegister__FUNCT__() do { \
604   static PetscBool __chked = PETSC_FALSE; \
605   if (!__chked) {\
606   void *ptr; PetscDLSym(PETSC_NULL,__FUNCT__,&ptr);\
607   __chked = PETSC_TRUE;\
608   }} while (0)
609 #else
610 #define PetscRegister__FUNCT__()
611 #endif
612 
613 #define PetscCheck__FUNCT__() do { \
614     if (strcmp(PETSC_FUNCTION_NAME,__FUNCT__) && strcmp(__FUNCT__,"User provided function")) { \
615       (*PetscErrorPrintf)("%s%s:%d: __FUNCT__=\"%s\" does not agree with %s=\"%s\"\n",__SDIR__,__FILE__,__LINE__,__FUNCT__,PetscStringize(PETSC_FUNCTION_NAME),PETSC_FUNCTION_NAME); \
616     }                                                                   \
617   } while (0)
618 
619 #define PetscStackPush(n) \
620   do {                                                                  \
621     PetscStack * petscstackp;                                           \
622     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
623     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {   \
624       petscstackp->function[petscstackp->currentsize]  = n;             \
625       petscstackp->file[petscstackp->currentsize]      = "unknown";     \
626       petscstackp->directory[petscstackp->currentsize] = "unknown";     \
627       petscstackp->line[petscstackp->currentsize]      = 0;             \
628       petscstackp->currentsize++;                                       \
629     } CHKMEMQ;} while (0)
630 
631 #define PetscStackPop \
632   do {PetscStack* petscstackp;CHKMEMQ;                                  \
633     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
634     if (petscstackp && petscstackp->currentsize > 0) {                  \
635       petscstackp->currentsize--;                                       \
636       petscstackp->function[petscstackp->currentsize]  = 0;             \
637       petscstackp->file[petscstackp->currentsize]      = 0;             \
638       petscstackp->directory[petscstackp->currentsize] = 0;             \
639       petscstackp->line[petscstackp->currentsize]      = 0;             \
640     }} while (0)
641 
642 /*MC
643    PetscFunctionReturn - Last executable line of each PETSc function
644         used for error handling. Replaces return()
645 
646    Synopsis:
647    #include "petscsys.h"
648    void PetscFunctionReturn(0);
649 
650    Not Collective
651 
652    Usage:
653 .vb
654     ....
655      PetscFunctionReturn(0);
656    }
657 .ve
658 
659    Notes:
660      Not available in Fortran
661 
662    Level: developer
663 
664 .seealso: PetscFunctionBegin()
665 
666 .keywords: traceback, error handling
667 M*/
668 #define PetscFunctionReturn(a) \
669   do {                                                                \
670     PetscStack* petscstackp;                                          \
671     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
672     if (petscstackp && petscstackp->currentsize > 0) {                \
673       petscstackp->currentsize--;                                     \
674       petscstackp->function[petscstackp->currentsize]  = 0;           \
675       petscstackp->file[petscstackp->currentsize]      = 0;           \
676       petscstackp->directory[petscstackp->currentsize] = 0;           \
677       petscstackp->line[petscstackp->currentsize]      = 0;           \
678     }                                                                 \
679     return(a);} while (0)
680 
681 #define PetscFunctionReturnVoid() \
682   do {                                                                \
683     PetscStack* petscstackp;                                          \
684     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
685     if (petscstackp && petscstackp->currentsize > 0) {                \
686       petscstackp->currentsize--;                                     \
687       petscstackp->function[petscstackp->currentsize]  = 0;           \
688       petscstackp->file[petscstackp->currentsize]      = 0;           \
689       petscstackp->directory[petscstackp->currentsize] = 0;           \
690       petscstackp->line[petscstackp->currentsize]      = 0;           \
691     }                                                                 \
692     return;} while (0)
693 #else
694 
695 #define PetscFunctionBegin
696 #define PetscFunctionBeginUser
697 #define PetscFunctionReturn(a)  return(a)
698 #define PetscFunctionReturnVoid() return
699 #define PetscStackPop     CHKMEMQ
700 #define PetscStackPush(f) CHKMEMQ
701 #define PetscStackActive        0
702 
703 #endif
704 
705 /*
706     PetscStackCall - Calls an external library routine or user function after pushing the name of the routine on the stack.
707 
708    Input Parameters:
709 +   name - string that gives the name of the function being called
710 -   routine - actual call to the routine, including ierr = and CHKERRQ(ierr);
711 
712    Note: Often one should use PetscStackCallStandard() instead
713 
714    Developer Note: this is so that when a user or external library routine results in a crash or corrupts memory, they get blamed instead of PETSc.
715 
716 
717 
718 */
719 #define PetscStackCall(name,routine) do { PetscStackPush(name);routine;PetscStackPop; } while(0)
720 
721 /*
722     PetscStackCallStandard - Calls an external library routine after pushing the name of the routine on the stack.
723 
724    Input Parameters:
725 +   func-  name of the routine
726 -   args - arguments to the routine surrounded by ()
727 
728    Developer Note: this is so that when a hypre routine results in a crash or corrupts memory, they get blamed instead of PETSc.
729 
730 */
731 #define PetscStackCallStandard(func,args) do {                        \
732     PetscStackPush(#func);ierr = func args;PetscStackPop; if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in %s()",#func); \
733   } while (0)
734 
735 PETSC_EXTERN PetscErrorCode PetscStackCreate(void);
736 PETSC_EXTERN PetscErrorCode PetscStackView(FILE*);
737 PETSC_EXTERN PetscErrorCode PetscStackDestroy(void);
738 PETSC_EXTERN PetscErrorCode PetscStackPublish(void);
739 PETSC_EXTERN PetscErrorCode PetscStackDepublish(void);
740 
741 #endif
742