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