xref: /petsc/src/sys/error/fp.c (revision 9371c9d470a9602b6d10a8bf50c9b2280a79e45a)
17d0a6c19SBarry Smith 
2e5c89e4eSSatish Balay /*
30e3d61c9SBarry Smith    IEEE error handler for all machines. Since each OS has
40e3d61c9SBarry Smith    enough slight differences we have completely separate codes for each one.
5e5c89e4eSSatish Balay */
6b014e56cSJed Brown 
7b014e56cSJed Brown /*
8b014e56cSJed Brown   This feature test macro provides FE_NOMASK_ENV on GNU.  It must be defined
9b014e56cSJed Brown   at the top of the file because other headers may pull in fenv.h even when
10b014e56cSJed Brown   not strictly necessary.  Strictly speaking, we could include ONLY petscconf.h,
11b014e56cSJed Brown   check PETSC_HAVE_FENV_H, and only define _GNU_SOURCE in that case, but such
12b014e56cSJed Brown   shenanigans ought to be unnecessary.
13b014e56cSJed Brown */
14519f805aSKarl Rupp #if !defined(_GNU_SOURCE)
15b014e56cSJed Brown #define _GNU_SOURCE
1676a6984eSJed Brown #endif
17b014e56cSJed Brown 
1827104ee2SJacob Faibussowitsch #include <petsc/private/petscimpl.h> /*I  "petscsys.h"  I*/
19e5c89e4eSSatish Balay #include <signal.h>
20e5c89e4eSSatish Balay 
21670f3ff9SJed Brown struct PetscFPTrapLink {
22670f3ff9SJed Brown   PetscFPTrap             trapmode;
23670f3ff9SJed Brown   struct PetscFPTrapLink *next;
24670f3ff9SJed Brown };
25aba4c478SBarry Smith static PetscFPTrap             _trapmode = PETSC_FP_TRAP_OFF; /* Current trapping mode; see PetscDetermineInitialFPTrap() */
26670f3ff9SJed Brown static struct PetscFPTrapLink *_trapstack;                    /* Any pushed states of _trapmode */
27670f3ff9SJed Brown 
28670f3ff9SJed Brown /*@
29cc9df77eSBarry Smith    PetscFPTrapPush - push a floating point trapping mode, restored using PetscFPTrapPop()
30670f3ff9SJed Brown 
31670f3ff9SJed Brown    Not Collective
32670f3ff9SJed Brown 
334165533cSJose E. Roman    Input Parameter:
34cf0818bdSBarry Smith .    trap - PETSC_FP_TRAP_ON or PETSC_FP_TRAP_OFF or any of the values passable to `PetscSetFPTrap()`
35670f3ff9SJed Brown 
36670f3ff9SJed Brown    Level: advanced
37670f3ff9SJed Brown 
38cc9df77eSBarry Smith    Notes:
39cc9df77eSBarry Smith      This only changes the trapping if the new mode is different than the current mode.
40cc9df77eSBarry Smith 
41cc9df77eSBarry Smith      This routine is called to turn off trapping for certain LAPACK routines that assume that dividing
42cc9df77eSBarry Smith      by zero is acceptable. In particular the routine ieeeck().
43cc9df77eSBarry Smith 
44cc9df77eSBarry Smith      Most systems by default have all trapping turned off, but certain Fortran compilers have
45cc9df77eSBarry Smith      link flags that turn on trapping before the program begins.
46cc9df77eSBarry Smith $       gfortran -ffpe-trap=invalid,zero,overflow,underflow,denormal
47cc9df77eSBarry Smith $       ifort -fpe0
48cc9df77eSBarry Smith 
49db781477SPatrick Sanan .seealso: `PetscFPTrapPop()`, `PetscSetFPTrap()`, `PetscDetermineInitialFPTrap()`
50670f3ff9SJed Brown @*/
51*9371c9d4SSatish Balay PetscErrorCode PetscFPTrapPush(PetscFPTrap trap) {
52670f3ff9SJed Brown   struct PetscFPTrapLink *link;
53670f3ff9SJed Brown 
54670f3ff9SJed Brown   PetscFunctionBegin;
559566063dSJacob Faibussowitsch   PetscCall(PetscNew(&link));
561f006be4SPierre Jolivet #if defined(PETSC_HAVE_THREADSAFETY) && defined(PETSC_HAVE_OPENMP)
571f006be4SPierre Jolivet #pragma omp critical
581f006be4SPierre Jolivet #endif
591f006be4SPierre Jolivet   {
60670f3ff9SJed Brown     link->trapmode = _trapmode;
61670f3ff9SJed Brown     link->next     = _trapstack;
62670f3ff9SJed Brown     _trapstack     = link;
631f006be4SPierre Jolivet   }
649566063dSJacob Faibussowitsch   if (trap != _trapmode) PetscCall(PetscSetFPTrap(trap));
65670f3ff9SJed Brown   PetscFunctionReturn(0);
66670f3ff9SJed Brown }
67670f3ff9SJed Brown 
68670f3ff9SJed Brown /*@
69670f3ff9SJed Brown    PetscFPTrapPop - push a floating point trapping mode, to be restored using PetscFPTrapPop()
70670f3ff9SJed Brown 
71670f3ff9SJed Brown    Not Collective
72670f3ff9SJed Brown 
73670f3ff9SJed Brown    Level: advanced
74670f3ff9SJed Brown 
75db781477SPatrick Sanan .seealso: `PetscFPTrapPush()`, `PetscSetFPTrap()`, `PetscDetermineInitialFPTrap()`
76670f3ff9SJed Brown @*/
77*9371c9d4SSatish Balay PetscErrorCode PetscFPTrapPop(void) {
78670f3ff9SJed Brown   struct PetscFPTrapLink *link;
79670f3ff9SJed Brown 
80670f3ff9SJed Brown   PetscFunctionBegin;
819566063dSJacob Faibussowitsch   if (_trapstack->trapmode != _trapmode) PetscCall(PetscSetFPTrap(_trapstack->trapmode));
821f006be4SPierre Jolivet #if defined(PETSC_HAVE_THREADSAFETY) && defined(PETSC_HAVE_OPENMP)
831f006be4SPierre Jolivet #pragma omp critical
841f006be4SPierre Jolivet #endif
851f006be4SPierre Jolivet   {
86670f3ff9SJed Brown     link       = _trapstack;
87670f3ff9SJed Brown     _trapstack = _trapstack->next;
881f006be4SPierre Jolivet   }
899566063dSJacob Faibussowitsch   PetscCall(PetscFree(link));
90670f3ff9SJed Brown   PetscFunctionReturn(0);
91670f3ff9SJed Brown }
92670f3ff9SJed Brown 
93e5c89e4eSSatish Balay /*--------------------------------------- ---------------------------------------------------*/
94e5c89e4eSSatish Balay #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
95e5c89e4eSSatish Balay #include <floatingpoint.h>
96e5c89e4eSSatish Balay 
978cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_flags(char *, char *, char *, char **);
988cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_handler(char *, char *, sigfpe_handler_type(int, int, struct sigcontext *, char *));
99e5c89e4eSSatish Balay 
100*9371c9d4SSatish Balay static struct {
101*9371c9d4SSatish Balay   int   code_no;
102*9371c9d4SSatish Balay   char *name;
103*9371c9d4SSatish Balay } error_codes[] = {
104e5c89e4eSSatish Balay   {FPE_INTDIV_TRAP,   "integer divide"               },
105e5c89e4eSSatish Balay   {FPE_FLTOPERR_TRAP, "IEEE operand error"           },
106e5c89e4eSSatish Balay   {FPE_FLTOVF_TRAP,   "floating point overflow"      },
107e5c89e4eSSatish Balay   {FPE_FLTUND_TRAP,   "floating point underflow"     },
108e5c89e4eSSatish Balay   {FPE_FLTDIV_TRAP,   "floating pointing divide"     },
109e5c89e4eSSatish Balay   {FPE_FLTINEX_TRAP,  "inexact floating point result"},
110e5c89e4eSSatish Balay   {0,                 "unknown error"                }
111e5c89e4eSSatish Balay };
112e5c89e4eSSatish Balay #define SIGPC(scp) (scp->sc_pc)
113e5c89e4eSSatish Balay 
114cf0818bdSBarry Smith /* this function gets called if a trap has occurred and been caught */
115*9371c9d4SSatish Balay sigfpe_handler_type PetscDefaultFPTrap(int sig, int code, struct sigcontext *scp, char *addr) {
1165f80ce2aSJacob Faibussowitsch   int err_ind = -1;
117e5c89e4eSSatish Balay 
118e5c89e4eSSatish Balay   PetscFunctionBegin;
1195f80ce2aSJacob Faibussowitsch   for (int j = 0; error_codes[j].code_no; j++) {
120e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
121e5c89e4eSSatish Balay   }
122e5c89e4eSSatish Balay 
123a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n", error_codes[err_ind].name, SIGPC(scp));
124a297a907SKarl Rupp   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n", code, SIGPC(scp));
125a297a907SKarl Rupp 
12649c86fc7SBarry Smith   (void)PetscError(PETSC_COMM_SELF, PETSC_ERR_FP, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
12741e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
128e5c89e4eSSatish Balay   PetscFunctionReturn(0);
129e5c89e4eSSatish Balay }
130e5c89e4eSSatish Balay 
131e30d2299SSatish Balay /*@
132cf0818bdSBarry Smith    PetscSetFPTrap - Enables traps/exceptions on common floating point errors. This option may not work on certain systems or only a
133cf0818bdSBarry Smith    subset of exceptions may be trapable.
134e5c89e4eSSatish Balay 
135e5c89e4eSSatish Balay    Not Collective
136e5c89e4eSSatish Balay 
137e5c89e4eSSatish Balay    Input Parameters:
138cf0818bdSBarry Smith .  flag - values are
139cf0818bdSBarry Smith .vb
140cf0818bdSBarry Smith     PETSC_FP_TRAP_OFF   - do not trap any exceptions
141cf0818bdSBarry Smith     PETSC_FP_TRAP_ON - all exceptions that are possible on the system except underflow
142cf0818bdSBarry Smith     PETSC_FP_TRAP_INDIV - integer divide by zero
143cf0818bdSBarry Smith     PETSC_FP_TRAP_FLTOPERR - improper argument to function, for example with real numbers, the square root of a negative number
144cf0818bdSBarry Smith     PETSC_FP_TRAP_FLTOVF - overflow
145cf0818bdSBarry Smith     PETSC_FP_TRAP_FLTUND - underflow - not trapped by default on most systems
146cf0818bdSBarry Smith     PETSC_FP_TRAP_FLTDIV - floating point divide by zero
147cf0818bdSBarry Smith     PETSC_FP_TRAP_FLTINEX - inexact floating point result
148cf0818bdSBarry Smith .ve
149e5c89e4eSSatish Balay 
150e5c89e4eSSatish Balay    Options Database Keys:
151cf0818bdSBarry Smith .  -fp_trap <off,on> - turn on or off trapping of floating point exceptions
152e5c89e4eSSatish Balay 
153e5c89e4eSSatish Balay    Level: advanced
154e5c89e4eSSatish Balay 
155cf0818bdSBarry Smith    Notes:
156cf0818bdSBarry Smith    Currently only PETSC_FP_TRAP_OFF and PETSC_FP_TRAP_ON are handled. All others are treated as PETSC_FP_TRAP_ON.
157cf0818bdSBarry Smith 
158cf0818bdSBarry Smith    The values are bit values and may be |ed together in the function call
159cf0818bdSBarry Smith 
160cf0818bdSBarry Smith    On systems that support it this routine causes floating point
161cf0818bdSBarry Smith    overflow, divide-by-zero, and invalid-operand (e.g., a NaN), but not underflow, to
162e5c89e4eSSatish Balay    cause a message to be printed and the program to exit.
163e5c89e4eSSatish Balay 
164cc9df77eSBarry Smith    On many common systems, the floating
1657d125cddSJed Brown    point exception state is not preserved from the location where the trap
1667d125cddSJed Brown    occurred through to the signal handler.  In this case, the signal handler
1677d125cddSJed Brown    will just say that an unknown floating point exception occurred and which
1687d125cddSJed Brown    function it occurred in.  If you run with -fp_trap in a debugger, it will
169cc9df77eSBarry Smith    break on the line where the error occurred.  On systems that support C99
170cc9df77eSBarry Smith    floating point exception handling You can check which
1717d125cddSJed Brown    exception occurred using fetestexcept(FE_ALL_EXCEPT).  See fenv.h
1727d125cddSJed Brown    (usually at /usr/include/bits/fenv.h) for the enum values on your system.
1737d125cddSJed Brown 
174e5c89e4eSSatish Balay    Caution:
175cc9df77eSBarry Smith    On certain machines, in particular the IBM PowerPC, floating point
176cc9df77eSBarry Smith    trapping may be VERY slow!
177e5c89e4eSSatish Balay 
178db781477SPatrick Sanan .seealso: `PetscFPTrapPush()`, `PetscFPTrapPop()`, `PetscDetermineInitialFPTrap()`
179e5c89e4eSSatish Balay @*/
180*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
181e5c89e4eSSatish Balay   char *out;
182e5c89e4eSSatish Balay 
183e5c89e4eSSatish Balay   PetscFunctionBegin;
184e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
185e5c89e4eSSatish Balay   (void)ieee_flags("clear", "exception", "all", &out);
186cf0818bdSBarry Smith   if (flag) {
187e5c89e4eSSatish Balay     /*
188a297a907SKarl Rupp       To trap more fp exceptions, including underflow, change the line below to
189e5c89e4eSSatish Balay       if (ieee_handler("set","all",PetscDefaultFPTrap)) {
190e5c89e4eSSatish Balay     */
191a297a907SKarl Rupp     if (ieee_handler("set", "common", PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
192a297a907SKarl Rupp   } else if (ieee_handler("clear", "common", PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
193a297a907SKarl Rupp 
194670f3ff9SJed Brown   _trapmode = flag;
195e5c89e4eSSatish Balay   PetscFunctionReturn(0);
196e5c89e4eSSatish Balay }
197e5c89e4eSSatish Balay 
198cc9df77eSBarry Smith /*@
199aba4c478SBarry Smith    PetscDetermineInitialFPTrap - Attempts to determine the floating point trapping that exists when PetscInitialize() is called
200cc9df77eSBarry Smith 
201cc9df77eSBarry Smith    Not Collective
202cc9df77eSBarry Smith 
203cc9df77eSBarry Smith    Notes:
204cc9df77eSBarry Smith       Currently only supported on Linux and MacOS. Checks if divide by zero is enable and if so declares that trapping is on.
205cc9df77eSBarry Smith 
206ee300463SSatish Balay    Level: advanced
207cc9df77eSBarry Smith 
208db781477SPatrick Sanan .seealso: `PetscFPTrapPush()`, `PetscFPTrapPop()`, `PetscDetermineInitialFPTrap()`
209cc9df77eSBarry Smith @*/
210*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
211cc9df77eSBarry Smith   PetscFunctionBegin;
2129566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
213cc9df77eSBarry Smith   PetscFunctionReturn(0);
214cc9df77eSBarry Smith }
215cc9df77eSBarry Smith 
216e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
217e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
218e5c89e4eSSatish Balay #include <sunmath.h>
219e5c89e4eSSatish Balay #include <floatingpoint.h>
220e5c89e4eSSatish Balay #include <siginfo.h>
221e5c89e4eSSatish Balay #include <ucontext.h>
222e5c89e4eSSatish Balay 
223*9371c9d4SSatish Balay static struct {
224*9371c9d4SSatish Balay   int   code_no;
225*9371c9d4SSatish Balay   char *name;
226*9371c9d4SSatish Balay } error_codes[] = {
227e5c89e4eSSatish Balay   {FPE_FLTINV, "invalid floating point operand"},
228e5c89e4eSSatish Balay   {FPE_FLTRES, "inexact floating point result" },
229e5c89e4eSSatish Balay   {FPE_FLTDIV, "division-by-zero"              },
230e5c89e4eSSatish Balay   {FPE_FLTUND, "floating point underflow"      },
231e5c89e4eSSatish Balay   {FPE_FLTOVF, "floating point overflow"       },
232e5c89e4eSSatish Balay   {0,          "unknown error"                 }
233e5c89e4eSSatish Balay };
234e5c89e4eSSatish Balay #define SIGPC(scp) (scp->si_addr)
235e5c89e4eSSatish Balay 
236*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig, siginfo_t *scp, ucontext_t *uap) {
2375f80ce2aSJacob Faibussowitsch   int err_ind = -1, code = scp->si_code;
238e5c89e4eSSatish Balay 
239e5c89e4eSSatish Balay   PetscFunctionBegin;
2405f80ce2aSJacob Faibussowitsch   for (int j = 0; error_codes[j].code_no; j++) {
241e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
242e5c89e4eSSatish Balay   }
243e5c89e4eSSatish Balay 
244a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n", error_codes[err_ind].name, SIGPC(scp));
245a297a907SKarl Rupp   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n", code, SIGPC(scp));
246a297a907SKarl Rupp 
24749c86fc7SBarry Smith   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
24841e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
249e5c89e4eSSatish Balay }
250e5c89e4eSSatish Balay 
251*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
252e5c89e4eSSatish Balay   char *out;
253e5c89e4eSSatish Balay 
254e5c89e4eSSatish Balay   PetscFunctionBegin;
255e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
256e5c89e4eSSatish Balay   (void)ieee_flags("clear", "exception", "all", &out);
257e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
258a297a907SKarl Rupp     if (ieee_handler("set", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floating point handler\n");
259cc9df77eSBarry Smith   } else {
260cc9df77eSBarry Smith     if (ieee_handler("clear", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
261cc9df77eSBarry Smith   }
262670f3ff9SJed Brown   _trapmode = flag;
263e5c89e4eSSatish Balay   PetscFunctionReturn(0);
264e5c89e4eSSatish Balay }
265e5c89e4eSSatish Balay 
266*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
267cc9df77eSBarry Smith   PetscFunctionBegin;
2689566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
269cc9df77eSBarry Smith   PetscFunctionReturn(0);
270cc9df77eSBarry Smith }
271cc9df77eSBarry Smith 
272cc9df77eSBarry Smith /* ------------------------------------------------------------------------------------------*/
273e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_IRIX_STYLE_FPTRAP)
274e5c89e4eSSatish Balay #include <sigfpe.h>
275*9371c9d4SSatish Balay static struct {
276*9371c9d4SSatish Balay   int   code_no;
277*9371c9d4SSatish Balay   char *name;
278*9371c9d4SSatish Balay } error_codes[] = {
279e5c89e4eSSatish Balay   {_INVALID, "IEEE operand error"      },
280e5c89e4eSSatish Balay   {_OVERFL,  "floating point overflow" },
281e5c89e4eSSatish Balay   {_UNDERFL, "floating point underflow"},
282e5c89e4eSSatish Balay   {_DIVZERO, "floating point divide"   },
283e5c89e4eSSatish Balay   {0,        "unknown error"           }
284e5c89e4eSSatish Balay };
285*9371c9d4SSatish Balay void PetscDefaultFPTrap(unsigned exception[], int val[]) {
2865f80ce2aSJacob Faibussowitsch   int err_ind = -1, code = exception[0];
287e5c89e4eSSatish Balay 
288e5c89e4eSSatish Balay   PetscFunctionBegin;
2895f80ce2aSJacob Faibussowitsch   for (int j = 0; error_codes[j].code_no; j++) {
290e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
291e5c89e4eSSatish Balay   }
292a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n", error_codes[err_ind].name);
293a297a907SKarl Rupp   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n", code);
294a297a907SKarl Rupp 
29549c86fc7SBarry Smith   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
29641e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
297e5c89e4eSSatish Balay }
298e5c89e4eSSatish Balay 
299*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
300e5c89e4eSSatish Balay   PetscFunctionBegin;
301cf0818bdSBarry Smith   if (flag) handle_sigfpes(_ON, , _EN_UNDERFL | _EN_OVERFL | _EN_DIVZERO | _EN_INVALID, PetscDefaultFPTrap, _ABORT_ON_ERROR, 0);
302cc9df77eSBarry Smith   else handle_sigfpes(_OFF, _EN_UNDERFL | _EN_OVERFL | _EN_DIVZERO | _EN_INVALID, 0, _ABORT_ON_ERROR, 0);
303670f3ff9SJed Brown   _trapmode = flag;
304e5c89e4eSSatish Balay   PetscFunctionReturn(0);
305e5c89e4eSSatish Balay }
306cc9df77eSBarry Smith 
307*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
308cc9df77eSBarry Smith   PetscFunctionBegin;
3099566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
310cc9df77eSBarry Smith   PetscFunctionReturn(0);
311cc9df77eSBarry Smith }
312cc9df77eSBarry Smith 
313e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
314cc9df77eSBarry Smith #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
315cc9df77eSBarry Smith #include <sunmath.h>
316cc9df77eSBarry Smith #include <floatingpoint.h>
317cc9df77eSBarry Smith #include <siginfo.h>
318cc9df77eSBarry Smith #include <ucontext.h>
319cc9df77eSBarry Smith 
320*9371c9d4SSatish Balay static struct {
321*9371c9d4SSatish Balay   int   code_no;
322*9371c9d4SSatish Balay   char *name;
323*9371c9d4SSatish Balay } error_codes[] = {
324cc9df77eSBarry Smith   {FPE_FLTINV, "invalid floating point operand"},
325cc9df77eSBarry Smith   {FPE_FLTRES, "inexact floating point result" },
326cc9df77eSBarry Smith   {FPE_FLTDIV, "division-by-zero"              },
327cc9df77eSBarry Smith   {FPE_FLTUND, "floating point underflow"      },
328cc9df77eSBarry Smith   {FPE_FLTOVF, "floating point overflow"       },
329cc9df77eSBarry Smith   {0,          "unknown error"                 }
330cc9df77eSBarry Smith };
331cc9df77eSBarry Smith #define SIGPC(scp) (scp->si_addr)
332cc9df77eSBarry Smith 
333*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig, siginfo_t *scp, ucontext_t *uap) {
3345f80ce2aSJacob Faibussowitsch   int err_ind = -1, code = scp->si_code;
335cc9df77eSBarry Smith 
336cc9df77eSBarry Smith   PetscFunctionBegin;
337cc9df77eSBarry Smith   err_ind = -1;
3385f80ce2aSJacob Faibussowitsch   for (int j = 0; error_codes[j].code_no; j++) {
339cc9df77eSBarry Smith     if (error_codes[j].code_no == code) err_ind = j;
340cc9df77eSBarry Smith   }
341cc9df77eSBarry Smith 
342cc9df77eSBarry Smith   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n", error_codes[err_ind].name, SIGPC(scp));
343cc9df77eSBarry Smith   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n", code, SIGPC(scp));
344cc9df77eSBarry Smith 
34549c86fc7SBarry Smith   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
346cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
347cc9df77eSBarry Smith }
348cc9df77eSBarry Smith 
349*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
350cc9df77eSBarry Smith   char *out;
351cc9df77eSBarry Smith 
352cc9df77eSBarry Smith   PetscFunctionBegin;
353cc9df77eSBarry Smith   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
354cc9df77eSBarry Smith   (void)ieee_flags("clear", "exception", "all", &out);
355cf0818bdSBarry Smith   if (flag) {
356cc9df77eSBarry Smith     if (ieee_handler("set", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floating point handler\n");
357cc9df77eSBarry Smith   } else {
358cc9df77eSBarry Smith     if (ieee_handler("clear", "common", (sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
359cc9df77eSBarry Smith   }
360cc9df77eSBarry Smith   _trapmode = flag;
361cc9df77eSBarry Smith   PetscFunctionReturn(0);
362cc9df77eSBarry Smith }
363cc9df77eSBarry Smith 
364*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
365cc9df77eSBarry Smith   PetscFunctionBegin;
3669566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
367cc9df77eSBarry Smith   PetscFunctionReturn(0);
368cc9df77eSBarry Smith }
369cc9df77eSBarry Smith 
370cc9df77eSBarry Smith /*----------------------------------------------- --------------------------------------------*/
371cc9df77eSBarry Smith #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
372e5c89e4eSSatish Balay /* In "fast" mode, floating point traps are imprecise and ignored.
373e5c89e4eSSatish Balay    This is the reason for the fptrap(FP_TRAP_SYNC) call */
374e5c89e4eSSatish Balay struct sigcontext;
375e5c89e4eSSatish Balay #include <fpxcp.h>
376e5c89e4eSSatish Balay #include <fptrap.h>
377e5c89e4eSSatish Balay #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
378e5c89e4eSSatish Balay #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
379e5c89e4eSSatish Balay #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
380e5c89e4eSSatish Balay #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
381e5c89e4eSSatish Balay #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
382e5c89e4eSSatish Balay 
383*9371c9d4SSatish Balay static struct {
384*9371c9d4SSatish Balay   int   code_no;
385*9371c9d4SSatish Balay   char *name;
386*9371c9d4SSatish Balay } error_codes[] = {
387e5c89e4eSSatish Balay   {FPE_FLTOPERR_TRAP, "IEEE operand error"           },
388e5c89e4eSSatish Balay   {FPE_FLTOVF_TRAP,   "floating point overflow"      },
389e5c89e4eSSatish Balay   {FPE_FLTUND_TRAP,   "floating point underflow"     },
390e5c89e4eSSatish Balay   {FPE_FLTDIV_TRAP,   "floating point divide"        },
391e5c89e4eSSatish Balay   {FPE_FLTINEX_TRAP,  "inexact floating point result"},
392e5c89e4eSSatish Balay   {0,                 "unknown error"                }
393e5c89e4eSSatish Balay };
394e5c89e4eSSatish Balay #define SIGPC(scp)        (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
395e5c89e4eSSatish Balay /*
396e5c89e4eSSatish Balay    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
397e5c89e4eSSatish Balay    it looks like it should from the include definitions.  It is probably
398e5c89e4eSSatish Balay    some strange interaction with the "POSIX_SOURCE" that we require.
399e5c89e4eSSatish Balay */
400e5c89e4eSSatish Balay 
401*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig, int code, struct sigcontext *scp) {
402e5c89e4eSSatish Balay   int      err_ind, j;
403e5c89e4eSSatish Balay   fp_ctx_t flt_context;
404e5c89e4eSSatish Balay 
405e5c89e4eSSatish Balay   PetscFunctionBegin;
406e5c89e4eSSatish Balay   fp_sh_trap_info(scp, &flt_context);
407e5c89e4eSSatish Balay 
408e5c89e4eSSatish Balay   err_ind = -1;
409e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
410e5c89e4eSSatish Balay     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
411e5c89e4eSSatish Balay   }
412e5c89e4eSSatish Balay 
413a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n", error_codes[err_ind].name);
414a297a907SKarl Rupp   else (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n", flt_context.trap);
415a297a907SKarl Rupp 
41649c86fc7SBarry Smith   (void)PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
41741e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
418e5c89e4eSSatish Balay }
419e5c89e4eSSatish Balay 
420*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
421e5c89e4eSSatish Balay   PetscFunctionBegin;
422cf0818bdSBarry Smith   if (flag) {
423e5c89e4eSSatish Balay     signal(SIGFPE, (void (*)(int))PetscDefaultFPTrap);
424e5c89e4eSSatish Balay     fp_trap(FP_TRAP_SYNC);
425cc9df77eSBarry Smith     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
426e5c89e4eSSatish Balay     /* fp_enable(mask) for individual traps.  Values are:
427e5c89e4eSSatish Balay        TRP_INVALID
428e5c89e4eSSatish Balay        TRP_DIV_BY_ZERO
429e5c89e4eSSatish Balay        TRP_OVERFLOW
430e5c89e4eSSatish Balay        TRP_UNDERFLOW
431e5c89e4eSSatish Balay        TRP_INEXACT
432e5c89e4eSSatish Balay        Can OR then together.
433e5c89e4eSSatish Balay        fp_enable_all(); for all traps.
434e5c89e4eSSatish Balay     */
435e5c89e4eSSatish Balay   } else {
436e5c89e4eSSatish Balay     signal(SIGFPE, SIG_DFL);
437cc9df77eSBarry Smith     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
438e5c89e4eSSatish Balay     fp_trap(FP_TRAP_OFF);
439e5c89e4eSSatish Balay   }
440cf0818bdSBarry Smith   _trapmode = flag;
441e5c89e4eSSatish Balay   PetscFunctionReturn(0);
442e5c89e4eSSatish Balay }
443e5c89e4eSSatish Balay 
444*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
445cc9df77eSBarry Smith   PetscFunctionBegin;
4469566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
447cc9df77eSBarry Smith   PetscFunctionReturn(0);
448cc9df77eSBarry Smith }
449cc9df77eSBarry Smith 
450cc9df77eSBarry Smith /* ------------------------------------------------------------*/
451cc9df77eSBarry Smith #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
452cc9df77eSBarry Smith #include <float.h>
453*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig) {
454cc9df77eSBarry Smith   PetscFunctionBegin;
455cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
45649c86fc7SBarry Smith   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
457cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
458cc9df77eSBarry Smith }
459cc9df77eSBarry Smith 
460*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
461cc9df77eSBarry Smith   unsigned int cw;
462cc9df77eSBarry Smith 
463cc9df77eSBarry Smith   PetscFunctionBegin;
464cf0818bdSBarry Smith   if (flag) {
465cc9df77eSBarry Smith     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW;
46608401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
467cc9df77eSBarry Smith   } else {
468cc9df77eSBarry Smith     cw = 0;
46908401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
470cc9df77eSBarry Smith   }
471cc9df77eSBarry Smith   (void)_controlfp(0, cw);
472cf0818bdSBarry Smith   _trapmode = flag;
473cc9df77eSBarry Smith   PetscFunctionReturn(0);
474cc9df77eSBarry Smith }
475cc9df77eSBarry Smith 
476*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
477cc9df77eSBarry Smith   PetscFunctionBegin;
4789566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
479cc9df77eSBarry Smith   PetscFunctionReturn(0);
480cc9df77eSBarry Smith }
481cc9df77eSBarry Smith 
482cc9df77eSBarry Smith /* ------------------------------------------------------------*/
4839a2402e9SBarry Smith #elif defined(PETSC_HAVE_FENV_H) && !defined(__cplusplus)
484b014e56cSJed Brown /*
485b014e56cSJed Brown    C99 style floating point environment.
486b014e56cSJed Brown 
487b014e56cSJed Brown    Note that C99 merely specifies how to save, restore, and clear the floating
488b014e56cSJed Brown    point environment as well as defining an enumeration of exception codes.  In
489b014e56cSJed Brown    particular, C99 does not specify how to make floating point exceptions raise
490b014e56cSJed Brown    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
491b014e56cSJed Brown    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
492b014e56cSJed Brown */
493b014e56cSJed Brown #include <fenv.h>
494*9371c9d4SSatish Balay typedef struct {
495*9371c9d4SSatish Balay   int         code;
496*9371c9d4SSatish Balay   const char *name;
497*9371c9d4SSatish Balay } FPNode;
498b014e56cSJed Brown static const FPNode error_codes[] = {
499b014e56cSJed Brown   {FE_DIVBYZERO, "divide by zero"                                 },
500b014e56cSJed Brown   {FE_INEXACT,   "inexact floating point result"                  },
501b014e56cSJed Brown   {FE_INVALID,   "invalid floating point arguments (domain error)"},
502b014e56cSJed Brown   {FE_OVERFLOW,  "floating point overflow"                        },
503b014e56cSJed Brown   {FE_UNDERFLOW, "floating point underflow"                       },
504b014e56cSJed Brown   {0,            "unknown error"                                  }
505b014e56cSJed Brown };
50699e0435eSBarry Smith 
507*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig) {
508b014e56cSJed Brown   const FPNode *node;
509b014e56cSJed Brown   int           code;
510ace3abfcSBarry Smith   PetscBool     matched = PETSC_FALSE;
511b014e56cSJed Brown 
512b014e56cSJed Brown   PetscFunctionBegin;
513b014e56cSJed Brown   /* Note: While it is possible for the exception state to be preserved by the
514b014e56cSJed Brown    * kernel, this seems to be rare which makes the following flag testing almost
515b014e56cSJed Brown    * useless.  But on a system where the flags can be preserved, it would provide
5167d125cddSJed Brown    * more detail.
517b014e56cSJed Brown    */
518b014e56cSJed Brown   code = fetestexcept(FE_ALL_EXCEPT);
519b014e56cSJed Brown   for (node = &error_codes[0]; node->code; node++) {
520b014e56cSJed Brown     if (code & node->code) {
521b014e56cSJed Brown       matched = PETSC_TRUE;
522b014e56cSJed Brown       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n", node->name);
523b014e56cSJed Brown       code &= ~node->code; /* Unset this flag since it has been processed */
524b014e56cSJed Brown     }
525b014e56cSJed Brown   }
526b014e56cSJed Brown   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
527b014e56cSJed Brown     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
5287d125cddSJed Brown     (*PetscErrorPrintf)("The specific exception can be determined by running in a debugger.  When the\n");
5297d125cddSJed Brown     (*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n", FE_ALL_EXCEPT);
5307d125cddSJed Brown     (*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
5317d125cddSJed Brown     (*PetscErrorPrintf)("FE_INVALID=0x%x FE_DIVBYZERO=0x%x FE_OVERFLOW=0x%x FE_UNDERFLOW=0x%x FE_INEXACT=0x%x\n", FE_INVALID, FE_DIVBYZERO, FE_OVERFLOW, FE_UNDERFLOW, FE_INEXACT);
532b014e56cSJed Brown   }
5337d125cddSJed Brown 
5347d125cddSJed Brown   (*PetscErrorPrintf)("Try option -start_in_debugger\n");
53527104ee2SJacob Faibussowitsch #if PetscDefined(USE_DEBUG)
5367d125cddSJed Brown   (*PetscErrorPrintf)("likely location of problem given in stack below\n");
5377d125cddSJed Brown   (*PetscErrorPrintf)("---------------------  Stack Frames ------------------------------------\n");
538639ff905SBarry Smith   PetscStackView(PETSC_STDOUT);
53927104ee2SJacob Faibussowitsch #else
5407d125cddSJed Brown   (*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
5417d125cddSJed Brown   (*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
54227104ee2SJacob Faibussowitsch #endif
54349c86fc7SBarry Smith   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_INITIAL, "trapped floating point error");
54441e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
545b014e56cSJed Brown }
546b014e56cSJed Brown 
547*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
548b014e56cSJed Brown   PetscFunctionBegin;
549cf0818bdSBarry Smith   if (flag) {
550b014e56cSJed Brown     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
551cc73adaaSBarry Smith     PetscCheck(!feclearexcept(FE_ALL_EXCEPT), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot clear floating point exception flags");
552cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
553cc9df77eSBarry Smith     /* Could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
554cf0818bdSBarry Smith     /* PetscCheck(feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) != -1,PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot activate floating point exceptions"); */
555cf0818bdSBarry Smith     PetscCheck(feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW) != -1, PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot activate floating point exceptions");
556b014e56cSJed Brown #elif defined PETSC_HAVE_XMMINTRIN_H
557cc9df77eSBarry Smith     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_DIV_ZERO);
558cc9df77eSBarry Smith     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_UNDERFLOW);
559cc9df77eSBarry Smith     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_OVERFLOW);
560cc9df77eSBarry Smith     _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_INVALID);
561b014e56cSJed Brown #else
562b014e56cSJed Brown     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
563b014e56cSJed Brown #endif
56408401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
565b014e56cSJed Brown   } else {
566cc73adaaSBarry Smith     PetscCheck(!fesetenv(FE_DFL_ENV), PETSC_COMM_SELF, PETSC_ERR_LIB, "Cannot disable floating point exceptions");
567cc9df77eSBarry Smith     /* can use _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() | _MM_MASK_UNDERFLOW); if PETSC_HAVE_XMMINTRIN_H exists */
56808401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
569b014e56cSJed Brown   }
570cf0818bdSBarry Smith   _trapmode = flag;
571b014e56cSJed Brown   PetscFunctionReturn(0);
572b014e56cSJed Brown }
573b014e56cSJed Brown 
574*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
575cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
576cc9df77eSBarry Smith   unsigned int flags;
577cc9df77eSBarry Smith #endif
578cc9df77eSBarry Smith 
579cc9df77eSBarry Smith   PetscFunctionBegin;
580cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
581cc9df77eSBarry Smith   flags = fegetexcept();
582cc9df77eSBarry Smith   if (flags & FE_DIVBYZERO) {
583cc9df77eSBarry Smith #elif defined PETSC_HAVE_XMMINTRIN_H
584cc9df77eSBarry Smith   flags = _MM_GET_EXCEPTION_MASK();
585cc9df77eSBarry Smith   if (!(flags & _MM_MASK_DIV_ZERO)) {
586cc9df77eSBarry Smith #else
5879566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Floating point trapping unknown, assuming off\n"));
588cc9df77eSBarry Smith   PetscFunctionReturn(0);
589cc9df77eSBarry Smith #endif
590cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
591cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_ON;
5929566063dSJacob Faibussowitsch     PetscCall(PetscInfo(NULL, "Floating point trapping is on by default %d\n", flags));
593cc9df77eSBarry Smith   } else {
594cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_OFF;
5959566063dSJacob Faibussowitsch     PetscCall(PetscInfo(NULL, "Floating point trapping is off by default %d\n", flags));
596cc9df77eSBarry Smith   }
597cc9df77eSBarry Smith   PetscFunctionReturn(0);
598cc9df77eSBarry Smith #endif
599cc9df77eSBarry Smith }
600cc9df77eSBarry Smith 
601cc9df77eSBarry Smith /* ------------------------------------------------------------*/
602cc9df77eSBarry Smith #elif defined(PETSC_HAVE_IEEEFP_H)
603cc9df77eSBarry Smith #include <ieeefp.h>
604*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig) {
605cc9df77eSBarry Smith   PetscFunctionBegin;
606cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
60749c86fc7SBarry Smith   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
608cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
609cc9df77eSBarry Smith }
610cc9df77eSBarry Smith 
611*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
612cc9df77eSBarry Smith   PetscFunctionBegin;
613cf0818bdSBarry Smith   if (flag == PETSC_FP_TRAP_ON) {
614cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
615cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
616cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
617cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
618cc9df77eSBarry Smith #endif
619cc9df77eSBarry Smith     fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL | FP_X_OFL);
62008401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, PetscDefaultFPTrap), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't set floating point handler");
621cc9df77eSBarry Smith   } else {
622cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
623cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
624cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
625cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
626cc9df77eSBarry Smith #endif
627cc9df77eSBarry Smith     fpsetmask(0);
62808401ef6SPierre Jolivet     PetscCheck(SIG_ERR != signal(SIGFPE, SIG_DFL), PETSC_COMM_SELF, PETSC_ERR_LIB, "Can't clear floating point handler");
629cc9df77eSBarry Smith   }
630cf0818bdSBarry Smith   _trapmode = flag;
631cc9df77eSBarry Smith   PetscFunctionReturn(0);
632cc9df77eSBarry Smith }
633cc9df77eSBarry Smith 
634*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
635cc9df77eSBarry Smith   PetscFunctionBegin;
6369566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
637cc9df77eSBarry Smith   PetscFunctionReturn(0);
638cc9df77eSBarry Smith }
639cc9df77eSBarry Smith 
640e5c89e4eSSatish Balay /* -------------------------Default -----------------------------------*/
641e5c89e4eSSatish Balay #else
64299e0435eSBarry Smith 
643*9371c9d4SSatish Balay void PetscDefaultFPTrap(int sig) {
644e5c89e4eSSatish Balay   PetscFunctionBegin;
645e5c89e4eSSatish Balay   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
64649c86fc7SBarry Smith   PetscError(PETSC_COMM_SELF, 0, NULL, NULL, PETSC_ERR_FP, PETSC_ERROR_REPEAT, "floating point error");
64741e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD, PETSC_ERR_FP);
648e5c89e4eSSatish Balay }
64999e0435eSBarry Smith 
650*9371c9d4SSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag) {
651e5c89e4eSSatish Balay   PetscFunctionBegin;
652cf0818bdSBarry Smith   if (flag) {
653a297a907SKarl Rupp     if (SIG_ERR == signal(SIGFPE, PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
654a297a907SKarl Rupp   } else if (SIG_ERR == signal(SIGFPE, SIG_DFL)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
655a297a907SKarl Rupp 
656cf0818bdSBarry Smith   _trapmode = flag;
657e5c89e4eSSatish Balay   PetscFunctionReturn(0);
658e5c89e4eSSatish Balay }
659cc9df77eSBarry Smith 
660*9371c9d4SSatish Balay PetscErrorCode PetscDetermineInitialFPTrap(void) {
661cc9df77eSBarry Smith   PetscFunctionBegin;
6629566063dSJacob Faibussowitsch   PetscCall(PetscInfo(NULL, "Unable to determine initial floating point trapping. Assuming it is off\n"));
663cc9df77eSBarry Smith   PetscFunctionReturn(0);
664cc9df77eSBarry Smith }
665e5c89e4eSSatish Balay #endif
666