xref: /petsc/src/sys/error/fp.c (revision aba4c478dbfe659dc4eb6bc99941d517bcb613f6)
17d0a6c19SBarry Smith 
2e5c89e4eSSatish Balay /*
3cc9df77eSBarry 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*aba4c478SBarry Smith static PetscFPTrap            _trapmode = PETSC_FP_TRAP_OFF; /* Current trapping mode; see PetscDetermineInitialFPTrap() */
27670f3ff9SJed Brown static struct PetscFPTrapLink *_trapstack;                   /* Any pushed states of _trapmode */
28670f3ff9SJed Brown 
29670f3ff9SJed Brown /*@
30cc9df77eSBarry 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 
39cc9df77eSBarry Smith    Notes:
40cc9df77eSBarry Smith      This only changes the trapping if the new mode is different than the current mode.
41cc9df77eSBarry Smith 
42cc9df77eSBarry Smith      This routine is called to turn off trapping for certain LAPACK routines that assume that dividing
43cc9df77eSBarry Smith      by zero is acceptable. In particular the routine ieeeck().
44cc9df77eSBarry Smith 
45cc9df77eSBarry Smith      Most systems by default have all trapping turned off, but certain Fortran compilers have
46cc9df77eSBarry Smith      link flags that turn on trapping before the program begins.
47cc9df77eSBarry Smith $       gfortran -ffpe-trap=invalid,zero,overflow,underflow,denormal
48cc9df77eSBarry Smith $       ifort -fpe0
49cc9df77eSBarry Smith 
50*aba4c478SBarry Smith .seealso: PetscFPTrapPop(), PetscSetFPTrap(), PetscDetermineInitialFPTrap()
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*aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscSetFPTrap(), PetscDetermineInitialFPTrap()
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.
126cc9df77eSBarry 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:
139cc9df77eSBarry Smith    On systems that support it, when called with PETSC_FP_TRAP_ON this routine causes floating point
140cc9df77eSBarry 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:
144cc9df77eSBarry 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
149cc9df77eSBarry Smith    break on the line where the error occurred.  On systems that support C99
150cc9df77eSBarry 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:
155cc9df77eSBarry Smith    On certain machines, in particular the IBM PowerPC, floating point
156cc9df77eSBarry Smith    trapping may be VERY slow!
157e5c89e4eSSatish Balay 
158e5c89e4eSSatish Balay 
159*aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitialFPTrap()
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 
180cc9df77eSBarry Smith /*@
181*aba4c478SBarry Smith    PetscDetermineInitialFPTrap - Attempts to determine the floating point trapping that exists when PetscInitialize() is called
182cc9df77eSBarry Smith 
183cc9df77eSBarry Smith    Not Collective
184cc9df77eSBarry Smith 
185cc9df77eSBarry Smith    Notes:
186cc9df77eSBarry Smith       Currently only supported on Linux and MacOS. Checks if divide by zero is enable and if so declares that trapping is on.
187cc9df77eSBarry Smith 
188cc9df77eSBarry Smith 
189*aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitialFPTrap()
190cc9df77eSBarry Smith @*/
191*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
192cc9df77eSBarry Smith {
193cc9df77eSBarry Smith   PetscErrorCode ierr;
194cc9df77eSBarry Smith 
195cc9df77eSBarry Smith   PetscFunctionBegin;
196cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
197cc9df77eSBarry Smith   PetscFunctionReturn(0);
198cc9df77eSBarry Smith }
199cc9df77eSBarry 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");
244cc9df77eSBarry Smith   } else {
245cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
246cc9df77eSBarry Smith   }
247670f3ff9SJed Brown   _trapmode = flag;
248e5c89e4eSSatish Balay   PetscFunctionReturn(0);
249e5c89e4eSSatish Balay }
250e5c89e4eSSatish Balay 
251*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
252cc9df77eSBarry Smith {
253cc9df77eSBarry Smith   PetscErrorCode ierr;
254e5c89e4eSSatish Balay 
255cc9df77eSBarry Smith   PetscFunctionBegin;
256cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
257cc9df77eSBarry Smith   PetscFunctionReturn(0);
258cc9df77eSBarry Smith }
259cc9df77eSBarry Smith 
260cc9df77eSBarry 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;
290cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) handle_sigfpes(_ON,,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
291cc9df77eSBarry 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 }
295cc9df77eSBarry Smith 
296*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
297cc9df77eSBarry Smith {
298cc9df77eSBarry Smith   PetscErrorCode ierr;
299cc9df77eSBarry Smith 
300cc9df77eSBarry Smith   PetscFunctionBegin;
301cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
302cc9df77eSBarry Smith   PetscFunctionReturn(0);
303cc9df77eSBarry Smith }
304cc9df77eSBarry Smith 
305e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
306cc9df77eSBarry Smith #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
307cc9df77eSBarry Smith #include <sunmath.h>
308cc9df77eSBarry Smith #include <floatingpoint.h>
309cc9df77eSBarry Smith #include <siginfo.h>
310cc9df77eSBarry Smith #include <ucontext.h>
311cc9df77eSBarry Smith 
312cc9df77eSBarry Smith static struct { int code_no; char *name; } error_codes[] = {
313cc9df77eSBarry Smith   { FPE_FLTINV,"invalid floating point operand"},
314cc9df77eSBarry Smith   { FPE_FLTRES,"inexact floating point result"},
315cc9df77eSBarry Smith   { FPE_FLTDIV,"division-by-zero"},
316cc9df77eSBarry Smith   { FPE_FLTUND,"floating point underflow"},
317cc9df77eSBarry Smith   { FPE_FLTOVF,"floating point overflow"},
318cc9df77eSBarry Smith   { 0,         "unknown error"}
319cc9df77eSBarry Smith };
320cc9df77eSBarry Smith #define SIGPC(scp) (scp->si_addr)
321cc9df77eSBarry Smith 
322cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
323cc9df77eSBarry Smith {
324cc9df77eSBarry Smith   int            err_ind,j,code = scp->si_code;
325cc9df77eSBarry Smith   PetscErrorCode ierr;
326cc9df77eSBarry Smith 
327cc9df77eSBarry Smith   PetscFunctionBegin;
328cc9df77eSBarry Smith   err_ind = -1;
329cc9df77eSBarry Smith   for (j = 0; error_codes[j].code_no; j++) {
330cc9df77eSBarry Smith     if (error_codes[j].code_no == code) err_ind = j;
331cc9df77eSBarry Smith   }
332cc9df77eSBarry Smith 
333cc9df77eSBarry Smith   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
334cc9df77eSBarry Smith   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
335cc9df77eSBarry Smith 
336cc9df77eSBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
337cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
338cc9df77eSBarry Smith }
339cc9df77eSBarry Smith 
340cc9df77eSBarry Smith PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
341cc9df77eSBarry Smith {
342cc9df77eSBarry Smith   char *out;
343cc9df77eSBarry Smith 
344cc9df77eSBarry Smith   PetscFunctionBegin;
345cc9df77eSBarry Smith   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
346cc9df77eSBarry Smith   (void) ieee_flags("clear","exception","all",&out);
347cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) {
348cc9df77eSBarry Smith     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
349cc9df77eSBarry Smith   } else {
350cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
351cc9df77eSBarry Smith   }
352cc9df77eSBarry Smith   _trapmode = flag;
353cc9df77eSBarry Smith   PetscFunctionReturn(0);
354cc9df77eSBarry Smith }
355cc9df77eSBarry Smith 
356*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
357cc9df77eSBarry Smith {
358cc9df77eSBarry Smith   PetscErrorCode ierr;
359cc9df77eSBarry Smith 
360cc9df77eSBarry Smith   PetscFunctionBegin;
361cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
362cc9df77eSBarry Smith   PetscFunctionReturn(0);
363cc9df77eSBarry Smith }
364cc9df77eSBarry Smith 
365cc9df77eSBarry Smith /*----------------------------------------------- --------------------------------------------*/
366cc9df77eSBarry 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);
420cc9df77eSBarry 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);
432cc9df77eSBarry 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*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
440cc9df77eSBarry Smith {
441cc9df77eSBarry Smith   PetscErrorCode ierr;
442cc9df77eSBarry Smith 
443cc9df77eSBarry Smith   PetscFunctionBegin;
444cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
445cc9df77eSBarry Smith   PetscFunctionReturn(0);
446cc9df77eSBarry Smith }
447cc9df77eSBarry Smith 
448cc9df77eSBarry Smith /* ------------------------------------------------------------*/
449cc9df77eSBarry Smith #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
450cc9df77eSBarry Smith #include <float.h>
451cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
452cc9df77eSBarry Smith {
453cc9df77eSBarry Smith   PetscFunctionBegin;
454cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
455cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
456cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
457cc9df77eSBarry Smith }
458cc9df77eSBarry Smith 
459cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
460cc9df77eSBarry Smith {
461cc9df77eSBarry Smith   unsigned int cw;
462cc9df77eSBarry Smith 
463cc9df77eSBarry Smith   PetscFunctionBegin;
464cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
465cc9df77eSBarry Smith     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW;
466cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
467cc9df77eSBarry Smith   } else {
468cc9df77eSBarry Smith     cw = 0;
469cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
470cc9df77eSBarry Smith   }
471cc9df77eSBarry Smith   (void)_controlfp(0, cw);
472cc9df77eSBarry Smith   _trapmode = on;
473cc9df77eSBarry Smith   PetscFunctionReturn(0);
474cc9df77eSBarry Smith }
475cc9df77eSBarry Smith 
476*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
477cc9df77eSBarry Smith {
478cc9df77eSBarry Smith   PetscErrorCode ierr;
479cc9df77eSBarry Smith 
480cc9df77eSBarry Smith   PetscFunctionBegin;
481cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
482cc9df77eSBarry Smith   PetscFunctionReturn(0);
483cc9df77eSBarry Smith }
484cc9df77eSBarry Smith 
485cc9df77eSBarry 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");
557cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
558cc9df77eSBarry 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
561cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_DIV_ZERO);
562cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_UNDERFLOW);
563cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_OVERFLOW);
564cc9df77eSBarry 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");
571cc9df77eSBarry 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*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
579cc9df77eSBarry Smith {
580cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
581cc9df77eSBarry Smith   unsigned int   flags;
582cc9df77eSBarry Smith #endif
583cc9df77eSBarry Smith   PetscErrorCode ierr;
584cc9df77eSBarry Smith 
585cc9df77eSBarry Smith   PetscFunctionBegin;
586cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
587cc9df77eSBarry Smith   flags = fegetexcept();
588cc9df77eSBarry Smith   if (flags & FE_DIVBYZERO) {
589cc9df77eSBarry Smith #elif defined PETSC_HAVE_XMMINTRIN_H
590cc9df77eSBarry Smith   flags = _MM_GET_EXCEPTION_MASK();
591cc9df77eSBarry Smith   if (!(flags & _MM_MASK_DIV_ZERO)) {
592cc9df77eSBarry Smith #else
593cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Floating point trapping unknown, assuming off\n");CHKERRQ(ierr);
594cc9df77eSBarry Smith   PetscFunctionReturn(0);
595cc9df77eSBarry Smith #endif
596cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
597cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_ON;
598cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is on by default %d\n",flags);CHKERRQ(ierr);
599cc9df77eSBarry Smith   } else {
600cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_OFF;
601cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is off by default %d\n",flags);CHKERRQ(ierr);
602cc9df77eSBarry Smith   }
603cc9df77eSBarry Smith   PetscFunctionReturn(0);
604cc9df77eSBarry Smith #endif
605cc9df77eSBarry Smith }
606cc9df77eSBarry Smith 
607cc9df77eSBarry Smith /* ------------------------------------------------------------*/
608cc9df77eSBarry Smith #elif defined(PETSC_HAVE_IEEEFP_H)
609cc9df77eSBarry Smith #include <ieeefp.h>
610cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
611cc9df77eSBarry Smith {
612cc9df77eSBarry Smith   PetscFunctionBegin;
613cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
614cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
615cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
616cc9df77eSBarry Smith }
617cc9df77eSBarry Smith 
618cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
619cc9df77eSBarry Smith {
620cc9df77eSBarry Smith   PetscFunctionBegin;
621cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
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(FP_X_INV | FP_X_DZ | FP_X_OFL |  FP_X_OFL);
628cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
629cc9df77eSBarry Smith   } else {
630cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
631cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
632cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
633cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
634cc9df77eSBarry Smith #endif
635cc9df77eSBarry Smith     fpsetmask(0);
636cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
637cc9df77eSBarry Smith   }
638cc9df77eSBarry Smith   _trapmode = on;
639cc9df77eSBarry Smith   PetscFunctionReturn(0);
640cc9df77eSBarry Smith }
641cc9df77eSBarry Smith 
642*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
643cc9df77eSBarry Smith {
644cc9df77eSBarry Smith   PetscErrorCode ierr;
645cc9df77eSBarry Smith 
646cc9df77eSBarry Smith   PetscFunctionBegin;
647cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
648cc9df77eSBarry Smith   PetscFunctionReturn(0);
649cc9df77eSBarry Smith }
650cc9df77eSBarry 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 }
672cc9df77eSBarry Smith 
673*aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
674cc9df77eSBarry Smith {
675cc9df77eSBarry Smith   PetscErrorCode ierr;
676cc9df77eSBarry Smith 
677cc9df77eSBarry Smith   PetscFunctionBegin;
678cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
679cc9df77eSBarry Smith   PetscFunctionReturn(0);
680cc9df77eSBarry Smith }
681e5c89e4eSSatish Balay #endif
682e5c89e4eSSatish Balay 
683e5c89e4eSSatish Balay 
684e5c89e4eSSatish Balay 
685