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