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