xref: /petsc/include/petscerror.h (revision d9e81513928b26c49fdf5ea3be4cf842c28ddf46)
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 PetscDefaultSignalHandler(int,void*);
365 PETSC_EXTERN PetscErrorCode PetscPushSignalHandler(PetscErrorCode (*)(int,void *),void*);
366 PETSC_EXTERN PetscErrorCode PetscPopSignalHandler(void);
367 
368 
369 /*MC
370     PetscErrorPrintf - Prints error messages.
371 
372    Synopsis:
373     #include "petscsys.h"
374      PetscErrorCode (*PetscErrorPrintf)(const char format[],...);
375 
376     Not Collective
377 
378     Input Parameters:
379 .   format - the usual printf() format string
380 
381    Options Database Keys:
382 +    -error_output_stdout - cause error messages to be printed to stdout instead of the
383          (default) stderr
384 -    -error_output_none to turn off all printing of error messages (does not change the way the
385           error is handled.)
386 
387    Notes: Use
388 $     PetscErrorPrintf = PetscErrorPrintfNone; to turn off all printing of error messages (does not change the way the
389 $                        error is handled.) and
390 $     PetscErrorPrintf = PetscErrorPrintfDefault; to turn it back on
391 $        of you can use your own function
392 
393           Use
394      PETSC_STDERR = FILE* obtained from a file open etc. to have stderr printed to the file.
395      PETSC_STDOUT = FILE* obtained from a file open etc. to have stdout printed to the file.
396 
397           Use
398       PetscPushErrorHandler() to provide your own error handler that determines what kind of messages to print
399 
400    Level: developer
401 
402     Fortran Note:
403     This routine is not supported in Fortran.
404 
405     Concepts: error messages^printing
406     Concepts: printing^error messages
407 
408 .seealso: PetscFPrintf(), PetscSynchronizedPrintf(), PetscHelpPrintf(), PetscPrintf(), PetscErrorHandlerPush(), PetscVFPrintf(), PetscHelpPrintf()
409 M*/
410 PETSC_EXTERN PetscErrorCode (*PetscErrorPrintf)(const char[],...);
411 
412 typedef enum {PETSC_FP_TRAP_OFF=0,PETSC_FP_TRAP_ON=1} PetscFPTrap;
413 PETSC_EXTERN PetscErrorCode PetscSetFPTrap(PetscFPTrap);
414 PETSC_EXTERN PetscErrorCode PetscFPTrapPush(PetscFPTrap);
415 PETSC_EXTERN PetscErrorCode PetscFPTrapPop(void);
416 
417 /*  Linux functions CPU_SET and others don't work if sched.h is not included before
418     including pthread.h. Also, these functions are active only if either _GNU_SOURCE
419     or __USE_GNU is not set (see /usr/include/sched.h and /usr/include/features.h), hence
420     set these first.
421 */
422 #if defined(PETSC_HAVE_PTHREADCLASSES)
423 #if defined(PETSC_HAVE_SCHED_H)
424 #ifndef _GNU_SOURCE
425 #define _GNU_SOURCE
426 #endif
427 #include <sched.h>
428 #endif
429 #include <pthread.h>
430 #endif
431 
432 /*
433      This code is for managing thread local global variables. Each of Linux, Microsoft WINDOWS, OpenMP, and Apple OS X have
434    different ways to indicate this. On OS X each thread local global is accessed by using a pthread_key_t for that variable.
435    Thus we have functions for creating destroying and using the keys. Except for OS X these access functions merely directly
436    acess the thread local variable.
437 */
438 
439 #if defined(PETSC_HAVE_PTHREADCLASSES) && !defined(PETSC_PTHREAD_LOCAL)
440 typedef pthread_key_t PetscThreadKey;
441 /* Get the value associated with key */
442 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(PetscThreadKey key)
443 {
444   return pthread_getspecific(key);
445 }
446 
447 /* Set the value for key */
448 PETSC_STATIC_INLINE void PetscThreadLocalSetValue(PetscThreadKey *key,void* value)
449 {
450   pthread_setspecific(*key,(void*)value);
451 }
452 
453 /* Create pthread thread local key */
454 PETSC_STATIC_INLINE void PetscThreadLocalRegister(PetscThreadKey *key)
455 {
456   pthread_key_create(key,NULL);
457 }
458 
459 /* Delete pthread thread local key */
460 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(PetscThreadKey key)
461 {
462   pthread_key_delete(key);
463 }
464 #else
465 typedef void* PetscThreadKey;
466 PETSC_STATIC_INLINE void* PetscThreadLocalGetValue(PetscThreadKey key)
467 {
468   return key;
469 }
470 
471 PETSC_STATIC_INLINE void PetscThreadLocalSetValue(PetscThreadKey *key,void* value)
472 {
473   *key = value;
474 }
475 
476 PETSC_STATIC_INLINE void PetscThreadLocalRegister(PETSC_UNUSED PetscThreadKey *key)
477 {
478 }
479 
480 PETSC_STATIC_INLINE void PetscThreadLocalDestroy(PETSC_UNUSED PetscThreadKey key)
481 {
482 }
483 #endif
484 
485 /*
486       Allows the code to build a stack frame as it runs
487 */
488 #if defined(PETSC_USE_DEBUG)
489 
490 #define PETSCSTACKSIZE 64
491 
492 typedef struct  {
493   const char      *function[PETSCSTACKSIZE];
494   const char      *file[PETSCSTACKSIZE];
495   const char      *directory[PETSCSTACKSIZE];
496         int       line[PETSCSTACKSIZE];
497         PetscBool petscroutine[PETSCSTACKSIZE];
498         int       currentsize;
499 } PetscStack;
500 
501 #if defined(PETSC_HAVE_PTHREADCLASSES)
502 #if defined(PETSC_PTHREAD_LOCAL)
503 PETSC_EXTERN PETSC_PTHREAD_LOCAL PetscStack *petscstack;
504 #else
505 PETSC_EXTERN PetscThreadKey petscstack;
506 #endif
507 #elif defined(PETSC_HAVE_OPENMP)
508 PETSC_EXTERN PetscStack *petscstack;
509 #pragma omp threadprivate(petscstack)
510 #else
511 PETSC_EXTERN PetscStack *petscstack;
512 #endif
513 
514 PETSC_EXTERN PetscErrorCode PetscStackCopy(PetscStack*,PetscStack*);
515 PETSC_EXTERN PetscErrorCode PetscStackPrint(PetscStack*,FILE* fp);
516 
517 PETSC_STATIC_INLINE PetscBool PetscStackActive(void)
518 {
519   return(PetscThreadLocalGetValue(petscstack) ? PETSC_TRUE : PETSC_FALSE);
520 }
521 
522 /*MC
523    PetscFunctionBegin - First executable line of each PETSc function
524         used for error handling.
525 
526    Synopsis:
527    #include "petscsys.h"
528    void PetscFunctionBegin;
529 
530    Not Collective
531 
532    Usage:
533 .vb
534      int something;
535 
536      PetscFunctionBegin;
537 .ve
538 
539    Notes:
540      Not available in Fortran
541 
542    Level: developer
543 
544 .seealso: PetscFunctionReturn()
545 
546 .keywords: traceback, error handling
547 M*/
548 #define PetscFunctionBegin \
549   do {                                                                        \
550     PetscStack* petscstackp;                                                  \
551     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
552     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
553       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
554       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
555       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
556       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
557       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_TRUE;       \
558       petscstackp->currentsize++;                                             \
559     }                                                                         \
560     PetscCheck__FUNCT__();                                                    \
561     PetscRegister__FUNCT__();                                                 \
562   } while (0)
563 
564 /*MC
565    PetscFunctionBeginUser - First executable line of user provided PETSc routine
566 
567    Synopsis:
568    #include "petscsys.h"
569    void PetscFunctionBeginUser;
570 
571    Not Collective
572 
573    Usage:
574 .vb
575      int something;
576 
577      PetscFunctionBegin;
578 .ve
579 
580    Notes:
581      Not available in Fortran
582 
583    Level: developer
584 
585 .seealso: PetscFunctionReturn()
586 
587 .keywords: traceback, error handling
588 M*/
589 #define PetscFunctionBeginUser \
590   do {                                                                        \
591     PetscStack* petscstackp;                                                  \
592     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);          \
593     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {         \
594       petscstackp->function[petscstackp->currentsize]  = PETSC_FUNCTION_NAME; \
595       petscstackp->file[petscstackp->currentsize]      = __FILE__;            \
596       petscstackp->directory[petscstackp->currentsize] = __SDIR__;            \
597       petscstackp->line[petscstackp->currentsize]      = __LINE__;            \
598       petscstackp->petscroutine[petscstackp->currentsize] = PETSC_FALSE;      \
599       petscstackp->currentsize++;                                             \
600     }                                                                         \
601     PetscCheck__FUNCT__();                                                    \
602     PetscRegister__FUNCT__();                                                 \
603   } while (0)
604 
605 
606 #if defined(PETSC_SERIALIZE_FUNCTIONS)
607 #include <petsc-private/petscfptimpl.h>
608 /*
609    Registers the current function into the global function pointer to function name table
610 
611    Have to fix this to handle errors but cannot return error since used in PETSC_VIEWER_DRAW_() etc
612 */
613 #define PetscRegister__FUNCT__() do { \
614   static PetscBool __chked = PETSC_FALSE; \
615   if (!__chked) {\
616   void *ptr; PetscDLSym(NULL,__FUNCT__,&ptr);\
617   __chked = PETSC_TRUE;\
618   }} while (0)
619 #else
620 #define PetscRegister__FUNCT__()
621 #endif
622 
623 #define PetscCheck__FUNCT__() do { PetscBool _sc1,_sc2;                  \
624     PetscStrcmpNoError(PETSC_FUNCTION_NAME,__FUNCT__,&_sc1);\
625     PetscStrcmpNoError(__FUNCT__,"User provided function",&_sc2);\
626     if (!_sc1 && !_sc2) { \
627       printf("%s%s:%d: __FUNCT__=\"%s\" does not agree with %s=\"%s\"\n",__SDIR__,__FILE__,__LINE__,__FUNCT__,PetscStringize(PETSC_FUNCTION_NAME),PETSC_FUNCTION_NAME); \
628     }                                                                   \
629   } while (0)
630 
631 #define PetscStackPush(n) \
632   do {                                                                  \
633     PetscStack * petscstackp;                                           \
634     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
635     if (petscstackp && (petscstackp->currentsize < PETSCSTACKSIZE)) {   \
636       petscstackp->function[petscstackp->currentsize]  = n;             \
637       petscstackp->file[petscstackp->currentsize]      = "unknown";     \
638       petscstackp->directory[petscstackp->currentsize] = "unknown";     \
639       petscstackp->line[petscstackp->currentsize]      = 0;             \
640       petscstackp->currentsize++;                                       \
641     } CHKMEMQ;} while (0)
642 
643 #define PetscStackPop \
644   do {PetscStack* petscstackp;CHKMEMQ;                                  \
645     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);    \
646     if (petscstackp && petscstackp->currentsize > 0) {                  \
647       petscstackp->currentsize--;                                       \
648       petscstackp->function[petscstackp->currentsize]  = 0;             \
649       petscstackp->file[petscstackp->currentsize]      = 0;             \
650       petscstackp->directory[petscstackp->currentsize] = 0;             \
651       petscstackp->line[petscstackp->currentsize]      = 0;             \
652     }} while (0)
653 
654 /*MC
655    PetscFunctionReturn - Last executable line of each PETSc function
656         used for error handling. Replaces return()
657 
658    Synopsis:
659    #include "petscsys.h"
660    void PetscFunctionReturn(0);
661 
662    Not Collective
663 
664    Usage:
665 .vb
666     ....
667      PetscFunctionReturn(0);
668    }
669 .ve
670 
671    Notes:
672      Not available in Fortran
673 
674    Level: developer
675 
676 .seealso: PetscFunctionBegin()
677 
678 .keywords: traceback, error handling
679 M*/
680 #define PetscFunctionReturn(a) \
681   do {                                                                \
682     PetscStack* petscstackp;                                          \
683     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
684     if (petscstackp && petscstackp->currentsize > 0) {                \
685       petscstackp->currentsize--;                                     \
686       petscstackp->function[petscstackp->currentsize]  = 0;           \
687       petscstackp->file[petscstackp->currentsize]      = 0;           \
688       petscstackp->directory[petscstackp->currentsize] = 0;           \
689       petscstackp->line[petscstackp->currentsize]      = 0;           \
690     }                                                                 \
691     return(a);} while (0)
692 
693 #define PetscFunctionReturnVoid() \
694   do {                                                                \
695     PetscStack* petscstackp;                                          \
696     petscstackp = (PetscStack*)PetscThreadLocalGetValue(petscstack);  \
697     if (petscstackp && petscstackp->currentsize > 0) {                \
698       petscstackp->currentsize--;                                     \
699       petscstackp->function[petscstackp->currentsize]  = 0;           \
700       petscstackp->file[petscstackp->currentsize]      = 0;           \
701       petscstackp->directory[petscstackp->currentsize] = 0;           \
702       petscstackp->line[petscstackp->currentsize]      = 0;           \
703     }                                                                 \
704     return;} while (0)
705 #else
706 
707 #define PetscFunctionBegin
708 #define PetscFunctionBeginUser
709 #define PetscFunctionReturn(a)  return(a)
710 #define PetscFunctionReturnVoid() return
711 #define PetscStackPop     CHKMEMQ
712 #define PetscStackPush(f) CHKMEMQ
713 #define PetscStackActive        PETSC_FALSE
714 
715 #endif
716 
717 /*
718     PetscStackCall - Calls an external library routine or user function after pushing the name of the routine on the stack.
719 
720    Input Parameters:
721 +   name - string that gives the name of the function being called
722 -   routine - actual call to the routine, including ierr = and CHKERRQ(ierr);
723 
724    Note: Often one should use PetscStackCallStandard() instead. This routine is intended for external library routines that DO NOT return error codes
725 
726    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.
727 
728 
729 
730 */
731 #define PetscStackCall(name,routine) do { PetscStackPush(name);routine;PetscStackPop; } while(0)
732 
733 /*
734     PetscStackCallStandard - Calls an external library routine after pushing the name of the routine on the stack.
735 
736    Input Parameters:
737 +   func-  name of the routine
738 -   args - arguments to the routine surrounded by ()
739 
740    Notes: This is intended for external package routines that return error codes. Use PetscStackCall() for those that do not.
741 
742    Developer Note: this is so that when an external packge routine results in a crash or corrupts memory, they get blamed instead of PETSc.
743 
744 */
745 #define PetscStackCallStandard(func,args) do {                        \
746     PetscStackPush(#func);ierr = func args;PetscStackPop; if (ierr) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"Error in %s()",#func); \
747   } while (0)
748 
749 PETSC_EXTERN PetscErrorCode PetscStackCreate(void);
750 PETSC_EXTERN PetscErrorCode PetscStackView(FILE*);
751 PETSC_EXTERN PetscErrorCode PetscStackDestroy(void);
752 PETSC_EXTERN PetscErrorCode PetscStackPublish(void);
753 PETSC_EXTERN PetscErrorCode PetscStackDepublish(void);
754 
755 #endif
756