xref: /petsc/src/sys/error/fp.c (revision 2c71b3e237ead271e4f3aa1505f92bf476e3413d)
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:
34670f3ff9SJed Brown .    trap - PETSC_FP_TRAP_ON or PETSC_FP_TRAP_OFF
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 
49aba4c478SBarry Smith .seealso: PetscFPTrapPop(), PetscSetFPTrap(), PetscDetermineInitialFPTrap()
50670f3ff9SJed Brown @*/
51670f3ff9SJed Brown PetscErrorCode PetscFPTrapPush(PetscFPTrap trap)
52670f3ff9SJed Brown {
53670f3ff9SJed Brown   PetscErrorCode         ierr;
54670f3ff9SJed Brown   struct PetscFPTrapLink *link;
55670f3ff9SJed Brown 
56670f3ff9SJed Brown   PetscFunctionBegin;
57854ce69bSBarry Smith   ierr           = PetscNew(&link);CHKERRQ(ierr);
58670f3ff9SJed Brown   link->trapmode = _trapmode;
59670f3ff9SJed Brown   link->next     = _trapstack;
60670f3ff9SJed Brown   _trapstack     = link;
61f6883b22SJed Brown   if (trap != _trapmode) {ierr = PetscSetFPTrap(trap);CHKERRQ(ierr);}
62670f3ff9SJed Brown   PetscFunctionReturn(0);
63670f3ff9SJed Brown }
64670f3ff9SJed Brown 
65670f3ff9SJed Brown /*@
66670f3ff9SJed Brown    PetscFPTrapPop - push a floating point trapping mode, to be restored using PetscFPTrapPop()
67670f3ff9SJed Brown 
68670f3ff9SJed Brown    Not Collective
69670f3ff9SJed Brown 
70670f3ff9SJed Brown    Level: advanced
71670f3ff9SJed Brown 
72aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscSetFPTrap(), PetscDetermineInitialFPTrap()
73670f3ff9SJed Brown @*/
74670f3ff9SJed Brown PetscErrorCode PetscFPTrapPop(void)
75670f3ff9SJed Brown {
76670f3ff9SJed Brown   PetscErrorCode         ierr;
77670f3ff9SJed Brown   struct PetscFPTrapLink *link;
78670f3ff9SJed Brown 
79670f3ff9SJed Brown   PetscFunctionBegin;
80f6883b22SJed Brown   if (_trapstack->trapmode != _trapmode) {ierr = PetscSetFPTrap(_trapstack->trapmode);CHKERRQ(ierr);}
81670f3ff9SJed Brown   link       = _trapstack;
82670f3ff9SJed Brown   _trapstack = _trapstack->next;
83670f3ff9SJed Brown   ierr       = PetscFree(link);CHKERRQ(ierr);
84670f3ff9SJed Brown   PetscFunctionReturn(0);
85670f3ff9SJed Brown }
86670f3ff9SJed Brown 
87e5c89e4eSSatish Balay /*--------------------------------------- ---------------------------------------------------*/
88e5c89e4eSSatish Balay #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
89e5c89e4eSSatish Balay #include <floatingpoint.h>
90e5c89e4eSSatish Balay 
918cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_flags(char*,char*,char*,char**);
928cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_handler(char*,char*,sigfpe_handler_type(int,int,struct sigcontext*,char*));
93e5c89e4eSSatish Balay 
94db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
95e5c89e4eSSatish Balay   { FPE_INTDIV_TRAP    ,"integer divide" },
96e5c89e4eSSatish Balay   { FPE_FLTOPERR_TRAP  ,"IEEE operand error" },
97e5c89e4eSSatish Balay   { FPE_FLTOVF_TRAP    ,"floating point overflow" },
98e5c89e4eSSatish Balay   { FPE_FLTUND_TRAP    ,"floating point underflow" },
99e5c89e4eSSatish Balay   { FPE_FLTDIV_TRAP    ,"floating pointing divide" },
100e5c89e4eSSatish Balay   { FPE_FLTINEX_TRAP   ,"inexact floating point result" },
101e5c89e4eSSatish Balay   { 0                  ,"unknown error" }
102e5c89e4eSSatish Balay };
103e5c89e4eSSatish Balay #define SIGPC(scp) (scp->sc_pc)
104e5c89e4eSSatish Balay 
105e5c89e4eSSatish Balay sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
106e5c89e4eSSatish Balay {
107e5c89e4eSSatish Balay   PetscErrorCode ierr;
108e5c89e4eSSatish Balay   int            err_ind = -1,j;
109e5c89e4eSSatish Balay 
110e5c89e4eSSatish Balay   PetscFunctionBegin;
111e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
112e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
113e5c89e4eSSatish Balay   }
114e5c89e4eSSatish Balay 
115a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
116a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
117a297a907SKarl Rupp 
118efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
11941e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
120e5c89e4eSSatish Balay   PetscFunctionReturn(0);
121e5c89e4eSSatish Balay }
122e5c89e4eSSatish Balay 
123e30d2299SSatish Balay /*@
124e5c89e4eSSatish Balay    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
125cc9df77eSBarry Smith                     This option may not work on certain systems.
126e5c89e4eSSatish Balay 
127e5c89e4eSSatish Balay    Not Collective
128e5c89e4eSSatish Balay 
129e5c89e4eSSatish Balay    Input Parameters:
130e5c89e4eSSatish Balay .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.
131e5c89e4eSSatish Balay 
132e5c89e4eSSatish Balay    Options Database Keys:
133e5c89e4eSSatish Balay .  -fp_trap - Activates floating point trapping
134e5c89e4eSSatish Balay 
135e5c89e4eSSatish Balay    Level: advanced
136e5c89e4eSSatish Balay 
137e5c89e4eSSatish Balay    Description:
138cc9df77eSBarry Smith    On systems that support it, when called with PETSC_FP_TRAP_ON this routine causes floating point
139cc9df77eSBarry Smith    underflow, overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
140e5c89e4eSSatish Balay    cause a message to be printed and the program to exit.
141e5c89e4eSSatish Balay 
1427d125cddSJed Brown    Note:
143cc9df77eSBarry Smith    On many common systems, the floating
1447d125cddSJed Brown    point exception state is not preserved from the location where the trap
1457d125cddSJed Brown    occurred through to the signal handler.  In this case, the signal handler
1467d125cddSJed Brown    will just say that an unknown floating point exception occurred and which
1477d125cddSJed Brown    function it occurred in.  If you run with -fp_trap in a debugger, it will
148cc9df77eSBarry Smith    break on the line where the error occurred.  On systems that support C99
149cc9df77eSBarry Smith    floating point exception handling You can check which
1507d125cddSJed Brown    exception occurred using fetestexcept(FE_ALL_EXCEPT).  See fenv.h
1517d125cddSJed Brown    (usually at /usr/include/bits/fenv.h) for the enum values on your system.
1527d125cddSJed Brown 
153e5c89e4eSSatish Balay    Caution:
154cc9df77eSBarry Smith    On certain machines, in particular the IBM PowerPC, floating point
155cc9df77eSBarry Smith    trapping may be VERY slow!
156e5c89e4eSSatish Balay 
157aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitialFPTrap()
158e5c89e4eSSatish Balay @*/
159e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
160e5c89e4eSSatish Balay {
161e5c89e4eSSatish Balay   char *out;
162e5c89e4eSSatish Balay 
163e5c89e4eSSatish Balay   PetscFunctionBegin;
164e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
165e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
166e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
167e5c89e4eSSatish Balay     /*
168a297a907SKarl Rupp       To trap more fp exceptions, including underflow, change the line below to
169e5c89e4eSSatish Balay       if (ieee_handler("set","all",PetscDefaultFPTrap)) {
170e5c89e4eSSatish Balay     */
171a297a907SKarl Rupp     if (ieee_handler("set","common",PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
172a297a907SKarl Rupp   } else if (ieee_handler("clear","common",PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
173a297a907SKarl Rupp 
174670f3ff9SJed Brown   _trapmode = flag;
175e5c89e4eSSatish Balay   PetscFunctionReturn(0);
176e5c89e4eSSatish Balay }
177e5c89e4eSSatish Balay 
178cc9df77eSBarry Smith /*@
179aba4c478SBarry Smith    PetscDetermineInitialFPTrap - Attempts to determine the floating point trapping that exists when PetscInitialize() is called
180cc9df77eSBarry Smith 
181cc9df77eSBarry Smith    Not Collective
182cc9df77eSBarry Smith 
183cc9df77eSBarry Smith    Notes:
184cc9df77eSBarry Smith       Currently only supported on Linux and MacOS. Checks if divide by zero is enable and if so declares that trapping is on.
185cc9df77eSBarry Smith 
186ee300463SSatish Balay    Level: advanced
187cc9df77eSBarry Smith 
188aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitialFPTrap()
189cc9df77eSBarry Smith @*/
190aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
191cc9df77eSBarry Smith {
192cc9df77eSBarry Smith   PetscErrorCode ierr;
193cc9df77eSBarry Smith 
194cc9df77eSBarry Smith   PetscFunctionBegin;
195cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
196cc9df77eSBarry Smith   PetscFunctionReturn(0);
197cc9df77eSBarry Smith }
198cc9df77eSBarry Smith 
199e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
200e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
201e5c89e4eSSatish Balay #include <sunmath.h>
202e5c89e4eSSatish Balay #include <floatingpoint.h>
203e5c89e4eSSatish Balay #include <siginfo.h>
204e5c89e4eSSatish Balay #include <ucontext.h>
205e5c89e4eSSatish Balay 
206db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
207e5c89e4eSSatish Balay   { FPE_FLTINV,"invalid floating point operand"},
208e5c89e4eSSatish Balay   { FPE_FLTRES,"inexact floating point result"},
209e5c89e4eSSatish Balay   { FPE_FLTDIV,"division-by-zero"},
210e5c89e4eSSatish Balay   { FPE_FLTUND,"floating point underflow"},
211e5c89e4eSSatish Balay   { FPE_FLTOVF,"floating point overflow"},
212e5c89e4eSSatish Balay   { 0,         "unknown error"}
213e5c89e4eSSatish Balay };
214e5c89e4eSSatish Balay #define SIGPC(scp) (scp->si_addr)
215e5c89e4eSSatish Balay 
216e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
217e5c89e4eSSatish Balay {
218e5c89e4eSSatish Balay   int            err_ind,j,code = scp->si_code;
219e5c89e4eSSatish Balay   PetscErrorCode ierr;
220e5c89e4eSSatish Balay 
221e5c89e4eSSatish Balay   PetscFunctionBegin;
222e5c89e4eSSatish Balay   err_ind = -1;
223e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
224e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
225e5c89e4eSSatish Balay   }
226e5c89e4eSSatish Balay 
227a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
228a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
229a297a907SKarl Rupp 
230efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
23141e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
232e5c89e4eSSatish Balay }
233e5c89e4eSSatish Balay 
234e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
235e5c89e4eSSatish Balay {
236e5c89e4eSSatish Balay   char *out;
237e5c89e4eSSatish Balay 
238e5c89e4eSSatish Balay   PetscFunctionBegin;
239e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
240e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
241e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
242a297a907SKarl Rupp     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
243cc9df77eSBarry Smith   } else {
244cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
245cc9df77eSBarry Smith   }
246670f3ff9SJed Brown   _trapmode = flag;
247e5c89e4eSSatish Balay   PetscFunctionReturn(0);
248e5c89e4eSSatish Balay }
249e5c89e4eSSatish Balay 
250aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
251cc9df77eSBarry Smith {
252cc9df77eSBarry Smith   PetscErrorCode ierr;
253e5c89e4eSSatish Balay 
254cc9df77eSBarry Smith   PetscFunctionBegin;
255cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
256cc9df77eSBarry Smith   PetscFunctionReturn(0);
257cc9df77eSBarry Smith }
258cc9df77eSBarry Smith 
259cc9df77eSBarry Smith /* ------------------------------------------------------------------------------------------*/
260e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_IRIX_STYLE_FPTRAP)
261e5c89e4eSSatish Balay #include <sigfpe.h>
262db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
263e5c89e4eSSatish Balay   { _INVALID   ,"IEEE operand error" },
264e5c89e4eSSatish Balay   { _OVERFL    ,"floating point overflow" },
265e5c89e4eSSatish Balay   { _UNDERFL   ,"floating point underflow" },
266e5c89e4eSSatish Balay   { _DIVZERO   ,"floating point divide" },
267e5c89e4eSSatish Balay   { 0          ,"unknown error" }
268e5c89e4eSSatish Balay } ;
269e5c89e4eSSatish Balay void PetscDefaultFPTrap(unsigned exception[],int val[])
270e5c89e4eSSatish Balay {
271e5c89e4eSSatish Balay   int err_ind,j,code;
272e5c89e4eSSatish Balay 
273e5c89e4eSSatish Balay   PetscFunctionBegin;
274e5c89e4eSSatish Balay   code    = exception[0];
275e5c89e4eSSatish Balay   err_ind = -1;
276e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
277e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
278e5c89e4eSSatish Balay   }
279a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
280a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
281a297a907SKarl Rupp 
282efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
28341e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
284e5c89e4eSSatish Balay }
285e5c89e4eSSatish Balay 
286e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
287e5c89e4eSSatish Balay {
288e5c89e4eSSatish Balay   PetscFunctionBegin;
289cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) handle_sigfpes(_ON,,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
290cc9df77eSBarry Smith   else                          handle_sigfpes(_OFF,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
291670f3ff9SJed Brown   _trapmode = flag;
292e5c89e4eSSatish Balay   PetscFunctionReturn(0);
293e5c89e4eSSatish Balay }
294cc9df77eSBarry Smith 
295aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
296cc9df77eSBarry Smith {
297cc9df77eSBarry Smith   PetscErrorCode ierr;
298cc9df77eSBarry Smith 
299cc9df77eSBarry Smith   PetscFunctionBegin;
300cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
301cc9df77eSBarry Smith   PetscFunctionReturn(0);
302cc9df77eSBarry Smith }
303cc9df77eSBarry Smith 
304e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
305cc9df77eSBarry Smith #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
306cc9df77eSBarry Smith #include <sunmath.h>
307cc9df77eSBarry Smith #include <floatingpoint.h>
308cc9df77eSBarry Smith #include <siginfo.h>
309cc9df77eSBarry Smith #include <ucontext.h>
310cc9df77eSBarry Smith 
311cc9df77eSBarry Smith static struct { int code_no; char *name; } error_codes[] = {
312cc9df77eSBarry Smith   { FPE_FLTINV,"invalid floating point operand"},
313cc9df77eSBarry Smith   { FPE_FLTRES,"inexact floating point result"},
314cc9df77eSBarry Smith   { FPE_FLTDIV,"division-by-zero"},
315cc9df77eSBarry Smith   { FPE_FLTUND,"floating point underflow"},
316cc9df77eSBarry Smith   { FPE_FLTOVF,"floating point overflow"},
317cc9df77eSBarry Smith   { 0,         "unknown error"}
318cc9df77eSBarry Smith };
319cc9df77eSBarry Smith #define SIGPC(scp) (scp->si_addr)
320cc9df77eSBarry Smith 
321cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
322cc9df77eSBarry Smith {
323cc9df77eSBarry Smith   int            err_ind,j,code = scp->si_code;
324cc9df77eSBarry Smith   PetscErrorCode ierr;
325cc9df77eSBarry Smith 
326cc9df77eSBarry Smith   PetscFunctionBegin;
327cc9df77eSBarry Smith   err_ind = -1;
328cc9df77eSBarry Smith   for (j = 0; error_codes[j].code_no; j++) {
329cc9df77eSBarry Smith     if (error_codes[j].code_no == code) err_ind = j;
330cc9df77eSBarry Smith   }
331cc9df77eSBarry Smith 
332cc9df77eSBarry Smith   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
333cc9df77eSBarry Smith   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
334cc9df77eSBarry Smith 
335cc9df77eSBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
336cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
337cc9df77eSBarry Smith }
338cc9df77eSBarry Smith 
339cc9df77eSBarry Smith PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
340cc9df77eSBarry Smith {
341cc9df77eSBarry Smith   char *out;
342cc9df77eSBarry Smith 
343cc9df77eSBarry Smith   PetscFunctionBegin;
344cc9df77eSBarry Smith   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
345cc9df77eSBarry Smith   (void) ieee_flags("clear","exception","all",&out);
346cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) {
347cc9df77eSBarry Smith     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
348cc9df77eSBarry Smith   } else {
349cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
350cc9df77eSBarry Smith   }
351cc9df77eSBarry Smith   _trapmode = flag;
352cc9df77eSBarry Smith   PetscFunctionReturn(0);
353cc9df77eSBarry Smith }
354cc9df77eSBarry Smith 
355aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
356cc9df77eSBarry Smith {
357cc9df77eSBarry Smith   PetscErrorCode ierr;
358cc9df77eSBarry Smith 
359cc9df77eSBarry Smith   PetscFunctionBegin;
360cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
361cc9df77eSBarry Smith   PetscFunctionReturn(0);
362cc9df77eSBarry Smith }
363cc9df77eSBarry Smith 
364cc9df77eSBarry Smith /*----------------------------------------------- --------------------------------------------*/
365cc9df77eSBarry Smith #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
366e5c89e4eSSatish Balay /* In "fast" mode, floating point traps are imprecise and ignored.
367e5c89e4eSSatish Balay    This is the reason for the fptrap(FP_TRAP_SYNC) call */
368e5c89e4eSSatish Balay struct sigcontext;
369e5c89e4eSSatish Balay #include <fpxcp.h>
370e5c89e4eSSatish Balay #include <fptrap.h>
371e5c89e4eSSatish Balay #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
372e5c89e4eSSatish Balay #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
373e5c89e4eSSatish Balay #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
374e5c89e4eSSatish Balay #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
375e5c89e4eSSatish Balay #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
376e5c89e4eSSatish Balay 
377db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
378e5c89e4eSSatish Balay   {FPE_FLTOPERR_TRAP   ,"IEEE operand error" },
379e5c89e4eSSatish Balay   { FPE_FLTOVF_TRAP    ,"floating point overflow" },
380e5c89e4eSSatish Balay   { FPE_FLTUND_TRAP    ,"floating point underflow" },
381e5c89e4eSSatish Balay   { FPE_FLTDIV_TRAP    ,"floating point divide" },
382e5c89e4eSSatish Balay   { FPE_FLTINEX_TRAP   ,"inexact floating point result" },
383e5c89e4eSSatish Balay   { 0                  ,"unknown error" }
384e5c89e4eSSatish Balay } ;
385e5c89e4eSSatish Balay #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
386e5c89e4eSSatish Balay /*
387e5c89e4eSSatish Balay    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
388e5c89e4eSSatish Balay    it looks like it should from the include definitions.  It is probably
389e5c89e4eSSatish Balay    some strange interaction with the "POSIX_SOURCE" that we require.
390e5c89e4eSSatish Balay */
391e5c89e4eSSatish Balay 
392e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
393e5c89e4eSSatish Balay {
394e5c89e4eSSatish Balay   PetscErrorCode ierr;
395e5c89e4eSSatish Balay   int            err_ind,j;
396e5c89e4eSSatish Balay   fp_ctx_t       flt_context;
397e5c89e4eSSatish Balay 
398e5c89e4eSSatish Balay   PetscFunctionBegin;
399e5c89e4eSSatish Balay   fp_sh_trap_info(scp,&flt_context);
400e5c89e4eSSatish Balay 
401e5c89e4eSSatish Balay   err_ind = -1;
402e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
403e5c89e4eSSatish Balay     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
404e5c89e4eSSatish Balay   }
405e5c89e4eSSatish Balay 
406a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
407a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
408a297a907SKarl Rupp 
409efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
41041e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
411e5c89e4eSSatish Balay }
412e5c89e4eSSatish Balay 
413e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
414e5c89e4eSSatish Balay {
415e5c89e4eSSatish Balay   PetscFunctionBegin;
416e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
417e5c89e4eSSatish Balay     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
418e5c89e4eSSatish Balay     fp_trap(FP_TRAP_SYNC);
419cc9df77eSBarry Smith     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
420e5c89e4eSSatish Balay     /* fp_enable(mask) for individual traps.  Values are:
421e5c89e4eSSatish Balay        TRP_INVALID
422e5c89e4eSSatish Balay        TRP_DIV_BY_ZERO
423e5c89e4eSSatish Balay        TRP_OVERFLOW
424e5c89e4eSSatish Balay        TRP_UNDERFLOW
425e5c89e4eSSatish Balay        TRP_INEXACT
426e5c89e4eSSatish Balay        Can OR then together.
427e5c89e4eSSatish Balay        fp_enable_all(); for all traps.
428e5c89e4eSSatish Balay     */
429e5c89e4eSSatish Balay   } else {
430e5c89e4eSSatish Balay     signal(SIGFPE,SIG_DFL);
431cc9df77eSBarry Smith     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
432e5c89e4eSSatish Balay     fp_trap(FP_TRAP_OFF);
433e5c89e4eSSatish Balay   }
434670f3ff9SJed Brown   _trapmode = on;
435e5c89e4eSSatish Balay   PetscFunctionReturn(0);
436e5c89e4eSSatish Balay }
437e5c89e4eSSatish Balay 
438aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
439cc9df77eSBarry Smith {
440cc9df77eSBarry Smith   PetscErrorCode ierr;
441cc9df77eSBarry Smith 
442cc9df77eSBarry Smith   PetscFunctionBegin;
443cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
444cc9df77eSBarry Smith   PetscFunctionReturn(0);
445cc9df77eSBarry Smith }
446cc9df77eSBarry Smith 
447cc9df77eSBarry Smith /* ------------------------------------------------------------*/
448cc9df77eSBarry Smith #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
449cc9df77eSBarry Smith #include <float.h>
450cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
451cc9df77eSBarry Smith {
452cc9df77eSBarry Smith   PetscFunctionBegin;
453cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
454cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
455cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
456cc9df77eSBarry Smith }
457cc9df77eSBarry Smith 
458cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
459cc9df77eSBarry Smith {
460cc9df77eSBarry Smith   unsigned int cw;
461cc9df77eSBarry Smith 
462cc9df77eSBarry Smith   PetscFunctionBegin;
463cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
464cc9df77eSBarry Smith     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW;
465*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler");
466cc9df77eSBarry Smith   } else {
467cc9df77eSBarry Smith     cw = 0;
468*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,SIG_DFL),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler");
469cc9df77eSBarry Smith   }
470cc9df77eSBarry Smith   (void)_controlfp(0, cw);
471cc9df77eSBarry Smith   _trapmode = on;
472cc9df77eSBarry Smith   PetscFunctionReturn(0);
473cc9df77eSBarry Smith }
474cc9df77eSBarry Smith 
475aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
476cc9df77eSBarry Smith {
477cc9df77eSBarry Smith   PetscErrorCode ierr;
478cc9df77eSBarry Smith 
479cc9df77eSBarry Smith   PetscFunctionBegin;
480cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
481cc9df77eSBarry Smith   PetscFunctionReturn(0);
482cc9df77eSBarry Smith }
483cc9df77eSBarry Smith 
484cc9df77eSBarry Smith /* ------------------------------------------------------------*/
4859a2402e9SBarry Smith #elif defined(PETSC_HAVE_FENV_H) && !defined(__cplusplus)
486b014e56cSJed Brown /*
487b014e56cSJed Brown    C99 style floating point environment.
488b014e56cSJed Brown 
489b014e56cSJed Brown    Note that C99 merely specifies how to save, restore, and clear the floating
490b014e56cSJed Brown    point environment as well as defining an enumeration of exception codes.  In
491b014e56cSJed Brown    particular, C99 does not specify how to make floating point exceptions raise
492b014e56cSJed Brown    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
493b014e56cSJed Brown    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
494b014e56cSJed Brown */
495b014e56cSJed Brown #include <fenv.h>
496b014e56cSJed Brown typedef struct {int code; const char *name;} FPNode;
497b014e56cSJed Brown static const FPNode error_codes[] = {
498b014e56cSJed Brown   {FE_DIVBYZERO,"divide by zero"},
499b014e56cSJed Brown   {FE_INEXACT,  "inexact floating point result"},
500b014e56cSJed Brown   {FE_INVALID,  "invalid floating point arguments (domain error)"},
501b014e56cSJed Brown   {FE_OVERFLOW, "floating point overflow"},
502b014e56cSJed Brown   {FE_UNDERFLOW,"floating point underflow"},
503b014e56cSJed Brown   {0           ,"unknown error"}
504b014e56cSJed Brown };
50599e0435eSBarry Smith 
506b014e56cSJed Brown void PetscDefaultFPTrap(int sig)
507b014e56cSJed Brown {
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
543efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_INITIAL,"trapped floating point error");
54441e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
545b014e56cSJed Brown }
546b014e56cSJed Brown 
5477087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
548b014e56cSJed Brown {
549b014e56cSJed Brown   PetscFunctionBegin;
550b014e56cSJed Brown   if (on == PETSC_FP_TRAP_ON) {
551b014e56cSJed Brown     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
552*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(feclearexcept(FE_ALL_EXCEPT),PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot clear floating point exception flags");
553cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
554cc9df77eSBarry Smith     /* Could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
555*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) == -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
564*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler");
565b014e56cSJed Brown   } else {
566*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(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 */
568*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,SIG_DFL),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler");
569b014e56cSJed Brown   }
570670f3ff9SJed Brown   _trapmode = on;
571b014e56cSJed Brown   PetscFunctionReturn(0);
572b014e56cSJed Brown }
573b014e56cSJed Brown 
574aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
575cc9df77eSBarry Smith {
576cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
577cc9df77eSBarry Smith   unsigned int   flags;
578cc9df77eSBarry Smith #endif
579cc9df77eSBarry Smith   PetscErrorCode ierr;
580cc9df77eSBarry Smith 
581cc9df77eSBarry Smith   PetscFunctionBegin;
582cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
583cc9df77eSBarry Smith   flags = fegetexcept();
584cc9df77eSBarry Smith   if (flags & FE_DIVBYZERO) {
585cc9df77eSBarry Smith #elif defined PETSC_HAVE_XMMINTRIN_H
586cc9df77eSBarry Smith   flags = _MM_GET_EXCEPTION_MASK();
587cc9df77eSBarry Smith   if (!(flags & _MM_MASK_DIV_ZERO)) {
588cc9df77eSBarry Smith #else
589cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Floating point trapping unknown, assuming off\n");CHKERRQ(ierr);
590cc9df77eSBarry Smith   PetscFunctionReturn(0);
591cc9df77eSBarry Smith #endif
592cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
593cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_ON;
5947d3de750SJacob Faibussowitsch     ierr = PetscInfo(NULL,"Floating point trapping is on by default %d\n",flags);CHKERRQ(ierr);
595cc9df77eSBarry Smith   } else {
596cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_OFF;
5977d3de750SJacob Faibussowitsch     ierr = PetscInfo(NULL,"Floating point trapping is off by default %d\n",flags);CHKERRQ(ierr);
598cc9df77eSBarry Smith   }
599cc9df77eSBarry Smith   PetscFunctionReturn(0);
600cc9df77eSBarry Smith #endif
601cc9df77eSBarry Smith }
602cc9df77eSBarry Smith 
603cc9df77eSBarry Smith /* ------------------------------------------------------------*/
604cc9df77eSBarry Smith #elif defined(PETSC_HAVE_IEEEFP_H)
605cc9df77eSBarry Smith #include <ieeefp.h>
606cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
607cc9df77eSBarry Smith {
608cc9df77eSBarry Smith   PetscFunctionBegin;
609cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
610cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
611cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
612cc9df77eSBarry Smith }
613cc9df77eSBarry Smith 
614cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
615cc9df77eSBarry Smith {
616cc9df77eSBarry Smith   PetscFunctionBegin;
617cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
618cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
619cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
620cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
621cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
622cc9df77eSBarry Smith #endif
623cc9df77eSBarry Smith     fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL |  FP_X_OFL);
624*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler");
625cc9df77eSBarry Smith   } else {
626cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
627cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
628cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
629cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
630cc9df77eSBarry Smith #endif
631cc9df77eSBarry Smith     fpsetmask(0);
632*2c71b3e2SJacob Faibussowitsch     PetscCheckFalse(SIG_ERR == signal(SIGFPE,SIG_DFL),PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler");
633cc9df77eSBarry Smith   }
634cc9df77eSBarry Smith   _trapmode = on;
635cc9df77eSBarry Smith   PetscFunctionReturn(0);
636cc9df77eSBarry Smith }
637cc9df77eSBarry Smith 
638aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
639cc9df77eSBarry Smith {
640cc9df77eSBarry Smith   PetscErrorCode ierr;
641cc9df77eSBarry Smith 
642cc9df77eSBarry Smith   PetscFunctionBegin;
643cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
644cc9df77eSBarry Smith   PetscFunctionReturn(0);
645cc9df77eSBarry Smith }
646cc9df77eSBarry Smith 
647e5c89e4eSSatish Balay /* -------------------------Default -----------------------------------*/
648e5c89e4eSSatish Balay #else
64999e0435eSBarry Smith 
650e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig)
651e5c89e4eSSatish Balay {
652e5c89e4eSSatish Balay   PetscFunctionBegin;
653e5c89e4eSSatish Balay   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
654efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
65541e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
656e5c89e4eSSatish Balay }
65799e0435eSBarry Smith 
6587087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
659e5c89e4eSSatish Balay {
660e5c89e4eSSatish Balay   PetscFunctionBegin;
661e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
662a297a907SKarl Rupp     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
663a297a907SKarl Rupp   } else if (SIG_ERR == signal(SIGFPE,SIG_DFL))       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
664a297a907SKarl Rupp 
665670f3ff9SJed Brown   _trapmode = on;
666e5c89e4eSSatish Balay   PetscFunctionReturn(0);
667e5c89e4eSSatish Balay }
668cc9df77eSBarry Smith 
669aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
670cc9df77eSBarry Smith {
671cc9df77eSBarry Smith   PetscErrorCode ierr;
672cc9df77eSBarry Smith 
673cc9df77eSBarry Smith   PetscFunctionBegin;
674cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
675cc9df77eSBarry Smith   PetscFunctionReturn(0);
676cc9df77eSBarry Smith }
677e5c89e4eSSatish Balay #endif
678e5c89e4eSSatish Balay 
679