xref: /petsc/include/petscerror.h (revision bb9aae2f3a4607d6d3ab71dfc6a74916dd210b51)
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 #define PetscStackActive (((PetscStack*)PetscThreadLocalGetValue(petscstack)) != 0)
521 
522 /*MC
523    PetscFunctionBegin - First executable line of each PETSc function
524         used for error handling.
525 
526    Synopsis:
527    #include "petscsys.h"
528    void PetscFunctionBegin;
529 
530    Not Collective
531 
532    Usage:
533 .vb
534      int something;
535 
536      PetscFunctionBegin;
537 .ve
538 
539    Notes:
540      Not available in Fortran
541 
542    Level: developer
543 
544 .seealso: PetscFunctionReturn()
545 
546 .keywords: traceback, error handling
547 M*/
548 #define PetscFunctionBegin \
549   do {                                                                        \
550     PetscStack* petscstackp;                                                  \
551     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
552     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
553       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
554       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
555       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
556       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
557       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_TRUE;       \
558       petscstackp->currentsize++;                                             \
559     }                                                                         \
560     PetscCheck__FUNCT__();                                                    \
561     PetscRegister__FUNCT__();                                                 \
562   } while (0)
563 
564 /*MC
565    PetscFunctionBeginUser - First executable line of user provided PETSc routine
566 
567    Synopsis:
568    #include "petscsys.h"
569    void PetscFunctionBeginUser;
570 
571    Not Collective
572 
573    Usage:
574 .vb
575      int something;
576 
577      PetscFunctionBegin;
578 .ve
579 
580    Notes:
581      Not available in Fortran
582 
583    Level: developer
584 
585 .seealso: PetscFunctionReturn()
586 
587 .keywords: traceback, error handling
588 M*/
589 #define PetscFunctionBeginUser \
590   do {                                                                        \
591     PetscStack* petscstackp;                                                  \
592     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
593     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
594       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
595       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
596       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
597       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
598       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_FALSE;      \
599       petscstackp->currentsize++;                                             \
600     }                                                                         \
601     PetscCheck__FUNCT__();                                                    \
602     PetscRegister__FUNCT__();                                                 \
603   } while (0)
604 
605 
606 #if defined(PETSC_SERIALIZE_FUNCTIONS)
607 #include <petsc-private/petscfptimpl.h>
608 /*
609    Registers the current function into the global function pointer to function name table
610 
611    Have to fix this to handle errors but cannot return error since used in PETSC_VIEWER_DRAW_() etc
612 */
613 #define PetscRegister__FUNCT__() do { \
614   static PetscBool __chked = PETSC_FALSE; \
615   if (!__chked) {\
616   void *ptr; PetscDLSym(PETSC_NULL,__FUNCT__,&ptr);\
617   __chked = PETSC_TRUE;\
618   }} while (0)
619 #else
620 #define PetscRegister__FUNCT__()
621 #endif
622 
623 #define PetscCheck__FUNCT__() do { \
624     if (strcmp(PETSC_FUNCTION_NAME,__FUNCT__) && strcmp(__FUNCT__,"User provided function")) { \
625       (*PetscErrorPrintf)("%s%s:%d: __FUNCT__=\"%s\" does not agree with %s=\"%s\"\n",__SDIR__,__FILE__,__LINE__,__FUNCT__,PetscStringize(PETSC_FUNCTION_NAME),PETSC_FUNCTION_NAME); \
626     }                                                                   \
627   } while (0)
628 
629 #define PetscStackPush(n) \
630   do {                                                                  \
631     PetscStack * petscstackp;                                           \
632     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
633     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {   \
634       petscstackp->function[petscstackp->currentsize]  = n;             \
635       petscstackp->file[petscstackp->currentsize]      = "unknown";     \
636       petscstackp->directory[petscstackp->currentsize] = "unknown";     \
637       petscstackp->line[petscstackp->currentsize]      = 0;             \
638       petscstackp->currentsize++;                                       \
639     } CHKMEMQ;} while (0)
640 
641 #define PetscStackPop \
642   do {PetscStack* petscstackp;CHKMEMQ;                                  \
643     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
644     if (petscstackp && petscstackp->currentsize > 0) {                  \
645       petscstackp->currentsize--;                                       \
646       petscstackp->function[petscstackp->currentsize]  = 0;             \
647       petscstackp->file[petscstackp->currentsize]      = 0;             \
648       petscstackp->directory[petscstackp->currentsize] = 0;             \
649       petscstackp->line[petscstackp->currentsize]      = 0;             \
650     }} while (0)
651 
652 /*MC
653    PetscFunctionReturn - Last executable line of each PETSc function
654         used for error handling. Replaces return()
655 
656    Synopsis:
657    #include "petscsys.h"
658    void PetscFunctionReturn(0);
659 
660    Not Collective
661 
662    Usage:
663 .vb
664     ....
665      PetscFunctionReturn(0);
666    }
667 .ve
668 
669    Notes:
670      Not available in Fortran
671 
672    Level: developer
673 
674 .seealso: PetscFunctionBegin()
675 
676 .keywords: traceback, error handling
677 M*/
678 #define PetscFunctionReturn(a) \
679   do {                                                                \
680     PetscStack* petscstackp;                                          \
681     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
682     if (petscstackp && petscstackp->currentsize > 0) {                \
683       petscstackp->currentsize--;                                     \
684       petscstackp->function[petscstackp->currentsize]  = 0;           \
685       petscstackp->file[petscstackp->currentsize]      = 0;           \
686       petscstackp->directory[petscstackp->currentsize] = 0;           \
687       petscstackp->line[petscstackp->currentsize]      = 0;           \
688     }                                                                 \
689     return(a);} while (0)
690 
691 #define PetscFunctionReturnVoid() \
692   do {                                                                \
693     PetscStack* petscstackp;                                          \
694     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
695     if (petscstackp && petscstackp->currentsize > 0) {                \
696       petscstackp->currentsize--;                                     \
697       petscstackp->function[petscstackp->currentsize]  = 0;           \
698       petscstackp->file[petscstackp->currentsize]      = 0;           \
699       petscstackp->directory[petscstackp->currentsize] = 0;           \
700       petscstackp->line[petscstackp->currentsize]      = 0;           \
701     }                                                                 \
702     return;} while (0)
703 #else
704 
705 #define PetscFunctionBegin
706 #define PetscFunctionBeginUser
707 #define PetscFunctionReturn(a)  return(a)
708 #define PetscFunctionReturnVoid() return
709 #define PetscStackPop     CHKMEMQ
710 #define PetscStackPush(f) CHKMEMQ
711 #define PetscStackActive        0
712 
713 #endif
714 
715 /*
716     PetscStackCall - Calls an external library routine or user function after pushing the name of the routine on the stack.
717 
718    Input Parameters:
719 +   name - string that gives the name of the function being called
720 -   routine - actual call to the routine, including ierr = and CHKERRQ(ierr);
721 
722    Note: Often one should use PetscStackCallStandard() instead
723 
724    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.
725 
726 
727 
728 */
729 #define PetscStackCall(name,routine) do { PetscStackPush(name);routine;PetscStackPop; } while(0)
730 
731 /*
732     PetscStackCallStandard - Calls an external library routine after pushing the name of the routine on the stack.
733 
734    Input Parameters:
735 +   func-  name of the routine
736 -   args - arguments to the routine surrounded by ()
737 
738    Developer Note: this is so that when a hypre routine results in a crash or corrupts memory, they get blamed instead of PETSc.
739 
740 */
741 #define PetscStackCallStandard(func,args) do {                        \
742     PetscStackPush(#func);ierr = func args;PetscStackPop; if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in %s()",#func); \
743   } while (0)
744 
745 PETSC_EXTERN PetscErrorCode PetscStackCreate(void);
746 PETSC_EXTERN PetscErrorCode PetscStackView(FILE*);
747 PETSC_EXTERN PetscErrorCode PetscStackDestroy(void);
748 PETSC_EXTERN PetscErrorCode PetscStackPublish(void);
749 PETSC_EXTERN PetscErrorCode PetscStackDepublish(void);
750 
751 #endif
752