xref: /petsc/include/petscerror.h (revision dbf62e16cdc1d232b534ec244cc0f4d44d5069e2)
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 /*
438      This code is for managing thread local global variables. Each of Linux, Microsoft WINDOWS, OpenMP, and Apple OS X have
439    different ways to indicate this. On OS X each thread local global is accessed by using a pthread_key_t for that variable.
440    Thus we have functions for creating destroying and using the keys. Except for OS X these access functions merely directly
441    acess the thread local variable.
442 */
443 
444 #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL)
445 /* Get the value associated with key */
446 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(pthread_key_t key)
447 {
448   return pthread_getspecific(key);
449 }
450 
451 /* Set the value for key */
452 PETSC_STATIC_INLINE void PetscThreadLocalSetValue(pthread_key_t *key,void* value)
453 {
454   pthread_setspecific(*key,(void*)value);
455 }
456 
457 /* Create pthread thread local key */
458 PETSC_STATIC_INLINE void PetscThreadLocalRegister(pthread_key_t *key)
459 {
460   pthread_key_create(key,PETSC_NULL);
461 }
462 
463 /* Delete pthread thread local key */
464 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(pthread_key_t key)
465 {
466   pthread_key_delete(key);
467 }
468 #else
469 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(void* key)
470 {
471   return key;
472 }
473 
474 PETSC_STATIC_INLINE void PetscThreadLocalSetValue(void **key,void* value)
475 {
476   *key = value;
477 }
478 
479 PETSC_STATIC_INLINE void PetscThreadLocalRegister(PETSC_UNUSED void *key)
480 {
481 }
482 
483 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(PETSC_UNUSED void *key)
484 {
485 }
486 #endif
487 
488 /*
489       Allows the code to build a stack frame as it runs
490 */
491 #if defined(PETSC_USE_DEBUG)
492 
493 #define PETSCSTACKSIZE 64
494 
495 typedef struct  {
496   const char      *function[PETSCSTACKSIZE];
497   const char      *file[PETSCSTACKSIZE];
498   const char      *directory[PETSCSTACKSIZE];
499         int       line[PETSCSTACKSIZE];
500         PetscBool petscroutine[PETSCSTACKSIZE];
501         int       currentsize;
502 } PetscStack;
503 
504 #if defined(PETSC_HAVE_PTHREADCLASSES)
505 #if defined(PETSC_PTHREAD_LOCAL)
506 PETSC_EXTERN PETSC_PTHREAD_LOCAL PetscStack *petscstack;
507 #else
508 PETSC_EXTERN pthread_key_t petscstack;
509 #endif
510 #elif defined(PETSC_HAVE_OPENMP)
511 PETSC_EXTERN PetscStack *petscstack;
512 #pragma omp threadprivate(petscstack)
513 #else
514 PETSC_EXTERN PetscStack *petscstack;
515 #endif
516 
517 PETSC_EXTERN PetscErrorCode PetscStackCopy(PetscStack*,PetscStack*);
518 PETSC_EXTERN PetscErrorCode PetscStackPrint(PetscStack*,FILE* fp);
519 
520 PETSC_STATIC_INLINE PetscBool PetscStackActive(void)
521 {
522   return(PetscThreadLocalGetValue(petscstack) ? PETSC_TRUE : PETSC_FALSE);
523 }
524 
525 /*MC
526    PetscFunctionBegin - First executable line of each PETSc function
527         used for error handling.
528 
529    Synopsis:
530    #include "petscsys.h"
531    void PetscFunctionBegin;
532 
533    Not Collective
534 
535    Usage:
536 .vb
537      int something;
538 
539      PetscFunctionBegin;
540 .ve
541 
542    Notes:
543      Not available in Fortran
544 
545    Level: developer
546 
547 .seealso: PetscFunctionReturn()
548 
549 .keywords: traceback, error handling
550 M*/
551 #define PetscFunctionBegin \
552   do {                                                                        \
553     PetscStack* petscstackp;                                                  \
554     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
555     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
556       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
557       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
558       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
559       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
560       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_TRUE;       \
561       petscstackp->currentsize++;                                             \
562     }                                                                         \
563     PetscCheck__FUNCT__();                                                    \
564     PetscRegister__FUNCT__();                                                 \
565   } while (0)
566 
567 /*MC
568    PetscFunctionBeginUser - First executable line of user provided PETSc routine
569 
570    Synopsis:
571    #include "petscsys.h"
572    void PetscFunctionBeginUser;
573 
574    Not Collective
575 
576    Usage:
577 .vb
578      int something;
579 
580      PetscFunctionBegin;
581 .ve
582 
583    Notes:
584      Not available in Fortran
585 
586    Level: developer
587 
588 .seealso: PetscFunctionReturn()
589 
590 .keywords: traceback, error handling
591 M*/
592 #define PetscFunctionBeginUser \
593   do {                                                                        \
594     PetscStack* petscstackp;                                                  \
595     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
596     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
597       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
598       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
599       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
600       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
601       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_FALSE;      \
602       petscstackp->currentsize++;                                             \
603     }                                                                         \
604     PetscCheck__FUNCT__();                                                    \
605     PetscRegister__FUNCT__();                                                 \
606   } while (0)
607 
608 
609 #if defined(PETSC_SERIALIZE_FUNCTIONS)
610 #include <petsc-private/petscfptimpl.h>
611 /*
612    Registers the current function into the global function pointer to function name table
613 
614    Have to fix this to handle errors but cannot return error since used in PETSC_VIEWER_DRAW_() etc
615 */
616 #define PetscRegister__FUNCT__() do { \
617   static PetscBool __chked = PETSC_FALSE; \
618   if (!__chked) {\
619   void *ptr; PetscDLSym(PETSC_NULL,__FUNCT__,&ptr);\
620   __chked = PETSC_TRUE;\
621   }} while (0)
622 #else
623 #define PetscRegister__FUNCT__()
624 #endif
625 
626 #define PetscCheck__FUNCT__() do { \
627     if (strcmp(PETSC_FUNCTION_NAME,__FUNCT__) && strcmp(__FUNCT__,"User provided function")) { \
628       (*PetscErrorPrintf)("%s%s:%d: __FUNCT__=\"%s\" does not agree with %s=\"%s\"\n",__SDIR__,__FILE__,__LINE__,__FUNCT__,PetscStringize(PETSC_FUNCTION_NAME),PETSC_FUNCTION_NAME); \
629     }                                                                   \
630   } while (0)
631 
632 #define PetscStackPush(n) \
633   do {                                                                  \
634     PetscStack * petscstackp;                                           \
635     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
636     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {   \
637       petscstackp->function[petscstackp->currentsize]  = n;             \
638       petscstackp->file[petscstackp->currentsize]      = "unknown";     \
639       petscstackp->directory[petscstackp->currentsize] = "unknown";     \
640       petscstackp->line[petscstackp->currentsize]      = 0;             \
641       petscstackp->currentsize++;                                       \
642     } CHKMEMQ;} while (0)
643 
644 #define PetscStackPop \
645   do {PetscStack* petscstackp;CHKMEMQ;                                  \
646     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
647     if (petscstackp && petscstackp->currentsize > 0) {                  \
648       petscstackp->currentsize--;                                       \
649       petscstackp->function[petscstackp->currentsize]  = 0;             \
650       petscstackp->file[petscstackp->currentsize]      = 0;             \
651       petscstackp->directory[petscstackp->currentsize] = 0;             \
652       petscstackp->line[petscstackp->currentsize]      = 0;             \
653     }} while (0)
654 
655 /*MC
656    PetscFunctionReturn - Last executable line of each PETSc function
657         used for error handling. Replaces return()
658 
659    Synopsis:
660    #include "petscsys.h"
661    void PetscFunctionReturn(0);
662 
663    Not Collective
664 
665    Usage:
666 .vb
667     ....
668      PetscFunctionReturn(0);
669    }
670 .ve
671 
672    Notes:
673      Not available in Fortran
674 
675    Level: developer
676 
677 .seealso: PetscFunctionBegin()
678 
679 .keywords: traceback, error handling
680 M*/
681 #define PetscFunctionReturn(a) \
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(a);} while (0)
693 
694 #define PetscFunctionReturnVoid() \
695   do {                                                                \
696     PetscStack* petscstackp;                                          \
697     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
698     if (petscstackp && petscstackp->currentsize > 0) {                \
699       petscstackp->currentsize--;                                     \
700       petscstackp->function[petscstackp->currentsize]  = 0;           \
701       petscstackp->file[petscstackp->currentsize]      = 0;           \
702       petscstackp->directory[petscstackp->currentsize] = 0;           \
703       petscstackp->line[petscstackp->currentsize]      = 0;           \
704     }                                                                 \
705     return;} while (0)
706 #else
707 
708 #define PetscFunctionBegin
709 #define PetscFunctionBeginUser
710 #define PetscFunctionReturn(a)  return(a)
711 #define PetscFunctionReturnVoid() return
712 #define PetscStackPop     CHKMEMQ
713 #define PetscStackPush(f) CHKMEMQ
714 #define PetscStackActive        PETSC_FALSE
715 
716 #endif
717 
718 /*
719     PetscStackCall - Calls an external library routine or user function after pushing the name of the routine on the stack.
720 
721    Input Parameters:
722 +   name - string that gives the name of the function being called
723 -   routine - actual call to the routine, including ierr = and CHKERRQ(ierr);
724 
725    Note: Often one should use PetscStackCallStandard() instead. This routine is intended for external library routines that DO NOT return error codes
726 
727    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.
728 
729 
730 
731 */
732 #define PetscStackCall(name,routine) do { PetscStackPush(name);routine;PetscStackPop; } while(0)
733 
734 /*
735     PetscStackCallStandard - Calls an external library routine after pushing the name of the routine on the stack.
736 
737    Input Parameters:
738 +   func-  name of the routine
739 -   args - arguments to the routine surrounded by ()
740 
741    Notes: This is intended for external package routines that return error codes. Use PetscStackCall() for those that do not.
742 
743    Developer Note: this is so that when an external packge routine results in a crash or corrupts memory, they get blamed instead of PETSc.
744 
745 */
746 #define PetscStackCallStandard(func,args) do {                        \
747     PetscStackPush(#func);ierr = func args;PetscStackPop; if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in %s()",#func); \
748   } while (0)
749 
750 PETSC_EXTERN PetscErrorCode PetscStackCreate(void);
751 PETSC_EXTERN PetscErrorCode PetscStackView(FILE*);
752 PETSC_EXTERN PetscErrorCode PetscStackDestroy(void);
753 PETSC_EXTERN PetscErrorCode PetscStackPublish(void);
754 PETSC_EXTERN PetscErrorCode PetscStackDepublish(void);
755 
756 #endif
757