xref: /petsc/src/sys/error/fp.c (revision ee300463989a2a62176bb6db43f2742707834045)
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 };
26aba4c478SBarry 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 
50aba4c478SBarry 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 
73aba4c478SBarry 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 
159aba4c478SBarry 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 /*@
181aba4c478SBarry 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 
188*ee300463SSatish Balay    Level: advanced
189cc9df77eSBarry Smith 
190aba4c478SBarry Smith .seealso: PetscFPTrapPush(), PetscFPTrapPop(), PetscDetermineInitialFPTrap()
191cc9df77eSBarry Smith @*/
192aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
193cc9df77eSBarry Smith {
194cc9df77eSBarry Smith   PetscErrorCode ierr;
195cc9df77eSBarry Smith 
196cc9df77eSBarry Smith   PetscFunctionBegin;
197cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
198cc9df77eSBarry Smith   PetscFunctionReturn(0);
199cc9df77eSBarry Smith }
200cc9df77eSBarry Smith 
201e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
202e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
203e5c89e4eSSatish Balay #include <sunmath.h>
204e5c89e4eSSatish Balay #include <floatingpoint.h>
205e5c89e4eSSatish Balay #include <siginfo.h>
206e5c89e4eSSatish Balay #include <ucontext.h>
207e5c89e4eSSatish Balay 
208db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
209e5c89e4eSSatish Balay   { FPE_FLTINV,"invalid floating point operand"},
210e5c89e4eSSatish Balay   { FPE_FLTRES,"inexact floating point result"},
211e5c89e4eSSatish Balay   { FPE_FLTDIV,"division-by-zero"},
212e5c89e4eSSatish Balay   { FPE_FLTUND,"floating point underflow"},
213e5c89e4eSSatish Balay   { FPE_FLTOVF,"floating point overflow"},
214e5c89e4eSSatish Balay   { 0,         "unknown error"}
215e5c89e4eSSatish Balay };
216e5c89e4eSSatish Balay #define SIGPC(scp) (scp->si_addr)
217e5c89e4eSSatish Balay 
218e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
219e5c89e4eSSatish Balay {
220e5c89e4eSSatish Balay   int            err_ind,j,code = scp->si_code;
221e5c89e4eSSatish Balay   PetscErrorCode ierr;
222e5c89e4eSSatish Balay 
223e5c89e4eSSatish Balay   PetscFunctionBegin;
224e5c89e4eSSatish Balay   err_ind = -1;
225e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
226e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
227e5c89e4eSSatish Balay   }
228e5c89e4eSSatish Balay 
229a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
230a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
231a297a907SKarl Rupp 
232efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
23341e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
234e5c89e4eSSatish Balay }
235e5c89e4eSSatish Balay 
236e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
237e5c89e4eSSatish Balay {
238e5c89e4eSSatish Balay   char *out;
239e5c89e4eSSatish Balay 
240e5c89e4eSSatish Balay   PetscFunctionBegin;
241e5c89e4eSSatish Balay   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
242e5c89e4eSSatish Balay   (void) ieee_flags("clear","exception","all",&out);
243e5c89e4eSSatish Balay   if (flag == PETSC_FP_TRAP_ON) {
244a297a907SKarl Rupp     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
245cc9df77eSBarry Smith   } else {
246cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
247cc9df77eSBarry Smith   }
248670f3ff9SJed Brown   _trapmode = flag;
249e5c89e4eSSatish Balay   PetscFunctionReturn(0);
250e5c89e4eSSatish Balay }
251e5c89e4eSSatish Balay 
252aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
253cc9df77eSBarry Smith {
254cc9df77eSBarry Smith   PetscErrorCode ierr;
255e5c89e4eSSatish Balay 
256cc9df77eSBarry Smith   PetscFunctionBegin;
257cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
258cc9df77eSBarry Smith   PetscFunctionReturn(0);
259cc9df77eSBarry Smith }
260cc9df77eSBarry Smith 
261cc9df77eSBarry Smith /* ------------------------------------------------------------------------------------------*/
262e5c89e4eSSatish Balay #elif defined(PETSC_HAVE_IRIX_STYLE_FPTRAP)
263e5c89e4eSSatish Balay #include <sigfpe.h>
264db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
265e5c89e4eSSatish Balay   { _INVALID   ,"IEEE operand error" },
266e5c89e4eSSatish Balay   { _OVERFL    ,"floating point overflow" },
267e5c89e4eSSatish Balay   { _UNDERFL   ,"floating point underflow" },
268e5c89e4eSSatish Balay   { _DIVZERO   ,"floating point divide" },
269e5c89e4eSSatish Balay   { 0          ,"unknown error" }
270e5c89e4eSSatish Balay } ;
271e5c89e4eSSatish Balay void PetscDefaultFPTrap(unsigned exception[],int val[])
272e5c89e4eSSatish Balay {
273e5c89e4eSSatish Balay   int err_ind,j,code;
274e5c89e4eSSatish Balay 
275e5c89e4eSSatish Balay   PetscFunctionBegin;
276e5c89e4eSSatish Balay   code    = exception[0];
277e5c89e4eSSatish Balay   err_ind = -1;
278e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
279e5c89e4eSSatish Balay     if (error_codes[j].code_no == code) err_ind = j;
280e5c89e4eSSatish Balay   }
281a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
282a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",code);
283a297a907SKarl Rupp 
284efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
28541e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
286e5c89e4eSSatish Balay }
287e5c89e4eSSatish Balay 
288e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
289e5c89e4eSSatish Balay {
290e5c89e4eSSatish Balay   PetscFunctionBegin;
291cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) handle_sigfpes(_ON,,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,PetscDefaultFPTrap,_ABORT_ON_ERROR,0);
292cc9df77eSBarry Smith   else                          handle_sigfpes(_OFF,_EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,0,_ABORT_ON_ERROR,0);
293670f3ff9SJed Brown   _trapmode = flag;
294e5c89e4eSSatish Balay   PetscFunctionReturn(0);
295e5c89e4eSSatish Balay }
296cc9df77eSBarry Smith 
297aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
298cc9df77eSBarry Smith {
299cc9df77eSBarry Smith   PetscErrorCode ierr;
300cc9df77eSBarry Smith 
301cc9df77eSBarry Smith   PetscFunctionBegin;
302cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
303cc9df77eSBarry Smith   PetscFunctionReturn(0);
304cc9df77eSBarry Smith }
305cc9df77eSBarry Smith 
306e5c89e4eSSatish Balay /* -------------------------------------------------------------------------------------------*/
307cc9df77eSBarry Smith #elif defined(PETSC_HAVE_SOLARIS_STYLE_FPTRAP)
308cc9df77eSBarry Smith #include <sunmath.h>
309cc9df77eSBarry Smith #include <floatingpoint.h>
310cc9df77eSBarry Smith #include <siginfo.h>
311cc9df77eSBarry Smith #include <ucontext.h>
312cc9df77eSBarry Smith 
313cc9df77eSBarry Smith static struct { int code_no; char *name; } error_codes[] = {
314cc9df77eSBarry Smith   { FPE_FLTINV,"invalid floating point operand"},
315cc9df77eSBarry Smith   { FPE_FLTRES,"inexact floating point result"},
316cc9df77eSBarry Smith   { FPE_FLTDIV,"division-by-zero"},
317cc9df77eSBarry Smith   { FPE_FLTUND,"floating point underflow"},
318cc9df77eSBarry Smith   { FPE_FLTOVF,"floating point overflow"},
319cc9df77eSBarry Smith   { 0,         "unknown error"}
320cc9df77eSBarry Smith };
321cc9df77eSBarry Smith #define SIGPC(scp) (scp->si_addr)
322cc9df77eSBarry Smith 
323cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig,siginfo_t *scp,ucontext_t *uap)
324cc9df77eSBarry Smith {
325cc9df77eSBarry Smith   int            err_ind,j,code = scp->si_code;
326cc9df77eSBarry Smith   PetscErrorCode ierr;
327cc9df77eSBarry Smith 
328cc9df77eSBarry Smith   PetscFunctionBegin;
329cc9df77eSBarry Smith   err_ind = -1;
330cc9df77eSBarry Smith   for (j = 0; error_codes[j].code_no; j++) {
331cc9df77eSBarry Smith     if (error_codes[j].code_no == code) err_ind = j;
332cc9df77eSBarry Smith   }
333cc9df77eSBarry Smith 
334cc9df77eSBarry Smith   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred at pc=%X ***\n",error_codes[err_ind].name,SIGPC(scp));
335cc9df77eSBarry Smith   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred at pc=%X ***\n",code,SIGPC(scp));
336cc9df77eSBarry Smith 
337cc9df77eSBarry Smith   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
338cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
339cc9df77eSBarry Smith }
340cc9df77eSBarry Smith 
341cc9df77eSBarry Smith PetscErrorCode PetscSetFPTrap(PetscFPTrap flag)
342cc9df77eSBarry Smith {
343cc9df77eSBarry Smith   char *out;
344cc9df77eSBarry Smith 
345cc9df77eSBarry Smith   PetscFunctionBegin;
346cc9df77eSBarry Smith   /* Clear accumulated exceptions.  Used to suppress meaningless messages from f77 programs */
347cc9df77eSBarry Smith   (void) ieee_flags("clear","exception","all",&out);
348cc9df77eSBarry Smith   if (flag == PETSC_FP_TRAP_ON) {
349cc9df77eSBarry Smith     if (ieee_handler("set","common",(sigfpe_handler_type)PetscDefaultFPTrap))        (*PetscErrorPrintf)("Can't set floating point handler\n");
350cc9df77eSBarry Smith   } else {
351cc9df77eSBarry Smith     if (ieee_handler("clear","common",(sigfpe_handler_type)PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
352cc9df77eSBarry Smith   }
353cc9df77eSBarry Smith   _trapmode = flag;
354cc9df77eSBarry Smith   PetscFunctionReturn(0);
355cc9df77eSBarry Smith }
356cc9df77eSBarry Smith 
357aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
358cc9df77eSBarry Smith {
359cc9df77eSBarry Smith   PetscErrorCode ierr;
360cc9df77eSBarry Smith 
361cc9df77eSBarry Smith   PetscFunctionBegin;
362cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
363cc9df77eSBarry Smith   PetscFunctionReturn(0);
364cc9df77eSBarry Smith }
365cc9df77eSBarry Smith 
366cc9df77eSBarry Smith /*----------------------------------------------- --------------------------------------------*/
367cc9df77eSBarry Smith #elif defined(PETSC_HAVE_RS6000_STYLE_FPTRAP)
368e5c89e4eSSatish Balay /* In "fast" mode, floating point traps are imprecise and ignored.
369e5c89e4eSSatish Balay    This is the reason for the fptrap(FP_TRAP_SYNC) call */
370e5c89e4eSSatish Balay struct sigcontext;
371e5c89e4eSSatish Balay #include <fpxcp.h>
372e5c89e4eSSatish Balay #include <fptrap.h>
373e5c89e4eSSatish Balay #define FPE_FLTOPERR_TRAP (fptrap_t)(0x20000000)
374e5c89e4eSSatish Balay #define FPE_FLTOVF_TRAP   (fptrap_t)(0x10000000)
375e5c89e4eSSatish Balay #define FPE_FLTUND_TRAP   (fptrap_t)(0x08000000)
376e5c89e4eSSatish Balay #define FPE_FLTDIV_TRAP   (fptrap_t)(0x04000000)
377e5c89e4eSSatish Balay #define FPE_FLTINEX_TRAP  (fptrap_t)(0x02000000)
378e5c89e4eSSatish Balay 
379db32a245SJed Brown static struct { int code_no; char *name; } error_codes[] = {
380e5c89e4eSSatish Balay   {FPE_FLTOPERR_TRAP   ,"IEEE operand error" },
381e5c89e4eSSatish Balay   { FPE_FLTOVF_TRAP    ,"floating point overflow" },
382e5c89e4eSSatish Balay   { FPE_FLTUND_TRAP    ,"floating point underflow" },
383e5c89e4eSSatish Balay   { FPE_FLTDIV_TRAP    ,"floating point divide" },
384e5c89e4eSSatish Balay   { FPE_FLTINEX_TRAP   ,"inexact floating point result" },
385e5c89e4eSSatish Balay   { 0                  ,"unknown error" }
386e5c89e4eSSatish Balay } ;
387e5c89e4eSSatish Balay #define SIGPC(scp) (0) /* Info MIGHT be in scp->sc_jmpbuf.jmp_context.iar */
388e5c89e4eSSatish Balay /*
389e5c89e4eSSatish Balay    For some reason, scp->sc_jmpbuf does not work on the RS6000, even though
390e5c89e4eSSatish Balay    it looks like it should from the include definitions.  It is probably
391e5c89e4eSSatish Balay    some strange interaction with the "POSIX_SOURCE" that we require.
392e5c89e4eSSatish Balay */
393e5c89e4eSSatish Balay 
394e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig,int code,struct sigcontext *scp)
395e5c89e4eSSatish Balay {
396e5c89e4eSSatish Balay   PetscErrorCode ierr;
397e5c89e4eSSatish Balay   int            err_ind,j;
398e5c89e4eSSatish Balay   fp_ctx_t       flt_context;
399e5c89e4eSSatish Balay 
400e5c89e4eSSatish Balay   PetscFunctionBegin;
401e5c89e4eSSatish Balay   fp_sh_trap_info(scp,&flt_context);
402e5c89e4eSSatish Balay 
403e5c89e4eSSatish Balay   err_ind = -1;
404e5c89e4eSSatish Balay   for (j = 0; error_codes[j].code_no; j++) {
405e5c89e4eSSatish Balay     if (error_codes[j].code_no == flt_context.trap) err_ind = j;
406e5c89e4eSSatish Balay   }
407e5c89e4eSSatish Balay 
408a297a907SKarl Rupp   if (err_ind >= 0) (*PetscErrorPrintf)("*** %s occurred ***\n",error_codes[err_ind].name);
409a297a907SKarl Rupp   else              (*PetscErrorPrintf)("*** floating point error 0x%x occurred ***\n",flt_context.trap);
410a297a907SKarl Rupp 
411efca3c55SSatish Balay   ierr = PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
41241e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
413e5c89e4eSSatish Balay }
414e5c89e4eSSatish Balay 
415e5c89e4eSSatish Balay PetscErrorCode PetscSetFPTrap(PetscFPTrap on)
416e5c89e4eSSatish Balay {
417e5c89e4eSSatish Balay   PetscFunctionBegin;
418e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
419e5c89e4eSSatish Balay     signal(SIGFPE,(void (*)(int))PetscDefaultFPTrap);
420e5c89e4eSSatish Balay     fp_trap(FP_TRAP_SYNC);
421cc9df77eSBarry Smith     fp_enable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
422e5c89e4eSSatish Balay     /* fp_enable(mask) for individual traps.  Values are:
423e5c89e4eSSatish Balay        TRP_INVALID
424e5c89e4eSSatish Balay        TRP_DIV_BY_ZERO
425e5c89e4eSSatish Balay        TRP_OVERFLOW
426e5c89e4eSSatish Balay        TRP_UNDERFLOW
427e5c89e4eSSatish Balay        TRP_INEXACT
428e5c89e4eSSatish Balay        Can OR then together.
429e5c89e4eSSatish Balay        fp_enable_all(); for all traps.
430e5c89e4eSSatish Balay     */
431e5c89e4eSSatish Balay   } else {
432e5c89e4eSSatish Balay     signal(SIGFPE,SIG_DFL);
433cc9df77eSBarry Smith     fp_disable(TRP_INVALID | TRP_DIV_BY_ZERO | TRP_OVERFLOW | TRP_UNDERFLOW);
434e5c89e4eSSatish Balay     fp_trap(FP_TRAP_OFF);
435e5c89e4eSSatish Balay   }
436670f3ff9SJed Brown   _trapmode = on;
437e5c89e4eSSatish Balay   PetscFunctionReturn(0);
438e5c89e4eSSatish Balay }
439e5c89e4eSSatish Balay 
440aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
441cc9df77eSBarry Smith {
442cc9df77eSBarry Smith   PetscErrorCode ierr;
443cc9df77eSBarry Smith 
444cc9df77eSBarry Smith   PetscFunctionBegin;
445cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
446cc9df77eSBarry Smith   PetscFunctionReturn(0);
447cc9df77eSBarry Smith }
448cc9df77eSBarry Smith 
449cc9df77eSBarry Smith /* ------------------------------------------------------------*/
450cc9df77eSBarry Smith #elif defined(PETSC_HAVE_WINDOWS_COMPILERS)
451cc9df77eSBarry Smith #include <float.h>
452cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
453cc9df77eSBarry Smith {
454cc9df77eSBarry Smith   PetscFunctionBegin;
455cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
456cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
457cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
458cc9df77eSBarry Smith }
459cc9df77eSBarry Smith 
460cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
461cc9df77eSBarry Smith {
462cc9df77eSBarry Smith   unsigned int cw;
463cc9df77eSBarry Smith 
464cc9df77eSBarry Smith   PetscFunctionBegin;
465cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
466cc9df77eSBarry Smith     cw = _EM_INVALID | _EM_ZERODIVIDE | _EM_OVERFLOW | _EM_UNDERFLOW;
467cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
468cc9df77eSBarry Smith   } else {
469cc9df77eSBarry Smith     cw = 0;
470cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
471cc9df77eSBarry Smith   }
472cc9df77eSBarry Smith   (void)_controlfp(0, cw);
473cc9df77eSBarry Smith   _trapmode = on;
474cc9df77eSBarry Smith   PetscFunctionReturn(0);
475cc9df77eSBarry Smith }
476cc9df77eSBarry Smith 
477aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
478cc9df77eSBarry Smith {
479cc9df77eSBarry Smith   PetscErrorCode ierr;
480cc9df77eSBarry Smith 
481cc9df77eSBarry Smith   PetscFunctionBegin;
482cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
483cc9df77eSBarry Smith   PetscFunctionReturn(0);
484cc9df77eSBarry Smith }
485cc9df77eSBarry Smith 
486cc9df77eSBarry Smith /* ------------------------------------------------------------*/
4879a2402e9SBarry Smith #elif defined(PETSC_HAVE_FENV_H) && !defined(__cplusplus)
488b014e56cSJed Brown /*
489b014e56cSJed Brown    C99 style floating point environment.
490b014e56cSJed Brown 
491b014e56cSJed Brown    Note that C99 merely specifies how to save, restore, and clear the floating
492b014e56cSJed Brown    point environment as well as defining an enumeration of exception codes.  In
493b014e56cSJed Brown    particular, C99 does not specify how to make floating point exceptions raise
494b014e56cSJed Brown    a signal.  Glibc offers this capability through FE_NOMASK_ENV (or with finer
495b014e56cSJed Brown    granularity, feenableexcept()), xmmintrin.h offers _MM_SET_EXCEPTION_MASK().
496b014e56cSJed Brown */
497b014e56cSJed Brown #include <fenv.h>
498b014e56cSJed Brown typedef struct {int code; const char *name;} FPNode;
499b014e56cSJed Brown static const FPNode error_codes[] = {
500b014e56cSJed Brown   {FE_DIVBYZERO,"divide by zero"},
501b014e56cSJed Brown   {FE_INEXACT,  "inexact floating point result"},
502b014e56cSJed Brown   {FE_INVALID,  "invalid floating point arguments (domain error)"},
503b014e56cSJed Brown   {FE_OVERFLOW, "floating point overflow"},
504b014e56cSJed Brown   {FE_UNDERFLOW,"floating point underflow"},
505b014e56cSJed Brown   {0           ,"unknown error"}
506b014e56cSJed Brown };
50799e0435eSBarry Smith 
508b014e56cSJed Brown void PetscDefaultFPTrap(int sig)
509b014e56cSJed Brown {
510b014e56cSJed Brown   const FPNode *node;
511b014e56cSJed Brown   int          code;
512ace3abfcSBarry Smith   PetscBool    matched = PETSC_FALSE;
513b014e56cSJed Brown 
514b014e56cSJed Brown   PetscFunctionBegin;
515b014e56cSJed Brown   /* Note: While it is possible for the exception state to be preserved by the
516b014e56cSJed Brown    * kernel, this seems to be rare which makes the following flag testing almost
517b014e56cSJed Brown    * useless.  But on a system where the flags can be preserved, it would provide
5187d125cddSJed Brown    * more detail.
519b014e56cSJed Brown    */
520b014e56cSJed Brown   code = fetestexcept(FE_ALL_EXCEPT);
521b014e56cSJed Brown   for (node=&error_codes[0]; node->code; node++) {
522b014e56cSJed Brown     if (code & node->code) {
523b014e56cSJed Brown       matched = PETSC_TRUE;
524b014e56cSJed Brown       (*PetscErrorPrintf)("*** floating point error \"%s\" occurred ***\n",node->name);
525b014e56cSJed Brown       code &= ~node->code; /* Unset this flag since it has been processed */
526b014e56cSJed Brown     }
527b014e56cSJed Brown   }
528b014e56cSJed Brown   if (!matched || code) { /* If any remaining flags are set, or we didn't process any flags */
529b014e56cSJed Brown     (*PetscErrorPrintf)("*** unknown floating point error occurred ***\n");
5307d125cddSJed Brown     (*PetscErrorPrintf)("The specific exception can be determined by running in a debugger.  When the\n");
5317d125cddSJed Brown     (*PetscErrorPrintf)("debugger traps the signal, the exception can be found with fetestexcept(0x%x)\n",FE_ALL_EXCEPT);
5327d125cddSJed Brown     (*PetscErrorPrintf)("where the result is a bitwise OR of the following flags:\n");
5337d125cddSJed 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);
534b014e56cSJed Brown   }
5357d125cddSJed Brown 
5367d125cddSJed Brown   (*PetscErrorPrintf)("Try option -start_in_debugger\n");
53776bd3646SJed Brown   if (PetscDefined(USE_DEBUG)) {
538dbf62e16SBarry Smith     if (!PetscStackActive()) (*PetscErrorPrintf)("  or try option -log_stack\n");
539a297a907SKarl Rupp     else {
5407d125cddSJed Brown       (*PetscErrorPrintf)("likely location of problem given in stack below\n");
5417d125cddSJed Brown       (*PetscErrorPrintf)("---------------------  Stack Frames ------------------------------------\n");
542639ff905SBarry Smith       PetscStackView(PETSC_STDOUT);
5437d125cddSJed Brown     }
54476bd3646SJed Brown   } else {
5457d125cddSJed Brown     (*PetscErrorPrintf)("configure using --with-debugging=yes, recompile, link, and run \n");
5467d125cddSJed Brown     (*PetscErrorPrintf)("with -start_in_debugger to get more information on the crash.\n");
54776bd3646SJed Brown   }
548efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_INITIAL,"trapped floating point error");
54941e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
550b014e56cSJed Brown }
551b014e56cSJed Brown 
5527087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
553b014e56cSJed Brown {
554b014e56cSJed Brown   PetscFunctionBegin;
555b014e56cSJed Brown   if (on == PETSC_FP_TRAP_ON) {
556b014e56cSJed Brown     /* Clear any flags that are currently set so that activating trapping will not immediately call the signal handler. */
557e32f2f54SBarry Smith     if (feclearexcept(FE_ALL_EXCEPT)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot clear floating point exception flags\n");
558cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
559cc9df77eSBarry Smith     /* Could use fesetenv(FE_NOMASK_ENV), but that causes spurious exceptions (like gettimeofday() -> PetscLogDouble). */
560e32f2f54SBarry 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");
561b014e56cSJed Brown #elif defined PETSC_HAVE_XMMINTRIN_H
562cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_DIV_ZERO);
563cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_UNDERFLOW);
564cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_OVERFLOW);
565cc9df77eSBarry Smith    _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() & ~_MM_MASK_INVALID);
566b014e56cSJed Brown #else
567b014e56cSJed Brown     /* C99 does not provide a way to modify the environment so there is no portable way to activate trapping. */
568b014e56cSJed Brown #endif
569e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
570b014e56cSJed Brown   } else {
571e32f2f54SBarry Smith     if (fesetenv(FE_DFL_ENV)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Cannot disable floating point exceptions");
572cc9df77eSBarry Smith     /* can use _MM_SET_EXCEPTION_MASK(_MM_GET_EXCEPTION_MASK() | _MM_MASK_UNDERFLOW); if PETSC_HAVE_XMMINTRIN_H exists */
573e32f2f54SBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
574b014e56cSJed Brown   }
575670f3ff9SJed Brown   _trapmode = on;
576b014e56cSJed Brown   PetscFunctionReturn(0);
577b014e56cSJed Brown }
578b014e56cSJed Brown 
579aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
580cc9df77eSBarry Smith {
581cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
582cc9df77eSBarry Smith   unsigned int   flags;
583cc9df77eSBarry Smith #endif
584cc9df77eSBarry Smith   PetscErrorCode ierr;
585cc9df77eSBarry Smith 
586cc9df77eSBarry Smith   PetscFunctionBegin;
587cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV)
588cc9df77eSBarry Smith   flags = fegetexcept();
589cc9df77eSBarry Smith   if (flags & FE_DIVBYZERO) {
590cc9df77eSBarry Smith #elif defined PETSC_HAVE_XMMINTRIN_H
591cc9df77eSBarry Smith   flags = _MM_GET_EXCEPTION_MASK();
592cc9df77eSBarry Smith   if (!(flags & _MM_MASK_DIV_ZERO)) {
593cc9df77eSBarry Smith #else
594cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Floating point trapping unknown, assuming off\n");CHKERRQ(ierr);
595cc9df77eSBarry Smith   PetscFunctionReturn(0);
596cc9df77eSBarry Smith #endif
597cc9df77eSBarry Smith #if defined(FE_NOMASK_ENV) || defined PETSC_HAVE_XMMINTRIN_H
598cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_ON;
599cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is on by default %d\n",flags);CHKERRQ(ierr);
600cc9df77eSBarry Smith   } else {
601cc9df77eSBarry Smith     _trapmode = PETSC_FP_TRAP_OFF;
602cc9df77eSBarry Smith     ierr = PetscInfo1(NULL,"Floating point trapping is off by default %d\n",flags);CHKERRQ(ierr);
603cc9df77eSBarry Smith   }
604cc9df77eSBarry Smith   PetscFunctionReturn(0);
605cc9df77eSBarry Smith #endif
606cc9df77eSBarry Smith }
607cc9df77eSBarry Smith 
608cc9df77eSBarry Smith /* ------------------------------------------------------------*/
609cc9df77eSBarry Smith #elif defined(PETSC_HAVE_IEEEFP_H)
610cc9df77eSBarry Smith #include <ieeefp.h>
611cc9df77eSBarry Smith void PetscDefaultFPTrap(int sig)
612cc9df77eSBarry Smith {
613cc9df77eSBarry Smith   PetscFunctionBegin;
614cc9df77eSBarry Smith   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
615cc9df77eSBarry Smith   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
616cc9df77eSBarry Smith   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
617cc9df77eSBarry Smith }
618cc9df77eSBarry Smith 
619cc9df77eSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
620cc9df77eSBarry Smith {
621cc9df77eSBarry Smith   PetscFunctionBegin;
622cc9df77eSBarry Smith   if (on == PETSC_FP_TRAP_ON) {
623cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
624cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
625cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
626cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
627cc9df77eSBarry Smith #endif
628cc9df77eSBarry Smith     fpsetmask(FP_X_INV | FP_X_DZ | FP_X_OFL |  FP_X_OFL);
629cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't set floating point handler\n");
630cc9df77eSBarry Smith   } else {
631cc9df77eSBarry Smith #if defined(PETSC_HAVE_FPPRESETSTICKY)
632cc9df77eSBarry Smith     fpresetsticky(fpgetsticky());
633cc9df77eSBarry Smith #elif defined(PETSC_HAVE_FPSETSTICKY)
634cc9df77eSBarry Smith     fpsetsticky(fpgetsticky());
635cc9df77eSBarry Smith #endif
636cc9df77eSBarry Smith     fpsetmask(0);
637cc9df77eSBarry Smith     if (SIG_ERR == signal(SIGFPE,SIG_DFL)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Can't clear floating point handler\n");
638cc9df77eSBarry Smith   }
639cc9df77eSBarry Smith   _trapmode = on;
640cc9df77eSBarry Smith   PetscFunctionReturn(0);
641cc9df77eSBarry Smith }
642cc9df77eSBarry Smith 
643aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
644cc9df77eSBarry Smith {
645cc9df77eSBarry Smith   PetscErrorCode ierr;
646cc9df77eSBarry Smith 
647cc9df77eSBarry Smith   PetscFunctionBegin;
648cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
649cc9df77eSBarry Smith   PetscFunctionReturn(0);
650cc9df77eSBarry Smith }
651cc9df77eSBarry Smith 
652e5c89e4eSSatish Balay /* -------------------------Default -----------------------------------*/
653e5c89e4eSSatish Balay #else
65499e0435eSBarry Smith 
655e5c89e4eSSatish Balay void PetscDefaultFPTrap(int sig)
656e5c89e4eSSatish Balay {
657e5c89e4eSSatish Balay   PetscFunctionBegin;
658e5c89e4eSSatish Balay   (*PetscErrorPrintf)("*** floating point error occurred ***\n");
659efca3c55SSatish Balay   PetscError(PETSC_COMM_SELF,0,"User provided function","Unknown file",PETSC_ERR_FP,PETSC_ERROR_REPEAT,"floating point error");
66041e02c4dSJunchao Zhang   PETSCABORT(MPI_COMM_WORLD,PETSC_ERR_FP);
661e5c89e4eSSatish Balay }
66299e0435eSBarry Smith 
6637087cfbeSBarry Smith PetscErrorCode  PetscSetFPTrap(PetscFPTrap on)
664e5c89e4eSSatish Balay {
665e5c89e4eSSatish Balay   PetscFunctionBegin;
666e5c89e4eSSatish Balay   if (on == PETSC_FP_TRAP_ON) {
667a297a907SKarl Rupp     if (SIG_ERR == signal(SIGFPE,PetscDefaultFPTrap)) (*PetscErrorPrintf)("Can't set floatingpoint handler\n");
668a297a907SKarl Rupp   } else if (SIG_ERR == signal(SIGFPE,SIG_DFL))       (*PetscErrorPrintf)("Can't clear floatingpoint handler\n");
669a297a907SKarl Rupp 
670670f3ff9SJed Brown   _trapmode = on;
671e5c89e4eSSatish Balay   PetscFunctionReturn(0);
672e5c89e4eSSatish Balay }
673cc9df77eSBarry Smith 
674aba4c478SBarry Smith PetscErrorCode  PetscDetermineInitialFPTrap(void)
675cc9df77eSBarry Smith {
676cc9df77eSBarry Smith   PetscErrorCode ierr;
677cc9df77eSBarry Smith 
678cc9df77eSBarry Smith   PetscFunctionBegin;
679cc9df77eSBarry Smith   ierr = PetscInfo(NULL,"Unable to determine initial floating point trapping. Assuming it is off\n");CHKERRQ(ierr);
680cc9df77eSBarry Smith   PetscFunctionReturn(0);
681cc9df77eSBarry Smith }
682e5c89e4eSSatish Balay #endif
683e5c89e4eSSatish Balay 
684e5c89e4eSSatish Balay 
685e5c89e4eSSatish Balay 
686