xref: /petsc/src/sys/error/fp.c (revision cc9df77e78d3dc3cdc08dd390383483966f6a2a2)
17d0a6c19SBarry Smith 
2e5c89e4eSSatish Balay /*
3*cc9df77eSBarry Smith *   IEEE error handler for all machines. Since each OS has
4e5c89e4eSSatish Balay *   enough slight differences we have completely separate codes for each one.
5e5c89e4eSSatish Balay *
6e5c89e4eSSatish Balay */
7b014e56cSJed Brown 
8b014e56cSJed Brown /*
9b014e56cSJed Brown   This feature test macro provides FE_NOMASK_ENV on GNU.  It must be defined
10b014e56cSJed Brown   at the top of the file because other headers may pull in fenv.h even when
11b014e56cSJed Brown   not strictly necessary.  Strictly speaking, we could include ONLY petscconf.h,
12b014e56cSJed Brown   check PETSC_HAVE_FENV_H, and only define _GNU_SOURCE in that case, but such
13b014e56cSJed Brown   shenanigans ought to be unnecessary.
14b014e56cSJed Brown */
15519f805aSKarl Rupp #if !defined(_GNU_SOURCE)
16b014e56cSJed Brown #define _GNU_SOURCE
1776a6984eSJed Brown #endif
18b014e56cSJed Brown 
19c6db04a5SJed Brown #include <petscsys.h>           /*I  "petscsys.h"  I*/
20e5c89e4eSSatish Balay #include <signal.h>
21e5c89e4eSSatish Balay 
22670f3ff9SJed Brown struct PetscFPTrapLink {
23670f3ff9SJed Brown   PetscFPTrap            trapmode;
24670f3ff9SJed Brown   struct PetscFPTrapLink *next;
25670f3ff9SJed Brown };
26*cc9df77eSBarry Smith static PetscFPTrap            _trapmode = PETSC_FP_TRAP_OFF; /* Current trapping mode; see PetscDetermineInitalFPTrap() */
27670f3ff9SJed Brown static struct PetscFPTrapLink *_trapstack;                   /* Any pushed states of _trapmode */
28670f3ff9SJed Brown 
29670f3ff9SJed Brown /*@
30*cc9df77eSBarry Smith    PetscFPTrapPush - push a floating point trapping mode, restored using PetscFPTrapPop()
31670f3ff9SJed Brown 
32670f3ff9SJed Brown    Not Collective
33670f3ff9SJed Brown 
34670f3ff9SJed Brown    Input Arguments:
35670f3ff9SJed Brown .    trap - PETSC_FP_TRAP_ON or PETSC_FP_TRAP_OFF
36670f3ff9SJed Brown 
37670f3ff9SJed Brown    Level: advanced
38670f3ff9SJed Brown 
39*cc9df77eSBarry Smith    Notes:
40*cc9df77eSBarry Smith      This only changes the trapping if the new mode is different than the current mode.
41*cc9df77eSBarry Smith 
42*cc9df77eSBarry Smith      This routine is called to turn off trapping for certain LAPACK routines that assume that dividing
43*cc9df77eSBarry Smith      by zero is acceptable. In particular the routine ieeeck().
44*cc9df77eSBarry Smith 
45*cc9df77eSBarry Smith      Most systems by default have all trapping turned off, but certain Fortran compilers have
46*cc9df77eSBarry Smith      link flags that turn on trapping before the program begins.
47*cc9df77eSBarry Smith $       gfortran -ffpe-trap=invalid,zero,overflow,underflow,denormal
48*cc9df77eSBarry Smith $       ifort -fpe0
49*cc9df77eSBarry Smith 
50*cc9df77eSBarry Smith .seealso: PetscFPTrapPop(), PetscSetFPTrap(), PetscDetermineInitalFPTrap()
51670f3ff9SJed Brown @*/
52670f3ff9SJed Brown PetscErrorCode PetscFPTrapPush(PetscFPTrap trap)
53670f3ff9SJed Brown {
54670f3ff9SJed Brown   PetscErrorCode         ierr;
55670f3ff9SJed Brown   struct PetscFPTrapLink *link;
56670f3ff9SJed Brown 
57670f3ff9SJed Brown   PetscFunctionBegin;
58854ce69bSBarry Smith   ierr           = PetscNew(&link);CHKERRQ(ierr);
59670f3ff9SJed Brown   link->trapmode = _trapmode;
60670f3ff9SJed Brown   link->next     = _trapstack;
61670f3ff9SJed Brown   _trapstack     = link;
62f6883b22SJed Brown   if (trap != _trapmode) {ierr = PetscSetFPTrap(trap);CHKERRQ(ierr);}
63670f3ff9SJed Brown   PetscFunctionReturn(0);
64670f3ff9SJed Brown }
65670f3ff9SJed Brown 
66670f3ff9SJed Brown /*@
67670f3ff9SJed Brown    PetscFPTrapPop - push a floating point trapping mode, to be restored using PetscFPTrapPop()
68670f3ff9SJed Brown 
69670f3ff9SJed Brown    Not Collective
70670f3ff9SJed Brown 
71670f3ff9SJed Brown    Level: advanced
72670f3ff9SJed Brown 
73*cc9df77eSBarry Smith .seealso: PetscFPTrapPush(), PetscSetFPTrap(), PetscDetermineInitalFPTrap()
74670f3ff9SJed Brown @*/
75670f3ff9SJed Brown PetscErrorCode PetscFPTrapPop(void)
76670f3ff9SJed Brown {
77670f3ff9SJed Brown   PetscErrorCode         ierr;
78670f3ff9SJed Brown   struct PetscFPTrapLink *link;
79670f3ff9SJed Brown 
80670f3ff9SJed Brown   PetscFunctionBegin;
81f6883b22SJed Brown   if (_trapstack->trapmode != _trapmode) {ierr = PetscSetFPTrap(_trapstack->trapmode);CHKERRQ(ierr);}
82670f3ff9SJed Brown   link       = _trapstack;
83670f3ff9SJed Brown   _trapstack = _trapstack->next;
84670f3ff9SJed Brown   ierr       = PetscFree(link);CHKERRQ(ierr);
85670f3ff9SJed Brown   PetscFunctionReturn(0);
86670f3ff9SJed Brown }
87670f3ff9SJed Brown 
88e5c89e4eSSatish Balay /*--------------------------------------- ---------------------------------------------------*/
89e5c89e4eSSatish Balay #if defined(PETSC_HAVE_SUN4_STYLE_FPTRAP)
90e5c89e4eSSatish Balay #include <floatingpoint.h>
91e5c89e4eSSatish Balay 
928cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_flags(char*,char*,char*,char**);
938cc058d9SJed Brown PETSC_EXTERN PetscErrorCode ieee_handler(char*,char*,sigfpe_handler_type(int,int,struct sigcontext*,char*));
94e5c89e4eSSatish Balay 
95db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
96e5c89e4eSSatish Balay   { FPE_INTDIV_TRAP    ,"integer divide" },
97e5c89e4eSSatish Balay   { FPE_FLTOPERR_TRAP  ,"IEEE operand error" },
98e5c89e4eSSatish Balay   { FPE_FLTOVF_TRAP    ,"floating point overflow" },
99e5c89e4eSSatish Balay   { FPE_FLTUND_TRAP    ,"floating point underflow" },
100e5c89e4eSSatish Balay   { FPE_FLTDIV_TRAP    ,"floating pointing divide" },
101e5c89e4eSSatish Balay   { FPE_FLTINEX_TRAP   ,"inexact floating point result" },
102e5c89e4eSSatish Balay   { 0                  ,"unknown error" }
103e5c89e4eSSatish Balay };
104e5c89e4eSSatish Balay #define SIGPC(scp) (scp->sc_pc)
105e5c89e4eSSatish Balay 
106e5c89e4eSSatish Balay sigfpe_handler_type PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp,char *addr)
107e5c89e4eSSatish Balay {
108e5c89e4eSSatish Balay   PetscErrorCode ierr;
109e5c89e4eSSatish Balay   int            err_ind = -1,j;
110e5c89e4eSSatish Balay 
111e5c89e4eSSatish Balay   PetscFunctionBegin;
112e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
113e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
114e5c89e4eSSatish Balay   }
115e5c89e4eSSatish Balay 
116a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
117a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
118a297a907SKarl Rupp 
119efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,PETSC_ERR_FP,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
12041e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
121e5c89e4eSSatish Balay   PetscFunctionReturn(0);
122e5c89e4eSSatish Balay }
123e5c89e4eSSatish Balay 
124e30d2299SSatish Balay /*@
125e5c89e4eSSatish Balay    PetscSetFPTrap - Enables traps/exceptions on common floating point errors.
126*cc9df77eSBarry Smith                     This option may not work on certain systems.
127e5c89e4eSSatish Balay 
128e5c89e4eSSatish Balay    Not Collective
129e5c89e4eSSatish Balay 
130e5c89e4eSSatish Balay    Input Parameters:
131e5c89e4eSSatish Balay .  flag - PETSC_FP_TRAP_ON, PETSC_FP_TRAP_OFF.
132e5c89e4eSSatish Balay 
133e5c89e4eSSatish Balay    Options Database Keys:
134e5c89e4eSSatish Balay .  -fp_trap - Activates floating point trapping
135e5c89e4eSSatish Balay 
136e5c89e4eSSatish Balay    Level: advanced
137e5c89e4eSSatish Balay 
138e5c89e4eSSatish Balay    Description:
139*cc9df77eSBarry Smith    On systems that support it, when called with PETSC_FP_TRAP_ON this routine causes floating point
140*cc9df77eSBarry Smith    underflow, overflow, divide-by-zero, and invalid-operand (e.g., a NaN) to
141e5c89e4eSSatish Balay    cause a message to be printed and the program to exit.
142e5c89e4eSSatish Balay 
1437d125cddSJed Brown    Note:
144*cc9df77eSBarry Smith    On many common systems, the floating
1457d125cddSJed Brown    point exception state is not preserved from the location where the trap
1467d125cddSJed Brown    occurred through to the signal handler.  In this case, the signal handler
1477d125cddSJed Brown    will just say that an unknown floating point exception occurred and which
1487d125cddSJed Brown    function it occurred in.  If you run with -fp_trap in a debugger, it will
149*cc9df77eSBarry Smith    break on the line where the error occurred.  On systems that support C99
150*cc9df77eSBarry Smith    floating point exception handling You can check which
1517d125cddSJed Brown    exception occurred using fetestexcept(FE_ALL_EXCEPT).  See fenv.h
1527d125cddSJed Brown    (usually at /usr/include/bits/fenv.h) for the enum values on your system.
1537d125cddSJed Brown 
154e5c89e4eSSatish Balay    Caution:
155*cc9df77eSBarry Smith    On certain machines, in particular the IBM PowerPC, floating point
156*cc9df77eSBarry Smith    trapping may be VERY slow!
157e5c89e4eSSatish Balay 
158e5c89e4eSSatish Balay 
159*cc9df77eSBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitalFPTrap()
160e5c89e4eSSatish Balay @*/
161e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
162e5c89e4eSSatish Balay {
163e5c89e4eSSatish Balay   char *out;
164e5c89e4eSSatish Balay 
165e5c89e4eSSatish Balay   PetscFunctionBegin;
166e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
167e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
168e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
169e5c89e4eSSatish Balay     /*
170a297a907SKarl Rupp       To trap more fp exceptions, including underflow, change the line below to
171e5c89e4eSSatish Balay       if (ieee_handler("set","all",PetscDefaultFPTrap)) {
172e5c89e4eSSatish Balay     */
173a297a907SKarl Rupp     if (ieee_handler("set","common",PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
174a297a907SKarl Rupp   } else if (ieee_handler("clear","common",PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
175a297a907SKarl Rupp 
176670f3ff9SJed Brown   _trapmode = flag;
177e5c89e4eSSatish Balay   PetscFunctionReturn(0);
178e5c89e4eSSatish Balay }
179e5c89e4eSSatish Balay 
180*cc9df77eSBarry Smith /*@
181*cc9df77eSBarry Smith    PetscDetermineInitalFPTrap - Attempts to determine the floating point trapping that exists when PetscInitialize() is called
182*cc9df77eSBarry Smith 
183*cc9df77eSBarry Smith    Not Collective
184*cc9df77eSBarry Smith 
185*cc9df77eSBarry Smith    Notes:
186*cc9df77eSBarry Smith       Currently only supported on Linux and MacOS. Checks if divide by zero is enable and if so declares that trapping is on.
187*cc9df77eSBarry Smith 
188*cc9df77eSBarry Smith 
189*cc9df77eSBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitalFPTrap()
190*cc9df77eSBarry Smith @*/
191*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
192*cc9df77eSBarry Smith {
193*cc9df77eSBarry Smith   PetscErrorCode ierr;
194*cc9df77eSBarry Smith 
195*cc9df77eSBarry Smith   PetscFunctionBegin;
196*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
197*cc9df77eSBarry Smith   PetscFunctionReturn(0);
198*cc9df77eSBarry Smith }
199*cc9df77eSBarry Smith 
200e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
201e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
202e5c89e4eSSatish Balay #include <sunmath.h>
203e5c89e4eSSatish Balay #include <floatingpoint.h>
204e5c89e4eSSatish Balay #include <siginfo.h>
205e5c89e4eSSatish Balay #include <ucontext.h>
206e5c89e4eSSatish Balay 
207db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
208e5c89e4eSSatish Balay   { FPE_FLTINV,"invalid floating point operand"},
209e5c89e4eSSatish Balay   { FPE_FLTRES,"inexact floating point result"},
210e5c89e4eSSatish Balay   { FPE_FLTDIV,"division-by-zero"},
211e5c89e4eSSatish Balay   { FPE_FLTUND,"floating point underflow"},
212e5c89e4eSSatish Balay   { FPE_FLTOVF,"floating point overflow"},
213e5c89e4eSSatish Balay   { 0,         "unknown error"}
214e5c89e4eSSatish Balay };
215e5c89e4eSSatish Balay #define SIGPC(scp) (scp->si_addr)
216e5c89e4eSSatish Balay 
217e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
218e5c89e4eSSatish Balay {
219e5c89e4eSSatish Balay   int            err_ind,j,code = scp->si_code;
220e5c89e4eSSatish Balay   PetscErrorCode ierr;
221e5c89e4eSSatish Balay 
222e5c89e4eSSatish Balay   PetscFunctionBegin;
223e5c89e4eSSatish Balay   err_ind = -1;
224e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
225e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
226e5c89e4eSSatish Balay   }
227e5c89e4eSSatish Balay 
228a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
229a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
230a297a907SKarl Rupp 
231efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
23241e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
233e5c89e4eSSatish Balay }
234e5c89e4eSSatish Balay 
235e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
236e5c89e4eSSatish Balay {
237e5c89e4eSSatish Balay   char *out;
238e5c89e4eSSatish Balay 
239e5c89e4eSSatish Balay   PetscFunctionBegin;
240e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
241e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
242e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
243a297a907SKarl Rupp     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
244*cc9df77eSBarry Smith   } else {
245*cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
246*cc9df77eSBarry Smith   }
247670f3ff9SJed Brown   _trapmode = flag;
248e5c89e4eSSatish Balay   PetscFunctionReturn(0);
249e5c89e4eSSatish Balay }
250e5c89e4eSSatish Balay 
251*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
252*cc9df77eSBarry Smith {
253*cc9df77eSBarry Smith   PetscErrorCode ierr;
254e5c89e4eSSatish Balay 
255*cc9df77eSBarry Smith   PetscFunctionBegin;
256*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
257*cc9df77eSBarry Smith   PetscFunctionReturn(0);
258*cc9df77eSBarry Smith }
259*cc9df77eSBarry Smith 
260*cc9df77eSBarry Smith /* ------------------------------------------------------------------------------------------*/
261e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_IRIX_STYLE_FPTRAP)
262e5c89e4eSSatish Balay #include <sigfpe.h>
263db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
264e5c89e4eSSatish Balay   { _INVALID   ,"IEEE operand error" },
265e5c89e4eSSatish Balay   { _OVERFL    ,"floating point overflow" },
266e5c89e4eSSatish Balay   { _UNDERFL   ,"floating point underflow" },
267e5c89e4eSSatish Balay   { _DIVZERO   ,"floating point divide" },
268e5c89e4eSSatish Balay   { 0          ,"unknown error" }
269e5c89e4eSSatish Balay } ;
270e5c89e4eSSatish Balay void PetscDefaultFPTrap(unsigned exception[],int val[])
271e5c89e4eSSatish Balay {
272e5c89e4eSSatish Balay   int err_ind,j,code;
273e5c89e4eSSatish Balay 
274e5c89e4eSSatish Balay   PetscFunctionBegin;
275e5c89e4eSSatish Balay   code    = exception[0];
276e5c89e4eSSatish Balay   err_ind = -1;
277e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
278e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
279e5c89e4eSSatish Balay   }
280a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
281a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
282a297a907SKarl Rupp 
283efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
28441e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
285e5c89e4eSSatish Balay }
286e5c89e4eSSatish Balay 
287e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
288e5c89e4eSSatish Balay {
289e5c89e4eSSatish Balay   PetscFunctionBegin;
290*cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) handle_sigfpes(_ON,,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
291*cc9df77eSBarry Smith   else                          handle_sigfpes(_OFF,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
292670f3ff9SJed Brown   _trapmode = flag;
293e5c89e4eSSatish Balay   PetscFunctionReturn(0);
294e5c89e4eSSatish Balay }
295*cc9df77eSBarry Smith 
296*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
297*cc9df77eSBarry Smith {
298*cc9df77eSBarry Smith   PetscErrorCode ierr;
299*cc9df77eSBarry Smith 
300*cc9df77eSBarry Smith   PetscFunctionBegin;
301*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
302*cc9df77eSBarry Smith   PetscFunctionReturn(0);
303*cc9df77eSBarry Smith }
304*cc9df77eSBarry Smith 
305e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
306*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
307*cc9df77eSBarry Smith #include <sunmath.h>
308*cc9df77eSBarry Smith #include <floatingpoint.h>
309*cc9df77eSBarry Smith #include <siginfo.h>
310*cc9df77eSBarry Smith #include <ucontext.h>
311*cc9df77eSBarry Smith 
312*cc9df77eSBarry Smith static struct { int code_no; char *name; } error_codes[] = {
313*cc9df77eSBarry Smith   { FPE_FLTINV,"invalid floating point operand"},
314*cc9df77eSBarry Smith   { FPE_FLTRES,"inexact floating point result"},
315*cc9df77eSBarry Smith   { FPE_FLTDIV,"division-by-zero"},
316*cc9df77eSBarry Smith   { FPE_FLTUND,"floating point underflow"},
317*cc9df77eSBarry Smith   { FPE_FLTOVF,"floating point overflow"},
318*cc9df77eSBarry Smith   { 0,         "unknown error"}
319*cc9df77eSBarry Smith };
320*cc9df77eSBarry Smith #define SIGPC(scp) (scp->si_addr)
321*cc9df77eSBarry Smith 
322*cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
323*cc9df77eSBarry Smith {
324*cc9df77eSBarry Smith   int            err_ind,j,code = scp->si_code;
325*cc9df77eSBarry Smith   PetscErrorCode ierr;
326*cc9df77eSBarry Smith 
327*cc9df77eSBarry Smith   PetscFunctionBegin;
328*cc9df77eSBarry Smith   err_ind = -1;
329*cc9df77eSBarry Smith   for (j = 0; error_codes[j].code_no; j++) {
330*cc9df77eSBarry Smith     if (error_codes[j].code_no == code) err_ind = j;
331*cc9df77eSBarry Smith   }
332*cc9df77eSBarry Smith 
333*cc9df77eSBarry Smith   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
334*cc9df77eSBarry Smith   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
335*cc9df77eSBarry Smith 
336*cc9df77eSBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
337*cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
338*cc9df77eSBarry Smith }
339*cc9df77eSBarry Smith 
340*cc9df77eSBarry Smith PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
341*cc9df77eSBarry Smith {
342*cc9df77eSBarry Smith   char *out;
343*cc9df77eSBarry Smith 
344*cc9df77eSBarry Smith   PetscFunctionBegin;
345*cc9df77eSBarry Smith   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
346*cc9df77eSBarry Smith   (void) ieee_flags("clear","exception","all",&out);
347*cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) {
348*cc9df77eSBarry Smith     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
349*cc9df77eSBarry Smith   } else {
350*cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
351*cc9df77eSBarry Smith   }
352*cc9df77eSBarry Smith   _trapmode = flag;
353*cc9df77eSBarry Smith   PetscFunctionReturn(0);
354*cc9df77eSBarry Smith }
355*cc9df77eSBarry Smith 
356*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
357*cc9df77eSBarry Smith {
358*cc9df77eSBarry Smith   PetscErrorCode ierr;
359*cc9df77eSBarry Smith 
360*cc9df77eSBarry Smith   PetscFunctionBegin;
361*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
362*cc9df77eSBarry Smith   PetscFunctionReturn(0);
363*cc9df77eSBarry Smith }
364*cc9df77eSBarry Smith 
365*cc9df77eSBarry Smith /*----------------------------------------------- --------------------------------------------*/
366*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
367e5c89e4eSSatish Balay /* In "fast" mode, floating point traps are imprecise and ignored.
368e5c89e4eSSatish Balay    This is the reason for the fptrap(FP_TRAP_SYNC) call */
369e5c89e4eSSatish Balay struct sigcontext;
370e5c89e4eSSatish Balay #include <fpxcp.h>
371e5c89e4eSSatish Balay #include <fptrap.h>
372e5c89e4eSSatish Balay #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
373e5c89e4eSSatish Balay #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
374e5c89e4eSSatish Balay #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
375e5c89e4eSSatish Balay #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
376e5c89e4eSSatish Balay #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
377e5c89e4eSSatish Balay 
378db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
379e5c89e4eSSatish Balay   {FPE_FLTOPERR_TRAP   ,"IEEE operand error" },
380e5c89e4eSSatish Balay   { FPE_FLTOVF_TRAP    ,"floating point overflow" },
381e5c89e4eSSatish Balay   { FPE_FLTUND_TRAP    ,"floating point underflow" },
382e5c89e4eSSatish Balay   { FPE_FLTDIV_TRAP    ,"floating point divide" },
383e5c89e4eSSatish Balay   { FPE_FLTINEX_TRAP   ,"inexact floating point result" },
384e5c89e4eSSatish Balay   { 0                  ,"unknown error" }
385e5c89e4eSSatish Balay } ;
386e5c89e4eSSatish Balay #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
387e5c89e4eSSatish Balay /*
388e5c89e4eSSatish Balay    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
389e5c89e4eSSatish Balay    it looks like it should from the include definitions.  It is probably
390e5c89e4eSSatish Balay    some strange interaction with the "POSIX_SOURCE" that we require.
391e5c89e4eSSatish Balay */
392e5c89e4eSSatish Balay 
393e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
394e5c89e4eSSatish Balay {
395e5c89e4eSSatish Balay   PetscErrorCode ierr;
396e5c89e4eSSatish Balay   int            err_ind,j;
397e5c89e4eSSatish Balay   fp_ctx_t       flt_context;
398e5c89e4eSSatish Balay 
399e5c89e4eSSatish Balay   PetscFunctionBegin;
400e5c89e4eSSatish Balay   fp_sh_trap_info(scp,&flt_context);
401e5c89e4eSSatish Balay 
402e5c89e4eSSatish Balay   err_ind = -1;
403e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
404e5c89e4eSSatish Balay     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
405e5c89e4eSSatish Balay   }
406e5c89e4eSSatish Balay 
407a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
408a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
409a297a907SKarl Rupp 
410efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
41141e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
412e5c89e4eSSatish Balay }
413e5c89e4eSSatish Balay 
414e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
415e5c89e4eSSatish Balay {
416e5c89e4eSSatish Balay   PetscFunctionBegin;
417e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
418e5c89e4eSSatish Balay     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
419e5c89e4eSSatish Balay     fp_trap(FP_TRAP_SYNC);
420*cc9df77eSBarry Smith     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
421e5c89e4eSSatish Balay     /* fp_enable(mask) for individual traps.  Values are:
422e5c89e4eSSatish Balay        TRP_INVALID
423e5c89e4eSSatish Balay        TRP_DIV_BY_ZERO
424e5c89e4eSSatish Balay        TRP_OVERFLOW
425e5c89e4eSSatish Balay        TRP_UNDERFLOW
426e5c89e4eSSatish Balay        TRP_INEXACT
427e5c89e4eSSatish Balay        Can OR then together.
428e5c89e4eSSatish Balay        fp_enable_all(); for all traps.
429e5c89e4eSSatish Balay     */
430e5c89e4eSSatish Balay   } else {
431e5c89e4eSSatish Balay     signal(SIGFPE,SIG_DFL);
432*cc9df77eSBarry Smith     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
433e5c89e4eSSatish Balay     fp_trap(FP_TRAP_OFF);
434e5c89e4eSSatish Balay   }
435670f3ff9SJed Brown   _trapmode = on;
436e5c89e4eSSatish Balay   PetscFunctionReturn(0);
437e5c89e4eSSatish Balay }
438e5c89e4eSSatish Balay 
439*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
440*cc9df77eSBarry Smith {
441*cc9df77eSBarry Smith   PetscErrorCode ierr;
442*cc9df77eSBarry Smith 
443*cc9df77eSBarry Smith   PetscFunctionBegin;
444*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
445*cc9df77eSBarry Smith   PetscFunctionReturn(0);
446*cc9df77eSBarry Smith }
447*cc9df77eSBarry Smith 
448*cc9df77eSBarry Smith /* ------------------------------------------------------------*/
449*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
450*cc9df77eSBarry Smith #include <float.h>
451*cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
452*cc9df77eSBarry Smith {
453*cc9df77eSBarry Smith   PetscFunctionBegin;
454*cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
455*cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
456*cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
457*cc9df77eSBarry Smith }
458*cc9df77eSBarry Smith 
459*cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
460*cc9df77eSBarry Smith {
461*cc9df77eSBarry Smith   unsigned int cw;
462*cc9df77eSBarry Smith 
463*cc9df77eSBarry Smith   PetscFunctionBegin;
464*cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
465*cc9df77eSBarry Smith     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW;
466*cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
467*cc9df77eSBarry Smith   } else {
468*cc9df77eSBarry Smith     cw = 0;
469*cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
470*cc9df77eSBarry Smith   }
471*cc9df77eSBarry Smith   (void)_controlfp(0, cw);
472*cc9df77eSBarry Smith   _trapmode = on;
473*cc9df77eSBarry Smith   PetscFunctionReturn(0);
474*cc9df77eSBarry Smith }
475*cc9df77eSBarry Smith 
476*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
477*cc9df77eSBarry Smith {
478*cc9df77eSBarry Smith   PetscErrorCode ierr;
479*cc9df77eSBarry Smith 
480*cc9df77eSBarry Smith   PetscFunctionBegin;
481*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
482*cc9df77eSBarry Smith   PetscFunctionReturn(0);
483*cc9df77eSBarry Smith }
484*cc9df77eSBarry Smith 
485*cc9df77eSBarry Smith /* ------------------------------------------------------------*/
4869a2402e9SBarry Smith #elif defined(PETSC_HAVE_FENV_H) && !defined(__cplusplus)
487b014e56cSJed Brown /*
488b014e56cSJed Brown    C99 style floating point environment.
489b014e56cSJed Brown 
490b014e56cSJed Brown    Note that C99 merely specifies how to save, restore, and clear the floating
491b014e56cSJed Brown    point environment as well as defining an enumeration of exception codes.  In
492b014e56cSJed Brown    particular, C99 does not specify how to make floating point exceptions raise
493b014e56cSJed Brown    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
494b014e56cSJed Brown    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
495b014e56cSJed Brown */
496b014e56cSJed Brown #include <fenv.h>
497b014e56cSJed Brown typedef struct {int code; const char *name;} 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 
507b014e56cSJed Brown void PetscDefaultFPTrap(int sig)
508b014e56cSJed Brown {
509b014e56cSJed Brown   const FPNode *node;
510b014e56cSJed Brown   int          code;
511ace3abfcSBarry Smith   PetscBool    matched = PETSC_FALSE;
512b014e56cSJed Brown 
513b014e56cSJed Brown   PetscFunctionBegin;
514b014e56cSJed Brown   /* Note: While it is possible for the exception state to be preserved by the
515b014e56cSJed Brown    * kernel, this seems to be rare which makes the following flag testing almost
516b014e56cSJed Brown    * useless.  But on a system where the flags can be preserved, it would provide
5177d125cddSJed Brown    * more detail.
518b014e56cSJed Brown    */
519b014e56cSJed Brown   code = fetestexcept(FE_ALL_EXCEPT);
520b014e56cSJed Brown   for (node=&error_codes[0]; node->code; node++) {
521b014e56cSJed Brown     if (code & node->code) {
522b014e56cSJed Brown       matched = PETSC_TRUE;
523b014e56cSJed Brown       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n",node->name);
524b014e56cSJed Brown       code &= ~node->code; /* Unset this flag since it has been processed */
525b014e56cSJed Brown     }
526b014e56cSJed Brown   }
527b014e56cSJed Brown   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
528b014e56cSJed Brown     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
5297d125cddSJed Brown     (*PetscErrorPrintf)("The specific exception can be determined by running in a debugger.  When the\n");
5307d125cddSJed Brown     (*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n",FE_ALL_EXCEPT);
5317d125cddSJed Brown     (*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
5327d125cddSJed 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);
533b014e56cSJed Brown   }
5347d125cddSJed Brown 
5357d125cddSJed Brown   (*PetscErrorPrintf)("Try option -start_in_debugger\n");
53676bd3646SJed Brown   if (PetscDefined(USE_DEBUG)) {
537dbf62e16SBarry Smith     if (!PetscStackActive()) (*PetscErrorPrintf)("  or try option -log_stack\n");
538a297a907SKarl Rupp     else {
5397d125cddSJed Brown       (*PetscErrorPrintf)("likely location of problem given in stack below\n");
5407d125cddSJed Brown       (*PetscErrorPrintf)("---------------------  Stack Frames ------------------------------------\n");
541639ff905SBarry Smith       PetscStackView(PETSC_STDOUT);
5427d125cddSJed Brown     }
54376bd3646SJed Brown   } else {
5447d125cddSJed Brown     (*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
5457d125cddSJed Brown     (*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
54676bd3646SJed Brown   }
547efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_INITIAL,"trapped floating point error");
54841e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
549b014e56cSJed Brown }
550b014e56cSJed Brown 
5517087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
552b014e56cSJed Brown {
553b014e56cSJed Brown   PetscFunctionBegin;
554b014e56cSJed Brown   if (on == PETSC_FP_TRAP_ON) {
555b014e56cSJed Brown     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
556e32f2f54SBarry Smith     if (feclearexcept(FE_ALL_EXCEPT)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot clear floating point exception flags\n");
557*cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
558*cc9df77eSBarry Smith     /* Could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
559e32f2f54SBarry Smith     if (feenableexcept(FE_DIVBYZERO | FE_INVALID | FE_OVERFLOW | FE_UNDERFLOW) == -1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot activate floating point exceptions\n");
560b014e56cSJed Brown #elif defined PETSC_HAVE_XMMINTRIN_H
561*cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_DIV_ZERO);
562*cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_UNDERFLOW);
563*cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_OVERFLOW);
564*cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_INVALID);
565b014e56cSJed Brown #else
566b014e56cSJed Brown     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
567b014e56cSJed Brown #endif
568e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
569b014e56cSJed Brown   } else {
570e32f2f54SBarry Smith     if (fesetenv(FE_DFL_ENV)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot disable floating point exceptions");
571*cc9df77eSBarry Smith     /* can use _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() | _MM_MASK_UNDERFLOW); if PETSC_HAVE_XMMINTRIN_H exists */
572e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
573b014e56cSJed Brown   }
574670f3ff9SJed Brown   _trapmode = on;
575b014e56cSJed Brown   PetscFunctionReturn(0);
576b014e56cSJed Brown }
577b014e56cSJed Brown 
578*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
579*cc9df77eSBarry Smith {
580*cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
581*cc9df77eSBarry Smith   unsigned int   flags;
582*cc9df77eSBarry Smith #endif
583*cc9df77eSBarry Smith   PetscErrorCode ierr;
584*cc9df77eSBarry Smith 
585*cc9df77eSBarry Smith   PetscFunctionBegin;
586*cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
587*cc9df77eSBarry Smith   flags = fegetexcept();
588*cc9df77eSBarry Smith   if (flags & FE_DIVBYZERO) {
589*cc9df77eSBarry Smith #elif defined PETSC_HAVE_XMMINTRIN_H
590*cc9df77eSBarry Smith   flags = _MM_GET_EXCEPTION_MASK();
591*cc9df77eSBarry Smith   if (!(flags & _MM_MASK_DIV_ZERO)) {
592*cc9df77eSBarry Smith #else
593*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Floating point trapping unknown, assuming off\n");CHKERRQ(ierr);
594*cc9df77eSBarry Smith   PetscFunctionReturn(0);
595*cc9df77eSBarry Smith #endif
596*cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
597*cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_ON;
598*cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is on by default %d\n",flags);CHKERRQ(ierr);
599*cc9df77eSBarry Smith   } else {
600*cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_OFF;
601*cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is off by default %d\n",flags);CHKERRQ(ierr);
602*cc9df77eSBarry Smith   }
603*cc9df77eSBarry Smith   PetscFunctionReturn(0);
604*cc9df77eSBarry Smith #endif
605*cc9df77eSBarry Smith }
606*cc9df77eSBarry Smith 
607*cc9df77eSBarry Smith /* ------------------------------------------------------------*/
608*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_IEEEFP_H)
609*cc9df77eSBarry Smith #include <ieeefp.h>
610*cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
611*cc9df77eSBarry Smith {
612*cc9df77eSBarry Smith   PetscFunctionBegin;
613*cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
614*cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
615*cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
616*cc9df77eSBarry Smith }
617*cc9df77eSBarry Smith 
618*cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
619*cc9df77eSBarry Smith {
620*cc9df77eSBarry Smith   PetscFunctionBegin;
621*cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
622*cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
623*cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
624*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
625*cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
626*cc9df77eSBarry Smith #endif
627*cc9df77eSBarry Smith     fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL |  FP_X_OFL);
628*cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
629*cc9df77eSBarry Smith   } else {
630*cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
631*cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
632*cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
633*cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
634*cc9df77eSBarry Smith #endif
635*cc9df77eSBarry Smith     fpsetmask(0);
636*cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
637*cc9df77eSBarry Smith   }
638*cc9df77eSBarry Smith   _trapmode = on;
639*cc9df77eSBarry Smith   PetscFunctionReturn(0);
640*cc9df77eSBarry Smith }
641*cc9df77eSBarry Smith 
642*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
643*cc9df77eSBarry Smith {
644*cc9df77eSBarry Smith   PetscErrorCode ierr;
645*cc9df77eSBarry Smith 
646*cc9df77eSBarry Smith   PetscFunctionBegin;
647*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
648*cc9df77eSBarry Smith   PetscFunctionReturn(0);
649*cc9df77eSBarry Smith }
650*cc9df77eSBarry Smith 
651e5c89e4eSSatish Balay /* -------------------------Default -----------------------------------*/
652e5c89e4eSSatish Balay #else
65399e0435eSBarry Smith 
654e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig)
655e5c89e4eSSatish Balay {
656e5c89e4eSSatish Balay   PetscFunctionBegin;
657e5c89e4eSSatish Balay   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
658efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
65941e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
660e5c89e4eSSatish Balay }
66199e0435eSBarry Smith 
6627087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
663e5c89e4eSSatish Balay {
664e5c89e4eSSatish Balay   PetscFunctionBegin;
665e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
666a297a907SKarl Rupp     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
667a297a907SKarl Rupp   } else if (SIG_ERR == signal(SIGFPE,SIG_DFL))       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
668a297a907SKarl Rupp 
669670f3ff9SJed Brown   _trapmode = on;
670e5c89e4eSSatish Balay   PetscFunctionReturn(0);
671e5c89e4eSSatish Balay }
672*cc9df77eSBarry Smith 
673*cc9df77eSBarry Smith PetscErrorCode  PetscDetermineInitalFPTrap(void)
674*cc9df77eSBarry Smith {
675*cc9df77eSBarry Smith   PetscErrorCode ierr;
676*cc9df77eSBarry Smith 
677*cc9df77eSBarry Smith   PetscFunctionBegin;
678*cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
679*cc9df77eSBarry Smith   PetscFunctionReturn(0);
680*cc9df77eSBarry Smith }
681e5c89e4eSSatish Balay #endif
682e5c89e4eSSatish Balay 
683e5c89e4eSSatish Balay 
684e5c89e4eSSatish Balay 
685